plumb RemoteGitConfig through to encryptCipher
This commit is contained in:
parent
b9ce477fa2
commit
0d0a796d63
2 changed files with 23 additions and 13 deletions
32
Crypto.hs
32
Crypto.hs
|
@ -3,7 +3,7 @@
|
||||||
- Currently using gpg; could later be modified to support different
|
- Currently using gpg; could later be modified to support different
|
||||||
- crypto backends if neccessary.
|
- crypto backends if neccessary.
|
||||||
-
|
-
|
||||||
- Copyright 2011-2014 Joey Hess <id@joeyh.name>
|
- Copyright 2011-2016 Joey Hess <id@joeyh.name>
|
||||||
-
|
-
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -73,11 +73,11 @@ cipherMac (Cipher c) = take cipherBeginning c
|
||||||
cipherMac (MacOnlyCipher c) = c
|
cipherMac (MacOnlyCipher c) = c
|
||||||
|
|
||||||
{- Creates a new Cipher, encrypted to the specified key id. -}
|
{- Creates a new Cipher, encrypted to the specified key id. -}
|
||||||
genEncryptedCipher :: Gpg.GpgCmd -> Gpg.KeyId -> EncryptedCipherVariant -> Bool -> IO StorableCipher
|
genEncryptedCipher :: LensGpgEncParams c => Gpg.GpgCmd -> c -> Gpg.KeyId -> EncryptedCipherVariant -> Bool -> IO StorableCipher
|
||||||
genEncryptedCipher cmd keyid variant highQuality = do
|
genEncryptedCipher cmd c keyid variant highQuality = do
|
||||||
ks <- Gpg.findPubKeys cmd keyid
|
ks <- Gpg.findPubKeys cmd keyid
|
||||||
random <- Gpg.genRandom cmd highQuality size
|
random <- Gpg.genRandom cmd highQuality size
|
||||||
encryptCipher cmd (mkCipher random) variant ks
|
encryptCipher cmd c (mkCipher random) variant ks
|
||||||
where
|
where
|
||||||
(mkCipher, size) = case variant of
|
(mkCipher, size) = case variant of
|
||||||
Hybrid -> (Cipher, cipherSize) -- used for MAC + symmetric
|
Hybrid -> (Cipher, cipherSize) -- used for MAC + symmetric
|
||||||
|
@ -105,7 +105,7 @@ updateCipherKeyIds _ _ [] c = return c
|
||||||
updateCipherKeyIds cmd encparams changes encipher@(EncryptedCipher _ variant ks) = do
|
updateCipherKeyIds cmd encparams changes encipher@(EncryptedCipher _ variant ks) = do
|
||||||
ks' <- updateCipherKeyIds' cmd changes ks
|
ks' <- updateCipherKeyIds' cmd changes ks
|
||||||
cipher <- decryptCipher cmd encparams encipher
|
cipher <- decryptCipher cmd encparams encipher
|
||||||
encryptCipher cmd cipher variant ks'
|
encryptCipher cmd encparams cipher variant ks'
|
||||||
updateCipherKeyIds cmd _ changes (SharedPubKeyCipher cipher ks) =
|
updateCipherKeyIds cmd _ changes (SharedPubKeyCipher cipher ks) =
|
||||||
SharedPubKeyCipher cipher <$> updateCipherKeyIds' cmd changes ks
|
SharedPubKeyCipher cipher <$> updateCipherKeyIds' cmd changes ks
|
||||||
|
|
||||||
|
@ -123,15 +123,19 @@ updateCipherKeyIds' cmd changes (KeyIds ks) = do
|
||||||
listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys cmd)
|
listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys cmd)
|
||||||
|
|
||||||
{- Encrypts a Cipher to the specified KeyIds. -}
|
{- Encrypts a Cipher to the specified KeyIds. -}
|
||||||
encryptCipher :: Gpg.GpgCmd -> Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher
|
encryptCipher :: LensGpgEncParams c => Gpg.GpgCmd -> c -> Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher
|
||||||
encryptCipher cmd c variant (KeyIds ks) = do
|
encryptCipher cmd c cip variant (KeyIds ks) = do
|
||||||
-- gpg complains about duplicate recipient keyids
|
-- gpg complains about duplicate recipient keyids
|
||||||
let ks' = nub $ sort ks
|
let ks' = nub $ sort ks
|
||||||
let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False
|
let params = concat
|
||||||
|
[ getGpgEncParamsBase c
|
||||||
|
, Gpg.pkEncTo ks'
|
||||||
|
, Gpg.stdEncryptionParams False
|
||||||
|
]
|
||||||
encipher <- Gpg.pipeStrict cmd params cipher
|
encipher <- Gpg.pipeStrict cmd params cipher
|
||||||
return $ EncryptedCipher encipher variant (KeyIds ks')
|
return $ EncryptedCipher encipher variant (KeyIds ks')
|
||||||
where
|
where
|
||||||
cipher = case c of
|
cipher = case cip of
|
||||||
Cipher x -> x
|
Cipher x -> x
|
||||||
MacOnlyCipher x -> x
|
MacOnlyCipher x -> x
|
||||||
|
|
||||||
|
@ -210,7 +214,11 @@ prop_HmacSha1WithCipher_sane = known_good == macWithCipher' HmacSha1 "foo" "bar"
|
||||||
known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51"
|
known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51"
|
||||||
|
|
||||||
class LensGpgEncParams a where
|
class LensGpgEncParams a where
|
||||||
{- Parameters for encrypting. -}
|
{- Base parameters for encrypting. Does not include specification
|
||||||
|
- of recipient keys. -}
|
||||||
|
getGpgEncParamsBase :: a -> [CommandParam]
|
||||||
|
{- Parameters for encrypting. When the remote is configured to use
|
||||||
|
- public-key encryption, includes specification of recipient keys. -}
|
||||||
getGpgEncParams :: a -> [CommandParam]
|
getGpgEncParams :: a -> [CommandParam]
|
||||||
{- Parameters for decrypting. -}
|
{- Parameters for decrypting. -}
|
||||||
getGpgDecParams :: a -> [CommandParam]
|
getGpgDecParams :: a -> [CommandParam]
|
||||||
|
@ -218,7 +226,8 @@ class LensGpgEncParams a where
|
||||||
{- Extract the GnuPG options from a pair of a Remote Config and a Remote
|
{- Extract the GnuPG options from a pair of a Remote Config and a Remote
|
||||||
- Git Config. -}
|
- Git Config. -}
|
||||||
instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where
|
instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where
|
||||||
getGpgEncParams (c,gc) = map Param (remoteAnnexGnupgOptions gc) ++
|
getGpgEncParamsBase (_c,gc) = map Param (remoteAnnexGnupgOptions gc)
|
||||||
|
getGpgEncParams (c,gc) = getGpgEncParamsBase (c,gc) ++
|
||||||
{- When the remote is configured to use public-key encryption,
|
{- When the remote is configured to use public-key encryption,
|
||||||
- look up the recipient keys and add them to the option list. -}
|
- look up the recipient keys and add them to the option list. -}
|
||||||
case M.lookup "encryption" c of
|
case M.lookup "encryption" c of
|
||||||
|
@ -229,5 +238,6 @@ instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where
|
||||||
|
|
||||||
{- Extract the GnuPG options from a Remote. -}
|
{- Extract the GnuPG options from a Remote. -}
|
||||||
instance LensGpgEncParams (RemoteA a) where
|
instance LensGpgEncParams (RemoteA a) where
|
||||||
|
getGpgEncParamsBase r = getGpgEncParamsBase (config r, gitconfig r)
|
||||||
getGpgEncParams r = getGpgEncParams (config r, gitconfig r)
|
getGpgEncParams r = getGpgEncParams (config r, gitconfig r)
|
||||||
getGpgDecParams r = getGpgDecParams (config r, gitconfig r)
|
getGpgDecParams r = getGpgDecParams (config r, gitconfig r)
|
||||||
|
|
|
@ -63,8 +63,8 @@ encryptionSetup c gc = do
|
||||||
-- hybrid encryption is the default when a keyid is
|
-- hybrid encryption is the default when a keyid is
|
||||||
-- specified but no encryption
|
-- specified but no encryption
|
||||||
_ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
|
_ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
|
||||||
encsetup $ genEncryptedCipher cmd key Hybrid
|
encsetup $ genEncryptedCipher cmd (c, gc) key Hybrid
|
||||||
Just "pubkey" -> encsetup $ genEncryptedCipher cmd key PubKey
|
Just "pubkey" -> encsetup $ genEncryptedCipher cmd (c, gc) key PubKey
|
||||||
Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key
|
Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key
|
||||||
_ -> error $ "Specify " ++ intercalate " or "
|
_ -> error $ "Specify " ++ intercalate " or "
|
||||||
(map ("encryption=" ++)
|
(map ("encryption=" ++)
|
||||||
|
|
Loading…
Add table
Reference in a new issue