include creds location in info

This is intended to let the user easily tell if a remote's creds are
coming from info embedded in the repository, or instead from the
environment, or perhaps are locally stored in a creds file.

This commit was sponsored by Frédéric Schütz.

3 files changed, 30 insertions, 5 deletions

diff --git a/Creds.hs b/Creds.hs
index 5e6c54ecc..64ff3ffeb 100644
--- a/Creds.hs
+++ b/Creds.hs
@@ -15,6 +15,7 @@ module Creds (
 	writeCacheCreds,
 	readCacheCreds,
 	removeCreds,
+	includeCredsInfo,
 ) where
 
 import Common.Annex
@@ -144,10 +145,16 @@ readCacheCredPair storage = maybe Nothing decodeCredPair
 	<$> readCacheCreds (credPairFile storage)
 
 readCacheCreds :: FilePath -> Annex (Maybe Creds)
-readCacheCreds file = do
+readCacheCreds f = liftIO . catchMaybeIO . readFile =<< cacheCredsFile f
+
+cacheCredsFile :: FilePath -> Annex FilePath
+cacheCredsFile basefile = do
 	d <- fromRepo gitAnnexCredsDir
-	let f = d </> file
-	liftIO $ catchMaybeIO $ readFile f
+	return $ d </> basefile
+
+existsCacheCredPair :: CredPairStorage -> Annex Bool
+existsCacheCredPair storage = 
+	liftIO . doesFileExist =<< cacheCredsFile (credPairFile storage)
 
 encodeCredPair :: CredPair -> Creds
 encodeCredPair (l, p) = unlines [l, p]
@@ -162,3 +169,19 @@ removeCreds file = do
 	d <- fromRepo gitAnnexCredsDir
 	let f = d </> file
 	liftIO $ nukeFile f
+
+includeCredsInfo :: RemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)]
+includeCredsInfo c storage info = do
+	v <- liftIO $ getEnvCredPair storage
+	case v of
+		Just _ -> do
+			let (uenv, penv) = credPairEnvironment storage
+			ret $ "from environment variables (" ++ unwords [uenv, penv] ++ ")"
+		Nothing -> case (\ck -> M.lookup ck c) =<< credPairRemoteKey storage of
+			Nothing -> ifM (existsCacheCredPair storage)
+				( ret "stored locally"
+				, ret "not available"
+				)
+			Just _ -> ret "embedded in git repository"
+  where
+	ret s = return $ ("creds", s) : info
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 154fb1ed4..5a956a5df 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -72,7 +72,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			availability = GloballyAvailable,
 			remotetype = remote,
 			mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc,
-			getInfo = return [("bucket", fromMaybe "unknown" (getBucket c))]
+			getInfo = includeCredsInfo c (AWS.creds u)
+				[ ("bucket", fromMaybe "unknown" (getBucket c)) ]
 		}
 
 s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
diff --git a/debian/changelog b/debian/changelog
index 35277539f..66629983c 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -14,7 +14,8 @@ git-annex (5.20141014) UNRELEASED; urgency=medium
   * info: When run on a single annexed file, displays some info about the 
     file, including its key and size.
   * info: When passed the name or uuid of a remote, displays info about that
-    remote.
+    remote. Remotes that support encryption, chunking, or embedded
+    creds will include that in their info.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 14 Oct 2014 14:09:24 -0400