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
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
|
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE QuasiQuotes #-}
module Data.OpenPGP.Util.Cv25519 where
import Control.Arrow
import Control.Monad
import Data.Binary
import Data.Binary.Get
import Data.ByteString (ByteString)
import Data.Bits
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.Char
import Numeric
import Data.Int
import Data.OpenPGP.Internal
import Data.OpenPGP.Util.Fingerprint
import Data.OpenPGP.Util.Base
import Data.OpenPGP as OpenPGP
import Crypto.Cipher.SBox
import Data.OpenPGP.Util.Ed25519 (zeroExtend,zeroPad)
import qualified Crypto.PubKey.Curve25519 as Cv25519
import Crypto.Error
import Crypto.Cipher.AES
import Crypto.Cipher.Types
import Data.OpenPGP.Util.DecryptSecretKey -- (withS2K, simpleUnCFB, Enciphered(..))
import Crypto.JOSE.AESKW
oid_cv25519 = 0x2B060104019755010501
getEphemeralKey :: OpenPGP.Packet -> Maybe ([(Char,MPI)],BL.ByteString)
getEphemeralKey AsymmetricSessionKeyPacket
{ version = 3
, key_algorithm = ECC
, encrypted_data = dta } = do
-- Algorithm-Specific Fields for ECDH encryption:
--
-- * MPI of an EC point representing an ephemeral public key.
--
-- * a one-octet size, followed by a symmetric key encoded using the
-- method described in Section 13.5.
(b,_,d) <- either (const Nothing) Just $ runGetOrFail getEllipticCurvePublicKey dta
(sz,m) <- BL.uncons b
guard $ BL.length m == fromIntegral sz
return (d,m)
getEphemeralKey _ = Nothing
-- The value "m" in the above formulas is derived from the session key
-- as follows. First, the session key is prefixed with a one-octet
-- algorithm identifier that specifies the symmetric encryption
-- algorithm used to encrypt the following Symmetrically Encrypted Data
-- Packet. Then a two-octet checksum is appended, which is equal to the
-- sum of the preceding session key octets, not including the algorithm
-- identifier, modulo 65536. This value is then encoded as described in
-- PKCS#1 block encoding EME-PKCS1-v1_5 in Section 7.2.1 of [RFC3447] to
-- form the "m" value used in the formulas above. See Section 14.1 of
-- this document for notes on OpenPGP's use of PKCS#1.
privateCv25519Key :: OpenPGP.Packet -> Maybe Cv25519.SecretKey
privateCv25519Key k@SecretKeyPacket { key_algorithm = ECC, symmetric_algorithm = Unencrypted } = do
guard $ oid_cv25519 == keyParam 'c' k
case Cv25519.secretKey $ zeroExtend 32 $ integerToLE (keyParam 'd' k) of
CryptoPassed cv25519sec -> Just cv25519sec
CryptoFailed err -> Nothing
hexify = map toUpper . hexString . BS.unpack
hexString :: [Word8] -> String
hexString = foldr (pad `oo` showHex) ""
where
pad s | odd $ length s = '0':s
| otherwise = s
oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c
oo = (.) . (.)
cv25519Key :: [(Char,MPI)] -> Maybe Cv25519.PublicKey
cv25519Key k = do
MPI flag <- lookup 'f' k
n <- case flag of
0x40 -> zeroPad 32 . integerToBS . (\(MPI n)-> n) <$> lookup 'n' k
-- TODO: The following was based on Ed25519. Verify that it is correct for Cv25519.
_ -> do MPI y <- lookup 'y' k
MPI x <- lookup 'x' k
let ybs = zeroExtend 32 $ integerToLE y
lb = BS.last ybs
return $ if x < 0 then BS.take 31 ybs `BS.snoc` (lb .|. 0x80)
else BS.take 31 ybs `BS.snoc` (lb .&. 0x7F)
maybeCryptoError $ Cv25519.publicKey n
kdfParams :: OpenPGP.Packet -> (OpenPGP.HashAlgorithm, OpenPGP.SymmetricAlgorithm)
kdfParams k = toEnum *** toEnum $ divMod e 256
where
e = 0x0FFFF .&. (fromIntegral $ keyParam 'e' k)
-- flen <- get :: Get Word8 -- always 3 (length of following bytes)
-- one <- get :: Get Word8 -- always 0x01 (reserved)
-- hashid <- get :: Get Word8 -- HashAlgorithm
-- algoid <- get :: Get Word8 -- SymmetricAlgorithm
data SomeKeyCipher = forall c. BlockCipher128 c => SomeKeyCipher c
someAES128 :: AES128 -> SomeKeyCipher
someAES192 :: AES192 -> SomeKeyCipher
someAES256 :: AES256 -> SomeKeyCipher
someAES128 = SomeKeyCipher
someAES192 = SomeKeyCipher
someAES256 = SomeKeyCipher
keyCipher :: OpenPGP.SymmetricAlgorithm -> BS.ByteString -> Maybe SomeKeyCipher
keyCipher OpenPGP.AES128 key = someAES128 <$> maybeCryptoError (cipherInit key)
keyCipher OpenPGP.AES192 key = someAES192 <$> maybeCryptoError (cipherInit key)
keyCipher OpenPGP.AES256 key = someAES256 <$> maybeCryptoError (cipherInit key)
keyCipher _ _ = Nothing
keyCipherSize OpenPGP.AES128 = cipherKeySize (undefined :: AES128)
keyCipherSize OpenPGP.AES192 = cipherKeySize (undefined :: AES192)
keyCipherSize OpenPGP.AES256 = cipherKeySize (undefined :: AES256)
kdfParamBytes :: OpenPGP.Packet -> BL.ByteString
kdfParamBytes k = BL.fromChunks
[ BL.toStrict $ encodeOID (MPI $ keyParam 'c' k) -- curve_OID_len || curve_OID
, BS.singleton $ fromIntegral $ fromEnum $ key_algorithm k -- public_key_alg_ID
, BL.toStrict $ encode (fromIntegral (keyParam 'e' k) :: Word32) -- 03 || 01 || KDF_hash_ID || KEK_alg_ID for AESKeyWrap
, B8.pack "Anonymous Sender "
, let Fingerprint fp = fingerprint k in fp
]
-- The Concatenation Key Derivation Function (Approved Alternative 1) [SP800-56A]
kdf :: OpenPGP.HashAlgorithm -> Cv25519.DhSecret -> Int -> BL.ByteString -> Maybe BL.ByteString
kdf hsh z keybytelen otherinfo
| reps > 2^32 - 1 = Nothing
-- XXX: I don't understand /max_hash_inputlen/.
--
-- max_hash_inputlen: an integer that indicates the maximum length (in
-- bits) of the bit string(s) input to the hash function.
--
-- | 8 * (BS.length zo) > max_hash_inputlen - 32 = Nothing
| otherwise = Just derivedKeyingMaterial
where
keydatalen = 8 * fromIntegral keybytelen :: Int64
hashlen = 8 * fromIntegral (hashLen hsh) :: Int64
reps = fromIntegral $ (keydatalen + hashlen - 1) `div` hashlen
counter = 0x00000001 :: Word32
zo = BL.fromStrict (BA.convert z) <> otherinfo
hashes = [ hashBySymbol hsh (encode (i::Word32) <> zo)
| i <- [1 .. reps] ] -- Compute Hash i = H(counter || Z || OtherInfo).
-- Let Hhash be set to Hash[reps] if (keydatalen / hashlen) is an integer; otherwise, let Hhash
-- be set to the (keydatalen mod hashlen) leftmost bits of Hash[reps].
hhash = case keydatalen `mod` hashlen of
0 -> last hashes
r -> BS.take (fromIntegral $ (r + 7) `div` 8) $ last hashes -- TODO: Zero out the 8 - (r `mod` 8) last bits?
derivedKeyingMaterial = BL.fromChunks $ init hashes ++ [ hhash ]
-- The input to the key wrapping method is the value "m" derived from
-- the session key, as described in Section 5.1, "Public-Key Encrypted
-- Session Key Packets (Tag 1)", except that the PKCS #1.5 padding step
-- is omitted. The result is padded using the method described in
-- [PKCS5] to the 8-byte granularity. For example, the following
-- AES-256 session key, in which 32 octets are denoted from k0 to k31,
-- is composed to form the following 40 octet sequence:
--
-- 09 k0 k1 ... k31 c0 c1 05 05 05 05 05
--
-- The octets c0 and c1 above denote the checksum. This encoding allows
-- the sender to obfuscate the size of the symmetric encryption key used
-- to encrypt the data. For example, assuming that an AES algorithm is
-- used for the session key, the sender MAY use 21, 13, and 5 bytes of
-- padding for AES-128, AES-192, and AES-256, respectively, to provide
-- the same number of octets, 40 total, as an input to the key wrapping
-- method.
--
-- From Section 5.1, "Public-Key Encrypted Session Key Packets (Tag 1)"
--
-- The value "m" in the above formulas is derived from the session key
-- as follows. First, the session key is prefixed with a one-octet
-- algorithm identifier that specifies the symmetric encryption
-- algorithm used to encrypt the following Symmetrically Encrypted Data
-- Packet. Then a two-octet checksum is appended, which is equal to the
-- sum of the preceding session key octets, not including the algorithm
-- identifier, modulo 65536. This value is then encoded as described in
-- PKCS#1 block encoding EME-PKCS1-v1_5 in Section 7.2.1 of [RFC3447] to
-- form the "m" value used in the formulas above. See Section 14.1 of
-- this document for notes on OpenPGP's use of PKCS#1.
decodeEncryptedKey :: ByteString -> Maybe (SymmetricAlgorithm, ByteString)
decodeEncryptedKey m = do
(algb,ks) <- BS.uncons m
let alg = toEnum $ fromIntegral algb :: OpenPGP.SymmetricAlgorithm
sz <- case keyCipherSize alg of
KeySizeFixed n -> Just n
_ -> Nothing
let (key,macbs) = BS.splitAt sz ks
(macb,trail) = BS.splitAt 2 macbs
mac = decode $ BL.fromStrict macb :: Word16
chk = sum $ map fromIntegral $ BS.unpack key
guard $ chk == mac
Just (alg, key)
decryptMessage :: Packet -- ^ local secret key (ecdh cv25519)
-> Packet -- ^ ephemeral remote public key (ecdh cv25519) and encrypted symmetric key.
-> Packet -- ^ symmetrically encrypted data packet
-> Maybe [Packet]
decryptMessage ecdhkey asym encdta = do
(pubk,m) <- getEphemeralKey asym
pub25519 <- cv25519Key pubk
sec25519 <- privateCv25519Key ecdhkey
let shared = Cv25519.dh pub25519 sec25519
(hsh, alg) = kdfParams ecdhkey
miv = let sz = case keyCipherSize alg of
KeySizeFixed n -> n
KeySizeEnum ns -> head ns
KeySizeRange mn mx -> mn
in kdf hsh shared sz (kdfParamBytes ecdhkey)
(alg,k) <- do
iv <- BL.toStrict <$> miv
SomeKeyCipher c <- keyCipher alg iv
m' <- aesKeyUnwrap c (BL.toStrict m) :: Maybe BS.ByteString
decodeEncryptedKey m'
withS2K' alg Nothing (BL.fromStrict k) $ \cipher -> do
let blksize = blockSize cipher
b0 = simpleUnCFB cipher nullIV (encrypted_data encdta)
b1 = BL.drop (2 + fromIntegral blksize) b0
(_,_, Message ps) <- either (const Nothing) Just $ decodeOrFail b1
return ps
|
