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
|
{-# LANGUAGE CPP #-}
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 Control.Monad (foldM)
import Data.Binary (get,Binary,Get,encode)
#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.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 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 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 = string2sdecrypt salgo s2k (toLazyBS pass) (EncipheredWithIV encd)
checksum :: BS.ByteString -> Word16
checksum key = fromIntegral $
BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536
decryptSecretKey _ _ = Nothing
#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
string2sdecrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Enciphered -> LZ.ByteString
string2sdecrypt OpenPGP.AES128 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES128)
string2sdecrypt OpenPGP.AES192 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES192)
string2sdecrypt OpenPGP.AES256 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES256)
string2sdecrypt OpenPGP.Blowfish s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.Blowfish128)
string2sdecrypt OpenPGP.CAST5 s2k s = withIV $ simpleUnCFB (string2key s2k s :: ThomasToVincent CAST5_128)
string2sdecrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2sdecrypt"
simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString
simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS)
where
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"
|
