diff options
Diffstat (limited to 'Data')
-rw-r--r-- | Data/OpenPGP.hs | 9 | ||||
-rw-r--r-- | Data/OpenPGP/Crypto.hs | 19 |
2 files changed, 23 insertions, 5 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index c285127..0ce9991 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs | |||
@@ -1,3 +1,8 @@ | |||
1 | -- | Main implementation of the OpenPGP message format <http://tools.ietf.org/html/rfc4880> | ||
2 | -- | ||
3 | -- The recommended way to import this module is: | ||
4 | -- | ||
5 | -- > import qualified Data.OpenPGP as OpenPGP | ||
1 | module Data.OpenPGP (Message(..), Packet(..), SignatureSubpacket(..), HashAlgorithm(..), KeyAlgorithm(..), CompressionAlgorithm(..), MPI(..), fingerprint_material, signatures_and_data, signature_issuer) where | 6 | module Data.OpenPGP (Message(..), Packet(..), SignatureSubpacket(..), HashAlgorithm(..), KeyAlgorithm(..), CompressionAlgorithm(..), MPI(..), fingerprint_material, signatures_and_data, signature_issuer) where |
2 | 7 | ||
3 | import Control.Monad | 8 | import Control.Monad |
@@ -384,7 +389,7 @@ parse_packet 13 = | |||
384 | -- Fail nicely for unimplemented packets | 389 | -- Fail nicely for unimplemented packets |
385 | parse_packet x = fail $ "Unimplemented OpenPGP packet tag " ++ (show x) ++ "." | 390 | parse_packet x = fail $ "Unimplemented OpenPGP packet tag " ++ (show x) ++ "." |
386 | 391 | ||
387 | -- Helper method for fingerprints and such | 392 | -- | Helper method for fingerprints and such |
388 | fingerprint_material :: Packet -> [LZ.ByteString] | 393 | fingerprint_material :: Packet -> [LZ.ByteString] |
389 | fingerprint_material (PublicKeyPacket {version = 4, | 394 | fingerprint_material (PublicKeyPacket {version = 4, |
390 | timestamp = timestamp, | 395 | timestamp = timestamp, |
@@ -482,6 +487,7 @@ instance Binary Message where | |||
482 | (Message tail) <- get :: Get Message | 487 | (Message tail) <- get :: Get Message |
483 | return (Message (next_packet:tail)) | 488 | return (Message (next_packet:tail)) |
484 | 489 | ||
490 | -- | Extract all signature and data packets from a 'Message' | ||
485 | signatures_and_data :: Message -> ([Packet], [Packet]) | 491 | signatures_and_data :: Message -> ([Packet], [Packet]) |
486 | signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) = | 492 | signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) = |
487 | signatures_and_data m | 493 | signatures_and_data m |
@@ -535,6 +541,7 @@ instance Binary SignatureSubpacket where | |||
535 | packet <- getLazyByteString len | 541 | packet <- getLazyByteString len |
536 | return $ runGet (parse_signature_subpacket tag) packet | 542 | return $ runGet (parse_signature_subpacket tag) packet |
537 | 543 | ||
544 | -- | Find the keyid that issued a SignaturePacket | ||
538 | signature_issuer :: Packet -> Maybe String | 545 | signature_issuer :: Packet -> Maybe String |
539 | signature_issuer (SignaturePacket {hashed_subpackets = hashed, | 546 | signature_issuer (SignaturePacket {hashed_subpackets = hashed, |
540 | unhashed_subpackets = unhashed}) = | 547 | unhashed_subpackets = unhashed}) = |
diff --git a/Data/OpenPGP/Crypto.hs b/Data/OpenPGP/Crypto.hs index e2151fc..fee1d55 100644 --- a/Data/OpenPGP/Crypto.hs +++ b/Data/OpenPGP/Crypto.hs | |||
@@ -1,3 +1,9 @@ | |||
1 | -- | This is a wrapper around <http://hackage.haskell.org/package/Crypto> | ||
2 | -- that currently does fingerprint generation and signature verification. | ||
3 | -- | ||
4 | -- The recommended way to import this module is: | ||
5 | -- | ||
6 | -- > import qualified Data.OpenPGP.Crypto as OpenPGP | ||
1 | module Data.OpenPGP.Crypto (verify, fingerprint) where | 7 | module Data.OpenPGP.Crypto (verify, fingerprint) where |
2 | 8 | ||
3 | import Data.Word | 9 | import Data.Word |
@@ -15,7 +21,8 @@ import qualified Data.Digest.SHA512 as SHA512 | |||
15 | import qualified Data.OpenPGP as OpenPGP | 21 | import qualified Data.OpenPGP as OpenPGP |
16 | import qualified Data.BaseConvert as BaseConvert | 22 | import qualified Data.BaseConvert as BaseConvert |
17 | 23 | ||
18 | -- http://tools.ietf.org/html/rfc4880#section-12.2 | 24 | -- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket |
25 | -- <http://tools.ietf.org/html/rfc4880#section-12.2> | ||
19 | fingerprint :: OpenPGP.Packet -> String | 26 | fingerprint :: OpenPGP.Packet -> String |
20 | fingerprint p | OpenPGP.version p == 4 = | 27 | fingerprint p | OpenPGP.version p == 4 = |
21 | BaseConvert.toString 16 $ SHA1.toInteger $ SHA1.hash $ | 28 | BaseConvert.toString 16 $ SHA1.toInteger $ SHA1.hash $ |
@@ -66,8 +73,12 @@ emsa_pkcs1_v1_5_encode m emLen algo = | |||
66 | [0, 1] ++ replicate (emLen - length t - 3) 0xff ++ [0] ++ t | 73 | [0, 1] ++ replicate (emLen - length t - 3) 0xff ++ [0] ++ t |
67 | where t = emsa_pkcs1_v1_5_hash_padding algo ++ hash algo m | 74 | where t = emsa_pkcs1_v1_5_hash_padding algo ++ hash algo m |
68 | 75 | ||
69 | verify :: OpenPGP.Message -> OpenPGP.Message -> Int -> Bool | 76 | -- | Verify a message signature. Only supports RSA keys for now. |
70 | verify keys packet sigidx = | 77 | verify :: OpenPGP.Message -- ^ Keys that may have made the signature |
78 | -> OpenPGP.Message -- ^ Message containing data and signature packet | ||
79 | -> Int -- ^ Index of signature to verify (0th, 1st, etc) | ||
80 | -> Bool | ||
81 | verify keys message sigidx = | ||
71 | encoded == RSA.encrypt (n, e) raw_sig | 82 | encoded == RSA.encrypt (n, e) raw_sig |
72 | where | 83 | where |
73 | raw_sig = LZ.unpack $ LZ.drop 2 $ encode (OpenPGP.signature sig) | 84 | raw_sig = LZ.unpack $ LZ.drop 2 $ encode (OpenPGP.signature sig) |
@@ -79,4 +90,4 @@ verify keys packet sigidx = | |||
79 | Just issuer = OpenPGP.signature_issuer sig | 90 | Just issuer = OpenPGP.signature_issuer sig |
80 | sig = sigs !! sigidx | 91 | sig = sigs !! sigidx |
81 | (sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) = | 92 | (sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) = |
82 | OpenPGP.signatures_and_data packet | 93 | OpenPGP.signatures_and_data message |