Parse v5 public key packets (draft-ietf-openpgp-rfc4880bis-09).

1 files 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