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
|
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
newtype Message = Message [Packet] deriving (Show, Read, Eq)
newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord)
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)
data KeyAlgorithm = RSA | ELGAMAL | DSA | ECC | ECDSA | DH deriving (Show, Read, Eq)
data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 deriving (Show, Read, Eq)
hash_algorithms :: (Num a) => a -> HashAlgorithm
hash_algorithms 1 = MD5
hash_algorithms 2 = SHA1
hash_algorithms 3 = RIPEMD160
hash_algorithms 8 = SHA256
hash_algorithms 9 = SHA384
hash_algorithms 10 = SHA512
hash_algorithms 11 = SHA224
key_algorithms :: (Num a) => a -> KeyAlgorithm
key_algorithms 1 = RSA
key_algorithms 2 = RSA
key_algorithms 3 = RSA
key_algorithms 16 = ELGAMAL
key_algorithms 17 = DSA
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 ()
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))
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
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 :: Get Word8
key_algo <- get :: Get Word8
key_id <- get :: Get Word64
nested <- get
return (OnePassSignaturePacket {
version = version,
signature_type = signature_type,
hash_algorithm = (hash_algorithms hash_algo),
key_algorithm = (key_algorithms 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 <- 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
message <- getRemainingLazyByteString
case algorithm of
0 ->
return (CompressedDataPacket {
compressed_data_algorithm = Uncompressed,
message = runGet (get :: Get Message) message
})
1 ->
return (CompressedDataPacket {
compressed_data_algorithm = ZIP,
message = runGet (get :: Get Message) (Zip.decompress message)
})
2 ->
return (CompressedDataPacket {
compressed_data_algorithm = ZLIB,
message = runGet (get :: Get Message) (Zlib.decompress message)
})
3 ->
return (CompressedDataPacket {
compressed_data_algorithm = BZip2,
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"
|
