diff options
Diffstat (limited to 'Data/OpenPGP/Crypto.hs')
-rw-r--r-- | Data/OpenPGP/Crypto.hs | 82 |
1 files changed, 82 insertions, 0 deletions
diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs new file mode 100644 index 0000000..e2151fc --- /dev/null +++ b/Data/OpenPGP/Crypto.hs | |||
@@ -0,0 +1,82 @@ | |||
1 | module Data.OpenPGP.Crypto (verify, fingerprint) where | ||
2 | |||
3 | import Data.Word | ||
4 | import Data.Map ((!)) | ||
5 | import qualified Data.ByteString.Lazy as LZ | ||
6 | |||
7 | import Data.Binary | ||
8 | import qualified Codec.Encryption.RSA as RSA | ||
9 | import qualified Data.Digest.MD5 as MD5 | ||
10 | import qualified Data.Digest.SHA1 as SHA1 | ||
11 | import qualified Data.Digest.SHA256 as SHA256 | ||
12 | import qualified Data.Digest.SHA384 as SHA384 | ||
13 | import qualified Data.Digest.SHA512 as SHA512 | ||
14 | |||
15 | import qualified Data.OpenPGP as OpenPGP | ||
16 | import qualified Data.BaseConvert as BaseConvert | ||
17 | |||
18 | -- http://tools.ietf.org/html/rfc4880#section-12.2 | ||
19 | fingerprint :: OpenPGP.Packet -> String | ||
20 | fingerprint p | OpenPGP.version p == 4 = | ||
21 | BaseConvert.toString 16 $ SHA1.toInteger $ SHA1.hash $ | ||
22 | LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p)) | ||
23 | fingerprint p | OpenPGP.version p `elem` [2, 3] = | ||
24 | concatMap (BaseConvert.toString 16) $ | ||
25 | MD5.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p)) | ||
26 | fingerprint _ = error "Unsupported Packet version or type in fingerprint." | ||
27 | |||
28 | find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet | ||
29 | find_key (OpenPGP.Message (x@(OpenPGP.PublicKeyPacket {}):xs)) keyid = | ||
30 | find_key_ x xs keyid | ||
31 | find_key (OpenPGP.Message (x@(OpenPGP.SecretKeyPacket {}):xs)) keyid = | ||
32 | find_key_ x xs keyid | ||
33 | find_key _ _ = Nothing | ||
34 | |||
35 | find_key_ :: OpenPGP.Packet -> [OpenPGP.Packet] -> String -> Maybe OpenPGP.Packet | ||
36 | find_key_ x xs keyid = | ||
37 | if thisid == keyid then Just x else find_key (OpenPGP.Message xs) keyid | ||
38 | where thisid = reverse $ | ||
39 | take (length keyid) (reverse (fingerprint x)) | ||
40 | |||
41 | keyfield_as_octets :: OpenPGP.Packet -> Char -> [Word8] | ||
42 | keyfield_as_octets k f = | ||
43 | LZ.unpack $ LZ.drop 2 (encode (k' ! f)) | ||
44 | where k' = OpenPGP.key k | ||
45 | |||
46 | -- http://tools.ietf.org/html/rfc3447#page-43 | ||
47 | emsa_pkcs1_v1_5_hash_padding :: OpenPGP.HashAlgorithm -> [Word8] | ||
48 | emsa_pkcs1_v1_5_hash_padding OpenPGP.MD5 = [0x30, 0x20, 0x30, 0x0c, 0x06, 0x08, 0x2a, 0x86, 0x48, 0x86, 0xf7, 0x0d, 0x02, 0x05, 0x05, 0x00, 0x04, 0x10] | ||
49 | emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA1 = [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2b, 0x0e, 0x03, 0x02, 0x1a, 0x05, 0x00, 0x04, 0x14] | ||
50 | emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA256 = [0x30, 0x31, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01, 0x05, 0x00, 0x04, 0x20] | ||
51 | emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA384 = [0x30, 0x41, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02, 0x05, 0x00, 0x04, 0x30] | ||
52 | emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA512 = [0x30, 0x51, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03, 0x05, 0x00, 0x04, 0x40] | ||
53 | emsa_pkcs1_v1_5_hash_padding _ = | ||
54 | error "Unsupported HashAlgorithm in emsa_pkcs1_v1_5_hash_padding." | ||
55 | |||
56 | hash :: OpenPGP.HashAlgorithm -> [Word8] -> [Word8] | ||
57 | hash OpenPGP.MD5 = MD5.hash | ||
58 | hash OpenPGP.SHA1 = reverse . drop 2 . LZ.unpack . encode . OpenPGP.MPI . SHA1.toInteger . SHA1.hash | ||
59 | hash OpenPGP.SHA256 = SHA256.hash | ||
60 | hash OpenPGP.SHA384 = SHA384.hash | ||
61 | hash OpenPGP.SHA512 = SHA512.hash | ||
62 | hash _ = error "Unsupported HashAlgorithm in hash." | ||
63 | |||
64 | emsa_pkcs1_v1_5_encode :: [Word8] -> Int -> OpenPGP.HashAlgorithm -> [Word8] | ||
65 | emsa_pkcs1_v1_5_encode m emLen algo = | ||
66 | [0, 1] ++ replicate (emLen - length t - 3) 0xff ++ [0] ++ t | ||
67 | where t = emsa_pkcs1_v1_5_hash_padding algo ++ hash algo m | ||
68 | |||
69 | verify :: OpenPGP.Message -> OpenPGP.Message -> Int -> Bool | ||
70 | verify keys packet sigidx = | ||
71 | encoded == RSA.encrypt (n, e) raw_sig | ||
72 | where | ||
73 | raw_sig = LZ.unpack $ LZ.drop 2 $ encode (OpenPGP.signature sig) | ||
74 | encoded = emsa_pkcs1_v1_5_encode signature_over | ||
75 | (length n) (OpenPGP.hash_algorithm sig) | ||
76 | signature_over = LZ.unpack $ dta `LZ.append` OpenPGP.trailer sig | ||
77 | (n, e) = (keyfield_as_octets k 'n', keyfield_as_octets k 'e') | ||
78 | Just k = find_key keys issuer | ||
79 | Just issuer = OpenPGP.signature_issuer sig | ||
80 | sig = sigs !! sigidx | ||
81 | (sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) = | ||
82 | OpenPGP.signatures_and_data packet | ||