mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

wip separate RemoteConfig parsing

Browse source 
Remote now contains a ParsedRemoteConfig. The parsing happens when the
Remote is constructed, rather than when individual configs are used.

This is more efficient, and it lets initremote/enableremote
reject configs that have unknown fields or unparsable values.

It also allows for improved type safety, as shown in
Remote.Helper.Encryptable where things that used to match on string
configs now match on data types.

This is a work in progress, it does not build yet.

The main risk in this conversion is forgetting to add a field to
RemoteConfigParser. That will prevent using that field with
initremote/enableremote, and will prevent remotes that already are set
up from seeing that configuration. So will need to check carefully that
every field that getRemoteConfigValue is called on has been added to
RemoteConfigParser.

(One such case I need to remember is that credPairRemoteField needs to be
included in the RemoteConfigParser.)
This commit is contained in:
Joey Hess 2020-01-13 12:35:39 -04:00
parent 4a135934ff
commit 71f78fe45d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
10 changed files with 266 additions and 101 deletions
Download patch file Download diff file Expand all files Collapse all files

32
Creds.hs
View file

@ -23,12 +23,14 @@ module Creds (
import Annex.Common
import qualified Annex
import Types.Creds
import Types.RemoteConfig
import Config.RemoteConfig
import Annex.Perms
import Utility.FileMode
import Crypto
import Types.Remote (RemoteConfig, RemoteConfigField)
import Types.ProposedAccepted
import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher)
import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher, encryptionConfigParser)
import Utility.Env (getEnv)
import qualified Data.ByteString.Lazy.Char8 as L
@ -56,30 +58,34 @@ data CredPairStorage = CredPairStorage
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
=<< getRemoteCredPair pc gc storage
Just creds
| embedCreds c ->
| embedCreds pc -> do
let key = credPairRemoteField storage
in storeconfig creds key =<< flip remoteCipher gc =<< localcache creds
| otherwise -> localcache creds
localcache creds
storeconfig creds key =<< remoteCipher pc gc
| otherwise -> do
localcache creds
return c
where
localcache creds = do
writeCacheCredPair creds storage
return c
localcache creds = writeCacheCredPair creds storage
storeconfig creds key (Just cipher) = do
cmd <- gpgCmd <$> Annex.getGitConfig
s <- liftIO $ encrypt cmd (c, gc) cipher
s <- liftIO $ encrypt cmd (pc, gc) cipher
(feedBytes $ L.pack $ encodeCredPair creds)
(readBytes $ return . L.unpack)
return $ M.insert key (Accepted (toB64 s)) c
storeconfig creds key Nothing =
return $ M.insert key (Accepted (toB64 $ encodeCredPair creds)) c
pc = either (const mempty) id
(parseRemoteConfig c encryptionConfigParser)
{- 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 -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
getRemoteCredPair :: ParsedRemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
where
fromenv = liftIO $ getEnvCredPair storage
@ -87,7 +93,7 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
fromconfig = do
let key = credPairRemoteField storage
mcipher <- remoteCipher' c gc
case (fromProposedAccepted <$> M.lookup key c, mcipher) of
case (fromProposedAccepted <$> getRemoteConfigValue key c, mcipher) of
(Nothing, _) -> return Nothing
(Just enccreds, Just (cipher, storablecipher)) ->
fromenccreds enccreds cipher storablecipher
@ -115,7 +121,7 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
return $ Just credpair
_ -> error "bad creds"
getRemoteCredPairFor :: String -> RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
getRemoteCredPairFor :: String -> ParsedRemoteConfig -> RemoteGitConfig -> CredPairStorage -> Annex (Maybe CredPair)
getRemoteCredPairFor this c gc storage = go =<< getRemoteCredPair c gc storage
where
go Nothing = do
@ -184,7 +190,7 @@ removeCreds file = do
let f = d </> file
liftIO $ nukeFile f
includeCredsInfo :: RemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)]
includeCredsInfo :: ParsedRemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)]
includeCredsInfo c storage info = do
v <- liftIO $ getEnvCredPair storage
case v of