Issuer Fingerprint hashed subpacket (draft-ietf-openpgp-rfc4880bis-09).

1 files changed, 20 insertions, 5 deletions

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 571e8a4..4133f38 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -1196,7 +1196,10 @@ data SignatureSubpacket =
                 hash                  :: B.ByteString
         } |
         EmbeddedSignaturePacket Packet |
-        -- TODO: IssuerFingerprintPacket (tag=33)
+        IssuerFingerprintPacket {
+                fingerprint_version :: Word8,
+                issuer_fingerprint :: BS.ByteString
+        } |
         UnsupportedSignatureSubpacket Word8 B.ByteString
         deriving (Show, Read, Eq)
 
@@ -1307,6 +1310,8 @@ put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) =
 put_signature_subpacket (EmbeddedSignaturePacket packet)
         | isSignaturePacket packet = (fst $ put_packet packet, 32)
         | otherwise = error $ "Tried to put non-SignaturePacket in EmbeddedSignaturePacket: " ++ show packet
+put_signature_subpacket (IssuerFingerprintPacket v fp) =
+        (runPut . putByteString $ v `BS.cons` fp,33)
 put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) =
         (bytes, tag)
 
@@ -1421,6 +1426,11 @@ parse_signature_subpacket 31 =
 -- EmbeddedSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.2.3.26
 parse_signature_subpacket 32 =
         fmap EmbeddedSignaturePacket (parse_packet 2)
+-- IssuerFingerprintPacket
+parse_signature_subpacket 33 = do
+        v <- get
+        fp <- getByteString (if v==4 then 20 else 32)
+        return $ IssuerFingerprintPacket v fp
 -- Represent unsupported packets as their tag and literal bytes
 parse_signature_subpacket tag =
         fmap (UnsupportedSignatureSubpacket tag) getRemainingByteString
@@ -1429,13 +1439,18 @@ parse_signature_subpacket tag =
 signature_issuer :: Packet -> Maybe String
 signature_issuer (SignaturePacket {hashed_subpackets = hashed,
                                    unhashed_subpackets = unhashed}) =
-        case issuers of
-                IssuerPacket issuer : _ -> Just issuer
-                _                       -> Nothing
+        case fps of
+            IssuerFingerprintPacket _ fp : _ -> Just $ hexify fp
+            _ -> case issuers of
+                    IssuerPacket issuer : _ -> Just issuer
+                    _                       -> Nothing
         where
+        fps = filter isFingerprint hashed
         issuers = filter isIssuer hashed ++ filter isIssuer unhashed
         isIssuer (IssuerPacket {}) = True
         isIssuer _                 = False
+        isFingerprint (IssuerFingerprintPacket {}) = True
+        isFingerprint _                            = False
 signature_issuer _ = Nothing
 
 -- | Find a key with the given Fingerprint/KeyID
@@ -1457,7 +1472,7 @@ find_key' fpr x xs keyid
         | thisid == keyid = Just x
         | otherwise = find_key fpr (Message xs) keyid
         where
-        thisid = takeFromEnd (length keyid) (fpr x)
+        thisid = (if version x >= 5 then take else takeFromEnd) (length keyid) (fpr x)
 
 takeFromEnd :: Int -> String -> String
 takeFromEnd l = reverse . take l . reverse