From bc518fbdc3bce78f61bfa76bac95ae435a7216a8 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Thu, 4 Jul 2019 16:14:13 -0400 Subject: Minimal support for cv25519 parsing. --- Data/OpenPGP.hs | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 71 insertions(+), 9 deletions(-) diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 8fef50a..2fab94a 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs @@ -62,7 +62,8 @@ module Data.OpenPGP ( signatures, signature_issuer, public_key_fields, - secret_key_fields + secret_key_fields, + eccOID ) where import Numeric @@ -288,7 +289,7 @@ instance BINARY_CLASS Packet where get = do tag <- get let (t, l) = - if testBit tag 6 then + if testBit (tag :: Word8) 6 then (tag .&. 63, parse_new_length) else ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False) @@ -342,8 +343,10 @@ public_key_fields RSA_E = public_key_fields RSA public_key_fields RSA_S = public_key_fields RSA public_key_fields ELGAMAL = ['p', 'g', 'y'] public_key_fields DSA = ['p', 'q', 'g', 'y'] -public_key_fields ECDSA = ['c','l','x', 'y'] -public_key_fields _ = undefined -- Nothing in the spec. Maybe empty +public_key_fields ECDSA = ['c','l','x', 'y'] -- TODO: These probably need special fingerprint handling. +public_key_fields Ed25519 = ['c','l','x', 'y'] -- TODO: These probably need special fingerprint handling. +public_key_fields ECC = ['c','l','x', 'y'] -- TODO: These probably need special fingerprint handling. +public_key_fields alg = error ("Unknown key fields for "++show alg) -- Nothing in the spec. Maybe empty -- http://tools.ietf.org/html/rfc4880#section-5.5.3 secret_key_fields :: KeyAlgorithm -> [Char] @@ -353,7 +356,7 @@ secret_key_fields RSA_S = secret_key_fields RSA secret_key_fields ELGAMAL = ['x'] secret_key_fields DSA = ['x'] secret_key_fields ECDSA = ['d'] -secret_key_fields _ = undefined -- Nothing in the spec. Maybe empty +secret_key_fields alg = error ("Unkown secret fields for "++show alg) -- Nothing in the spec. Maybe empty (!) :: (Eq k) => [(k,v)] -> k -> v (!) xs k = let Just x = lookup k xs in x @@ -405,6 +408,16 @@ calculate_signature_trailer x = error ("Trying to calculate signature trailer for: " ++ show x) +-- 0x2b06010401da470f01 +-- common/openpgp-oid.c 50 { "Ed25519", "1.3.6.1.4.1.11591.15.1", 255, "ed25519", PUBKEY_ALGO_EDDSA }, +-- +-- 0x2b060104019755010501 +-- common/openpgp-oid.c 49 { "Curve25519", "1.3.6.1.4.1.3029.1.5.1", 255, "cv25519", PUBKEY_ALGO_ECDH }, +eccOID :: Packet -> Maybe BS.ByteString +eccOID PublicKeyPacket { key = k } = lookup 'c' k >>= \(MPI oid) -> Just (snd $ putBigNum oid) +eccOID SecretKeyPacket { key = k } = lookup 'c' k >>= \(MPI oid) -> Just (snd $ putBigNum oid) +eccOID _ = Nothing + encode_public_key_material :: Packet -> [B.ByteString] encode_public_key_material k | key_algorithm k == ECDSA = do -- http://tools.ietf.org/html/rfc6637 @@ -421,13 +434,30 @@ encode_public_key_material k | key_algorithm k == ECDSA = do encode_public_key_material k = map (encode . (key k !)) (public_key_fields $ key_algorithm k) decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)] -decode_public_key_material ECDSA = do - -- http://tools.ietf.org/html/rfc6637 +decode_public_key_material algorithm | algorithm `elem` [ECDSA, Ed25519] = do + -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDSA keys + oidlen <- get :: Get Word8 + oidbytes <- getSomeByteString (fromIntegral oidlen) + let mpiFromBytes bytes = MPI (getBigNum $ B.toStrict bytes) + oid = mpiFromBytes oidbytes + MPI xy <- get + let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2 + width = ( integerBytesize xy - 1 ) `div` 2 + (fx,y) = xy `quotRem` (256^width) + x = fx `rem` (256^width) + l = width*8 + return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y)] +decode_public_key_material ECC = do + -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDH keys: oidlen <- get :: Get Word8 oidbytes <- getSomeByteString (fromIntegral oidlen) - let mpiFromBytes bytes = MPI (B.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 bytes) + let mpiFromBytes bytes = MPI (getBigNum $ B.toStrict bytes) oid = mpiFromBytes oidbytes MPI xy <- get + flen <- get :: Get Word8 + one <- get :: Get Word8 + hashid <- get :: Get Word8 + algoid <- get :: Get Word8 let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2 width = ( integerBytesize xy - 1 ) `div` 2 (fx,y) = xy `quotRem` (256^width) @@ -556,6 +586,36 @@ put_packet (ModificationDetectionCodePacket bstr) = (bstr, 19) put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag) put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ show x) +-- For reference, GnuPG (as of commit 3a403ab04) uses this: +-- typedef enum +-- { +-- PKT_NONE = 0, +-- PKT_PUBKEY_ENC = 1, /* Public key encrypted packet. */ +-- PKT_SIGNATURE = 2, /* Secret key encrypted packet. */ +-- PKT_SYMKEY_ENC = 3, /* Session key packet. */ +-- PKT_ONEPASS_SIG = 4, /* One pass sig packet. */ +-- PKT_SECRET_KEY = 5, /* Secret key. */ +-- PKT_PUBLIC_KEY = 6, /* Public key. */ +-- PKT_SECRET_SUBKEY = 7, /* Secret subkey. */ +-- PKT_COMPRESSED = 8, /* Compressed data packet. */ +-- PKT_ENCRYPTED = 9, /* Conventional encrypted data. */ +-- PKT_MARKER = 10, /* Marker packet. */ +-- PKT_PLAINTEXT = 11, /* Literal data packet. */ +-- PKT_RING_TRUST = 12, /* Keyring trust packet. */ +-- PKT_USER_ID = 13, /* User id packet. */ +-- PKT_PUBLIC_SUBKEY = 14, /* Public subkey. */ +-- PKT_OLD_COMMENT = 16, /* Comment packet from an OpenPGP draft. */ +-- PKT_ATTRIBUTE = 17, /* PGP's attribute packet. */ +-- PKT_ENCRYPTED_MDC = 18, /* Integrity protected encrypted data. */ +-- PKT_MDC = 19, /* Manipulation detection code packet. */ +-- PKT_ENCRYPTED_AEAD= 20, /* AEAD encrypted data packet. */ +-- PKT_COMMENT = 61, /* new comment packet (GnuPG specific). */ +-- PKT_GPG_CONTROL = 63 /* internal control packet (GnuPG specific). */ +-- } +-- pkttype_t; +-- +-- PKT_OLD_COMMENT, PKT_ATTRIBUTE, PKT_ENCRYPTED_AEAD, are not implemented here. +-- Also ommitted are GnuPG-specific packets: PKT_COMMENT and PKT_GPG_CONTROL. parse_packet :: Word8 -> Get Packet -- AsymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.1 parse_packet 1 = AsymmetricSessionKeyPacket @@ -832,7 +892,7 @@ instance BINARY_CLASS HashAlgorithm where put = put . enum_to_word8 get = fmap enum_from_word8 get -data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH | KeyAlgorithm Word8 +data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH | Ed25519 | KeyAlgorithm Word8 deriving (Show, Read, Eq) instance Enum KeyAlgorithm where @@ -844,6 +904,7 @@ instance Enum KeyAlgorithm where toEnum 18 = ECC toEnum 19 = ECDSA toEnum 21 = DH + toEnum 22 = Ed25519 toEnum x = KeyAlgorithm $ fromIntegral x fromEnum RSA = 01 fromEnum RSA_E = 02 @@ -853,6 +914,7 @@ instance Enum KeyAlgorithm where fromEnum ECC = 18 fromEnum ECDSA = 19 fromEnum DH = 21 + fromEnum Ed25519 = 22 fromEnum (KeyAlgorithm x) = fromIntegral x instance BINARY_CLASS KeyAlgorithm where -- cgit v1.2.3