summaryrefslogtreecommitdiff
path: root/Creds.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-19 17:32:58 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-19 17:32:58 -0400
commitcf415b5bd3dc63b20b5c167eaecfc431786196a3 (patch)
treea0bb86a7130ac7834ca8338b8ac3696e167b1259 /Creds.hs
parent877ca5d739c6a80b1ee91ba00f828bc576e08569 (diff)
Allow controlling whether login credentials for S3 and webdav are committed to the repository, by setting embedcreds=yes|no when running initremote.
Diffstat (limited to 'Creds.hs')
-rw-r--r--Creds.hs51
1 files changed, 30 insertions, 21 deletions
diff --git a/Creds.hs b/Creds.hs
index 0c69fc7a5..dbd05e3ef 100644
--- a/Creds.hs
+++ b/Creds.hs
@@ -12,7 +12,7 @@ import Annex.Perms
import Utility.FileMode
import Crypto
import Types.Remote (RemoteConfig, RemoteConfigKey)
-import Remote.Helper.Encryptable (remoteCipher, isTrustedCipher)
+import Remote.Helper.Encryptable (remoteCipher, embedCreds)
import System.Environment
import System.Posix.Env (setEnv)
@@ -31,26 +31,32 @@ data CredPairStorage = CredPairStorage
, credPairRemoteKey :: Maybe RemoteConfigKey
}
-{- Stores creds in a remote's configuration, if the remote is encrypted
- - with a GPG key. Otherwise, caches them locally. -}
+{- Stores creds in a remote's configuration, if the remote allows
+ - that. Otherwise, caches them locally. -}
setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex RemoteConfig
setRemoteCredPair c storage = go =<< getRemoteCredPair c storage
where
- go (Just creds) = do
- mcipher <- remoteCipher c
- case (mcipher, credPairRemoteKey storage) of
- (Just cipher, Just key) | isTrustedCipher c -> do
- s <- liftIO $ encrypt cipher
- (feedBytes $ L.pack $ encodeCredPair creds)
- (readBytes $ return . L.unpack)
- return $ M.insert key (toB64 s) c
- _ -> do
- writeCacheCredPair creds storage
- return c
+ go (Just creds)
+ | embedCreds c = case credPairRemoteKey storage of
+ Nothing -> localcache creds
+ Just key -> storeconfig creds key =<< remoteCipher c
+ | otherwise = localcache creds
go Nothing = return c
+ localcache creds = do
+ writeCacheCredPair creds storage
+ return c
+
+ storeconfig creds key (Just cipher) = do
+ s <- liftIO $ encrypt cipher
+ (feedBytes $ L.pack $ encodeCredPair creds)
+ (readBytes $ return . L.unpack)
+ return $ M.insert key (toB64 s) c
+ storeconfig creds key Nothing =
+ return $ M.insert key (toB64 $ encodeCredPair creds) c
+
{- Gets a remote's credpair, from the environment if set, otherwise
- - from the cache in gitAnnexCredsDir, or failing that, from the encrypted
+ - from the cache in gitAnnexCredsDir, or failing that, from the
- value in RemoteConfig. -}
getRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
@@ -61,17 +67,20 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
Just key -> do
mcipher <- remoteCipher c
case (M.lookup key c, mcipher) of
+ (Nothing, _) -> return Nothing
(Just enccreds, Just cipher) -> do
creds <- liftIO $ decrypt cipher
(feedBytes $ L.pack $ fromB64 enccreds)
(readBytes $ return . L.unpack)
- case decodeCredPair creds of
- Just credpair -> do
- writeCacheCredPair credpair storage
- return $ Just credpair
- _ -> do error $ "bad " ++ key
- _ -> return Nothing
+ fromcreds creds
+ (Just bcreds, Nothing) ->
+ fromcreds $ fromB64 bcreds
Nothing -> return Nothing
+ fromcreds creds = case decodeCredPair creds of
+ Just credpair -> do
+ writeCacheCredPair credpair storage
+ return $ Just credpair
+ _ -> do error $ "bad creds"
{- Gets a CredPair from the environment. -}
getEnvCredPair :: CredPairStorage -> IO (Maybe CredPair)