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.
This commit is contained in:
parent
16efe45a35
commit
91df4c6b53
24 changed files with 140 additions and 126 deletions
38
Creds.hs
38
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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue