external: SETCREDS include creds in externalConfigChanges
This makes the creds get saved, since only things recorded there will be saved. IIRC, unparsedRemoteConfig was not originally available when I implemented this; now that it is things get a bit simpler. More could probably be simplified, is externalConfigChanges needed at all? This does not entirely fix the bugs though, because creds are only embedded when embedcreds=yes, but not when encryption=pubkey is used without embedcreds=yes.
This commit is contained in:
parent
9fb549b3f1
commit
a1d4c8e4ec
4 changed files with 40 additions and 19 deletions
|
@ -45,6 +45,11 @@ git-annex (8.20200523) UNRELEASED; urgency=medium
|
|||
* Fix regression in external special remote handling: GETCONFIG did not
|
||||
return a value that was set with SETCONFIG immediately before.
|
||||
(Regression introduced in version 7.20200202.7)
|
||||
* Fix bug that made initremote of extrnal special remotes with
|
||||
embedcreds=yes or gpg encryption not store the creds in the git-annex
|
||||
branch. git-annex-remote-googledrive one was special remote affected by
|
||||
this bug.
|
||||
(Regression introduced in version 7.20200202.7)
|
||||
|
||||
-- Joey Hess <id@joeyh.name> Tue, 26 May 2020 10:20:52 -0400
|
||||
|
||||
|
|
38
Creds.hs
38
Creds.hs
|
@ -57,20 +57,25 @@ data CredPairStorage = CredPairStorage
|
|||
- if that's going to be done, so that the creds can be encrypted using the
|
||||
- cipher. The EncryptionIsSetup is witness to that being the case.
|
||||
-}
|
||||
setRemoteCredPair :: EncryptionIsSetup -> ParsedRemoteConfig -> RemoteGitConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
|
||||
setRemoteCredPair encsetup pc = setRemoteCredPair' id (const pc) encsetup (unparsedRemoteConfig pc)
|
||||
|
||||
setRemoteCredPair'
|
||||
:: (ProposedAccepted String -> a)
|
||||
-> (M.Map RemoteConfigField a -> ParsedRemoteConfig)
|
||||
-> EncryptionIsSetup
|
||||
-> M.Map RemoteConfigField a
|
||||
setRemoteCredPair
|
||||
:: EncryptionIsSetup
|
||||
-> ParsedRemoteConfig
|
||||
-> RemoteGitConfig
|
||||
-> CredPairStorage
|
||||
-> Maybe CredPair
|
||||
-> Annex (M.Map RemoteConfigField a)
|
||||
setRemoteCredPair' mkval parseconfig encsetup c gc storage mcreds = case mcreds of
|
||||
Nothing -> maybe (return c) (setRemoteCredPair' mkval parseconfig encsetup c gc storage . Just)
|
||||
-> Annex RemoteConfig
|
||||
setRemoteCredPair encsetup pc gc storage mcreds = unparsedRemoteConfig <$>
|
||||
setRemoteCredPair' pc encsetup gc storage mcreds
|
||||
|
||||
setRemoteCredPair'
|
||||
:: ParsedRemoteConfig
|
||||
-> EncryptionIsSetup
|
||||
-> RemoteGitConfig
|
||||
-> CredPairStorage
|
||||
-> Maybe CredPair
|
||||
-> Annex ParsedRemoteConfig
|
||||
setRemoteCredPair' pc encsetup gc storage mcreds = case mcreds of
|
||||
Nothing -> maybe (return pc) (setRemoteCredPair' pc encsetup gc storage . Just)
|
||||
=<< getRemoteCredPair pc gc storage
|
||||
Just creds
|
||||
| embedCreds pc -> do
|
||||
|
@ -79,7 +84,7 @@ setRemoteCredPair' mkval parseconfig encsetup c gc storage mcreds = case mcreds
|
|||
storeconfig creds key =<< remoteCipher pc gc
|
||||
| otherwise -> do
|
||||
localcache creds
|
||||
return c
|
||||
return pc
|
||||
where
|
||||
localcache creds = writeCacheCredPair creds storage
|
||||
|
||||
|
@ -88,11 +93,14 @@ setRemoteCredPair' mkval parseconfig encsetup c gc storage mcreds = case mcreds
|
|||
s <- liftIO $ encrypt cmd (pc, gc) cipher
|
||||
(feedBytes $ L.pack $ encodeCredPair creds)
|
||||
(readBytesStrictly $ return . S.unpack)
|
||||
return $ M.insert key (mkval (Accepted (toB64 s))) c
|
||||
storeconfig' key (Accepted (toB64 s))
|
||||
storeconfig creds key Nothing =
|
||||
return $ M.insert key (mkval (Accepted (toB64 $ encodeCredPair creds))) c
|
||||
storeconfig' key (Accepted (toB64 $ encodeCredPair creds))
|
||||
|
||||
pc = parseconfig c
|
||||
storeconfig' key val = return $ pc
|
||||
{ parsedRemoteConfigMap = M.insert key (RemoteConfigValue val) (parsedRemoteConfigMap pc)
|
||||
, unparsedRemoteConfig = M.insert key val (unparsedRemoteConfig pc)
|
||||
}
|
||||
|
||||
{- Gets a remote's credpair, from the environment if set, otherwise
|
||||
- from the cache in gitAnnexCredsDir, or failing that, from the
|
||||
|
|
|
@ -420,7 +420,7 @@ handleRequest' st external req mp responsehandler
|
|||
c
|
||||
in ParsedRemoteConfig m' c'
|
||||
modifyTVar' (externalConfigChanges st) $ \f ->
|
||||
f . M.insert (Accepted setting) (Accepted value)
|
||||
M.insert (Accepted setting) (Accepted value) . f
|
||||
handleRemoteRequest (GETCONFIG setting) = do
|
||||
value <- maybe "" fromProposedAccepted
|
||||
. (M.lookup (Accepted setting))
|
||||
|
@ -430,11 +430,18 @@ handleRequest' st external req mp responsehandler
|
|||
handleRemoteRequest (SETCREDS setting login password) = case (externalUUID external, externalGitConfig external) of
|
||||
(Just u, Just gc) -> do
|
||||
let v = externalConfig st
|
||||
(ParsedRemoteConfig m c) <- liftIO $ atomically $ readTVar v
|
||||
m' <- setRemoteCredPair' RemoteConfigValue (\m' -> ParsedRemoteConfig m' c) encryptionAlreadySetup m gc
|
||||
pc <- liftIO $ atomically $ readTVar v
|
||||
pc' <- setRemoteCredPair' pc encryptionAlreadySetup gc
|
||||
(credstorage setting u)
|
||||
(Just (login, password))
|
||||
void $ liftIO $ atomically $ swapTVar v (ParsedRemoteConfig m' c)
|
||||
let configchanges = M.differenceWithKey
|
||||
(\_k a b -> if a == b then Nothing else Just a)
|
||||
(unparsedRemoteConfig pc')
|
||||
(unparsedRemoteConfig pc)
|
||||
void $ liftIO $ atomically $ do
|
||||
_ <- swapTVar v pc'
|
||||
modifyTVar' (externalConfigChanges st) $ \f ->
|
||||
M.union configchanges . f
|
||||
_ -> senderror "cannot send SETCREDS here"
|
||||
handleRemoteRequest (GETCREDS setting) = case (externalUUID external, externalGitConfig external) of
|
||||
(Just u, Just gc) -> do
|
||||
|
|
|
@ -36,6 +36,7 @@ data EncryptionMethod
|
|||
|
||||
-- XXX ideally, this would be a locked memory region
|
||||
data Cipher = Cipher String | MacOnlyCipher String
|
||||
deriving (Show) -- XXXDO NOT COMMIT
|
||||
|
||||
data StorableCipher
|
||||
= EncryptedCipher String EncryptedCipherVariant KeyIds
|
||||
|
|
Loading…
Reference in a new issue