diff options
| -rw-r--r-- | Creds.hs | 29 | ||||
| -rw-r--r-- | Remote/S3.hs | 3 | ||||
| -rw-r--r-- | debian/changelog | 3 |
3 files changed, 30 insertions, 5 deletions
@@ -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 |