summaryrefslogtreecommitdiff
path: root/Creds.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-05-23 17:03:20 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-05-23 17:03:20 -0400
commitd5f672ddd59b43cb9b1bac8f836864165c8931f2 (patch)
tree6a020605b69d22252d2b9d619115326848a779c1 /Creds.hs
parent7e637c86630b65621d301afb174cd95efe567130 (diff)
Pass the various gnupg-options configs to gpg in several cases where they were not before.
Removed the instance LensGpgEncParams RemoteConfig because it encouraged code that does not take the RemoteGitConfig into account. RemoteType's setup was changed to take a RemoteGitConfig, although the only place that is able to provide a non-empty one is enableremote, when it's changing an existing remote. This led to several folow-on changes, and got RemoteGitConfig plumbed through.
Diffstat (limited to 'Creds.hs')
-rw-r--r--Creds.hs38
1 files changed, 21 insertions, 17 deletions
diff --git a/Creds.hs b/Creds.hs
index 6a2eaafd5..a72c704e8 100644
--- a/Creds.hs
+++ b/Creds.hs
@@ -52,33 +52,37 @@ data CredPairStorage = CredPairStorage
- cipher. The EncryptionIsSetup phantom type ensures that is the case.
-}
setRemoteCredPair :: EncryptionIsSetup -> RemoteConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
-setRemoteCredPair encsetup c storage Nothing =
- maybe (return c) (setRemoteCredPair encsetup c storage . Just)
- =<< getRemoteCredPair c storage
-setRemoteCredPair _ c storage (Just creds)
- | embedCreds c = case credPairRemoteKey storage of
- Nothing -> localcache
- Just key -> storeconfig key =<< remoteCipher =<< localcache
- | otherwise = localcache
+setRemoteCredPair encsetup c storage mcreds = case mcreds of
+ Nothing -> maybe (return c) (setRemoteCredPair encsetup c storage . Just)
+ =<< getRemoteCredPair c nogitconfig storage
+ Just creds
+ | embedCreds c -> case credPairRemoteKey storage of
+ Nothing -> localcache creds
+ Just key -> storeconfig creds key =<< remoteCipher =<< localcache creds
+ | otherwise -> localcache creds
where
- localcache = do
+ localcache creds = do
writeCacheCredPair creds storage
return c
- storeconfig key (Just cipher) = do
+ storeconfig creds key (Just cipher) = do
cmd <- gpgCmd <$> Annex.getGitConfig
- s <- liftIO $ encrypt cmd (getGpgEncParams c) cipher
+ s <- liftIO $ encrypt cmd (c, nogitconfig) cipher
(feedBytes $ L.pack $ encodeCredPair creds)
(readBytes $ return . L.unpack)
return $ M.insert key (toB64 s) c
- storeconfig key Nothing =
+ 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
- value in RemoteConfig. -}
-getRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
-getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
+getRemoteCredPair :: RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
where
fromenv = liftIO $ getEnvCredPair storage
fromcache = maybe fromconfig (return . Just) =<< readCacheCredPair storage
@@ -94,7 +98,7 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
Nothing -> return Nothing
fromenccreds enccreds cipher storablecipher = do
cmd <- gpgCmd <$> Annex.getGitConfig
- mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (getGpgDecParams c) cipher
+ mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (c, gc) cipher
(feedBytes $ L.pack $ fromB64 enccreds)
(readBytes $ return . L.unpack)
case mcreds of
@@ -114,8 +118,8 @@ getRemoteCredPair c storage = maybe fromcache (return . Just) =<< fromenv
return $ Just credpair
_ -> error "bad creds"
-getRemoteCredPairFor :: String -> RemoteConfig -> CredPairStorage -> Annex (Maybe CredPair)
-getRemoteCredPairFor this c storage = go =<< getRemoteCredPair c storage
+getRemoteCredPairFor :: String -> RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
+getRemoteCredPairFor this c gc storage = go =<< getRemoteCredPair c gc storage
where
go Nothing = do
warnMissingCredPairFor this storage