diff options
Diffstat (limited to 'Data')
-rw-r--r-- | Data/OpenPGP.hs | 84 |
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 ( | |||
64 | SignatureOver(..), | 64 | SignatureOver(..), |
65 | signatures, | 65 | signatures, |
66 | signature_issuer, | 66 | signature_issuer, |
67 | known_public_key_fields, | ||
68 | known_secret_key_fields, | ||
67 | public_key_fields, | 69 | public_key_fields, |
68 | secret_key_fields, | 70 | secret_key_fields, |
69 | eccOID, | 71 | eccOID, |
@@ -339,28 +341,36 @@ parse_old_length tag = | |||
339 | _ -> fail "Unsupported old packet length." | 341 | _ -> fail "Unsupported old packet length." |
340 | 342 | ||
341 | -- http://tools.ietf.org/html/rfc4880#section-5.5.2 | 343 | -- http://tools.ietf.org/html/rfc4880#section-5.5.2 |
342 | public_key_fields :: KeyAlgorithm -> [Char] | 344 | known_public_key_fields :: KeyAlgorithm -> Maybe [Char] |
343 | public_key_fields RSA = ['n', 'e'] | 345 | known_public_key_fields RSA = Just ['n', 'e'] |
344 | public_key_fields RSA_E = public_key_fields RSA | 346 | known_public_key_fields RSA_E = known_public_key_fields RSA |
345 | public_key_fields RSA_S = public_key_fields RSA | 347 | known_public_key_fields RSA_S = known_public_key_fields RSA |
346 | public_key_fields ELGAMAL = ['p', 'g', 'y'] | 348 | known_public_key_fields ELGAMAL = Just ['p', 'g', 'y'] |
347 | public_key_fields DSA = ['p', 'q', 'g', 'y'] | 349 | known_public_key_fields DSA = Just ['p', 'q', 'g', 'y'] |
348 | public_key_fields ECDSA = ['c','l','x', 'y', 'f'] | 350 | known_public_key_fields ECDSA = Just ['c','l','x', 'y', 'f'] |
349 | public_key_fields Ed25519 = ['c','l','x', 'y', 'n', 'f'] | 351 | known_public_key_fields Ed25519 = Just ['c','l','x', 'y', 'n', 'f'] |
350 | public_key_fields ECC = ['c','l','x', 'y', 'n', 'f', 'e'] | 352 | known_public_key_fields ECC = Just ['c','l','x', 'y', 'n', 'f', 'e'] |
351 | public_key_fields alg = error ("Unknown key fields for "++show alg) -- Nothing in the spec. Maybe empty | 353 | known_public_key_fields _ = Nothing |
354 | |||
355 | public_key_fields :: HasCallStack => KeyAlgorithm -> [Char] | ||
356 | public_key_fields alg = fromMaybe (error $ "Unknown key fields for "++show alg) | ||
357 | $ known_public_key_fields alg | ||
352 | 358 | ||
353 | -- http://tools.ietf.org/html/rfc4880#section-5.5.3 | 359 | -- http://tools.ietf.org/html/rfc4880#section-5.5.3 |
354 | secret_key_fields :: KeyAlgorithm -> [Char] | 360 | known_secret_key_fields :: KeyAlgorithm -> Maybe [Char] |
355 | secret_key_fields RSA = ['d', 'p', 'q', 'u'] | 361 | known_secret_key_fields RSA = Just ['d', 'p', 'q', 'u'] |
356 | secret_key_fields RSA_E = secret_key_fields RSA | 362 | known_secret_key_fields RSA_E = known_secret_key_fields RSA |
357 | secret_key_fields RSA_S = secret_key_fields RSA | 363 | known_secret_key_fields RSA_S = known_secret_key_fields RSA |
358 | secret_key_fields ELGAMAL = ['x'] | 364 | known_secret_key_fields ELGAMAL = Just ['x'] |
359 | secret_key_fields DSA = ['x'] | 365 | known_secret_key_fields DSA = Just ['x'] |
360 | secret_key_fields ECDSA = ['d'] | 366 | known_secret_key_fields ECDSA = Just ['d'] |
361 | secret_key_fields Ed25519 = ['d'] | 367 | known_secret_key_fields Ed25519 = Just ['d'] |
362 | secret_key_fields ECC = ['d'] | 368 | known_secret_key_fields ECC = Just ['d'] |
363 | secret_key_fields alg = error ("Unknown secret fields for "++show alg) -- Nothing in the spec. Maybe empty | 369 | known_secret_key_fields _ = Nothing |
370 | |||
371 | secret_key_fields :: HasCallStack => KeyAlgorithm -> [Char] | ||
372 | secret_key_fields alg = fromMaybe (error $ "Unknown secret fields for "++show alg) | ||
373 | (known_secret_key_fields alg) | ||
364 | 374 | ||
365 | (!) :: (HasCallStack, Show k, Eq k) => [(k,v)] -> k -> v | 375 | (!) :: (HasCallStack, Show k, Eq k) => [(k,v)] -> k -> v |
366 | (!) xs k = case lookup k xs of | 376 | (!) xs k = case lookup k xs of |
@@ -476,12 +486,12 @@ getOID = do | |||
476 | oid = mpiFromBytes oidbytes | 486 | oid = mpiFromBytes oidbytes |
477 | return oid | 487 | return oid |
478 | 488 | ||
479 | decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)] | 489 | decode_public_key_material :: KeyAlgorithm -> Maybe (Get [(Char,MPI)]) |
480 | decode_public_key_material algorithm | algorithm `elem` [ECDSA, Ed25519] = do | 490 | decode_public_key_material algorithm | algorithm `elem` [ECDSA, Ed25519] = Just $ do |
481 | -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDSA keys | 491 | -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDSA keys |
482 | oid <- getOID | 492 | oid <- getOID |
483 | fmap (('c',oid) :) getEllipticCurvePublicKey | 493 | fmap (('c',oid) :) getEllipticCurvePublicKey |
484 | decode_public_key_material ECC = do | 494 | decode_public_key_material ECC = Just $ do |
485 | -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDH keys: | 495 | -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDH keys: |
486 | oid <- getOID | 496 | oid <- getOID |
487 | result <- getEllipticCurvePublicKey | 497 | result <- getEllipticCurvePublicKey |
@@ -493,7 +503,7 @@ decode_public_key_material ECC = do | |||
493 | algoid <- get :: Get Word8 | 503 | algoid <- get :: Get Word8 |
494 | -} | 504 | -} |
495 | return $ ('c', oid) : result ++ [('e',MPI (fromIntegral eccstuff))] | 505 | return $ ('c', oid) : result ++ [('e',MPI (fromIntegral eccstuff))] |
496 | decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm) | 506 | decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) <$> known_public_key_fields algorithm |
497 | 507 | ||
498 | put_packet :: Packet -> (B.ByteString, Word8) | 508 | put_packet :: Packet -> (B.ByteString, Word8) |
499 | put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) = | 509 | put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) = |
@@ -615,6 +625,9 @@ put_packet (ModificationDetectionCodePacket bstr) = (bstr, 19) | |||
615 | put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag) | 625 | put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag) |
616 | put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ show x) | 626 | put_packet x = error ("Unsupported Packet version or type in put_packet: " ++ show x) |
617 | 627 | ||
628 | opaqueKey :: Char -> BS.ByteString -> [(Char,MPI)] | ||
629 | opaqueKey f bs = [(f, MPI $ getBigNum bs)] | ||
630 | |||
618 | -- For reference, GnuPG (as of commit 3a403ab04) uses this: | 631 | -- For reference, GnuPG (as of commit 3a403ab04) uses this: |
619 | -- typedef enum | 632 | -- typedef enum |
620 | -- { | 633 | -- { |
@@ -770,7 +783,9 @@ parse_packet 6 = do | |||
770 | timestamp <- get | 783 | timestamp <- get |
771 | days <- get | 784 | days <- get |
772 | algorithm <- get | 785 | algorithm <- get |
773 | key <- decode_public_key_material algorithm | 786 | key <- |
787 | fromMaybe (fail $ "Unknown public key fields for "++show algorithm) | ||
788 | $ decode_public_key_material algorithm | ||
774 | return PublicKeyPacket { | 789 | return PublicKeyPacket { |
775 | version = version, | 790 | version = version, |
776 | timestamp = timestamp, | 791 | timestamp = timestamp, |
@@ -782,7 +797,9 @@ parse_packet 6 = do | |||
782 | 4 -> do | 797 | 4 -> do |
783 | timestamp <- get | 798 | timestamp <- get |
784 | algorithm <- get | 799 | algorithm <- get |
785 | key <- decode_public_key_material algorithm | 800 | key <- |
801 | fromMaybe (fail $ "Unknown public key fields for "++show algorithm) | ||
802 | $ decode_public_key_material algorithm | ||
786 | return PublicKeyPacket { | 803 | return PublicKeyPacket { |
787 | version = 4, | 804 | version = 4, |
788 | timestamp = timestamp, | 805 | timestamp = timestamp, |
@@ -791,6 +808,21 @@ parse_packet 6 = do | |||
791 | is_subkey = False, | 808 | is_subkey = False, |
792 | v3_days_of_validity = Nothing | 809 | v3_days_of_validity = Nothing |
793 | } | 810 | } |
811 | 5 -> do | ||
812 | timestamp <- get | ||
813 | algorithm <- get | ||
814 | keylen <- fmap (fromIntegral :: Word32 -> Int) get | ||
815 | key <- isolate keylen $ | ||
816 | fromMaybe (opaqueKey 'L' <$> getByteString keylen) | ||
817 | $ decode_public_key_material algorithm | ||
818 | return PublicKeyPacket { | ||
819 | version = 5, | ||
820 | timestamp = timestamp, | ||
821 | key_algorithm = algorithm, | ||
822 | key = key, | ||
823 | is_subkey = False, | ||
824 | v3_days_of_validity = Nothing | ||
825 | } | ||
794 | x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "." | 826 | x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "." |
795 | -- Secret-SubKey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.4 | 827 | -- Secret-SubKey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.4 |
796 | parse_packet 7 = do | 828 | parse_packet 7 = do |