plumb RemoteGitConfig through to setRemoteCredPair

This commit is contained in:
Joey Hess 2016-05-23 17:08:43 -04:00
parent 91df4c6b53
commit 22c174158c
Failed to extract signature
5 changed files with 11 additions and 14 deletions

View file

@ -51,10 +51,10 @@ data CredPairStorage = CredPairStorage
- if that's going to be done, so that the creds can be encrypted using the
- cipher. The EncryptionIsSetup phantom type ensures that is the case.
-}
setRemoteCredPair :: EncryptionIsSetup -> RemoteConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
setRemoteCredPair encsetup c storage mcreds = case mcreds of
Nothing -> maybe (return c) (setRemoteCredPair encsetup c storage . Just)
=<< getRemoteCredPair c nogitconfig storage
setRemoteCredPair :: EncryptionIsSetup -> RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
setRemoteCredPair encsetup c gc storage mcreds = case mcreds of
Nothing -> maybe (return c) (setRemoteCredPair encsetup c gc storage . Just)
=<< getRemoteCredPair c gc storage
Just creds
| embedCreds c -> case credPairRemoteKey storage of
Nothing -> localcache creds
@ -67,16 +67,12 @@ setRemoteCredPair encsetup c storage mcreds = case mcreds of
storeconfig creds key (Just cipher) = do
cmd <- gpgCmd <$> Annex.getGitConfig
s <- liftIO $ encrypt cmd (c, nogitconfig) cipher
s <- liftIO $ encrypt cmd (c, gc) 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
-- This is used before a remote is set up typically, so
-- use a default RemoteGitConfig
nogitconfig :: RemoteGitConfig
nogitconfig = def
{- Gets a remote's credpair, from the environment if set, otherwise
- from the cache in gitAnnexCredsDir, or failing that, from the

View file

@ -241,7 +241,8 @@ handleRequest' lck external req mp responsehandler
send $ VALUE value
handleRemoteRequest (SETCREDS setting login password) = do
c <- liftIO $ atomically $ readTMVar $ externalConfig external
c' <- setRemoteCredPair encryptionAlreadySetup c (credstorage setting) $
gc <- liftIO $ atomically $ readTMVar $ externalGitConfig external
c' <- setRemoteCredPair encryptionAlreadySetup c gc (credstorage setting) $
Just (login, password)
void $ liftIO $ atomically $ swapTMVar (externalConfig external) c'
handleRemoteRequest (GETCREDS setting) = do

View file

@ -85,7 +85,7 @@ glacierSetup mu mcreds c gc = do
glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
glacierSetup' enabling u mcreds c gc = do
(c', encsetup) <- encryptionSetup c
c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
let fullconfig = c'' `M.union` defaults
unless enabling $
genVault fullconfig gc u

View file

@ -124,7 +124,7 @@ s3Setup' new u mcreds c gc
defaulthost = do
(c', encsetup) <- encryptionSetup c
c'' <- setRemoteCredPair encsetup c' (AWS.creds u) mcreds
c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
let fullconfig = c'' `M.union` defaults
when new $
genBucket fullconfig gc u
@ -132,7 +132,7 @@ s3Setup' new u mcreds c gc
archiveorg = do
showNote "Internet Archive mode"
c' <- setRemoteCredPair noEncryptionUsed c (AWS.creds u) mcreds
c' <- setRemoteCredPair noEncryptionUsed c gc (AWS.creds u) mcreds
-- Ensure user enters a valid bucket name, since
-- this determines the name of the archive.org item.
let validbucket = replace " " "-" $

View file

@ -91,7 +91,7 @@ webdavSetup mu mcreds c gc = do
creds <- maybe (getCreds c' gc u) (return . Just) mcreds
testDav url creds
gitConfigSpecialRemote u c' "webdav" "true"
c'' <- setRemoteCredPair encsetup c' (davCreds u) creds
c'' <- setRemoteCredPair encsetup c' gc (davCreds u) creds
return (c'', u)
-- Opens a http connection to the DAV server, which will be reused