diff options
author | 2012-11-14 19:32:27 -0400 | |
---|---|---|
committer | 2012-11-14 19:32:27 -0400 | |
commit | 50548a7496bd72dcdd5b582f88c9bcad3522f3f9 (patch) | |
tree | 82e32a34601713b2ee49f352bfcaf93b91721727 /Remote/S3.hs | |
parent | db1f42f93da8749282e58194eb57dc3e7cb03484 (diff) |
factor out Creds
Diffstat (limited to 'Remote/S3.hs')
-rw-r--r-- | Remote/S3.hs | 105 |
1 files changed, 18 insertions, 87 deletions
diff --git a/Remote/S3.hs b/Remote/S3.hs index 0c9d523b8..b05de6ad4 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -14,8 +14,6 @@ import Network.AWS.AWSResult import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M import Data.Char -import System.Environment -import System.Posix.Env (setEnv) import Common.Annex import Types.Remote @@ -25,10 +23,8 @@ import Config import Remote.Helper.Special import Remote.Helper.Encryptable import Crypto +import Creds import Annex.Content -import Utility.Base64 -import Annex.Perms -import Utility.FileMode remote :: RemoteType remote = RemoteType { @@ -87,7 +83,7 @@ s3Setup u c = handlehost $ M.lookup "host" c use fullconfig = do gitConfigSpecialRemote u fullconfig "s3" "true" - s3SetCreds fullconfig u + setRemoteCredPair fullconfig (s3Creds u) defaulthost = do c' <- encryptionSetup c @@ -257,93 +253,28 @@ s3ConnectionRequired c u = maybe (error "Cannot connect to S3") return =<< s3Connection c u s3Connection :: RemoteConfig -> UUID -> Annex (Maybe AWSConnection) -s3Connection c u = do - creds <- s3GetCreds c u - case creds of - Just (ak, sk) -> return $ Just $ AWSConnection host port ak sk - _ -> do - warning $ "Set both " ++ s3AccessKey ++ " and " ++ s3SecretKey ++ " to use S3" - return Nothing +s3Connection c u = go =<< getRemoteCredPair c creds where + go Nothing = do + warning $ "Set both " ++ s3AccessKey ++ " and " ++ s3SecretKey ++ " to use S3" + return Nothing + go (Just (ak, sk)) = return $ Just $ AWSConnection host port ak sk + + creds = s3Creds u + (s3AccessKey, s3SecretKey) = credPairEnvironment creds + host = fromJust $ M.lookup "host" c port = let s = fromJust $ M.lookup "port" c in case reads s of [(p, _)] -> p _ -> error $ "bad S3 port value: " ++ s -{- 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 fromcache (return . Just) =<< liftIO getenv - where - getenv = liftM2 (,) - <$> get s3AccessKey - <*> get s3SecretKey - where - get = catchMaybeIO . getEnv - fromcache = do - d <- fromRepo gitAnnexCredsDir - let f = d </> fromUUID u - v <- liftIO $ catchMaybeIO $ readFile f - case lines <$> v of - 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 = 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. -} -s3SetCreds :: RemoteConfig -> UUID -> Annex RemoteConfig -s3SetCreds c u = do - creds <- s3GetCreds c u - case creds of - Just (ak, sk) -> do - mcipher <- remoteCipher c - case mcipher of - Just cipher | isTrustedCipher c -> do - s <- liftIO $ withEncryptedContent cipher - (return $ L.pack $ unlines [ak, sk]) - (return . L.unpack) - return $ M.insert "s3creds" (toB64 s) c - _ -> do - 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 +s3Creds :: UUID -> CredPairStorage +s3Creds u = CredPairStorage + { credPairFile = fromUUID u + , credPairEnvironment = ("AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY") + , credPairRemoteKey = Just "s3creds" + } -{- 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 -s3SecretKey = "AWS_SECRET_ACCESS_KEY" +s3SetCredsEnv creds = setEnvCredPair creds $ s3Creds undefined |