diff options
Diffstat (limited to 'Data/OpenPGP')
-rw-r--r-- | Data/OpenPGP/Util.hs | 12 | ||||
-rw-r--r-- | Data/OpenPGP/Util/Base.hs | 83 | ||||
-rw-r--r-- | Data/OpenPGP/Util/DecryptSecretKey.hs | 126 | ||||
-rw-r--r-- | Data/OpenPGP/Util/Fingerprint.hs | 33 | ||||
-rw-r--r-- | Data/OpenPGP/Util/Sign.hs | 170 | ||||
-rw-r--r-- | Data/OpenPGP/Util/Verify.hs | 74 |
6 files changed, 498 insertions, 0 deletions
diff --git a/Data/OpenPGP/Util.hs b/Data/OpenPGP/Util.hs new file mode 100644 index 0000000..c675ec2 --- /dev/null +++ b/Data/OpenPGP/Util.hs | |||
@@ -0,0 +1,12 @@ | |||
1 | module Data.OpenPGP.Util | ||
2 | ( fingerprint | ||
3 | , decryptSecretKey | ||
4 | , verify | ||
5 | , pgpSign | ||
6 | ) where | ||
7 | |||
8 | import Data.OpenPGP.Util.Fingerprint | ||
9 | import Data.OpenPGP.Util.Sign | ||
10 | import Data.OpenPGP.Util.Verify | ||
11 | import Data.OpenPGP.Util.DecryptSecretKey | ||
12 | |||
diff --git a/Data/OpenPGP/Util/Base.hs b/Data/OpenPGP/Util/Base.hs new file mode 100644 index 0000000..aaa02c7 --- /dev/null +++ b/Data/OpenPGP/Util/Base.hs | |||
@@ -0,0 +1,83 @@ | |||
1 | module Data.OpenPGP.Util.Base where | ||
2 | |||
3 | import qualified Data.ByteString as BS | ||
4 | import qualified Data.ByteString.Lazy as LZ | ||
5 | import Data.Binary (encode) | ||
6 | |||
7 | import Data.OpenPGP as OpenPGP | ||
8 | import Crypto.Hash.MD5 as MD5 | ||
9 | import Crypto.Hash.SHA1 as SHA1 | ||
10 | import Crypto.Hash.SHA256 as SHA256 | ||
11 | import Crypto.Hash.SHA384 as SHA384 | ||
12 | import Crypto.Hash.SHA512 as SHA512 | ||
13 | import Crypto.Hash.SHA224 as SHA224 | ||
14 | import Crypto.Hash.RIPEMD160 as RIPEMD160 | ||
15 | import qualified Crypto.PubKey.RSA as Vincent.RSA | ||
16 | import Crypto.PubKey.HashDescr as Vincent | ||
17 | import qualified Crypto.Types.PubKey.ECC as Vincent.ECDSA | ||
18 | import qualified Crypto.Types.PubKey.ECDSA as Vincent.ECDSA | ||
19 | |||
20 | import Data.OpenPGP.Util.Fingerprint (fingerprint) | ||
21 | |||
22 | hashBySymbol OpenPGP.MD5 = MD5.hashlazy | ||
23 | hashBySymbol OpenPGP.SHA1 = SHA1.hashlazy | ||
24 | hashBySymbol OpenPGP.SHA256 = SHA256.hashlazy | ||
25 | hashBySymbol OpenPGP.SHA384 = SHA384.hashlazy | ||
26 | hashBySymbol OpenPGP.SHA512 = SHA512.hashlazy | ||
27 | hashBySymbol OpenPGP.SHA224 = SHA224.hashlazy | ||
28 | hashBySymbol OpenPGP.RIPEMD160 = RIPEMD160.hashlazy | ||
29 | |||
30 | curveFromOID :: Integer -> Vincent.ECDSA.Curve | ||
31 | curveFromOID 0x2a8648ce3d030107 = Vincent.ECDSA.getCurveByName Vincent.ECDSA.SEC_p256r1 -- NIST P-256 | ||
32 | curveFromOID 0x2B81040022 = Vincent.ECDSA.getCurveByName Vincent.ECDSA.SEC_p384r1 -- NIST P-384 | ||
33 | curveFromOID 0x2B81040023 = Vincent.ECDSA.getCurveByName Vincent.ECDSA.SEC_p521r1 -- NIST P-521 | ||
34 | curveFromOID 0x2b8104000a = Vincent.ECDSA.getCurveByName Vincent.ECDSA.SEC_p256k1 -- bitcoin curve | ||
35 | curveFromOID n = error $ "Unknown curve: "++ show n | ||
36 | |||
37 | ecdsaKey k = Vincent.ECDSA.PublicKey curve (Vincent.ECDSA.Point x y) | ||
38 | where | ||
39 | x = keyParam 'x' k | ||
40 | y = keyParam 'y' k | ||
41 | curve = curveFromOID (keyParam 'c' k) | ||
42 | |||
43 | |||
44 | toStrictBS :: LZ.ByteString -> BS.ByteString | ||
45 | toStrictBS = BS.concat . LZ.toChunks | ||
46 | |||
47 | toLazyBS :: BS.ByteString -> LZ.ByteString | ||
48 | toLazyBS = LZ.fromChunks . (:[]) | ||
49 | |||
50 | find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet | ||
51 | find_key = OpenPGP.find_key fingerprint | ||
52 | |||
53 | |||
54 | |||
55 | keyParam :: Char -> OpenPGP.Packet -> Integer | ||
56 | keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k) | ||
57 | where | ||
58 | fromJustMPI :: Maybe OpenPGP.MPI -> Integer | ||
59 | fromJustMPI (Just (OpenPGP.MPI x)) = x | ||
60 | fromJustMPI _ = error "Not a Just MPI, Data.OpenPGP.CryptoAPI" | ||
61 | |||
62 | integerBytesize :: Integer -> Int | ||
63 | integerBytesize i = fromIntegral $ LZ.length (encode (OpenPGP.MPI i)) - 2 | ||
64 | |||
65 | rsaKey :: OpenPGP.Packet -> Vincent.RSA.PublicKey | ||
66 | rsaKey k = | ||
67 | Vincent.RSA.PublicKey (integerBytesize n) n (keyParam 'e' k) | ||
68 | where | ||
69 | n = keyParam 'n' k | ||
70 | |||
71 | -- http://tools.ietf.org/html/rfc3447#page-43 | ||
72 | -- http://tools.ietf.org/html/rfc4880#section-5.2.2 | ||
73 | hashAlgoDesc OpenPGP.MD5 = Vincent.hashDescrMD5 | ||
74 | hashAlgoDesc OpenPGP.SHA1 = Vincent.hashDescrSHA1 | ||
75 | hashAlgoDesc OpenPGP.RIPEMD160 = Vincent.hashDescrRIPEMD160 | ||
76 | hashAlgoDesc OpenPGP.SHA256 = Vincent.hashDescrSHA256 | ||
77 | hashAlgoDesc OpenPGP.SHA384 = Vincent.hashDescrSHA384 | ||
78 | hashAlgoDesc OpenPGP.SHA512 = Vincent.hashDescrSHA512 | ||
79 | hashAlgoDesc OpenPGP.SHA224 = Vincent.hashDescrSHA224 | ||
80 | hashAlgoDesc _ = | ||
81 | error "Unsupported HashAlgorithm in hashAlgoDesc" | ||
82 | |||
83 | |||
diff --git a/Data/OpenPGP/Util/DecryptSecretKey.hs b/Data/OpenPGP/Util/DecryptSecretKey.hs new file mode 100644 index 0000000..6bfc2af --- /dev/null +++ b/Data/OpenPGP/Util/DecryptSecretKey.hs | |||
@@ -0,0 +1,126 @@ | |||
1 | {-# LANGUAGE CPP #-} | ||
2 | module Data.OpenPGP.Util.DecryptSecretKey where | ||
3 | |||
4 | import qualified Data.OpenPGP as OpenPGP | ||
5 | import qualified Data.ByteString as BS | ||
6 | import qualified Data.ByteString.Lazy as LZ | ||
7 | import Data.Word (Word16) | ||
8 | import Control.Monad (foldM) | ||
9 | import Data.Binary (get,Binary,Get,encode) | ||
10 | #if MIN_VERSION_binary(0,6,4) | ||
11 | import Data.Binary.Get (runGetOrFail) | ||
12 | #else | ||
13 | import Control.Exception as Exception (handle,ErrorCall(..)) | ||
14 | import System.IO.Unsafe | ||
15 | import Data.Binary.Get (runGet) | ||
16 | #endif | ||
17 | import Control.Applicative ( (<$>) ) | ||
18 | |||
19 | import Crypto.Hash.SHA1 as SHA1 | ||
20 | |||
21 | import qualified Crypto.Cipher.AES as Vincent | ||
22 | import qualified Crypto.Cipher.Blowfish as Vincent | ||
23 | |||
24 | import qualified Crypto.Cipher.Types as Vincent | ||
25 | import qualified Data.Byteable as Vincent | ||
26 | |||
27 | import Crypto.Cipher.Cast5 (CAST5_128) | ||
28 | import Crypto.Cipher.ThomasToVincent | ||
29 | import Data.OpenPGP.Util.Base (toStrictBS,toLazyBS,hashBySymbol) | ||
30 | |||
31 | |||
32 | |||
33 | |||
34 | data Enciphered = | ||
35 | EncipheredWithIV !LZ.ByteString -- initial vector is appended to front of ByteString | ||
36 | | EncipheredZeroIV !LZ.ByteString -- initial vector is zero, ByteString contains only the block | ||
37 | |||
38 | withIV :: (Vincent.BlockCipher k) => (Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString | ||
39 | withIV f (EncipheredWithIV s) = f iv bs | ||
40 | where | ||
41 | Just iv = Vincent.makeIV (toStrictBS ivbs) | ||
42 | (ivbs,bs) = LZ.splitAt (fromIntegral ivlen) s | ||
43 | ivlen = Vincent.byteableLength z | ||
44 | z = Vincent.nullIV | ||
45 | _ = Vincent.constEqBytes z iv | ||
46 | withIV f (EncipheredZeroIV s) = f Vincent.nullIV s | ||
47 | |||
48 | decryptSecretKey :: | ||
49 | BS.ByteString -- ^ Passphrase | ||
50 | -> OpenPGP.Packet -- ^ Encrypted SecretKeyPacket | ||
51 | -> Maybe OpenPGP.Packet -- ^ Decrypted SecretKeyPacket | ||
52 | decryptSecretKey pass k@(OpenPGP.SecretKeyPacket { | ||
53 | OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo, | ||
54 | OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo, | ||
55 | OpenPGP.key = existing, OpenPGP.encrypted_data = encd | ||
56 | }) | chkF material == toStrictBS chk = | ||
57 | fmap (\m -> k { | ||
58 | OpenPGP.s2k_useage = 0, | ||
59 | OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted, | ||
60 | OpenPGP.encrypted_data = LZ.empty, | ||
61 | OpenPGP.key = m | ||
62 | }) parseMaterial | ||
63 | | otherwise = Nothing | ||
64 | where | ||
65 | parseMaterial = maybeGet | ||
66 | (foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing | ||
67 | (OpenPGP.secret_key_fields kalgo)) material | ||
68 | (material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd | ||
69 | (chkSize, chkF) | ||
70 | | OpenPGP.s2k_useage k == 254 = (20, SHA1.hash . toStrictBS) | ||
71 | | otherwise = (2, toStrictBS . encode . checksum . toStrictBS) | ||
72 | -- Words16s are written as 2 bytes in big-endian (network) order | ||
73 | decd = string2sdecrypt salgo s2k (toLazyBS pass) (EncipheredWithIV encd) | ||
74 | |||
75 | checksum :: BS.ByteString -> Word16 | ||
76 | checksum key = fromIntegral $ | ||
77 | BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536 | ||
78 | |||
79 | decryptSecretKey _ _ = Nothing | ||
80 | |||
81 | |||
82 | #if MIN_VERSION_binary(0,6,4) | ||
83 | maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a | ||
84 | maybeGet g bs = (\(_,_,x) -> x) <$> hush (runGetOrFail g bs) | ||
85 | where | ||
86 | hush :: Either a b -> Maybe b | ||
87 | hush (Left _) = Nothing | ||
88 | hush (Right x) = Just x | ||
89 | #else | ||
90 | maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a | ||
91 | maybeGet g bs = unsafePerformIO $ | ||
92 | handle (\(ErrorCall _)-> return Nothing) $ return . Just $ runGet g bs | ||
93 | #endif | ||
94 | |||
95 | |||
96 | |||
97 | string2sdecrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Enciphered -> LZ.ByteString | ||
98 | string2sdecrypt OpenPGP.AES128 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES128) | ||
99 | string2sdecrypt OpenPGP.AES192 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES192) | ||
100 | string2sdecrypt OpenPGP.AES256 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES256) | ||
101 | string2sdecrypt OpenPGP.Blowfish s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.Blowfish128) | ||
102 | string2sdecrypt OpenPGP.CAST5 s2k s = withIV $ simpleUnCFB (string2key s2k s :: ThomasToVincent CAST5_128) | ||
103 | string2sdecrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2sdecrypt" | ||
104 | |||
105 | simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString | ||
106 | simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS) | ||
107 | where | ||
108 | padThenUnpad :: (Vincent.BlockCipher k) => k -> (LZ.ByteString -> LZ.ByteString) -> LZ.ByteString -> LZ.ByteString | ||
109 | padThenUnpad k f s = dropPadEnd (f padded) | ||
110 | where | ||
111 | dropPadEnd s = LZ.take (LZ.length s - padAmount) s | ||
112 | padded = s `LZ.append` LZ.replicate padAmount 0 | ||
113 | padAmount = blksize - (LZ.length s `mod` blksize) | ||
114 | blksize = fromIntegral $ Vincent.blockSize k | ||
115 | |||
116 | string2key :: (Vincent.BlockCipher k) => OpenPGP.S2K -> LZ.ByteString -> k | ||
117 | string2key s2k s = cipher | ||
118 | where | ||
119 | cipher = Vincent.cipherInit k | ||
120 | Right k = Vincent.makeKey $ toStrictBS $ | ||
121 | LZ.take ksize $ OpenPGP.string2key hashBySymbol s2k s | ||
122 | ksize = case Vincent.cipherKeySize cipher of | ||
123 | Vincent.KeySizeFixed n -> fromIntegral n | ||
124 | Vincent.KeySizeEnum xs -> error $ "Unknown key size in string2key" | ||
125 | Vincent.KeySizeRange min max -> error $ "Unknown key size range in string2key" | ||
126 | |||
diff --git a/Data/OpenPGP/Util/Fingerprint.hs b/Data/OpenPGP/Util/Fingerprint.hs new file mode 100644 index 0000000..538688b --- /dev/null +++ b/Data/OpenPGP/Util/Fingerprint.hs | |||
@@ -0,0 +1,33 @@ | |||
1 | module Data.OpenPGP.Util.Fingerprint (fingerprint) 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.Char (toUpper) | ||
7 | import Data.Word (Word8) | ||
8 | import Numeric (showHex) | ||
9 | |||
10 | import Crypto.Hash.MD5 as MD5 | ||
11 | import Crypto.Hash.SHA1 as SHA1 | ||
12 | |||
13 | -- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket | ||
14 | -- <http://tools.ietf.org/html/rfc4880#section-12.2> | ||
15 | fingerprint :: OpenPGP.Packet -> String | ||
16 | fingerprint p | ||
17 | | OpenPGP.version p == 4 = hexify $ SHA1.hashlazy material | ||
18 | | OpenPGP.version p `elem` [2, 3] = hexify $ MD5.hashlazy material | ||
19 | | otherwise = error "Unsupported Packet version or type in fingerprint" | ||
20 | where | ||
21 | material = LZ.concat $ OpenPGP.fingerprint_material p | ||
22 | |||
23 | hexify = map toUpper . hexString . BS.unpack | ||
24 | |||
25 | hexString :: [Word8] -> String | ||
26 | hexString = foldr (pad `oo` showHex) "" | ||
27 | where | ||
28 | pad s | odd $ length s = '0':s | ||
29 | | otherwise = s | ||
30 | |||
31 | oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c | ||
32 | oo = (.) . (.) | ||
33 | |||
diff --git a/Data/OpenPGP/Util/Sign.hs b/Data/OpenPGP/Util/Sign.hs new file mode 100644 index 0000000..4a6eb4f --- /dev/null +++ b/Data/OpenPGP/Util/Sign.hs | |||
@@ -0,0 +1,170 @@ | |||
1 | {-# LANGUAGE ScopedTypeVariables #-} | ||
2 | module Data.OpenPGP.Util.Sign where | ||
3 | |||
4 | import qualified Data.OpenPGP as OpenPGP | ||
5 | import Data.Maybe | ||
6 | import Data.Binary (encode) | ||
7 | import qualified Data.ByteString as BS | ||
8 | import qualified Data.ByteString.Lazy as LZ | ||
9 | import Data.Bits ( (.|.), shiftL ) | ||
10 | import Control.Applicative ( (<$>) ) | ||
11 | import Data.Time.Clock.POSIX | ||
12 | import Control.Exception as Exception (IOException(..),catch) | ||
13 | |||
14 | import Data.OpenPGP.Util.Fingerprint (fingerprint) | ||
15 | |||
16 | import qualified Crypto.Random as Vincent | ||
17 | import qualified Crypto.PubKey.DSA as Vincent.DSA | ||
18 | import qualified Crypto.PubKey.RSA as Vincent.RSA | ||
19 | import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA | ||
20 | import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA | ||
21 | |||
22 | import Data.OpenPGP.Util.Base | ||
23 | |||
24 | privateECDSAkey :: OpenPGP.Packet -> Vincent.ECDSA.PrivateKey | ||
25 | privateECDSAkey k = Vincent.ECDSA.PrivateKey curve d | ||
26 | where | ||
27 | d = keyParam 'd' k | ||
28 | curve = curveFromOID (keyParam 'c' k) | ||
29 | |||
30 | privateDSAkey :: OpenPGP.Packet -> Vincent.DSA.PrivateKey | ||
31 | privateDSAkey k = Vincent.DSA.PrivateKey | ||
32 | (Vincent.DSA.Params (keyParam 'p' k) (keyParam 'g' k) (keyParam 'q' k)) | ||
33 | (keyParam 'x' k) | ||
34 | privateRSAkey :: OpenPGP.Packet -> Vincent.RSA.PrivateKey | ||
35 | privateRSAkey k = | ||
36 | -- Invert p and q because u is pinv not qinv | ||
37 | Vincent.RSA.PrivateKey pubkey d q p | ||
38 | (d `mod` (q-1)) | ||
39 | (d `mod` (p-1)) | ||
40 | (keyParam 'u' k) | ||
41 | where | ||
42 | d = keyParam 'd' k | ||
43 | p = keyParam 'p' k | ||
44 | q = keyParam 'q' k | ||
45 | pubkey = rsaKey k | ||
46 | |||
47 | |||
48 | |||
49 | -- | Make a signature | ||
50 | -- | ||
51 | -- In order to set more options on a signature, pass in a signature packet. | ||
52 | -- Operation is unsafe in that it silently re-uses "random" bytes when | ||
53 | -- entropy runs out. Use pgpSign for a safer interface. | ||
54 | unsafeSign :: (Vincent.CPRG g) => -- CryptoRandomGen g) => | ||
55 | OpenPGP.Message -- ^ SecretKeys, one of which will be used | ||
56 | -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet | ||
57 | -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature | ||
58 | -> String -- ^ KeyID of key to choose | ||
59 | -> Integer -- ^ Timestamp for signature (unless sig supplied) | ||
60 | -> g -- ^ Random number generator | ||
61 | -> (OpenPGP.SignatureOver, g) | ||
62 | unsafeSign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g') | ||
63 | where | ||
64 | (final, g') = case OpenPGP.key_algorithm sig of | ||
65 | OpenPGP.DSA -> ([dsaR, dsaS], dsaG) | ||
66 | OpenPGP.ECDSA -> ([ecdsaR,ecdsaS],ecdsaG) | ||
67 | kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g) | ||
68 | | otherwise -> | ||
69 | error ("Unsupported key algorithm " ++ show kalgo ++ " in sign") | ||
70 | (Vincent.DSA.Signature dsaR dsaS,dsaG) = let k' = privateDSAkey k in | ||
71 | Vincent.DSA.sign g k' (dsaTruncate k' . bhash) dta | ||
72 | (Vincent.ECDSA.Signature ecdsaR ecdsaS,ecdsaG) = let k' = privateECDSAkey k in | ||
73 | Vincent.ECDSA.sign g k' bhash dta | ||
74 | (Right rsaFinal,_) = Vincent.RSA.signSafer g desc (privateRSAkey k) dta | ||
75 | dsaTruncate (Vincent.DSA.PrivateKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q) | ||
76 | dta = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig | ||
77 | sig = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over) | ||
78 | -- padding = emsa_pkcs1_v1_5_hash_padding hsh | ||
79 | desc = hashAlgoDesc hsh | ||
80 | bhash = hashBySymbol hsh . toLazyBS | ||
81 | toNum = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 | ||
82 | Just k = find_key keys keyid | ||
83 | |||
84 | -- Either a SignaturePacket was found, or we need to make one | ||
85 | findSigOrDefault (Just s) = OpenPGP.signaturePacket | ||
86 | (OpenPGP.version s) | ||
87 | (OpenPGP.signature_type s) | ||
88 | (OpenPGP.key_algorithm k) -- force to algo of key | ||
89 | hsh -- force hash algorithm | ||
90 | (OpenPGP.hashed_subpackets s) | ||
91 | (OpenPGP.unhashed_subpackets s) | ||
92 | (OpenPGP.hash_head s) | ||
93 | (map OpenPGP.MPI final) | ||
94 | findSigOrDefault Nothing = OpenPGP.signaturePacket | ||
95 | 4 | ||
96 | defaultStype | ||
97 | (OpenPGP.key_algorithm k) -- force to algo of key | ||
98 | hsh | ||
99 | ([ | ||
100 | -- Do we really need to pass in timestamp just for the default? | ||
101 | OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp, | ||
102 | OpenPGP.IssuerPacket $ fingerprint k | ||
103 | ] ++ (case over of | ||
104 | OpenPGP.KeySignature {} -> [OpenPGP.KeyFlagsPacket { | ||
105 | OpenPGP.certify_keys = True, | ||
106 | OpenPGP.sign_data = True, | ||
107 | OpenPGP.encrypt_communication = False, | ||
108 | OpenPGP.encrypt_storage = False, | ||
109 | OpenPGP.split_key = False, | ||
110 | OpenPGP.authentication = False, | ||
111 | OpenPGP.group_key = False | ||
112 | }] | ||
113 | _ -> [] | ||
114 | )) | ||
115 | [] | ||
116 | 0 -- TODO | ||
117 | (map OpenPGP.MPI final) | ||
118 | |||
119 | defaultStype = case over of | ||
120 | OpenPGP.DataSignature ld _ | ||
121 | | OpenPGP.format ld == 'b' -> 0x00 | ||
122 | | otherwise -> 0x01 | ||
123 | OpenPGP.KeySignature {} -> 0x1F | ||
124 | OpenPGP.SubkeySignature {} -> 0x18 | ||
125 | OpenPGP.CertificationSignature {} -> 0x13 | ||
126 | |||
127 | |||
128 | |||
129 | now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime | ||
130 | |||
131 | stampit timestamp sig = sig { OpenPGP.hashed_subpackets = hashed' } | ||
132 | where | ||
133 | hashed_stamps = filter isStamp (OpenPGP.hashed_subpackets sig) | ||
134 | unhashed_stamps = filter isStamp (OpenPGP.unhashed_subpackets sig) | ||
135 | hashed' = case hashed_stamps ++ unhashed_stamps of | ||
136 | [] -> OpenPGP.SignatureCreationTimePacket (fromIntegral timestamp) | ||
137 | : OpenPGP.hashed_subpackets sig | ||
138 | _ -> OpenPGP.hashed_subpackets sig | ||
139 | isStamp (OpenPGP.SignatureCreationTimePacket {}) = True | ||
140 | isStamp _ = False | ||
141 | |||
142 | -- | Make a signature | ||
143 | -- | ||
144 | -- In order to set more options on a signature, pass in a signature packet. | ||
145 | pgpSign :: | ||
146 | OpenPGP.Message -- ^ SecretKeys, one of which will be used | ||
147 | -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet | ||
148 | -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature | ||
149 | -> String -- ^ KeyID of key to choose | ||
150 | -> IO (Maybe OpenPGP.SignatureOver) | ||
151 | pgpSign seckeys dta hash_algo keyid = | ||
152 | handleIO_ (return Nothing) $ do | ||
153 | timestamp <- now | ||
154 | -- g <- Thomas.newGenIO :: IO Thomas.SystemRandom | ||
155 | g <- fmap Vincent.cprgCreate $ Vincent.createEntropyPool | ||
156 | let _ = g :: Vincent.SystemRNG | ||
157 | let sigs = map (stampit timestamp) $ OpenPGP.signatures_over dta | ||
158 | dta' = dta { OpenPGP.signatures_over = sigs } | ||
159 | let (r,g') = unsafeSign seckeys dta' hash_algo keyid timestamp g | ||
160 | return (Just r) | ||
161 | |||
162 | catchIO_ :: IO a -> IO a -> IO a | ||
163 | catchIO_ a h = Exception.catch a (\(_ :: IOException) -> h) | ||
164 | |||
165 | catchIO :: IO a -> (IOException -> IO a) -> IO a | ||
166 | catchIO body handler = Exception.catch body handler | ||
167 | |||
168 | handleIO_ = flip catchIO_ | ||
169 | handleIO = flip catchIO | ||
170 | |||
diff --git a/Data/OpenPGP/Util/Verify.hs b/Data/OpenPGP/Util/Verify.hs new file mode 100644 index 0000000..b42e664 --- /dev/null +++ b/Data/OpenPGP/Util/Verify.hs | |||
@@ -0,0 +1,74 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | module Data.OpenPGP.Util.Verify where | ||
3 | |||
4 | import Debug.Trace | ||
5 | import qualified Data.OpenPGP as OpenPGP | ||
6 | import Data.Maybe | ||
7 | import Data.Binary (encode) | ||
8 | import Control.Monad | ||
9 | import qualified Data.ByteString as BS | ||
10 | import qualified Data.ByteString.Lazy as LZ | ||
11 | |||
12 | import qualified Crypto.PubKey.DSA as Vincent.DSA | ||
13 | import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA | ||
14 | import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA | ||
15 | -- import Math.NumberTheory.Moduli | ||
16 | |||
17 | import Data.OpenPGP.Util.Base | ||
18 | |||
19 | |||
20 | dsaKey :: OpenPGP.Packet -> Vincent.DSA.PublicKey | ||
21 | dsaKey k = Vincent.DSA.PublicKey | ||
22 | (Vincent.DSA.Params (keyParam 'p' k) (keyParam 'g' k) (keyParam 'q' k)) | ||
23 | (keyParam 'y' k) | ||
24 | |||
25 | |||
26 | {- | ||
27 | applyCurve :: Vincent.ECDSA.CurveCommon -> Integer -> Integer | ||
28 | applyCurve curve x = x*x*x + x*a + b | ||
29 | where | ||
30 | a = Vincent.ECDSA.ecc_a curve | ||
31 | b = Vincent.ECDSA.ecc_b curve | ||
32 | -} | ||
33 | |||
34 | -- | Verify a message signature | ||
35 | verify :: | ||
36 | OpenPGP.Message -- ^ Keys that may have made the signature | ||
37 | -> OpenPGP.SignatureOver -- ^ Signatures to verify | ||
38 | -> OpenPGP.SignatureOver -- ^ Will only contain signatures that passed | ||
39 | verify keys over = | ||
40 | over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs} | ||
41 | where | ||
42 | sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s)) | ||
43 | (OpenPGP.signatures_over over) | ||
44 | |||
45 | verifyOne :: OpenPGP.Message -> OpenPGP.Packet -> BS.ByteString -> Maybe OpenPGP.Packet | ||
46 | verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard | ||
47 | where | ||
48 | verification = case OpenPGP.key_algorithm sig of | ||
49 | OpenPGP.DSA -> dsaVerify | ||
50 | OpenPGP.ECDSA -> ecdsaVerify | ||
51 | alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify | ||
52 | | otherwise -> const Nothing | ||
53 | dsaVerify k = let k' = dsaKey k in | ||
54 | Just $ Vincent.DSA.verify (dsaTruncate k' . bhash) k' dsaSig over | ||
55 | ecdsaVerify k = let k' = ecdsaKey k | ||
56 | r = Just $ Vincent.ECDSA.verify bhash k' ecdsaSig over | ||
57 | in r -- trace ("ecdsaVerify: "++show r) r | ||
58 | rsaVerify k = Just $ Vincent.RSA.verify desc (rsaKey k) over rsaSig | ||
59 | [rsaSig] = map (toStrictBS . LZ.drop 2 . encode) (OpenPGP.signature sig) | ||
60 | dsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in | ||
61 | Vincent.DSA.Signature r s | ||
62 | ecdsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in | ||
63 | Vincent.ECDSA.Signature r s | ||
64 | dsaTruncate (Vincent.DSA.PublicKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q) | ||
65 | {- | ||
66 | ecdsaTruncate (Vincent.ECDSA.PublicKey _ (Vincent.ECDSA.Point x y)) = BS.take (integerBytesize x | ||
67 | + integerBytesize y ) | ||
68 | -} | ||
69 | bhash = hashBySymbol hash_algo . toLazyBS | ||
70 | desc = hashAlgoDesc hash_algo | ||
71 | hash_algo = OpenPGP.hash_algorithm sig | ||
72 | maybeKey = OpenPGP.signature_issuer sig >>= find_key keys | ||
73 | -- in trace ("maybeKey="++show (fmap OpenPGP.key_algorithm r)) r | ||
74 | |||