diff options
author | Stephen Paul Weber <singpolyma@singpolyma.net> | 2012-04-30 12:38:16 -0500 |
---|---|---|
committer | Stephen Paul Weber <singpolyma@singpolyma.net> | 2012-04-30 12:38:16 -0500 |
commit | be7580e37a1233be35131dcb957fe502cd47aa2f (patch) | |
tree | 801456d047648dd4c65ba94e09d9e9f582113707 /Data | |
parent | ad6cd0274c52c17c41ee863cd13fc8e70becf5b8 (diff) |
ModificationDetectionCodePacket
Diffstat (limited to 'Data')
-rw-r--r-- | Data/OpenPGP.hs | 26 |
1 files changed, 20 insertions, 6 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 5041a37..4904e54 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs | |||
@@ -13,6 +13,7 @@ module Data.OpenPGP ( | |||
13 | MarkerPacket, | 13 | MarkerPacket, |
14 | LiteralDataPacket, | 14 | LiteralDataPacket, |
15 | UserIDPacket, | 15 | UserIDPacket, |
16 | ModificationDetectionCodePacket, | ||
16 | UnsupportedPacket, | 17 | UnsupportedPacket, |
17 | compression_algorithm, | 18 | compression_algorithm, |
18 | content, | 19 | content, |
@@ -143,6 +144,9 @@ lazyDecompress ZLIB = Zlib.decompress | |||
143 | lazyDecompress BZip2 = BZip2.decompress | 144 | lazyDecompress BZip2 = BZip2.decompress |
144 | lazyDecompress x = error ("No implementation for " ++ show x) | 145 | lazyDecompress x = error ("No implementation for " ++ show x) |
145 | 146 | ||
147 | assertProp :: (a -> Bool) -> a -> a | ||
148 | assertProp f x = assert (f x) x | ||
149 | |||
146 | data Packet = | 150 | data Packet = |
147 | SignaturePacket { | 151 | SignaturePacket { |
148 | version::Word8, | 152 | version::Word8, |
@@ -195,6 +199,7 @@ data Packet = | |||
195 | content::B.ByteString | 199 | content::B.ByteString |
196 | } | | 200 | } | |
197 | UserIDPacket String | | 201 | UserIDPacket String | |
202 | ModificationDetectionCodePacket B.ByteString | | ||
198 | UnsupportedPacket Word8 B.ByteString | 203 | UnsupportedPacket Word8 B.ByteString |
199 | deriving (Show, Read, Eq) | 204 | deriving (Show, Read, Eq) |
200 | 205 | ||
@@ -202,11 +207,16 @@ instance BINARY_CLASS Packet where | |||
202 | put p = do | 207 | put p = do |
203 | -- First two bits are 1 for new packet format | 208 | -- First two bits are 1 for new packet format |
204 | put ((tag .|. 0xC0) :: Word8) | 209 | put ((tag .|. 0xC0) :: Word8) |
205 | -- Use 5-octet lengths | 210 | case tag of |
206 | put (255 :: Word8) | 211 | 19 -> put (assertProp (<192) blen :: Word8) |
207 | put ((fromIntegral $ B.length body) :: Word32) | 212 | _ -> do |
208 | putSomeByteString body | 213 | -- Use 5-octet lengths |
214 | put (255 :: Word8) | ||
215 | put (blen :: Word32) | ||
216 | putSomeByteString body | ||
209 | where | 217 | where |
218 | blen :: (Num a) => a | ||
219 | blen = fromIntegral $ B.length body | ||
210 | (body, tag) = put_packet p | 220 | (body, tag) = put_packet p |
211 | get = do | 221 | get = do |
212 | tag <- get :: Get Word8 | 222 | tag <- get :: Get Word8 |
@@ -377,6 +387,7 @@ put_packet (LiteralDataPacket { format = format, filename = filename, | |||
377 | filename_l = (fromIntegral $ B.length lz_filename) :: Word8 | 387 | filename_l = (fromIntegral $ B.length lz_filename) :: Word8 |
378 | lz_filename = B.fromString filename | 388 | lz_filename = B.fromString filename |
379 | put_packet (UserIDPacket txt) = (B.fromString txt, 13) | 389 | put_packet (UserIDPacket txt) = (B.fromString txt, 13) |
390 | put_packet (ModificationDetectionCodePacket bstr) = (bstr, 19) | ||
380 | put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag) | 391 | put_packet (UnsupportedPacket tag bytes) = (bytes, fromIntegral tag) |
381 | put_packet _ = error "Unsupported Packet version or type in put_packet." | 392 | put_packet _ = error "Unsupported Packet version or type in put_packet." |
382 | 393 | ||
@@ -507,6 +518,9 @@ parse_packet 11 = do | |||
507 | -- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11 | 518 | -- UserIDPacket, http://tools.ietf.org/html/rfc4880#section-5.11 |
508 | parse_packet 13 = | 519 | parse_packet 13 = |
509 | fmap (UserIDPacket . B.toString) getRemainingByteString | 520 | fmap (UserIDPacket . B.toString) getRemainingByteString |
521 | -- ModificationDetectionCodePacket, http://tools.ietf.org/html/rfc4880#section-5.14 | ||
522 | parse_packet 19 = | ||
523 | fmap ModificationDetectionCodePacket getRemainingByteString | ||
510 | -- Represent unsupported packets as their tag and literal bytes | 524 | -- Represent unsupported packets as their tag and literal bytes |
511 | parse_packet tag = fmap (UnsupportedPacket tag) getRemainingByteString | 525 | parse_packet tag = fmap (UnsupportedPacket tag) getRemainingByteString |
512 | 526 | ||
@@ -695,7 +709,7 @@ instance BINARY_CLASS MPI where | |||
695 | bytes' = B.reverse $ B.unfoldr (\x -> | 709 | bytes' = B.reverse $ B.unfoldr (\x -> |
696 | if x == 0 then Nothing else | 710 | if x == 0 then Nothing else |
697 | Just (fromIntegral x, x `shiftR` 8) | 711 | Just (fromIntegral x, x `shiftR` 8) |
698 | ) (assert (i>=0) i) | 712 | ) (assertProp (>=0) i) |
699 | get = do | 713 | get = do |
700 | length <- fmap fromIntegral (get :: Get Word16) | 714 | length <- fmap fromIntegral (get :: Get Word16) |
701 | bytes <- getSomeByteString ((length + 7) `div` 8) | 715 | bytes <- getSomeByteString ((length + 7) `div` 8) |
@@ -857,7 +871,7 @@ put_signature_subpacket (FeaturesPacket supports_mdc) = | |||
857 | put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) = | 871 | put_signature_subpacket (SignatureTargetPacket kalgo halgo hash) = |
858 | (B.concat [encode kalgo, encode halgo, hash], 31) | 872 | (B.concat [encode kalgo, encode halgo, hash], 31) |
859 | put_signature_subpacket (EmbeddedSignaturePacket packet) = | 873 | put_signature_subpacket (EmbeddedSignaturePacket packet) = |
860 | (encode (assert (isSignaturePacket packet) packet), 32) | 874 | (encode (assertProp isSignaturePacket packet), 32) |
861 | put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) = | 875 | put_signature_subpacket (UnsupportedSignatureSubpacket tag bytes) = |
862 | (bytes, tag) | 876 | (bytes, tag) |
863 | 877 | ||