diff options
author | Stephen Paul Weber <singpolyma@singpolyma.net> | 2011-08-01 15:00:10 -0500 |
---|---|---|
committer | Stephen Paul Weber <singpolyma@singpolyma.net> | 2011-08-01 15:00:10 -0500 |
commit | 502c7489e6c8cf4e5c39c0910fca232e6d9e7f63 (patch) | |
tree | 57d551352d028b0dc1a56b5f51d60d2d55f46904 /lib | |
parent | ede32bbb7038ee337968890ec80f4c693efadc58 (diff) |
PublicKeyPacket parser
Diffstat (limited to 'lib')
-rw-r--r-- | lib/OpenPGP.hs | 54 |
1 files 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 | |||
4 | import Data.Binary.Get | 4 | import Data.Binary.Get |
5 | import Data.Bits | 5 | import Data.Bits |
6 | import Data.Word | 6 | import Data.Word |
7 | import Data.Map (Map) | ||
8 | import qualified Data.Map as Map | ||
7 | import qualified Data.ByteString.Lazy as LZ | 9 | import qualified Data.ByteString.Lazy as LZ |
8 | import qualified Data.ByteString.Lazy.UTF8 as LZ | 10 | import qualified Data.ByteString.Lazy.UTF8 as LZ (toString) |
9 | import qualified Codec.Compression.Zlib.Raw as Zip | 11 | import qualified Codec.Compression.Zlib.Raw as Zip |
10 | import qualified Codec.Compression.Zlib as Zlib | 12 | import qualified Codec.Compression.Zlib as Zlib |
11 | import qualified Codec.Compression.BZip as BZip2 | 13 | import qualified Codec.Compression.BZip as BZip2 |
@@ -13,6 +15,7 @@ import qualified Codec.Compression.BZip as BZip2 | |||
13 | import qualified BaseConvert as BaseConvert | 15 | import qualified BaseConvert as BaseConvert |
14 | 16 | ||
15 | newtype Message = Message [Packet] deriving (Show, Read, Eq) | 17 | newtype Message = Message [Packet] deriving (Show, Read, Eq) |
18 | newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord) | ||
16 | 19 | ||
17 | data Packet = | 20 | data Packet = |
18 | OnePassSignaturePacket { | 21 | OnePassSignaturePacket { |
@@ -23,8 +26,14 @@ data Packet = | |||
23 | key_id::String, | 26 | key_id::String, |
24 | nested::Word8 | 27 | nested::Word8 |
25 | } | | 28 | } | |
29 | PublicKeyPacket { | ||
30 | version::Word8, | ||
31 | timestamp::Word32, | ||
32 | public_key_algorithm::KeyAlgorithm, | ||
33 | key::Map Char MPI | ||
34 | } | | ||
26 | CompressedDataPacket { | 35 | CompressedDataPacket { |
27 | algorithm::CompressionAlgorithm, | 36 | compressed_data_algorithm::CompressionAlgorithm, |
28 | message::Message | 37 | message::Message |
29 | } | | 38 | } | |
30 | LiteralDataPacket { | 39 | LiteralDataPacket { |
@@ -59,6 +68,11 @@ key_algorithms 18 = ECC | |||
59 | key_algorithms 19 = ECDSA | 68 | key_algorithms 19 = ECDSA |
60 | key_algorithms 21 = DH | 69 | key_algorithms 21 = DH |
61 | 70 | ||
71 | public_key_fields :: KeyAlgorithm -> [Char] | ||
72 | public_key_fields RSA = ['n', 'e'] | ||
73 | public_key_fields ELGAMAL = ['p', 'g', 'y'] | ||
74 | public_key_fields DSA = ['p', 'q', 'g', 'y'] | ||
75 | |||
62 | -- A message is encoded as a list that takes the entire file | 76 | -- A message is encoded as a list that takes the entire file |
63 | instance Binary Message where | 77 | instance Binary Message where |
64 | put (Message []) = return () | 78 | put (Message []) = return () |
@@ -74,6 +88,18 @@ instance Binary Message where | |||
74 | (Message tail) <- get :: Get Message | 88 | (Message tail) <- get :: Get Message |
75 | return (Message (next_packet:tail)) | 89 | return (Message (next_packet:tail)) |
76 | 90 | ||
91 | instance Binary MPI where | ||
92 | put (MPI i) = do | ||
93 | put ((((fromIntegral (LZ.length bytes)) - 1) * 8) + (floor (logBase 2 (fromIntegral (bytes `LZ.index` 1)))) + 1 :: Word16) | ||
94 | mapM (\x -> putWord8 x) (LZ.unpack bytes) | ||
95 | put () | ||
96 | where bytes = LZ.unfoldr (\x -> if x == 0 then Nothing else Just (fromIntegral x, x `shiftR` 8)) i | ||
97 | get = do | ||
98 | length <- fmap fromIntegral (get :: Get Word16) | ||
99 | bytes <- getLazyByteString (floor ((length + 7) / 8)) | ||
100 | return (MPI (LZ.foldr (\b a -> | ||
101 | a `shiftL` 8 .|. fromIntegral b) 0 bytes)) | ||
102 | |||
77 | instance Binary Packet where | 103 | instance Binary Packet where |
78 | get = do | 104 | get = do |
79 | tag <- get :: Get Word8 | 105 | tag <- get :: Get Word8 |
@@ -133,6 +159,22 @@ parse_packet 4 = do | |||
133 | key_id = (BaseConvert.toString 16 key_id), | 159 | key_id = (BaseConvert.toString 16 key_id), |
134 | nested = nested | 160 | nested = nested |
135 | }) | 161 | }) |
162 | -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2 | ||
163 | parse_packet 6 = do | ||
164 | version <- get :: Get Word8 | ||
165 | case version of | ||
166 | 4 -> do | ||
167 | timestamp <- get | ||
168 | algorithm <- fmap key_algorithms (get :: Get Word8) | ||
169 | key <- mapM (\f -> do | ||
170 | mpi <- get :: Get MPI | ||
171 | return (f, mpi)) (public_key_fields algorithm) | ||
172 | return (PublicKeyPacket { | ||
173 | version = 4, | ||
174 | timestamp = timestamp, | ||
175 | public_key_algorithm = algorithm, | ||
176 | key = Map.fromList key | ||
177 | }) | ||
136 | -- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6 | 178 | -- CompressedDataPacket, http://tools.ietf.org/html/rfc4880#section-5.6 |
137 | parse_packet 8 = do | 179 | parse_packet 8 = do |
138 | algorithm <- get :: Get Word8 | 180 | algorithm <- get :: Get Word8 |
@@ -140,22 +182,22 @@ parse_packet 8 = do | |||
140 | case algorithm of | 182 | case algorithm of |
141 | 0 -> | 183 | 0 -> |
142 | return (CompressedDataPacket { | 184 | return (CompressedDataPacket { |
143 | algorithm = Uncompressed, | 185 | compressed_data_algorithm = Uncompressed, |
144 | message = runGet (get :: Get Message) message | 186 | message = runGet (get :: Get Message) message |
145 | }) | 187 | }) |
146 | 1 -> | 188 | 1 -> |
147 | return (CompressedDataPacket { | 189 | return (CompressedDataPacket { |
148 | algorithm = ZIP, | 190 | compressed_data_algorithm = ZIP, |
149 | message = runGet (get :: Get Message) (Zip.decompress message) | 191 | message = runGet (get :: Get Message) (Zip.decompress message) |
150 | }) | 192 | }) |
151 | 2 -> | 193 | 2 -> |
152 | return (CompressedDataPacket { | 194 | return (CompressedDataPacket { |
153 | algorithm = ZLIB, | 195 | compressed_data_algorithm = ZLIB, |
154 | message = runGet (get :: Get Message) (Zlib.decompress message) | 196 | message = runGet (get :: Get Message) (Zlib.decompress message) |
155 | }) | 197 | }) |
156 | 3 -> | 198 | 3 -> |
157 | return (CompressedDataPacket { | 199 | return (CompressedDataPacket { |
158 | algorithm = BZip2, | 200 | compressed_data_algorithm = BZip2, |
159 | message = runGet (get :: Get Message) (BZip2.decompress message) | 201 | message = runGet (get :: Get Message) (BZip2.decompress message) |
160 | }) | 202 | }) |
161 | -- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9 | 203 | -- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9 |