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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
{- 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,
Gpg.getGpgEncParams,
prop_HmacSha1WithCipher_sane
) where
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.UTF8 (fromString)
import Control.Applicative
import Common.Annex
import qualified Utility.Gpg as Gpg
import Types.Key
import Types.Crypto
{- 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.
-
- 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"
- currently supported, namely HMAC-SHA512, which respectively need
- (ideally) 64 and 128 bytes of entropy.
-
- The remaining characters (320 bytes of entropy) is enough for GnuPG'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
cipherMac :: Cipher -> String
cipherMac (Cipher c) = take cipherBeginning c
{- Creates a new Cipher, encrypted to the specified key id. If the
- boolean 'symmetric' is true, use that cipher not only for MAC'ing,
- but also to symmetrically encrypt annexed file contents. Otherwise,
- we don't bother to generate so much random data. -}
genEncryptedCipher :: String -> Bool -> Bool -> IO StorableCipher
genEncryptedCipher keyid symmetric highQuality = do
ks <- Gpg.findPubKeys keyid
random <- Gpg.genRandom highQuality size
encryptCipher (Cipher random) symmetric ks
where
size = if symmetric then cipherSize else cipherBeginning
{- 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 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 _ symmetric (KeyIds ks)) = do
dropKeys <- listKeyIds [ k | (False, k) <- newkeys ]
forM_ dropKeys $ \k -> unless (k `elem` ks) $
error $ "Key " ++ k ++ " is not granted access."
addKeys <- listKeyIds [ k | (True, k) <- newkeys ]
let ks' = (addKeys ++ ks) \\ dropKeys
when (null ks') $ error "That would empty the access list."
cipher <- decryptCipher encipher
encryptCipher cipher symmetric $ KeyIds ks'
where
listKeyIds = mapM (Gpg.findPubKeys >=*> keyIds) >=*> concat
describeCipher :: StorableCipher -> String
describeCipher SharedCipher{} = "shared cipher"
describeCipher (EncryptedCipher _ symmetric (KeyIds ks)) =
scheme ++ " with gpg " ++ keys ks ++ " " ++ unwords ks
where
scheme = if symmetric then "hybrid cipher" else "pubkey crypto"
keys [_] = "key"
keys _ = "keys"
{- Encrypts a Cipher to the specified KeyIds. The boolean indicates
- whether to encrypt an hybrid cipher (True), which is going to be used
- both for MAC'ing and symmetric encryption of file contents, or for
- MAC'ing only (False), while pubkey crypto is used for file contents.
- -}
encryptCipher :: Cipher -> Bool -> KeyIds -> IO StorableCipher
encryptCipher (Cipher c) symmetric (KeyIds ks) = do
-- gpg complains about duplicate recipient keyids
let ks' = nub $ sort ks
-- The cipher itself is always encrypted to the given public keys
let params = Gpg.pkEncTo ks' ++ Gpg.stdEncryptionParams False
encipher <- Gpg.pipeStrict params c
return $ EncryptedCipher encipher symmetric (KeyIds ks')
{- 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 :: Mac -> Cipher -> Key -> Key
encryptKey mac c k = Key
{ keyName = macWithCipher mac c (key2file k)
, keyBackendName = "GPG" ++ showMac mac
, 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 (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 = Gpg.feedRead params' pass
where
pass = cipherPassphrase cipher
params' = params ++ Gpg.stdEncryptionParams (not $ null pass)
{- Runs a Feeder action, that generates content that is decrypted with the
- 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
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)
{- Ensure that macWithCipher' returns the same thing forevermore. -}
prop_HmacSha1WithCipher_sane :: Bool
prop_HmacSha1WithCipher_sane = known_good == macWithCipher' HmacSha1 "foo" "bar"
where
known_good = "46b4ec586117154dacd49d664e5d63fdc88efb51"
|
