diff options
-rw-r--r-- | Data/OpenPGP.hs | 53 | ||||
-rw-r--r-- | openpgp.cabal | 2 |
2 files changed, 47 insertions, 8 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 1f0ff34..74aae5f 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs | |||
@@ -74,17 +74,18 @@ import Data.Bits | |||
74 | import Data.Word | 74 | import Data.Word |
75 | import Data.Char | 75 | import Data.Char |
76 | import Data.List | 76 | import Data.List |
77 | import Data.Maybe | ||
77 | import Data.OpenPGP.Internal | 78 | import Data.OpenPGP.Internal |
78 | import qualified Data.ByteString as BS | 79 | import qualified Data.ByteString as BS |
79 | import qualified Data.ByteString.Lazy as LZ | 80 | import qualified Data.ByteString.Lazy as LZ |
80 | 81 | ||
81 | #ifdef CEREAL | 82 | #ifdef CEREAL |
82 | import Data.Serialize hiding (decode) | 83 | import Data.Serialize |
83 | import qualified Data.ByteString as B | 84 | import qualified Data.ByteString as B |
84 | import qualified Data.ByteString.UTF8 as B (toString, fromString) | 85 | import qualified Data.ByteString.UTF8 as B (toString, fromString) |
85 | #define BINARY_CLASS Serialize | 86 | #define BINARY_CLASS Serialize |
86 | #else | 87 | #else |
87 | import Data.Binary hiding (decode) | 88 | import Data.Binary |
88 | import Data.Binary.Get | 89 | import Data.Binary.Get |
89 | import Data.Binary.Put | 90 | import Data.Binary.Put |
90 | import qualified Data.ByteString.Lazy as B | 91 | import qualified Data.ByteString.Lazy as B |
@@ -135,12 +136,17 @@ getSomeByteString = getLazyByteString . fromIntegral | |||
135 | putSomeByteString :: B.ByteString -> Put | 136 | putSomeByteString :: B.ByteString -> Put |
136 | putSomeByteString = putLazyByteString | 137 | putSomeByteString = putLazyByteString |
137 | 138 | ||
139 | #if MIN_VERSION_binary(0,6,4) | ||
138 | localGet :: Get a -> B.ByteString -> Get a | 140 | localGet :: Get a -> B.ByteString -> Get a |
139 | localGet g bs = case runGetOrFail g bs of | 141 | localGet g bs = case runGetOrFail g bs of |
140 | Left (_,_,s) -> fail s | 142 | Left (_,_,s) -> fail s |
141 | Right (leftover,_,v) | 143 | Right (leftover,_,v) |
142 | | B.null leftover -> return v | 144 | | B.null leftover -> return v |
143 | | otherwise -> fail $ "Leftover in localGet: " ++ show leftover | 145 | | otherwise -> fail $ "Leftover in localGet: " ++ show leftover |
146 | #else | ||
147 | localGet :: Get a -> B.ByteString -> Get a | ||
148 | localGet g bs = return $ runGet g bs | ||
149 | #endif | ||
144 | 150 | ||
145 | compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString | 151 | compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString |
146 | compress = lazyCompress | 152 | compress = lazyCompress |
@@ -335,6 +341,7 @@ public_key_fields RSA_E = public_key_fields RSA | |||
335 | public_key_fields RSA_S = public_key_fields RSA | 341 | public_key_fields RSA_S = public_key_fields RSA |
336 | public_key_fields ELGAMAL = ['p', 'g', 'y'] | 342 | public_key_fields ELGAMAL = ['p', 'g', 'y'] |
337 | public_key_fields DSA = ['p', 'q', 'g', 'y'] | 343 | public_key_fields DSA = ['p', 'q', 'g', 'y'] |
344 | public_key_fields ECDSA = ['c','l','x', 'y'] | ||
338 | public_key_fields _ = undefined -- Nothing in the spec. Maybe empty | 345 | public_key_fields _ = undefined -- Nothing in the spec. Maybe empty |
339 | 346 | ||
340 | -- http://tools.ietf.org/html/rfc4880#section-5.5.3 | 347 | -- http://tools.ietf.org/html/rfc4880#section-5.5.3 |
@@ -344,6 +351,7 @@ secret_key_fields RSA_E = secret_key_fields RSA | |||
344 | secret_key_fields RSA_S = secret_key_fields RSA | 351 | secret_key_fields RSA_S = secret_key_fields RSA |
345 | secret_key_fields ELGAMAL = ['x'] | 352 | secret_key_fields ELGAMAL = ['x'] |
346 | secret_key_fields DSA = ['x'] | 353 | secret_key_fields DSA = ['x'] |
354 | secret_key_fields ECDSA = ['d'] | ||
347 | secret_key_fields _ = undefined -- Nothing in the spec. Maybe empty | 355 | secret_key_fields _ = undefined -- Nothing in the spec. Maybe empty |
348 | 356 | ||
349 | (!) :: (Eq k) => [(k,v)] -> k -> v | 357 | (!) :: (Eq k) => [(k,v)] -> k -> v |
@@ -395,6 +403,38 @@ calculate_signature_trailer p@(SignaturePacket {version = 4}) = | |||
395 | calculate_signature_trailer x = | 403 | calculate_signature_trailer x = |
396 | error ("Trying to calculate signature trailer for: " ++ show x) | 404 | error ("Trying to calculate signature trailer for: " ++ show x) |
397 | 405 | ||
406 | |||
407 | encode_public_key_material :: Packet -> [B.ByteString] | ||
408 | encode_public_key_material k | key_algorithm k == ECDSA = do | ||
409 | -- http://tools.ietf.org/html/rfc6637 | ||
410 | c <- maybeToList $ lookup 'c' (key k) | ||
411 | MPI l <- maybeToList $ lookup 'l' (key k) | ||
412 | MPI x <- maybeToList $ lookup 'x' (key k) | ||
413 | MPI y <- maybeToList $ lookup 'y' (key k) | ||
414 | let (bitlen,oid) = B.splitAt 2 (encode c) | ||
415 | len16 = decode bitlen :: Word16 | ||
416 | (fullbytes,rembits) = len16 `quotRem` 8 | ||
417 | len8 = fromIntegral (fullbytes + if rembits/=0 then 1 else 0) :: Word8 | ||
418 | xy = 4*(4^l) + x*(2^l) + y | ||
419 | [ len8 `B.cons` oid, encode (MPI xy) ] | ||
420 | encode_public_key_material k = map (encode . (key k !)) (public_key_fields $ key_algorithm k) | ||
421 | |||
422 | decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)] | ||
423 | decode_public_key_material ECDSA = do | ||
424 | -- http://tools.ietf.org/html/rfc6637 | ||
425 | oidlen <- get :: Get Word8 | ||
426 | oidbytes <- getSomeByteString (fromIntegral oidlen) | ||
427 | let mpiFromBytes bytes = MPI (B.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 bytes) | ||
428 | oid = mpiFromBytes oidbytes | ||
429 | MPI xy <- get | ||
430 | let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2 | ||
431 | width = ( integerBytesize xy - 1 ) `div` 2 | ||
432 | (fx,y) = xy `quotRem` (256^width) | ||
433 | x = fx `rem` (256^width) | ||
434 | l = width*8 | ||
435 | return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y)] | ||
436 | decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm) | ||
437 | |||
398 | put_packet :: Packet -> (B.ByteString, Word8) | 438 | put_packet :: Packet -> (B.ByteString, Word8) |
399 | put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) = | 439 | put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) = |
400 | (B.concat [ | 440 | (B.concat [ |
@@ -491,7 +531,7 @@ put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp, | |||
491 | where | 531 | where |
492 | Just v3_days = v3_days_of_validity p | 532 | Just v3_days = v3_days_of_validity p |
493 | final x = (x, if is_subkey then 14 else 6) | 533 | final x = (x, if is_subkey then 14 else 6) |
494 | material = map (encode . (key !)) (public_key_fields algorithm) | 534 | material = encode_public_key_material p |
495 | put_packet (CompressedDataPacket { compression_algorithm = algorithm, | 535 | put_packet (CompressedDataPacket { compression_algorithm = algorithm, |
496 | message = message }) = | 536 | message = message }) = |
497 | (B.append (encode algorithm) $ compress algorithm $ encode message, 8) | 537 | (B.append (encode algorithm) $ compress algorithm $ encode message, 8) |
@@ -632,7 +672,7 @@ parse_packet 6 = do | |||
632 | timestamp <- get | 672 | timestamp <- get |
633 | days <- get | 673 | days <- get |
634 | algorithm <- get | 674 | algorithm <- get |
635 | key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm) | 675 | key <- decode_public_key_material algorithm |
636 | return PublicKeyPacket { | 676 | return PublicKeyPacket { |
637 | version = version, | 677 | version = version, |
638 | timestamp = timestamp, | 678 | timestamp = timestamp, |
@@ -644,7 +684,7 @@ parse_packet 6 = do | |||
644 | 4 -> do | 684 | 4 -> do |
645 | timestamp <- get | 685 | timestamp <- get |
646 | algorithm <- get | 686 | algorithm <- get |
647 | key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm) | 687 | key <- decode_public_key_material algorithm |
648 | return PublicKeyPacket { | 688 | return PublicKeyPacket { |
649 | version = 4, | 689 | version = 4, |
650 | timestamp = timestamp, | 690 | timestamp = timestamp, |
@@ -710,8 +750,7 @@ fingerprint_material p | version p == 4 = | |||
710 | material | 750 | material |
711 | ] | 751 | ] |
712 | where | 752 | where |
713 | material = B.concat $ map (encode . (key p !)) | 753 | material = B.concat $ encode_public_key_material p |
714 | (public_key_fields $ key_algorithm p) | ||
715 | fingerprint_material p | version p `elem` [2, 3] = [n, e] | 754 | fingerprint_material p | version p `elem` [2, 3] = [n, e] |
716 | where | 755 | where |
717 | n = B.drop 2 (encode (key p ! 'n')) | 756 | n = B.drop 2 (encode (key p ! 'n')) |
diff --git a/openpgp.cabal b/openpgp.cabal index 7214bf5..d9af124 100644 --- a/openpgp.cabal +++ b/openpgp.cabal | |||
@@ -138,7 +138,7 @@ library | |||
138 | base == 4.*, | 138 | base == 4.*, |
139 | bytestring, | 139 | bytestring, |
140 | utf8-string, | 140 | utf8-string, |
141 | binary >= 0.6.4.0, | 141 | binary >= 0.5.1.1, |
142 | zlib, | 142 | zlib, |
143 | bzlib | 143 | bzlib |
144 | 144 | ||