diff options
author | joe <joe@jerkface.net> | 2013-12-14 22:34:26 -0500 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-12-14 22:34:26 -0500 |
commit | ce0d32ef83ccf15198bdd5248faa02abbcf2f769 (patch) | |
tree | 96155973d7af58bbb79a8f67a21f646af46cb47f /Data/OpenPGP/Util/DecryptSecretKey.hs |
New package openpgp-util as alternative to OpenPGP-CryptoAPI.
Diffstat (limited to 'Data/OpenPGP/Util/DecryptSecretKey.hs')
-rw-r--r-- | Data/OpenPGP/Util/DecryptSecretKey.hs | 134 |
1 files changed, 134 insertions, 0 deletions
diff --git a/Data/OpenPGP/Util/DecryptSecretKey.hs b/Data/OpenPGP/Util/DecryptSecretKey.hs new file mode 100644 index 0000000..0ba89d2 --- /dev/null +++ b/Data/OpenPGP/Util/DecryptSecretKey.hs | |||
@@ -0,0 +1,134 @@ | |||
1 | module Data.OpenPGP.Util.DecryptSecretKey where | ||
2 | |||
3 | import qualified Data.OpenPGP as OpenPGP | ||
4 | import qualified Data.ByteString as BS | ||
5 | import qualified Data.ByteString.Lazy as LZ | ||
6 | import Data.Word (Word16,Word8) | ||
7 | import Data.Char (toUpper) | ||
8 | import Control.Monad (foldM) | ||
9 | import Numeric (showHex) | ||
10 | import Data.Binary (get,Binary,Get) | ||
11 | import Data.Binary.Get (runGetOrFail) | ||
12 | import qualified Data.Serialize as Serialize | ||
13 | import Control.Applicative ( (<$>) ) | ||
14 | |||
15 | import Crypto.Hash.MD5 as MD5 | ||
16 | import Crypto.Hash.SHA1 as SHA1 | ||
17 | import Crypto.Hash.SHA256 as SHA256 | ||
18 | import Crypto.Hash.SHA384 as SHA384 | ||
19 | import Crypto.Hash.SHA512 as SHA512 | ||
20 | import Crypto.Hash.SHA224 as SHA224 | ||
21 | import Crypto.Hash.RIPEMD160 as RIPEMD160 | ||
22 | |||
23 | import qualified Crypto.Cipher.AES as Vincent | ||
24 | import qualified Crypto.Cipher.Blowfish as Vincent | ||
25 | |||
26 | import qualified Crypto.Cipher.Types as Vincent | ||
27 | import qualified Data.Byteable as Vincent | ||
28 | |||
29 | import Crypto.Cipher.Cast5 (CAST5_128) | ||
30 | import Crypto.Cipher.ThomasToVincent | ||
31 | |||
32 | |||
33 | hashBySymbol OpenPGP.MD5 = MD5.hashlazy | ||
34 | hashBySymbol OpenPGP.SHA1 = SHA1.hashlazy | ||
35 | hashBySymbol OpenPGP.SHA256 = SHA256.hashlazy | ||
36 | hashBySymbol OpenPGP.SHA384 = SHA384.hashlazy | ||
37 | hashBySymbol OpenPGP.SHA512 = SHA512.hashlazy | ||
38 | hashBySymbol OpenPGP.SHA224 = SHA224.hashlazy | ||
39 | hashBySymbol OpenPGP.RIPEMD160 = RIPEMD160.hashlazy | ||
40 | |||
41 | |||
42 | |||
43 | data Enciphered = | ||
44 | EncipheredWithIV !LZ.ByteString -- initial vector is appended to front of ByteString | ||
45 | | EncipheredZeroIV !LZ.ByteString -- initial vector is zero, ByteString contains only the block | ||
46 | |||
47 | withIV :: (Vincent.BlockCipher k) => (Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString | ||
48 | withIV f (EncipheredWithIV s) = f iv bs | ||
49 | where | ||
50 | Just iv = Vincent.makeIV (toStrictBS ivbs) | ||
51 | (ivbs,bs) = LZ.splitAt (fromIntegral ivlen) s | ||
52 | ivlen = Vincent.byteableLength z | ||
53 | z = Vincent.nullIV | ||
54 | _ = Vincent.constEqBytes z iv | ||
55 | withIV f (EncipheredZeroIV s) = f Vincent.nullIV s | ||
56 | |||
57 | decryptSecretKey :: | ||
58 | BS.ByteString -- ^ Passphrase | ||
59 | -> OpenPGP.Packet -- ^ Encrypted SecretKeyPacket | ||
60 | -> Maybe OpenPGP.Packet -- ^ Decrypted SecretKeyPacket | ||
61 | decryptSecretKey pass k@(OpenPGP.SecretKeyPacket { | ||
62 | OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo, | ||
63 | OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo, | ||
64 | OpenPGP.key = existing, OpenPGP.encrypted_data = encd | ||
65 | }) | chkF material == toStrictBS chk = | ||
66 | fmap (\m -> k { | ||
67 | OpenPGP.s2k_useage = 0, | ||
68 | OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted, | ||
69 | OpenPGP.encrypted_data = LZ.empty, | ||
70 | OpenPGP.key = m | ||
71 | }) parseMaterial | ||
72 | | otherwise = Nothing | ||
73 | where | ||
74 | parseMaterial = maybeGet | ||
75 | (foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing | ||
76 | (OpenPGP.secret_key_fields kalgo)) material | ||
77 | (material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd | ||
78 | (chkSize, chkF) | ||
79 | | OpenPGP.s2k_useage k == 254 = (20, SHA1.hash . toStrictBS) | ||
80 | | otherwise = (2, Serialize.encode . checksum . toStrictBS) | ||
81 | decd = string2sdecrypt salgo s2k (toLazyBS pass) (EncipheredWithIV encd) | ||
82 | |||
83 | checksum :: BS.ByteString -> Word16 | ||
84 | checksum key = fromIntegral $ | ||
85 | BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536 | ||
86 | |||
87 | maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a | ||
88 | maybeGet g bs = (\(_,_,x) -> x) <$> hush (runGetOrFail g bs) | ||
89 | |||
90 | hush :: Either a b -> Maybe b | ||
91 | hush (Left _) = Nothing | ||
92 | hush (Right x) = Just x | ||
93 | |||
94 | |||
95 | decryptSecretKey _ _ = Nothing | ||
96 | |||
97 | toStrictBS :: LZ.ByteString -> BS.ByteString | ||
98 | toStrictBS = BS.concat . LZ.toChunks | ||
99 | |||
100 | toLazyBS :: BS.ByteString -> LZ.ByteString | ||
101 | toLazyBS = LZ.fromChunks . (:[]) | ||
102 | |||
103 | |||
104 | |||
105 | string2sdecrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Enciphered -> LZ.ByteString | ||
106 | string2sdecrypt OpenPGP.AES128 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES128) | ||
107 | string2sdecrypt OpenPGP.AES192 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES192) | ||
108 | string2sdecrypt OpenPGP.AES256 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES256) | ||
109 | string2sdecrypt OpenPGP.Blowfish s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.Blowfish128) | ||
110 | string2sdecrypt OpenPGP.CAST5 s2k s = withIV $ simpleUnCFB (string2key s2k s :: ThomasToVincent CAST5_128) | ||
111 | string2sdecrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2sdecrypt" | ||
112 | |||
113 | simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString | ||
114 | simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS) | ||
115 | where | ||
116 | padThenUnpad :: (Vincent.BlockCipher k) => k -> (LZ.ByteString -> LZ.ByteString) -> LZ.ByteString -> LZ.ByteString | ||
117 | padThenUnpad k f s = dropPadEnd (f padded) | ||
118 | where | ||
119 | dropPadEnd s = LZ.take (LZ.length s - padAmount) s | ||
120 | padded = s `LZ.append` LZ.replicate padAmount 0 | ||
121 | padAmount = blksize - (LZ.length s `mod` blksize) | ||
122 | blksize = fromIntegral $ Vincent.blockSize k | ||
123 | |||
124 | string2key :: (Vincent.BlockCipher k) => OpenPGP.S2K -> LZ.ByteString -> k | ||
125 | string2key s2k s = cipher | ||
126 | where | ||
127 | cipher = Vincent.cipherInit k | ||
128 | Right k = Vincent.makeKey $ toStrictBS $ | ||
129 | LZ.take ksize $ OpenPGP.string2key hashBySymbol s2k s | ||
130 | ksize = case Vincent.cipherKeySize cipher of | ||
131 | Vincent.KeySizeFixed n -> fromIntegral n | ||
132 | Vincent.KeySizeEnum xs -> error $ "Unknown key size in string2key" | ||
133 | Vincent.KeySizeRange min max -> error $ "Unknown key size range in string2key" | ||
134 | |||