1  {- git-annex crypto
  2   -
  3   - Currently using gpg by default, or optionally stateless OpenPGP.
  4   -
  5   - Copyright 2011-2024 Joey Hess <id@joeyh.name>
  6   -
  7   - Licensed under the GNU AGPL version 3 or higher.
  8   -}
  9  
 10  {-# LANGUAGE FlexibleInstances #-}
 11  {-# LANGUAGE OverloadedStrings #-}
 12  {-# LANGUAGE Rank2Types #-}
 13  
 14  module Crypto (
 15  	EncryptionMethod(..),
 16  	Cipher,
 17  	KeyIds(..),
 18  	EncKey,
 19  	StorableCipher(..),
 20  	genEncryptedCipher,
 21  	genSharedCipher,
 22  	genSharedPubKeyCipher,
 23  	updateCipherKeyIds,
 24  	decryptCipher,
 25  	decryptCipher',
 26  	encryptKey,
 27  	isEncKey,
 28  	feedBytes,
 29  	readBytes,
 30  	readBytesStrictly,
 31  	encrypt,
 32  	decrypt,
 33  	LensEncParams(..),
 34  
 35  	prop_HmacSha1WithCipher_sane
 36  ) where
 37  
 38  import qualified Data.ByteString as S
 39  import qualified Data.ByteString.Lazy as L
 40  import Control.Monad.IO.Class
 41  import qualified Data.ByteString.Short as S (toShort)
 42  
 43  import Annex.Common
 44  import qualified Utility.Gpg as Gpg
 45  import qualified Utility.StatelessOpenPGP as SOP
 46  import Types.Crypto
 47  import Types.Remote
 48  import Types.Key
 49  import Annex.SpecialRemote.Config
 50  import Utility.Tmp.Dir
 51  
 52  {- The number of bytes of entropy used to generate a Cipher.
 53   -
 54   - Since a Cipher is base-64 encoded, the actual size of a Cipher
 55   - is larger than this. 512 bytes of date base-64 encodes to 684
 56   - characters.
 57   -}
 58  cipherSize :: Int
 59  cipherSize = 512
 60  
 61  {- The beginning of a Cipher is used for MAC'ing; the remainder is used
 62   - as the symmetric encryption passphrase.
 63   -
 64   - Due to the base-64 encoding of the Cipher, the beginning 265 characters
 65   - represent at best 192 bytes of entropy. However that's more than enough
 66   - for both the default MAC algorithm, namely HMAC-SHA1, and the "strongest"
 67   - currently supported, namely HMAC-SHA512, which respectively need
 68   - (ideally) 64 and 128 bytes of entropy.
 69   -
 70   - The remaining characters (320 bytes of entropy) is enough for
 71   - the symmetric encryption passphrase; unlike weaker public key crypto,
 72   - that does not need to be too large.
 73   -}
 74  cipherBeginning :: Int
 75  cipherBeginning = 256
 76  
 77  cipherPassphrase :: Cipher -> S.ByteString
 78  cipherPassphrase (Cipher c) = S.drop cipherBeginning c
 79  cipherPassphrase (MacOnlyCipher _) = giveup "MAC-only cipher"
 80  
 81  cipherMac :: Cipher -> S.ByteString
 82  cipherMac (Cipher c) = S.take cipherBeginning c
 83  cipherMac (MacOnlyCipher c) = c
 84  
 85  {- Creates a new Cipher, encrypted to the specified key id. -}
 86  genEncryptedCipher :: LensEncParams c => Gpg.GpgCmd -> c -> Gpg.KeyId -> EncryptedCipherVariant -> Bool -> IO StorableCipher
 87  genEncryptedCipher cmd c keyid variant highQuality = do
 88  	ks <- Gpg.findPubKeys cmd keyid
 89  	random <- Gpg.genRandom cmd highQuality size
 90  	encryptCipher cmd c (mkCipher random) variant ks
 91    where
 92  	(mkCipher, size) = case variant of
 93  		Hybrid -> (Cipher, cipherSize) -- used for MAC + symmetric
 94  		PubKey -> (MacOnlyCipher, cipherBeginning) -- only used for MAC
 95  
 96  {- Creates a new, shared Cipher. -}
 97  genSharedCipher :: Gpg.GpgCmd -> Bool -> IO StorableCipher
 98  genSharedCipher cmd highQuality =
 99  	SharedCipher <$> Gpg.genRandom cmd highQuality cipherSize
100  
101  {- Creates a new, shared Cipher, and looks up the gpg public key that will
102   - be used for encrypting content. -}
103  genSharedPubKeyCipher :: Gpg.GpgCmd -> Gpg.KeyId -> Bool -> IO StorableCipher
104  genSharedPubKeyCipher cmd keyid highQuality = do
105  	ks <- Gpg.findPubKeys cmd keyid
106  	random <- Gpg.genRandom cmd highQuality cipherSize
107  	return $ SharedPubKeyCipher random ks
108  
109  {- Updates an existing Cipher, making changes to its keyids.
110   -
111   - When the Cipher is encrypted, re-encrypts it. -}
112  updateCipherKeyIds :: LensEncParams encparams => Gpg.GpgCmd -> encparams -> [(Bool, Gpg.KeyId)] -> StorableCipher -> IO StorableCipher
113  updateCipherKeyIds _ _ _ SharedCipher{} = giveup "Cannot update shared cipher"
114  updateCipherKeyIds _ _ [] c = return c
115  updateCipherKeyIds cmd encparams changes encipher@(EncryptedCipher _ variant ks) = do
116  	ks' <- updateCipherKeyIds' cmd changes ks
117  	cipher <- decryptCipher cmd encparams encipher
118  	encryptCipher cmd encparams cipher variant ks'
119  updateCipherKeyIds cmd _ changes (SharedPubKeyCipher cipher ks) =
120  	SharedPubKeyCipher cipher <$> updateCipherKeyIds' cmd changes ks
121  
122  updateCipherKeyIds' :: Gpg.GpgCmd -> [(Bool, Gpg.KeyId)] -> KeyIds -> IO KeyIds
123  updateCipherKeyIds' cmd changes (KeyIds ks) = do
124  	dropkeys <- listKeyIds [ k | (False, k) <- changes ]
125  	forM_ dropkeys $ \k -> unless (k `elem` ks) $
126  		giveup $ "Key " ++ k ++ " was not present; cannot remove."
127  	addkeys <- listKeyIds [ k | (True, k) <- changes ]
128  	let ks' = (addkeys ++ ks) \\ dropkeys
129  	when (null ks') $
130  		giveup "Cannot remove the last key."
131  	return $ KeyIds ks'
132    where
133  	listKeyIds = concat <$$> mapM (keyIds <$$> Gpg.findPubKeys cmd)
134  
135  {- Encrypts a Cipher to the specified KeyIds. -}
136  encryptCipher :: LensEncParams c => Gpg.GpgCmd -> c -> Cipher -> EncryptedCipherVariant -> KeyIds -> IO StorableCipher
137  encryptCipher cmd c cip variant (KeyIds ks) = do
138  	-- gpg complains about duplicate recipient keyids
139  	let ks' = nub $ sort ks
140  	let params = concat
141  		[ getGpgEncParamsBase c
142  		, Gpg.pkEncTo ks'
143  		, Gpg.stdEncryptionParams False
144  		]
145  	encipher <- Gpg.pipeStrict cmd params cipher
146  	return $ EncryptedCipher encipher variant (KeyIds ks')
147    where
148  	cipher = case cip of
149  		Cipher x -> x
150  		MacOnlyCipher x -> x
151  
152  {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
153  decryptCipher :: LensEncParams c => Gpg.GpgCmd -> c -> StorableCipher -> IO Cipher
154  decryptCipher cmd c cip = decryptCipher' cmd Nothing c cip
155  
156  decryptCipher' :: LensEncParams c => Gpg.GpgCmd -> Maybe [(String, String)] -> c -> StorableCipher -> IO Cipher
157  decryptCipher' _ _ _ (SharedCipher t) = return $ Cipher t
158  decryptCipher' _ _ _ (SharedPubKeyCipher t _) = return $ MacOnlyCipher t
159  decryptCipher' cmd environ c (EncryptedCipher t variant _) =
160  	mkCipher <$> Gpg.pipeStrict' cmd params environ t
161    where
162  	mkCipher = case variant of
163  		Hybrid -> Cipher
164  		PubKey -> MacOnlyCipher
165  	params = Param "--decrypt" : getGpgDecParams c
166  
167  type EncKey = Key -> Key
168  
169  {- Generates an encrypted form of a Key. The encryption does not need to be
170   - reversible, nor does it need to be the same type of encryption used
171   - on content. It does need to be repeatable. -}
172  encryptKey :: Mac -> Cipher -> EncKey
173  encryptKey mac c k = mkKey $ \d -> d
174  	{ keyName = S.toShort $ encodeBS $ macWithCipher mac c (serializeKey' k)
175  	, keyVariety = OtherKey $
176  		encryptedBackendNamePrefix <> encodeBS (showMac mac)
177  	}
178  
179  encryptedBackendNamePrefix :: S.ByteString
180  encryptedBackendNamePrefix = "GPG"
181  
182  isEncKey :: Key -> Bool
183  isEncKey k = case fromKey keyVariety k of
184  	OtherKey s -> encryptedBackendNamePrefix `S.isPrefixOf` s
185  	_ -> False
186  
187  type Feeder = Handle -> IO ()
188  type Reader m a = Handle -> m a
189  
190  feedBytes :: L.ByteString -> Feeder
191  feedBytes = flip L.hPut
192  
193  readBytes :: (MonadIO m) => (L.ByteString -> m a) -> Reader m a
194  readBytes a h = liftIO (L.hGetContents h) >>= a
195  
196  readBytesStrictly :: (MonadIO m) => (S.ByteString -> m a) -> Reader m a
197  readBytesStrictly a h = liftIO (S.hGetContents h) >>= a
198  
199  {- Runs a Feeder action, that generates content that is symmetrically
200   - encrypted with the Cipher (unless it is empty, in which case
201   - public-key encryption is used), and then read by the Reader action. 
202   -
203   - Note that the Reader must fully consume all input before returning.
204   -}
205  encrypt :: (MonadIO m, MonadMask m, LensEncParams c) => Gpg.GpgCmd -> c -> Cipher -> Feeder -> Reader m a -> m a
206  encrypt gpgcmd c cipher feeder reader = case cipher of
207  	Cipher{} -> 
208  		let passphrase = cipherPassphrase cipher
209  		in case statelessOpenPGPCommand c of
210  			Just sopcmd -> withTmpDir (literalOsPath "sop") $ \d ->
211  				SOP.encryptSymmetric sopcmd passphrase
212  					(SOP.EmptyDirectory d)
213  					(statelessOpenPGPProfile c)
214  					(SOP.Armoring False)
215  					feeder reader
216  			Nothing -> Gpg.feedRead gpgcmd (params ++ Gpg.stdEncryptionParams True) passphrase feeder reader
217  	MacOnlyCipher{} -> Gpg.feedRead' gpgcmd (params ++ Gpg.stdEncryptionParams False) feeder reader
218    where
219  	params = getGpgEncParams c
220  
221  {- Runs a Feeder action, that generates content that is decrypted with the
222   - Cipher (or using a private key if the Cipher is empty), and read by the
223   - Reader action.
224   -
225   - Note that the Reader must fully consume all input before returning.
226   - -}
227  decrypt :: (MonadIO m, MonadMask m, LensEncParams c) => Gpg.GpgCmd -> c -> Cipher -> Feeder -> Reader m a -> m a
228  decrypt cmd c cipher feeder reader = case cipher of
229  	Cipher{} -> 
230  		let passphrase = cipherPassphrase cipher
231  		in case statelessOpenPGPCommand c of
232  			Just sopcmd -> withTmpDir (literalOsPath "sop") $ \d ->
233  				SOP.decryptSymmetric sopcmd passphrase
234  					(SOP.EmptyDirectory d)
235  					feeder reader
236  			Nothing -> Gpg.feedRead cmd params passphrase feeder reader
237  	MacOnlyCipher{} -> Gpg.feedRead' cmd params feeder reader
238    where
239  	params = Param "--decrypt" : getGpgDecParams c
240  
241  macWithCipher :: Mac -> Cipher -> S.ByteString -> String
242  macWithCipher mac c = macWithCipher' mac (cipherMac c)
243  macWithCipher' :: Mac -> S.ByteString -> S.ByteString -> String
244  macWithCipher' mac c s = calcMac show mac c s
245  
246  {- Ensure that macWithCipher' returns the same thing forevermore. -}
247  prop_HmacSha1WithCipher_sane :: Bool
248  prop_HmacSha1WithCipher_sane = known_good == macWithCipher' HmacSha1 "foo" "bar"
249    where
250  	known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51"
251  
252  class LensEncParams a where
253  	{- Base gpg parameters for encrypting. Does not include specification
254  	 - of recipient keys. -}
255  	getGpgEncParamsBase :: a -> [CommandParam]
256  	{- Gpg parameters for encrypting. When the remote is configured to use
257  	 - public-key encryption, includes specification of recipient keys. -}
258  	getGpgEncParams :: a -> [CommandParam]
259  	{- Gpg parameters for decrypting. -}
260  	getGpgDecParams :: a -> [CommandParam]
261  	{- Set when stateless OpenPGP should be used rather than gpg.
262  	 - It is currently only used for SharedEncryption and not the other
263  	 - schemes which use public keys. -}
264  	statelessOpenPGPCommand :: a -> Maybe SOP.SOPCmd
265  	{- When using stateless OpenPGP, this may be set to a profile
266  	 - which should be used instead of the default. -}
267  	statelessOpenPGPProfile :: a -> Maybe SOP.SOPProfile
268  
269  {- Extract the GnuPG options from a pair of a Remote Config and a Remote
270   - Git Config. -}
271  instance LensEncParams (ParsedRemoteConfig, RemoteGitConfig) where
272  	getGpgEncParamsBase (_c,gc) = map Param (remoteAnnexGnupgOptions gc)
273  	getGpgEncParams (c,gc) = getGpgEncParamsBase (c,gc) ++
274   		{- When the remote is configured to use public-key encryption,
275  		 - look up the recipient keys and add them to the option list. -}
276  		case getRemoteConfigValue encryptionField c of
277  			Just PubKeyEncryption -> 
278  				Gpg.pkEncTo $ maybe [] (splitc ',') $
279  					getRemoteConfigValue cipherkeysField c
280  			Just SharedPubKeyEncryption ->
281  				Gpg.pkEncTo $ maybe [] (splitc ',') $
282  					getRemoteConfigValue pubkeysField c
283  			_ -> []
284  	getGpgDecParams (_c,gc) = map Param (remoteAnnexGnupgDecryptOptions gc)
285  	statelessOpenPGPCommand (c,gc) = case remoteAnnexSharedSOPCommand gc of
286  		Nothing -> Nothing
287  		Just sopcmd ->
288  			{- So far stateless OpenPGP is only supported
289  			 - for SharedEncryption, not other encryption
290  			 - methods that involve public keys. -}
291  			case getRemoteConfigValue encryptionField c of
292  				Just SharedEncryption -> Just sopcmd
293  				_ -> Nothing
294  	statelessOpenPGPProfile (_c,gc) = remoteAnnexSharedSOPProfile gc
295  
296  {- Extract the GnuPG options from a Remote. -}
297  instance LensEncParams (RemoteA a) where
298  	getGpgEncParamsBase r = getGpgEncParamsBase (config r, gitconfig r)
299  	getGpgEncParams r = getGpgEncParams (config r, gitconfig r)
300  	getGpgDecParams r = getGpgDecParams (config r, gitconfig r)
301  	statelessOpenPGPCommand r = statelessOpenPGPCommand (config r, gitconfig r)
302  	statelessOpenPGPProfile r  = statelessOpenPGPProfile (config r, gitconfig r)