2011-04-15 22:18:39 +00:00
|
|
|
{- git-annex crypto
|
2011-04-16 17:25:27 +00:00
|
|
|
-
|
|
|
|
- Currently using gpg; could later be modified to support different
|
|
|
|
- crypto backends if neccessary.
|
2011-04-15 22:18:39 +00:00
|
|
|
-
|
2015-01-21 16:50:09 +00:00
|
|
|
- Copyright 2011-2014 Joey Hess <id@joeyh.name>
|
2011-04-15 22:18:39 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2013-09-05 03:16:33 +00:00
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
2014-07-29 20:22:19 +00:00
|
|
|
{-# LANGUAGE Rank2Types #-}
|
2013-09-05 03:16:33 +00:00
|
|
|
|
2011-04-15 22:18:39 +00:00
|
|
|
module Crypto (
|
2011-04-16 22:22:52 +00:00
|
|
|
Cipher,
|
2012-04-29 18:31:34 +00:00
|
|
|
KeyIds(..),
|
2014-07-27 00:14:09 +00:00
|
|
|
EncKey,
|
2012-04-29 18:02:18 +00:00
|
|
|
StorableCipher(..),
|
|
|
|
genEncryptedCipher,
|
|
|
|
genSharedCipher,
|
2016-05-10 20:50:31 +00:00
|
|
|
genSharedPubKeyCipher,
|
|
|
|
updateCipherKeyIds,
|
2011-04-15 22:18:39 +00:00
|
|
|
decryptCipher,
|
|
|
|
encryptKey,
|
2014-08-03 20:54:57 +00:00
|
|
|
isEncKey,
|
2012-11-18 19:27:44 +00:00
|
|
|
feedFile,
|
|
|
|
feedBytes,
|
|
|
|
readBytes,
|
|
|
|
encrypt,
|
2013-09-05 03:16:33 +00:00
|
|
|
decrypt,
|
|
|
|
getGpgEncParams,
|
2016-05-10 17:03:56 +00:00
|
|
|
getGpgDecParams,
|
2011-04-21 20:56:24 +00:00
|
|
|
|
2013-03-29 16:06:02 +00:00
|
|
|
prop_HmacSha1WithCipher_sane
|
2011-04-15 22:18:39 +00:00
|
|
|
) where
|
|
|
|
|
2012-06-20 17:13:40 +00:00
|
|
|
import qualified Data.ByteString.Lazy as L
|
2015-04-19 14:54:12 +00:00
|
|
|
import Data.ByteString.UTF8 (fromString)
|
2013-09-05 03:16:33 +00:00
|
|
|
import qualified Data.Map as M
|
2014-07-29 20:22:19 +00:00
|
|
|
import Control.Monad.IO.Class
|
2011-04-15 22:18:39 +00:00
|
|
|
|
2016-01-20 20:36:33 +00:00
|
|
|
import Annex.Common
|
2011-12-21 01:47:56 +00:00
|
|
|
import qualified Utility.Gpg as Gpg
|
2011-06-02 01:56:04 +00:00
|
|
|
import Types.Crypto
|
2013-09-05 03:16:33 +00:00
|
|
|
import Types.Remote
|
2011-04-15 22:18:39 +00:00
|
|
|
|
2013-03-29 16:06:02 +00:00
|
|
|
{- The beginning of a Cipher is used for MAC'ing; the remainder is used
|
2013-09-05 02:18:33 +00:00
|
|
|
- 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.
|
2011-04-17 05:34:28 +00:00
|
|
|
-
|
2013-03-29 16:06:02 +00:00
|
|
|
- The 256 first characters that feed the MAC represent at best 192
|
|
|
|
- bytes of entropy. However that's more than enough for both the
|
|
|
|
- default MAC algorithm, namely HMAC-SHA1, and the "strongest"
|
2013-03-29 22:06:14 +00:00
|
|
|
- currently supported, namely HMAC-SHA512, which respectively need
|
2013-03-29 16:06:02 +00:00
|
|
|
- (ideally) 64 and 128 bytes of entropy.
|
2011-04-17 15:13:54 +00:00
|
|
|
-
|
2013-03-29 22:06:14 +00:00
|
|
|
- The remaining characters (320 bytes of entropy) is enough for GnuPG's
|
2013-03-29 16:06:02 +00:00
|
|
|
- symetric cipher; unlike weaker public key crypto, the key does not
|
|
|
|
- need to be too large.
|
2011-04-17 05:34:28 +00:00
|
|
|
-}
|
2013-03-03 23:44:48 +00:00
|
|
|
cipherBeginning :: Int
|
|
|
|
cipherBeginning = 256
|
2011-04-17 05:34:28 +00:00
|
|
|
|
|
|
|
cipherSize :: Int
|
2013-03-03 23:44:48 +00:00
|
|
|
cipherSize = 512
|
2011-04-17 05:34:28 +00:00
|
|
|
|
|
|
|
cipherPassphrase :: Cipher -> String
|
2013-03-03 23:44:48 +00:00
|
|
|
cipherPassphrase (Cipher c) = drop cipherBeginning c
|
2013-09-05 06:09:39 +00:00
|
|
|
cipherPassphrase (MacOnlyCipher _) = error "MAC-only cipher"
|
2011-04-17 05:34:28 +00:00
|
|
|
|
2013-03-29 16:06:02 +00:00
|
|
|
cipherMac :: Cipher -> String
|
|
|
|
cipherMac (Cipher c) = take cipherBeginning c
|
2013-09-05 06:09:39 +00:00
|
|
|
cipherMac (MacOnlyCipher c) = c
|
2011-04-17 05:34:28 +00:00
|
|
|
|
2013-09-05 02:18:33 +00:00
|
|
|
{- Creates a new Cipher, encrypted to the specified key id. -}
|
2016-05-10 20:50:31 +00:00
|
|
|
genEncryptedCipher :: Gpg.GpgCmd -> Gpg.KeyId -> EncryptedCipherVariant -> Bool -> IO StorableCipher
|
2015-09-09 22:06:49 +00:00
|
|
|
genEncryptedCipher cmd keyid variant highQuality = do
|
|
|
|
ks <- Gpg.findPubKeys cmd keyid
|
|
|
|
random <- Gpg.genRandom cmd highQuality size
|
|
|
|
encryptCipher cmd (mkCipher random) variant ks
|
2013-09-01 18:12:00 +00:00
|
|
|
where
|
2013-09-05 06:09:39 +00:00
|
|
|
(mkCipher, size) = case variant of
|
2013-09-05 15:12:01 +00:00
|
|
|
Hybrid -> (Cipher, cipherSize) -- used for MAC + symmetric
|
|
|
|
PubKey -> (MacOnlyCipher, cipherBeginning) -- only used for MAC
|
2012-04-29 18:02:18 +00:00
|
|
|
|
|
|
|
{- Creates a new, shared Cipher. -}
|
2015-09-09 22:06:49 +00:00
|
|
|
genSharedCipher :: Gpg.GpgCmd -> Bool -> IO StorableCipher
|
|
|
|
genSharedCipher cmd highQuality =
|
|
|
|
SharedCipher <$> Gpg.genRandom cmd highQuality cipherSize
|
2012-04-29 18:02:18 +00:00
|
|
|
|
2016-05-10 20:50:31 +00:00
|
|
|
{- Creates a new, shared Cipher, and looks up the gpg public key that will
|
|
|
|
- be used for encrypting content. -}
|
|
|
|
genSharedPubKeyCipher :: Gpg.GpgCmd -> Gpg.KeyId -> Bool -> IO StorableCipher
|
|
|
|
genSharedPubKeyCipher cmd keyid highQuality = do
|
|
|
|
ks <- Gpg.findPubKeys cmd keyid
|
|
|
|
random <- Gpg.genRandom cmd highQuality cipherSize
|
|
|
|
return $ SharedPubKeyCipher random ks
|
|
|
|
|
|
|
|
{- Updates an existing Cipher, making changes to its keyids.
|
|
|
|
-
|
|
|
|
- When the Cipher is encrypted, re-encrypts it. -}
|
|
|
|
updateCipherKeyIds :: Gpg.GpgCmd -> [(Bool, Gpg.KeyId)] -> StorableCipher -> IO StorableCipher
|
|
|
|
updateCipherKeyIds _ _ SharedCipher{} = error "Cannot update shared cipher"
|
|
|
|
updateCipherKeyIds _ [] c = return c
|
|
|
|
updateCipherKeyIds cmd changes encipher@(EncryptedCipher _ variant ks) = do
|
|
|
|
ks' <- updateCipherKeyIds' cmd changes ks
|
|
|
|
cipher <- decryptCipher cmd encipher
|
|
|
|
encryptCipher cmd cipher variant ks'
|
|
|
|
updateCipherKeyIds cmd changes (SharedPubKeyCipher cipher ks) =
|
|
|
|
SharedPubKeyCipher cipher <$> updateCipherKeyIds' cmd changes ks
|
|
|
|
|
|
|
|
updateCipherKeyIds' :: Gpg.GpgCmd -> [(Bool, Gpg.KeyId)] -> KeyIds -> IO KeyIds
|
|
|
|
updateCipherKeyIds' cmd changes (KeyIds ks) = do
|
|
|
|
dropkeys <- listKeyIds [ k | (False, k) <- changes ]
|
|
|
|
forM_ dropkeys $ \k -> unless (k `elem` ks) $
|
2013-09-05 01:54:10 +00:00
|
|
|
error $ "Key " ++ k ++ " was not present; cannot remove."
|
2016-05-10 20:50:31 +00:00
|
|
|
addkeys <- listKeyIds [ k | (True, k) <- changes ]
|
|
|
|
let ks' = (addkeys ++ ks) \\ dropkeys
|
2013-09-05 01:54:10 +00:00
|
|
|
when (null ks') $
|
|
|
|
error "Cannot remove the last key."
|
2016-05-10 20:50:31 +00:00
|
|
|
return $ KeyIds ks'
|
2012-10-29 01:27:15 +00:00
|
|
|
where
|
2015-09-09 22:06:49 +00:00
|
|
|
listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys cmd)
|
2011-04-15 22:18:39 +00:00
|
|
|
|
2013-09-05 02:18:33 +00:00
|
|
|
{- Encrypts a Cipher to the specified KeyIds. -}
|
2015-09-09 22:06:49 +00:00
|
|
|
encryptCipher :: Gpg.GpgCmd -> Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher
|
|
|
|
encryptCipher cmd c variant (KeyIds ks) = do
|
2013-03-12 09:05:33 +00:00
|
|
|
-- gpg complains about duplicate recipient keyids
|
|
|
|
let ks' = nub $ sort ks
|
2013-09-01 18:12:00 +00:00
|
|
|
let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False
|
2015-09-09 22:06:49 +00:00
|
|
|
encipher <- Gpg.pipeStrict cmd params cipher
|
2013-09-05 02:18:33 +00:00
|
|
|
return $ EncryptedCipher encipher variant (KeyIds ks')
|
2013-09-05 06:09:39 +00:00
|
|
|
where
|
|
|
|
cipher = case c of
|
|
|
|
Cipher x -> x
|
|
|
|
MacOnlyCipher x -> x
|
2011-04-15 22:18:39 +00:00
|
|
|
|
|
|
|
{- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
|
2015-09-09 22:06:49 +00:00
|
|
|
decryptCipher :: Gpg.GpgCmd -> StorableCipher -> IO Cipher
|
|
|
|
decryptCipher _ (SharedCipher t) = return $ Cipher t
|
2016-05-10 20:50:31 +00:00
|
|
|
decryptCipher _ (SharedPubKeyCipher t _) = return $ MacOnlyCipher t
|
2015-09-09 22:06:49 +00:00
|
|
|
decryptCipher cmd (EncryptedCipher t variant _) =
|
|
|
|
mkCipher <$> Gpg.pipeStrict cmd [ Param "--decrypt" ] t
|
2013-09-05 06:09:39 +00:00
|
|
|
where
|
|
|
|
mkCipher = case variant of
|
2013-09-05 15:12:01 +00:00
|
|
|
Hybrid -> Cipher
|
|
|
|
PubKey -> MacOnlyCipher
|
2011-04-15 22:18:39 +00:00
|
|
|
|
2014-07-27 00:14:09 +00:00
|
|
|
type EncKey = Key -> Key
|
|
|
|
|
2011-04-16 20:26:47 +00:00
|
|
|
{- Generates an encrypted form of a Key. The encryption does not need to be
|
2011-04-15 22:18:39 +00:00
|
|
|
- reversable, nor does it need to be the same type of encryption used
|
2011-04-16 20:26:47 +00:00
|
|
|
- on content. It does need to be repeatable. -}
|
2014-07-27 00:14:09 +00:00
|
|
|
encryptKey :: Mac -> Cipher -> EncKey
|
2014-07-24 17:36:23 +00:00
|
|
|
encryptKey mac c k = stubKey
|
2013-03-29 16:06:02 +00:00
|
|
|
{ keyName = macWithCipher mac c (key2file k)
|
2014-08-03 20:54:57 +00:00
|
|
|
, keyBackendName = encryptedBackendNamePrefix ++ showMac mac
|
2011-04-16 20:26:47 +00:00
|
|
|
}
|
2011-04-15 22:18:39 +00:00
|
|
|
|
2014-08-03 20:54:57 +00:00
|
|
|
encryptedBackendNamePrefix :: String
|
|
|
|
encryptedBackendNamePrefix = "GPG"
|
|
|
|
|
|
|
|
isEncKey :: Key -> Bool
|
|
|
|
isEncKey k = encryptedBackendNamePrefix `isPrefixOf` keyBackendName k
|
|
|
|
|
2012-11-18 19:27:44 +00:00
|
|
|
type Feeder = Handle -> IO ()
|
2014-07-29 20:22:19 +00:00
|
|
|
type Reader m a = Handle -> m a
|
2012-11-18 19:27:44 +00:00
|
|
|
|
|
|
|
feedFile :: FilePath -> Feeder
|
|
|
|
feedFile f h = L.hPut h =<< L.readFile f
|
|
|
|
|
|
|
|
feedBytes :: L.ByteString -> Feeder
|
|
|
|
feedBytes = flip L.hPut
|
|
|
|
|
2014-07-29 20:22:19 +00:00
|
|
|
readBytes :: (MonadIO m) => (L.ByteString -> m a) -> Reader m a
|
|
|
|
readBytes a h = liftIO (L.hGetContents h) >>= a
|
2012-11-18 19:27:44 +00:00
|
|
|
|
2013-09-01 18:12:00 +00:00
|
|
|
{- 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
|
2013-09-04 22:00:02 +00:00
|
|
|
- 'getGpgEncParams'). -}
|
2015-09-09 22:06:49 +00:00
|
|
|
encrypt :: (MonadIO m, MonadMask m) => Gpg.GpgCmd -> [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a
|
|
|
|
encrypt cmd params cipher = case cipher of
|
|
|
|
Cipher{} -> Gpg.feedRead cmd (params ++ Gpg.stdEncryptionParams True) $
|
2013-09-05 06:09:39 +00:00
|
|
|
cipherPassphrase cipher
|
2015-09-09 22:06:49 +00:00
|
|
|
MacOnlyCipher{} -> Gpg.pipeLazy cmd $ params ++ Gpg.stdEncryptionParams False
|
2012-11-18 19:27:44 +00:00
|
|
|
|
|
|
|
{- Runs a Feeder action, that generates content that is decrypted with the
|
2013-09-01 18:12:00 +00:00
|
|
|
- Cipher (or using a private key if the Cipher is empty), and read by the
|
|
|
|
- Reader action. -}
|
2016-05-10 17:03:56 +00:00
|
|
|
decrypt :: (MonadIO m, MonadMask m) => Gpg.GpgCmd -> [CommandParam] -> Cipher -> Feeder -> Reader m a -> m a
|
|
|
|
decrypt cmd params cipher = case cipher of
|
|
|
|
Cipher{} -> Gpg.feedRead cmd params' $ cipherPassphrase cipher
|
|
|
|
MacOnlyCipher{} -> Gpg.pipeLazy cmd params'
|
|
|
|
where
|
|
|
|
params' = Param "--decrypt" : params
|
2011-04-15 22:18:39 +00:00
|
|
|
|
2013-03-29 16:06:02 +00:00
|
|
|
macWithCipher :: Mac -> Cipher -> String -> String
|
|
|
|
macWithCipher mac c = macWithCipher' mac (cipherMac c)
|
|
|
|
macWithCipher' :: Mac -> String -> String -> String
|
|
|
|
macWithCipher' mac c s = calcMac mac (fromString c) (fromString s)
|
2011-04-21 20:56:24 +00:00
|
|
|
|
2013-03-29 16:06:02 +00:00
|
|
|
{- Ensure that macWithCipher' returns the same thing forevermore. -}
|
|
|
|
prop_HmacSha1WithCipher_sane :: Bool
|
|
|
|
prop_HmacSha1WithCipher_sane = known_good == macWithCipher' HmacSha1 "foo" "bar"
|
2012-10-29 01:27:15 +00:00
|
|
|
where
|
|
|
|
known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51"
|
2013-09-05 03:16:33 +00:00
|
|
|
|
2016-05-10 17:03:56 +00:00
|
|
|
class LensGpgEncParams a where
|
|
|
|
{- Parameters for encrypting. -}
|
|
|
|
getGpgEncParams :: a -> [CommandParam]
|
|
|
|
{- Parameters for decrypting. -}
|
|
|
|
getGpgDecParams :: a -> [CommandParam]
|
2013-09-05 03:16:33 +00:00
|
|
|
|
|
|
|
{- Extract the GnuPG options from a pair of a Remote Config and a Remote
|
2014-02-06 22:25:31 +00:00
|
|
|
- Git Config. -}
|
2013-09-05 03:16:33 +00:00
|
|
|
instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where
|
2014-02-06 22:25:31 +00:00
|
|
|
getGpgEncParams (c,gc) = map Param (remoteAnnexGnupgOptions gc) ++ getGpgEncParams c
|
2016-05-10 17:03:56 +00:00
|
|
|
getGpgDecParams (c,gc) = map Param (remoteAnnexGnupgDecryptOptions gc) ++ getGpgDecParams c
|
2014-02-06 22:25:31 +00:00
|
|
|
|
|
|
|
{- Extract the GnuPG options from a Remote Config, ignoring any
|
|
|
|
- git config settings. (Which is ok if the remote is just being set up
|
2016-05-10 17:03:56 +00:00
|
|
|
- and so doesn't have any.) -}
|
2014-02-06 22:25:31 +00:00
|
|
|
instance LensGpgEncParams RemoteConfig where
|
2016-05-10 17:03:56 +00:00
|
|
|
{- If the remote is configured to use public-key encryption,
|
|
|
|
- look up the recipient keys and add them to the option list. -}
|
2014-02-06 22:25:31 +00:00
|
|
|
getGpgEncParams c = case M.lookup "encryption" c of
|
|
|
|
Just "pubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "cipherkeys" c
|
2016-05-10 20:50:31 +00:00
|
|
|
Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "pubkeys" c
|
2014-02-06 22:25:31 +00:00
|
|
|
_ -> []
|
2016-05-10 17:03:56 +00:00
|
|
|
getGpgDecParams _ = []
|
2013-09-05 03:16:33 +00:00
|
|
|
|
|
|
|
{- Extract the GnuPG options from a Remote. -}
|
|
|
|
instance LensGpgEncParams (RemoteA a) where
|
|
|
|
getGpgEncParams r = getGpgEncParams (config r, gitconfig r)
|
2016-05-10 17:03:56 +00:00
|
|
|
getGpgDecParams r = getGpgDecParams (config r, gitconfig r)
|