summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Data/OpenPGP.hs53
-rw-r--r--openpgp.cabal2
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
74import Data.Word 74import Data.Word
75import Data.Char 75import Data.Char
76import Data.List 76import Data.List
77import Data.Maybe
77import Data.OpenPGP.Internal 78import Data.OpenPGP.Internal
78import qualified Data.ByteString as BS 79import qualified Data.ByteString as BS
79import qualified Data.ByteString.Lazy as LZ 80import qualified Data.ByteString.Lazy as LZ
80 81
81#ifdef CEREAL 82#ifdef CEREAL
82import Data.Serialize hiding (decode) 83import Data.Serialize
83import qualified Data.ByteString as B 84import qualified Data.ByteString as B
84import qualified Data.ByteString.UTF8 as B (toString, fromString) 85import qualified Data.ByteString.UTF8 as B (toString, fromString)
85#define BINARY_CLASS Serialize 86#define BINARY_CLASS Serialize
86#else 87#else
87import Data.Binary hiding (decode) 88import Data.Binary
88import Data.Binary.Get 89import Data.Binary.Get
89import Data.Binary.Put 90import Data.Binary.Put
90import qualified Data.ByteString.Lazy as B 91import qualified Data.ByteString.Lazy as B
@@ -135,12 +136,17 @@ getSomeByteString = getLazyByteString . fromIntegral
135putSomeByteString :: B.ByteString -> Put 136putSomeByteString :: B.ByteString -> Put
136putSomeByteString = putLazyByteString 137putSomeByteString = putLazyByteString
137 138
139#if MIN_VERSION_binary(0,6,4)
138localGet :: Get a -> B.ByteString -> Get a 140localGet :: Get a -> B.ByteString -> Get a
139localGet g bs = case runGetOrFail g bs of 141localGet 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
147localGet :: Get a -> B.ByteString -> Get a
148localGet g bs = return $ runGet g bs
149#endif
144 150
145compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString 151compress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
146compress = lazyCompress 152compress = lazyCompress
@@ -335,6 +341,7 @@ public_key_fields RSA_E = public_key_fields RSA
335public_key_fields RSA_S = public_key_fields RSA 341public_key_fields RSA_S = public_key_fields RSA
336public_key_fields ELGAMAL = ['p', 'g', 'y'] 342public_key_fields ELGAMAL = ['p', 'g', 'y']
337public_key_fields DSA = ['p', 'q', 'g', 'y'] 343public_key_fields DSA = ['p', 'q', 'g', 'y']
344public_key_fields ECDSA = ['c','l','x', 'y']
338public_key_fields _ = undefined -- Nothing in the spec. Maybe empty 345public_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
344secret_key_fields RSA_S = secret_key_fields RSA 351secret_key_fields RSA_S = secret_key_fields RSA
345secret_key_fields ELGAMAL = ['x'] 352secret_key_fields ELGAMAL = ['x']
346secret_key_fields DSA = ['x'] 353secret_key_fields DSA = ['x']
354secret_key_fields ECDSA = ['d']
347secret_key_fields _ = undefined -- Nothing in the spec. Maybe empty 355secret_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}) =
395calculate_signature_trailer x = 403calculate_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
407encode_public_key_material :: Packet -> [B.ByteString]
408encode_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) ]
420encode_public_key_material k = map (encode . (key k !)) (public_key_fields $ key_algorithm k)
421
422decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)]
423decode_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)]
436decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
437
398put_packet :: Packet -> (B.ByteString, Word8) 438put_packet :: Packet -> (B.ByteString, Word8)
399put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) = 439put_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
495put_packet (CompressedDataPacket { compression_algorithm = algorithm, 535put_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)
715fingerprint_material p | version p `elem` [2, 3] = [n, e] 754fingerprint_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