diff options
author | Stephen Paul Weber <singpolyma@singpolyma.net> | 2012-04-27 16:14:04 -0500 |
---|---|---|
committer | Stephen Paul Weber <singpolyma@singpolyma.net> | 2012-04-27 16:14:04 -0500 |
commit | 4eb6591ec2d2efeb9fb55d23d3d6e6f54534f128 (patch) | |
tree | 65c776f79a0c93c9ee267d34b24cd0a22dacc744 /Data | |
parent | ca2ff90effdda221e16a201071d5fef0110596be (diff) |
RevocationKeyPacket
Diffstat (limited to 'Data')
-rw-r--r-- | Data/OpenPGP.hs | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 90450f5..194cccf 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs | |||
@@ -694,6 +694,11 @@ data SignatureSubpacket = | |||
694 | RevocablePacket Bool | | 694 | RevocablePacket Bool | |
695 | KeyExpirationTimePacket Word32 | -- seconds after key CreationTime | 695 | KeyExpirationTimePacket Word32 | -- seconds after key CreationTime |
696 | PreferredSymmetricAlgorithmsPacket [SymmetricAlgorithm] | | 696 | PreferredSymmetricAlgorithmsPacket [SymmetricAlgorithm] | |
697 | RevocationKeyPacket { | ||
698 | sensitive::Bool, | ||
699 | revocation_key_algorithm::KeyAlgorithm, | ||
700 | revocation_key_fingerprint::String | ||
701 | } | | ||
697 | IssuerPacket String | | 702 | IssuerPacket String | |
698 | UnsupportedSignatureSubpacket Word8 B.ByteString | 703 | UnsupportedSignatureSubpacket Word8 B.ByteString |
699 | deriving (Show, Read, Eq) | 704 | deriving (Show, Read, Eq) |
@@ -743,6 +748,12 @@ put_signature_subpacket (KeyExpirationTimePacket time) = | |||
743 | (encode time, 9) | 748 | (encode time, 9) |
744 | put_signature_subpacket (PreferredSymmetricAlgorithmsPacket algos) = | 749 | put_signature_subpacket (PreferredSymmetricAlgorithmsPacket algos) = |
745 | (B.concat $ map encode algos, 11) | 750 | (B.concat $ map encode algos, 11) |
751 | put_signature_subpacket (RevocationKeyPacket sensitive kalgo fpr) = | ||
752 | (B.concat [encode bitfield, encode kalgo, fprb], 12) | ||
753 | where | ||
754 | bitfield = 0x80 .|. (if sensitive then 0x40 else 0x0) :: Word8 | ||
755 | fprb = B.drop 2 $ encode (MPI fpri) | ||
756 | fpri = fst $ head $ readHex fpr | ||
746 | put_signature_subpacket (IssuerPacket keyid) = | 757 | put_signature_subpacket (IssuerPacket keyid) = |
747 | (encode (fst $ head $ readHex keyid :: Word64), 16) | 758 | (encode (fst $ head $ readHex keyid :: Word64), 16) |
748 | put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) = | 759 | put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) = |
@@ -769,6 +780,22 @@ parse_signature_subpacket 9 = fmap KeyExpirationTimePacket get | |||
769 | -- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6 | 780 | -- KeyExpirationTimePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.6 |
770 | parse_signature_subpacket 11 = | 781 | parse_signature_subpacket 11 = |
771 | fmap PreferredSymmetricAlgorithmsPacket listUntilEnd | 782 | fmap PreferredSymmetricAlgorithmsPacket listUntilEnd |
783 | -- RevocationKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.15 | ||
784 | parse_signature_subpacket 12 = do | ||
785 | bitfield <- get :: Get Word8 | ||
786 | kalgo <- get | ||
787 | fpr <- getSomeByteString 20 | ||
788 | -- bitfield must have bit 0x80 set, says the spec | ||
789 | return $ RevocationKeyPacket { | ||
790 | sensitive = if bitfield .&. 0x40 == 0x40 then True else False, | ||
791 | revocation_key_algorithm = kalgo, | ||
792 | revocation_key_fingerprint = | ||
793 | map toUpper $ foldr (pad `oo` showHex) "" (B.unpack fpr) | ||
794 | } | ||
795 | where | ||
796 | oo = (.) . (.) | ||
797 | pad s | odd $ length s = '0':s | ||
798 | | otherwise = s | ||
772 | -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5 | 799 | -- IssuerPacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.5 |
773 | parse_signature_subpacket 16 = do | 800 | parse_signature_subpacket 16 = do |
774 | keyid <- get :: Get Word64 | 801 | keyid <- get :: Get Word64 |