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
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
module Data.OpenPGP.Util.DecryptSecretKey where
import qualified Data.OpenPGP as OpenPGP
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LZ
import Data.Word (Word16)
import Data.Maybe
import Control.Monad (foldM)
import Data.Binary (get,Binary,Get,encode,put)
#if MIN_VERSION_binary(0,6,4)
import Data.Binary.Get (runGetOrFail)
#else
import Control.Exception as Exception (handle,ErrorCall(..))
import System.IO.Unsafe
import Data.Binary.Get (runGet)
#endif
import Control.Exception as Exception (IOException(..),catch)
import Data.Binary.Put (runPut)
import Control.Applicative ( (<$>) )
import Crypto.Hash.SHA1 as SHA1
import qualified Crypto.Cipher.AES as Vincent
import qualified Crypto.Cipher.Blowfish as Vincent
import qualified Crypto.Cipher.Types as Vincent
import qualified Data.Byteable as Vincent
import qualified Crypto.Random as Vincent
import Crypto.Cipher.Cast5 (CAST5_128)
import Crypto.Cipher.ThomasToVincent
import Data.OpenPGP.Util.Base (toStrictBS,toLazyBS,hashBySymbol)
data Enciphered =
EncipheredWithIV !LZ.ByteString -- initial vector is appended to front of ByteString
| EncipheredZeroIV !LZ.ByteString -- initial vector is zero, ByteString contains only the block
withIV :: (Vincent.BlockCipher k) => (Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString
withIV f (EncipheredWithIV s) = f iv bs
where
Just iv = Vincent.makeIV (toStrictBS ivbs)
(ivbs,bs) = LZ.splitAt (fromIntegral ivlen) s
ivlen = Vincent.byteableLength z
z = Vincent.nullIV
_ = Vincent.constEqBytes z iv
withIV f (EncipheredZeroIV s) = f Vincent.nullIV s
decryptSecretKey ::
BS.ByteString -- ^ Passphrase
-> OpenPGP.Packet -- ^ Encrypted SecretKeyPacket
-> Maybe OpenPGP.Packet -- ^ Decrypted SecretKeyPacket
decryptSecretKey _ k@(OpenPGP.SecretKeyPacket { OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted })
= Just k
decryptSecretKey pass k@(OpenPGP.SecretKeyPacket {
OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo,
OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo,
OpenPGP.key = existing, OpenPGP.encrypted_data = encd
}) | chkF material == toStrictBS chk =
fmap (\m -> k {
OpenPGP.s2k_useage = 0,
OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted,
OpenPGP.encrypted_data = LZ.empty,
OpenPGP.key = m
}) parseMaterial
| otherwise = Nothing
where
parseMaterial = maybeGet
(foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing
(OpenPGP.secret_key_fields kalgo)) material
(material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd
(chkSize, chkF)
| OpenPGP.s2k_useage k == 254 = (20, SHA1.hash . toStrictBS)
| otherwise = (2, toStrictBS . encode . checksum . toStrictBS)
-- Words16s are written as 2 bytes in big-endian (network) order
decd = withS2K simpleUnCFB salgo s2k (toLazyBS pass) (EncipheredWithIV encd)
decryptSecretKey _ _ = Nothing
checksum :: BS.ByteString -> Word16
checksum key = fromIntegral $
BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536
#if MIN_VERSION_binary(0,6,4)
maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a
maybeGet g bs = (\(_,_,x) -> x) <$> hush (runGetOrFail g bs)
where
hush :: Either a b -> Maybe b
hush (Left _) = Nothing
hush (Right x) = Just x
#else
maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a
maybeGet g bs = unsafePerformIO $
handle (\(ErrorCall _)-> return Nothing) $ return . Just $ runGet g bs
#endif
withS2K :: (forall k. (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString)
-> OpenPGP.SymmetricAlgorithm
-> OpenPGP.S2K
-> LZ.ByteString -> Enciphered -> LZ.ByteString
withS2K codec OpenPGP.AES128 s2k s = withIV $ codec (string2key s2k s :: Vincent.AES128)
withS2K codec OpenPGP.AES192 s2k s = withIV $ codec (string2key s2k s :: Vincent.AES192)
withS2K codec OpenPGP.AES256 s2k s = withIV $ codec (string2key s2k s :: Vincent.AES256)
withS2K codec OpenPGP.Blowfish s2k s = withIV $ codec (string2key s2k s :: Vincent.Blowfish128)
withS2K codec OpenPGP.CAST5 s2k s = withIV $ codec (string2key s2k s :: ThomasToVincent CAST5_128)
withS2K codec algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.withS2K"
withS2K' :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString
-> (forall b. Vincent.BlockCipher b => b -> x) -> x
withS2K' OpenPGP.AES128 s2k s f = f (string2key s2k s :: Vincent.AES128)
withS2K' OpenPGP.AES192 s2k s f = f (string2key s2k s :: Vincent.AES192)
withS2K' OpenPGP.AES256 s2k s f = f (string2key s2k s :: Vincent.AES256)
withS2K' OpenPGP.Blowfish s2k s f = f (string2key s2k s :: Vincent.Blowfish128)
withS2K' OpenPGP.CAST5 s2k s f = f (string2key s2k s :: ThomasToVincent CAST5_128)
-- decryption codec for withS2K
simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString
simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS)
simpleCFB :: (Vincent.BlockCipher k, Vincent.CPRG g) => g -> k -> LZ.ByteString -> (LZ.ByteString, g)
simpleCFB g k bs = ( padThenUnpad k (LZ.fromChunks . (ivbs:) . (:[]) . Vincent.cfbEncrypt k iv . toStrictBS) bs
, g' )
where
Just iv = Vincent.makeIV ivbs
(ivbs,g') = Vincent.cprgGenerate ivlen g
ivlen = Vincent.byteableLength z
z = Vincent.nullIV
_ = Vincent.constEqBytes z iv
-- Apply a function f to a zero-padded bytestring s to a multiple
-- of the blocksize for cyper k.
-- Then drop the same number of bytes from the result of f.
padThenUnpad :: (Vincent.BlockCipher k) => k -> (LZ.ByteString -> LZ.ByteString) -> LZ.ByteString -> LZ.ByteString
padThenUnpad k f s = dropPadEnd (f padded)
where
dropPadEnd s = LZ.take (LZ.length s - padAmount) s
padded = s `LZ.append` LZ.replicate padAmount 0
padAmount = blksize - (LZ.length s `mod` blksize)
blksize = fromIntegral $ Vincent.blockSize k
string2key :: (Vincent.BlockCipher k) => OpenPGP.S2K -> LZ.ByteString -> k
string2key s2k s = cipher
where
cipher = Vincent.cipherInit k
Right k = Vincent.makeKey $ toStrictBS $
LZ.take ksize $ OpenPGP.string2key hashBySymbol s2k s
ksize = case Vincent.cipherKeySize cipher of
Vincent.KeySizeFixed n -> fromIntegral n
Vincent.KeySizeEnum xs -> error $ "Unknown key size in string2key"
Vincent.KeySizeRange min max -> error $ "Unknown key size range in string2key"
catchIO_ :: IO a -> IO a -> IO a
catchIO_ a h = Exception.catch a (\(_ :: IOException) -> h)
encryptSecretKey :: BS.ByteString -> OpenPGP.S2K -> OpenPGP.SymmetricAlgorithm -> OpenPGP.Packet -> IO (Maybe OpenPGP.Packet)
encryptSecretKey passphrase s2k salgo plain = do
flip catchIO_ (return Nothing) $ do
g <- fmap Vincent.cprgCreate $ Vincent.createEntropyPool
let _ = g :: Vincent.SystemRNG
return $ Just
plain { OpenPGP.key = [ x | x <- OpenPGP.key plain
, fst x `elem` OpenPGP.public_key_fields (OpenPGP.key_algorithm plain) ]
, OpenPGP.symmetric_algorithm = salgo
, OpenPGP.s2k = s2k
, OpenPGP.s2k_useage = s2k_usage_octet
, OpenPGP.encrypted_data = encd g
}
where
material = runPut $ mapM_ put $ do
f <- OpenPGP.secret_key_fields (OpenPGP.key_algorithm plain)
maybeToList $ lookup f (OpenPGP.key plain)
chk = LZ.fromChunks [ chkF material ]
decd = LZ.append material chk
encd g = fst $ withS2K' salgo s2k (toLazyBS passphrase) (simpleCFB g) decd
-- If the string-to-key usage octet is zero or 255, then a two-octet
-- checksum of the plaintext of the algorithm-specific portion (sum
-- of all octets, mod 65536). If the string-to-key usage octet was
-- 254, then a 20-octet SHA-1 hash of the plaintext of the
-- algorithm-specific portion. This checksum or hash is encrypted
-- together with the algorithm-specific fields (if string-to-key
-- usage octet is not zero). Note that for all other values, a
-- two-octet checksum is required.
s2k_usage_octet = 255
-- chkSize = 2
chkF = toStrictBS . encode . checksum . toStrictBS
-- k = string2key s2k passphrase -- OpenPGP.string2key hashBySymbol s2k passphrase
|
