From 063d84ddd33f1aa0624cf5f363f2c58397b98562 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 23 May 2016 17:08:43 -0400 Subject: plumb RemoteGitConfig through to setRemoteCredPair --- Creds.hs | 14 +++++--------- Remote/External.hs | 3 ++- Remote/Glacier.hs | 2 +- Remote/S3.hs | 4 ++-- Remote/WebDAV.hs | 2 +- 5 files changed, 11 insertions(+), 14 deletions(-) diff --git a/Creds.hs b/Creds.hs index a72c704e8..72e177abc 100644 --- a/Creds.hs +++ b/Creds.hs @@ -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 diff --git a/Remote/External.hs b/Remote/External.hs index 04834c78f..26858a7f0 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -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 diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 800b16875..234b750d4 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -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 diff --git a/Remote/S3.hs b/Remote/S3.hs index cf662c3d1..3ed46a2ad 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -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 " " "-" $ diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 08b1a5496..413516e89 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -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 -- cgit v1.2.3