summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-09-26 14:42:51 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-09-26 14:42:51 -0400
commit3034bea385d32ec2ee63f53f33dd208ce77195db (patch)
tree02e674b8dca7aea61730b289bfeca0aa0e27cea9
parent4e48ea601400dac5f432b1eaa454acd219a029ad (diff)
change s3 creds caching
Rather than store decrypted creds in the environment, store them in the creds cache file. This way, a single git-annex can have multiple S3 remotes using different creds.
-rw-r--r--Remote/S3.hs75
1 files changed, 42 insertions, 33 deletions
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 1f33b3323..c4da0b2ec 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Remote.S3 (remote) where
+module Remote.S3 (remote, s3SetCredsEnv) where
import Network.AWS.AWSConnection
import Network.AWS.S3Object
@@ -274,42 +274,39 @@ s3Connection c u = do
[(p, _)] -> p
_ -> error $ "bad S3 port value: " ++ s
-{- S3 creds come from the environment if set.
- - Otherwise, might be stored encrypted in the remote's config, or
- - locally in gitAnnexCredsDir. -}
+{- S3 creds come from the environment if set, otherwise from the cache
+ - in gitAnnexCredsDir, or failing that, might be stored encrypted in
+ - the remote's config. -}
s3GetCreds :: RemoteConfig -> UUID -> Annex (Maybe (String, String))
-s3GetCreds c u = maybe fromconfig (return . Just) =<< liftIO getenv
+s3GetCreds c u = maybe fromcache (return . Just) =<< liftIO getenv
where
getenv = liftM2 (,)
<$> get s3AccessKey
<*> get s3SecretKey
where
get = catchMaybeIO . getEnv
- cache (ak, sk) = do
- setEnv s3AccessKey ak True
- setEnv s3SecretKey sk True
- return $ Just (ak, sk)
- fromconfig = do
- mcipher <- remoteCipher c
- case (M.lookup "s3creds" c, mcipher) of
- (Just s3creds, Just cipher) ->
- liftIO $ decrypt s3creds cipher
- _ -> fromcredsfile
- fromcredsfile = do
+ fromcache = do
d <- fromRepo gitAnnexCredsDir
let f = d </> fromUUID u
v <- liftIO $ catchMaybeIO $ readFile f
case lines <$> v of
- Just (ak:sk:[]) -> liftIO $ cache (ak, sk)
+ Just (ak:sk:[]) -> return $ Just (ak, sk)
+ _ -> fromconfig
+ fromconfig = do
+ mcipher <- remoteCipher c
+ case (M.lookup "s3creds" c, mcipher) of
+ (Just s3creds, Just cipher) -> do
+ creds <- liftIO $ decrypt s3creds cipher
+ case creds of
+ [ak, sk] -> do
+ s3CacheCreds (ak, sk) u
+ return $ Just (ak, sk)
+ _ -> do error "bad s3creds"
_ -> return Nothing
- decrypt s3creds cipher = do
- creds <- lines <$>
- withDecryptedContent cipher
- (return $ L.pack $ fromB64 s3creds)
- (return . L.unpack)
- case creds of
- [ak, sk] -> cache (ak, sk)
- _ -> do error "bad s3creds"
+ decrypt s3creds cipher = lines <$>
+ withDecryptedContent cipher
+ (return $ L.pack $ fromB64 s3creds)
+ (return . L.unpack)
{- Stores S3 creds encrypted in the remote's config if possible to do so
- securely, and otherwise locally in gitAnnexCredsDir. -}
@@ -326,17 +323,29 @@ s3SetCreds c u = do
(return . L.unpack)
return $ M.insert "s3creds" (toB64 s) c
_ -> do
- d <- fromRepo gitAnnexCredsDir
- createAnnexDirectory d
- let f = d </> fromUUID u
- h <- liftIO $ openFile f WriteMode
- liftIO $ modifyFileMode f $ removeModes
- [groupReadMode, otherReadMode]
- liftIO $ hPutStr h $ unlines [ak, sk]
- liftIO $ hClose h
+ s3CacheCreds (ak, sk) u
return c
_ -> return c
+{- The S3 creds are cached in gitAnnexCredsDir. -}
+s3CacheCreds :: (String, String) -> UUID -> Annex ()
+s3CacheCreds (ak, sk) u = do
+ d <- fromRepo gitAnnexCredsDir
+ createAnnexDirectory d
+ liftIO $ do
+ let f = d </> fromUUID u
+ h <- openFile f WriteMode
+ modifyFileMode f $ removeModes
+ [groupReadMode, otherReadMode]
+ hPutStr h $ unlines [ak, sk]
+ hClose h
+
+{- Sets the S3 creds in the environment. -}
+s3SetCredsEnv :: (String, String) -> IO ()
+s3SetCredsEnv (ak, sk) = do
+ setEnv s3AccessKey ak True
+ setEnv s3SecretKey sk True
+
s3AccessKey :: String
s3AccessKey = "AWS_ACCESS_KEY_ID"
s3SecretKey :: String