1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
module OpenPGP (Message(..), Packet(..), HashAlgorithm, KeyAlgorithm, CompressionAlgorithm) where
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 (toString)
import qualified Codec.Compression.Zlib.Raw as Zip
import qualified Codec.Compression.Zlib as Zlib
import qualified Codec.Compression.BZip as BZip2
import qualified BaseConvert as BaseConvert
data Packet =
OnePassSignaturePacket {
version::Word8,
signature_type::Word8,
hash_algorithm::HashAlgorithm,
key_algorithm::KeyAlgorithm,
key_id::String,
nested::Word8
} |
PublicKeyPacket {
version::Word8,
timestamp::Word32,
public_key_algorithm::KeyAlgorithm,
key::Map Char MPI
} |
CompressedDataPacket {
compressed_data_algorithm::CompressionAlgorithm,
message::Message
} |
LiteralDataPacket {
format::Char,
filename::String,
timestamp::Word32,
content::LZ.ByteString
} |
UserIDPacket String
deriving (Show, Read, Eq)
data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224
deriving (Show, Read, Eq)
instance Binary HashAlgorithm where
get = do
tag <- get :: Get Word8
case tag of
01 -> return MD5
02 -> return SHA1
03 -> return RIPEMD160
08 -> return SHA256
09 -> return SHA384
10 -> return SHA512
11 -> return SHA224
data KeyAlgorithm = RSA | RSA_E | RSA_S | ELGAMAL | DSA | ECC | ECDSA | DH
deriving (Show, Read, Eq)
instance Binary KeyAlgorithm where
put RSA = put (01 :: Word8)
put RSA_E = put (02 :: Word8)
put RSA_S = put (03 :: Word8)
put ELGAMAL = put (16 :: Word8)
put DSA = put (17 :: Word8)
put ECC = put (18 :: Word8)
put ECDSA = put (19 :: Word8)
put DH = put (21 :: Word8)
get = do
tag <- get :: Get Word8
case tag of
01 -> return RSA
02 -> return RSA_E
03 -> return RSA_S
16 -> return ELGAMAL
17 -> return DSA
18 -> return ECC
19 -> return ECDSA
21 -> return DH
data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2
deriving (Show, Read, Eq)
instance Binary CompressionAlgorithm where
get = do
tag <- get :: Get Word8
case tag of
0 -> return Uncompressed
1 -> return ZIP
2 -> return ZLIB
3 -> return BZip2
-- A message is encoded as a list that takes the entire file
newtype Message = Message [Packet] deriving (Show, Read, Eq)
instance Binary Message where
put (Message []) = return ()
put (Message (x:xs)) = do
put x
put (Message xs)
get = do
done <- isEmpty
if done then do
return (Message [])
else do
next_packet <- get :: Get Packet
(Message tail) <- get :: Get Message
return (Message (next_packet:tail))
newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
instance Binary MPI where
put (MPI i) = do
put ((((fromIntegral (LZ.length bytes)) - 1) * 8) + (floor (logBase 2 (fromIntegral (bytes `LZ.index` 0)))) + 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
if (tag .&. 64) /= 0 then do
len <- fmap fromIntegral parse_new_length
-- This forces the whole packet to be consumed
packet <- getLazyByteString len
return $ runGet (parse_packet (tag .&. 63)) packet
else do
len <- fmap fromIntegral (parse_old_length tag)
-- This forces the whole packet to be consumed
packet <- getLazyByteString len
return $ runGet (parse_packet ((tag `shiftR` 2) .&. 15)) packet
-- http://tools.ietf.org/html/rfc4880#section-4.2.2
parse_new_length :: Get Word32
parse_new_length = do
len <- fmap fromIntegral (get :: Get Word8)
case len of
-- One octet length
_ | len < 192 -> return len
-- Two octet length
_ | len > 191 && len < 224 -> do
second <- fmap fromIntegral (get :: Get Word8)
return $ ((len - 192) `shiftL` 8) + second + 192
-- Five octet length
_ | len == 255 -> get :: Get Word32
-- TODO: Partial body lengths. 1 << (len & 0x1F)
-- http://tools.ietf.org/html/rfc4880#section-4.2.1
parse_old_length :: Word8 -> Get Word32
parse_old_length tag =
case (tag .&. 3) of
-- One octet length
0 -> fmap fromIntegral (get :: Get Word8)
-- Two octet length
1 -> fmap fromIntegral (get :: Get Word16)
-- Four octet length
2 -> get
-- Indeterminate length
3 -> fmap fromIntegral remaining
parse_packet :: Word8 -> Get Packet
-- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4
parse_packet 4 = do
version <- get
signature_type <- get
hash_algo <- get
key_algo <- get
key_id <- get :: Get Word64
nested <- get
return (OnePassSignaturePacket {
version = version,
signature_type = signature_type,
hash_algorithm = hash_algo,
key_algorithm = key_algo,
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 <- get
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
message <- getRemainingLazyByteString
case algorithm of
Uncompressed ->
return (CompressedDataPacket {
compressed_data_algorithm = algorithm,
message = runGet (get :: Get Message) message
})
ZIP ->
return (CompressedDataPacket {
compressed_data_algorithm = algorithm,
message = runGet (get :: Get Message) (Zip.decompress message)
})
ZLIB ->
return (CompressedDataPacket {
compressed_data_algorithm = algorithm,
message = runGet (get :: Get Message) (Zlib.decompress message)
})
BZip2 ->
return (CompressedDataPacket {
compressed_data_algorithm = algorithm,
message = runGet (get :: Get Message) (BZip2.decompress message)
})
-- LiteralDataPacket, http://tools.ietf.org/html/rfc4880#section-5.9
parse_packet 11 = do
format <- get
filenameLength <- get :: Get Word8
filename <- getLazyByteString (fromIntegral filenameLength)
timestamp <- get
content <- getRemainingLazyByteString
return (LiteralDataPacket {
format = format,
filename = LZ.toString filename,
timestamp = timestamp,
content = content
})
-- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11
parse_packet 13 =
fmap UserIDPacket (fmap LZ.toString getRemainingLazyByteString)
parse_packet _ = fail "Unimplemented OpenPGP packet tag"
|
