From 06f96ec8d862e43d12cfb4c3ad8650395cfc662c Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 31 Dec 2012 12:54:41 -0500
Subject: Safe to put full fingerprint in packet

We don't type restrict the length of the key ids, so we shouldn't assume
the length is the one we wanted.
---
 Data/OpenPGP.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 6ffeba4..4dad404 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -383,7 +383,7 @@ put_packet :: Packet -> (B.ByteString, Word8)
 put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) =
 	(B.concat [
 		encode version,
-		encode (fst $ head $ readHex key_id :: Word64),
+		encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64),
 		encode key_algorithm,
 		dta
 	], 1)
@@ -431,7 +431,7 @@ put_packet (OnePassSignaturePacket { version = version,
 	(B.concat [
 		encode version, encode signature_type,
 		encode hash_algorithm, encode key_algorithm,
-		encode (fst $ head $ readHex key_id :: Word64),
+		encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64),
 		encode nested
 	], 4)
 put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
@@ -988,7 +988,7 @@ put_signature_subpacket (RevocationKeyPacket sensitive kalgo fpr) =
 	fprb = padBS 20 $ B.drop 2 $ encode (MPI fpri)
 	fpri = fst $ head $ readHex fpr
 put_signature_subpacket (IssuerPacket keyid) =
-	(encode (fst $ head $ readHex keyid :: Word64), 16)
+	(encode (fst $ head $ readHex $ takeFromEnd 16 keyid :: Word64), 16)
 put_signature_subpacket (NotationDataPacket human_readable name value) =
 	(B.concat [
 		B.pack [flag1,0,0,0],
@@ -1188,7 +1188,10 @@ find_key' fpr x xs keyid
 	| thisid == keyid = Just x
 	| otherwise = find_key fpr (Message xs) keyid
 	where
-	thisid = reverse $ take (length keyid) (reverse (fpr x))
+	thisid = takeFromEnd (length keyid) (fpr x)
+
+takeFromEnd :: Int -> String -> String
+takeFromEnd l = reverse . take l . reverse
 
 -- | SignaturePacket smart constructor
 --
-- 
cgit v1.2.3