wip separate RemoteConfig parsing
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:
parent
4a135934ff
commit
71f78fe45d
10 changed files with 266 additions and 101 deletions
32
Creds.hs
32
Creds.hs
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue