1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
{- git-annex crypto
-
- Currently using gpg; could later be modified to support different
- crypto backends if neccessary.
-
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Crypto (
Cipher,
KeyIds(..),
StorableCipher(..),
genEncryptedCipher,
genSharedCipher,
updateEncryptedCipher,
describeCipher,
decryptCipher,
encryptKey,
feedFile,
feedBytes,
readBytes,
encrypt,
decrypt,
GpgOpts(..),
getGpgOpts,
prop_hmacWithCipher_sane
) where
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.UTF8 (fromString)
import Data.Digest.Pure.SHA
import Control.Applicative
import Common.Annex
import qualified Utility.Gpg as Gpg
import Utility.Gpg.Types
import Types.Key
import Types.Crypto
{- The beginning of a Cipher is used for HMAC; the remainder
- is used as the GPG symmetric encryption passphrase.
-
- HMAC SHA1 needs only 64 bytes. The rest of the HMAC key is for expansion,
- perhaps to HMAC SHA512, which needs 128 bytes (ideally).
- It also provides room the Cipher to contain data in a form like base64,
- which does not pack a full byte of entropy into a byte of data.
-
- 256 bytes is enough for gpg's symetric cipher; unlike weaker public key
- crypto, the key does not need to be too large.
-}
cipherBeginning :: Int
cipherBeginning = 256
cipherSize :: Int
cipherSize = 512
cipherPassphrase :: Cipher -> String
cipherPassphrase (Cipher c) = drop cipherBeginning c
cipherHmac :: Cipher -> String
cipherHmac (Cipher c) = take cipherBeginning c
{- Creates a new Cipher, encrypted to the specified key id. -}
genEncryptedCipher :: String -> IO StorableCipher
genEncryptedCipher keyid = do
ks <- Gpg.findPubKeys keyid
random <- Gpg.genRandom cipherSize
encryptCipher (Cipher random) ks
{- Creates a new, shared Cipher. -}
genSharedCipher :: IO StorableCipher
genSharedCipher = SharedCipher <$> Gpg.genRandom 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
cipher <- decryptCipher encipher
encryptCipher cipher (merge ks ks')
where
merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
describeCipher :: StorableCipher -> String
describeCipher (SharedCipher _) = "shared cipher"
describeCipher (EncryptedCipher _ (KeyIds ks)) =
"with gpg " ++ keys ks ++ " " ++ unwords ks
where
keys [_] = "key"
keys _ = "keys"
{- Encrypts a Cipher to the specified KeyIds. -}
encryptCipher :: Cipher -> KeyIds -> IO StorableCipher
encryptCipher (Cipher c) (KeyIds ks) = do
let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids
encipher <- Gpg.pipeStrict ([ Params "--encrypt" ] ++ recipients ks') c
return $ EncryptedCipher encipher (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"
{- 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
{- 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
- on content. It does need to be repeatable. -}
encryptKey :: Cipher -> Key -> Key
encryptKey c k = Key
{ keyName = hmacWithCipher c (key2file k)
, keyBackendName = "GPGHMACSHA1"
, keySize = Nothing -- size and mtime omitted
, keyMtime = Nothing -- to avoid leaking data
}
type Feeder = Handle -> IO ()
type Reader a = Handle -> IO a
feedFile :: FilePath -> Feeder
feedFile f h = L.hPut h =<< L.readFile f
feedBytes :: L.ByteString -> Feeder
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 decrypted with the
- Cipher, and read by the Reader action. -}
decrypt :: Cipher -> Feeder -> Reader a -> IO a
decrypt = Gpg.feedRead [Param "--decrypt"] . cipherPassphrase
hmacWithCipher :: Cipher -> String -> String
hmacWithCipher c = hmacWithCipher' (cipherHmac c)
hmacWithCipher' :: String -> String -> String
hmacWithCipher' c s = showDigest $ hmacSha1 (fromString c) (fromString s)
{- Ensure that hmacWithCipher' returns the same thing forevermore. -}
prop_hmacWithCipher_sane :: Bool
prop_hmacWithCipher_sane = known_good == hmacWithCipher' "foo" "bar"
where
known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51"
|
