From 4bfc6b028527f43d9ae48d24dc2afb5f0db7ad1e Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 16 May 2020 08:36:57 -0400 Subject: Parse v5 public key packets (draft-ietf-openpgp-rfc4880bis-09). --- Data/OpenPGP.hs | 84 +++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 58 insertions(+), 26 deletions(-) diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index f05f83e..16fcd1e 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs @@ -64,6 +64,8 @@ module Data.OpenPGP ( SignatureOver(..), signatures, signature_issuer, + known_public_key_fields, + known_secret_key_fields, public_key_fields, secret_key_fields, eccOID, @@ -339,28 +341,36 @@ parse_old_length tag = _ -> fail "Unsupported old packet length." -- http://tools.ietf.org/html/rfc4880#section-5.5.2 -public_key_fields :: KeyAlgorithm -> [Char] -public_key_fields RSA = ['n', 'e'] -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', 'f'] -public_key_fields Ed25519 = ['c','l','x', 'y', 'n', 'f'] -public_key_fields ECC = ['c','l','x', 'y', 'n', 'f', 'e'] -public_key_fields alg = error ("Unknown key fields for "++show alg) -- Nothing in the spec. Maybe empty +known_public_key_fields :: KeyAlgorithm -> Maybe [Char] +known_public_key_fields RSA = Just ['n', 'e'] +known_public_key_fields RSA_E = known_public_key_fields RSA +known_public_key_fields RSA_S = known_public_key_fields RSA +known_public_key_fields ELGAMAL = Just ['p', 'g', 'y'] +known_public_key_fields DSA = Just ['p', 'q', 'g', 'y'] +known_public_key_fields ECDSA = Just ['c','l','x', 'y', 'f'] +known_public_key_fields Ed25519 = Just ['c','l','x', 'y', 'n', 'f'] +known_public_key_fields ECC = Just ['c','l','x', 'y', 'n', 'f', 'e'] +known_public_key_fields _ = Nothing + +public_key_fields :: HasCallStack => KeyAlgorithm -> [Char] +public_key_fields alg = fromMaybe (error $ "Unknown key fields for "++show alg) + $ known_public_key_fields alg -- http://tools.ietf.org/html/rfc4880#section-5.5.3 -secret_key_fields :: KeyAlgorithm -> [Char] -secret_key_fields RSA = ['d', 'p', 'q', 'u'] -secret_key_fields RSA_E = secret_key_fields RSA -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 Ed25519 = ['d'] -secret_key_fields ECC = ['d'] -secret_key_fields alg = error ("Unknown secret fields for "++show alg) -- Nothing in the spec. Maybe empty +known_secret_key_fields :: KeyAlgorithm -> Maybe [Char] +known_secret_key_fields RSA = Just ['d', 'p', 'q', 'u'] +known_secret_key_fields RSA_E = known_secret_key_fields RSA +known_secret_key_fields RSA_S = known_secret_key_fields RSA +known_secret_key_fields ELGAMAL = Just ['x'] +known_secret_key_fields DSA = Just ['x'] +known_secret_key_fields ECDSA = Just ['d'] +known_secret_key_fields Ed25519 = Just ['d'] +known_secret_key_fields ECC = Just ['d'] +known_secret_key_fields _ = Nothing + +secret_key_fields :: HasCallStack => KeyAlgorithm -> [Char] +secret_key_fields alg = fromMaybe (error $ "Unknown secret fields for "++show alg) + (known_secret_key_fields alg) (!) :: (HasCallStack, Show k, Eq k) => [(k,v)] -> k -> v (!) xs k = case lookup k xs of @@ -476,12 +486,12 @@ getOID = do oid = mpiFromBytes oidbytes return oid -decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)] -decode_public_key_material algorithm | algorithm `elem` [ECDSA, Ed25519] = do +decode_public_key_material :: KeyAlgorithm -> Maybe (Get [(Char,MPI)]) +decode_public_key_material algorithm | algorithm `elem` [ECDSA, Ed25519] = Just $ do -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDSA keys oid <- getOID fmap (('c',oid) :) getEllipticCurvePublicKey -decode_public_key_material ECC = do +decode_public_key_material ECC = Just $ do -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDH keys: oid <- getOID result <- getEllipticCurvePublicKey @@ -493,7 +503,7 @@ decode_public_key_material ECC = do algoid <- get :: Get Word8 -} return $ ('c', oid) : result ++ [('e',MPI (fromIntegral eccstuff))] -decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm) +decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) <$> known_public_key_fields algorithm put_packet :: Packet -> (B.ByteString, Word8) put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) = @@ -615,6 +625,9 @@ 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) +opaqueKey :: Char -> BS.ByteString -> [(Char,MPI)] +opaqueKey f bs = [(f, MPI $ getBigNum bs)] + -- For reference, GnuPG (as of commit 3a403ab04) uses this: -- typedef enum -- { @@ -770,7 +783,9 @@ parse_packet 6 = do timestamp <- get days <- get algorithm <- get - key <- decode_public_key_material algorithm + key <- + fromMaybe (fail $ "Unknown public key fields for "++show algorithm) + $ decode_public_key_material algorithm return PublicKeyPacket { version = version, timestamp = timestamp, @@ -782,7 +797,9 @@ parse_packet 6 = do 4 -> do timestamp <- get algorithm <- get - key <- decode_public_key_material algorithm + key <- + fromMaybe (fail $ "Unknown public key fields for "++show algorithm) + $ decode_public_key_material algorithm return PublicKeyPacket { version = 4, timestamp = timestamp, @@ -791,6 +808,21 @@ parse_packet 6 = do is_subkey = False, v3_days_of_validity = Nothing } + 5 -> do + timestamp <- get + algorithm <- get + keylen <- fmap (fromIntegral :: Word32 -> Int) get + key <- isolate keylen $ + fromMaybe (opaqueKey 'L' <$> getByteString keylen) + $ decode_public_key_material algorithm + return PublicKeyPacket { + version = 5, + timestamp = timestamp, + key_algorithm = algorithm, + key = key, + is_subkey = False, + v3_days_of_validity = Nothing + } x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "." -- Secret-SubKey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.4 parse_packet 7 = do -- cgit v1.2.3