From 502c7489e6c8cf4e5c39c0910fca232e6d9e7f63 Mon Sep 17 00:00:00 2001
From: Stephen Paul Weber <singpolyma@singpolyma.net>
Date: Mon, 1 Aug 2011 15:00:10 -0500
Subject: PublicKeyPacket parser

---
 lib/OpenPGP.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 48 insertions(+), 6 deletions(-)

diff --git a/lib/OpenPGP.hs b/lib/OpenPGP.hs
index 6f7c708..bf78af0 100644
--- a/lib/OpenPGP.hs
+++ b/lib/OpenPGP.hs
@@ -4,8 +4,10 @@ import Data.Binary
 import Data.Binary.Get
 import Data.Bits
 import Data.Word
+import Data.Map (Map)
+import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy as LZ
-import qualified Data.ByteString.Lazy.UTF8 as LZ
+import qualified Data.ByteString.Lazy.UTF8 as LZ (toString)
 import qualified Codec.Compression.Zlib.Raw as Zip
 import qualified Codec.Compression.Zlib as Zlib
 import qualified Codec.Compression.BZip as BZip2
@@ -13,6 +15,7 @@ import qualified Codec.Compression.BZip as BZip2
 import qualified BaseConvert as BaseConvert
 
 newtype Message = Message [Packet] deriving (Show, Read, Eq)
+newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
 
 data Packet =
 	OnePassSignaturePacket {
@@ -23,8 +26,14 @@ data Packet =
 		key_id::String,
 		nested::Word8
 	} |
+	PublicKeyPacket {
+		version::Word8,
+		timestamp::Word32,
+		public_key_algorithm::KeyAlgorithm,
+		key::Map Char MPI
+	} |
 	CompressedDataPacket {
-		algorithm::CompressionAlgorithm,
+		compressed_data_algorithm::CompressionAlgorithm,
 		message::Message
 	} |
 	LiteralDataPacket {
@@ -59,6 +68,11 @@ key_algorithms 18 = ECC
 key_algorithms 19 = ECDSA
 key_algorithms 21 = DH
 
+public_key_fields :: KeyAlgorithm -> [Char]
+public_key_fields RSA     = ['n', 'e']
+public_key_fields ELGAMAL = ['p', 'g', 'y']
+public_key_fields DSA     = ['p', 'q', 'g', 'y']
+
 -- A message is encoded as a list that takes the entire file
 instance Binary Message where
 	put (Message []) = return ()
@@ -74,6 +88,18 @@ instance Binary Message where
 			(Message tail) <- get :: Get Message
 			return (Message (next_packet:tail))
 
+instance Binary MPI where
+	put (MPI i) = do
+		put ((((fromIntegral (LZ.length bytes)) - 1) * 8) + (floor (logBase 2 (fromIntegral (bytes `LZ.index` 1)))) + 1 :: Word16)
+		mapM (\x -> putWord8 x) (LZ.unpack bytes)
+		put ()
+		where bytes = LZ.unfoldr (\x -> if x == 0 then Nothing else Just (fromIntegral x, x `shiftR` 8)) i
+	get = do
+		length <- fmap fromIntegral (get :: Get Word16)
+		bytes <- getLazyByteString (floor ((length + 7) / 8))
+		return (MPI (LZ.foldr (\b a ->
+			a `shiftL` 8 .|. fromIntegral b) 0 bytes))
+
 instance Binary Packet where
 	get = do
 		tag <- get :: Get Word8
@@ -133,6 +159,22 @@ parse_packet  4 = do
 		key_id = (BaseConvert.toString 16 key_id),
 		nested = nested
 	})
+-- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2
+parse_packet  6 = do
+	version <- get :: Get Word8
+	case version of
+		4 -> do
+			timestamp <- get
+			algorithm <- fmap key_algorithms (get :: Get Word8)
+			key <- mapM (\f -> do
+				mpi <- get :: Get MPI
+				return (f, mpi)) (public_key_fields algorithm)
+			return (PublicKeyPacket {
+				version = 4,
+				timestamp = timestamp,
+				public_key_algorithm = algorithm,
+				key = Map.fromList key
+			})
 -- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6
 parse_packet  8 = do
 	algorithm <- get :: Get Word8
@@ -140,22 +182,22 @@ parse_packet  8 = do
 	case algorithm of
 		0 ->
 			return (CompressedDataPacket {
-				algorithm = Uncompressed,
+				compressed_data_algorithm = Uncompressed,
 				message = runGet (get :: Get Message) message
 			})
 		1 ->
 			return (CompressedDataPacket {
-				algorithm = ZIP,
+				compressed_data_algorithm = ZIP,
 				message = runGet (get :: Get Message) (Zip.decompress message)
 			})
 		2 ->
 			return (CompressedDataPacket {
-				algorithm = ZLIB,
+				compressed_data_algorithm = ZLIB,
 				message = runGet (get :: Get Message) (Zlib.decompress message)
 			})
 		3 ->
 			return (CompressedDataPacket {
-				algorithm = BZip2,
+				compressed_data_algorithm = BZip2,
 				message = runGet (get :: Get Message) (BZip2.decompress message)
 			})
 -- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9
-- 
cgit v1.2.3