diff options
Diffstat (limited to 'Crypto.hs')
| -rw-r--r-- | Crypto.hs | 126 |
1 files changed, 87 insertions, 39 deletions
@@ -8,6 +8,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE FlexibleInstances #-} + module Crypto ( Cipher, KeyIds(..), @@ -22,9 +24,8 @@ module Crypto ( feedBytes, readBytes, encrypt, - decrypt, - GpgOpts(..), - getGpgOpts, + decrypt, + getGpgEncParams, prop_HmacSha1WithCipher_sane ) where @@ -32,17 +33,18 @@ module Crypto ( import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.UTF8 (fromString) import Control.Applicative +import qualified Data.Map as M import Common.Annex import qualified Utility.Gpg as Gpg -import Utility.Gpg.Types import Types.Key import Types.Crypto +import Types.Remote {- The beginning of a Cipher is used for MAC'ing; the remainder is used - - as the GPG symmetric encryption passphrase. Note that the cipher - - itself is base-64 encoded, hence the string is longer than - - 'cipherSize': 683 characters, padded to 684. + - as the GPG symmetric encryption passphrase when using the hybrid + - scheme. Note that the cipher itself is base-64 encoded, hence the + - string is longer than 'cipherSize': 683 characters, padded to 684. - - The 256 first characters that feed the MAC represent at best 192 - bytes of entropy. However that's more than enough for both the @@ -62,59 +64,79 @@ cipherSize = 512 cipherPassphrase :: Cipher -> String cipherPassphrase (Cipher c) = drop cipherBeginning c +cipherPassphrase (MacOnlyCipher _) = error "MAC-only cipher" cipherMac :: Cipher -> String cipherMac (Cipher c) = take cipherBeginning c +cipherMac (MacOnlyCipher c) = c {- Creates a new Cipher, encrypted to the specified key id. -} -genEncryptedCipher :: String -> Bool -> IO StorableCipher -genEncryptedCipher keyid highQuality = do +genEncryptedCipher :: String -> EncryptedCipherVariant -> Bool -> IO StorableCipher +genEncryptedCipher keyid variant highQuality = do ks <- Gpg.findPubKeys keyid - random <- Gpg.genRandom highQuality cipherSize - encryptCipher (Cipher random) ks + random <- Gpg.genRandom highQuality size + encryptCipher (mkCipher random) variant ks + where + (mkCipher, size) = case variant of + Hybrid -> (Cipher, cipherSize) -- used for MAC + symmetric + PubKey -> (MacOnlyCipher, cipherBeginning) -- only used for MAC {- Creates a new, shared Cipher. -} genSharedCipher :: Bool -> IO StorableCipher genSharedCipher highQuality = SharedCipher <$> Gpg.genRandom highQuality cipherSize -{- Updates an existing Cipher, re-encrypting it to add a keyid. -} -updateEncryptedCipher :: String -> StorableCipher -> IO StorableCipher -updateEncryptedCipher _ (SharedCipher _) = undefined -updateEncryptedCipher keyid encipher@(EncryptedCipher _ ks) = do - ks' <- Gpg.findPubKeys keyid +{- Updates an existing Cipher, re-encrypting it to add or remove keyids, + - depending on whether the first component is True or False. -} +updateEncryptedCipher :: [(Bool, String)] -> StorableCipher -> IO StorableCipher +updateEncryptedCipher _ SharedCipher{} = undefined +updateEncryptedCipher [] encipher = return encipher +updateEncryptedCipher newkeys encipher@(EncryptedCipher _ variant (KeyIds ks)) = do + dropKeys <- listKeyIds [ k | (False, k) <- newkeys ] + forM_ dropKeys $ \k -> unless (k `elem` ks) $ + error $ "Key " ++ k ++ " was not present; cannot remove." + addKeys <- listKeyIds [ k | (True, k) <- newkeys ] + let ks' = (addKeys ++ ks) \\ dropKeys + when (null ks') $ + error "Cannot remove the last key." cipher <- decryptCipher encipher - encryptCipher cipher (merge ks ks') + encryptCipher cipher variant $ KeyIds ks' where - merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b + listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys) describeCipher :: StorableCipher -> String describeCipher (SharedCipher _) = "shared cipher" -describeCipher (EncryptedCipher _ (KeyIds ks)) = - "with gpg " ++ keys ks ++ " " ++ unwords ks +describeCipher (EncryptedCipher _ variant (KeyIds ks)) = + scheme ++ " with gpg " ++ keys ks ++ " " ++ unwords ks where + scheme = case variant of + Hybrid -> "hybrid cipher" + PubKey -> "pubkey crypto" keys [_] = "key" keys _ = "keys" {- Encrypts a Cipher to the specified KeyIds. -} -encryptCipher :: Cipher -> KeyIds -> IO StorableCipher -encryptCipher (Cipher c) (KeyIds ks) = do +encryptCipher :: Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher +encryptCipher c variant (KeyIds ks) = do -- gpg complains about duplicate recipient keyids let ks' = nub $ sort ks - encipher <- Gpg.pipeStrict (Params "--encrypt" : recipients ks') c - return $ EncryptedCipher encipher (KeyIds ks') + let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False + encipher <- Gpg.pipeStrict params cipher + return $ EncryptedCipher encipher variant (KeyIds ks') where - recipients l = force_recipients : - concatMap (\k -> [Param "--recipient", Param k]) l - -- Force gpg to only encrypt to the specified - -- recipients, not configured defaults. - force_recipients = Params "--no-encrypt-to --no-default-recipient" + cipher = case c of + Cipher x -> x + MacOnlyCipher x -> x {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -} decryptCipher :: StorableCipher -> IO Cipher decryptCipher (SharedCipher t) = return $ Cipher t -decryptCipher (EncryptedCipher t _) = - Cipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t +decryptCipher (EncryptedCipher t variant _) = + mkCipher <$> Gpg.pipeStrict [ Param "--decrypt" ] t + where + mkCipher = case variant of + Hybrid -> Cipher + PubKey -> MacOnlyCipher {- Generates an encrypted form of a Key. The encryption does not need to be - reversable, nor does it need to be the same type of encryption used @@ -139,17 +161,25 @@ feedBytes = flip L.hPut readBytes :: (L.ByteString -> IO a) -> Reader a readBytes a h = L.hGetContents h >>= a -{- Runs a Feeder action, that generates content that is symmetrically encrypted - - with the Cipher using the given GnuPG options, and then read by the Reader - - action. -} -encrypt :: GpgOpts -> Cipher -> Feeder -> Reader a -> IO a -encrypt opts = Gpg.feedRead ( Params "--symmetric --force-mdc" : toParams opts ) - . cipherPassphrase +{- Runs a Feeder action, that generates content that is symmetrically + - encrypted with the Cipher (unless it is empty, in which case + - public-key encryption is used) using the given gpg options, and then + - read by the Reader action. Note: For public-key encryption, + - recipients MUST be included in 'params' (for instance using + - 'getGpgEncParams'). -} +encrypt :: [CommandParam] -> Cipher -> Feeder -> Reader a -> IO a +encrypt params cipher = case cipher of + Cipher{} -> Gpg.feedRead (params ++ Gpg.stdEncryptionParams True) $ + cipherPassphrase cipher + MacOnlyCipher{} -> Gpg.pipeLazy $ params ++ Gpg.stdEncryptionParams False {- Runs a Feeder action, that generates content that is decrypted with the - - Cipher, and read by the Reader action. -} + - Cipher (or using a private key if the Cipher is empty), and read by the + - Reader action. -} decrypt :: Cipher -> Feeder -> Reader a -> IO a -decrypt = Gpg.feedRead [Param "--decrypt"] . cipherPassphrase +decrypt cipher = case cipher of + Cipher{} -> Gpg.feedRead [Param "--decrypt"] $ cipherPassphrase cipher + MacOnlyCipher{} -> Gpg.pipeLazy [Param "--decrypt"] macWithCipher :: Mac -> Cipher -> String -> String macWithCipher mac c = macWithCipher' mac (cipherMac c) @@ -161,3 +191,21 @@ prop_HmacSha1WithCipher_sane :: Bool prop_HmacSha1WithCipher_sane = known_good == macWithCipher' HmacSha1 "foo" "bar" where known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51" + +{- Return some options suitable for GnuPG encryption, symmetric or not. -} +class LensGpgEncParams a where getGpgEncParams :: a -> [CommandParam] + +{- Extract the GnuPG options from a pair of a Remote Config and a Remote + - Git Config. If the remote is configured to use public-key encryption, + - look up the recipient keys and add them to the option list. -} +instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where + getGpgEncParams (c,gc) = map Param (remoteAnnexGnupgOptions gc) ++ recipients + where + recipients = case M.lookup "encryption" c of + Just "pubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ + M.lookup "cipherkeys" c + _ -> [] + +{- Extract the GnuPG options from a Remote. -} +instance LensGpgEncParams (RemoteA a) where + getGpgEncParams r = getGpgEncParams (config r, gitconfig r) |