From 36601fd1d12270d1215f55e43fc8c075815fb638 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sun, 13 Oct 2019 00:02:36 -0400 Subject: Ed25519 support. --- Data/OpenPGP.hs | 75 ++++++++++++++++++++++++++++++-------------- Data/OpenPGP/Internal.hs | 42 ++++++++++++++++++------- Data/OpenPGP/Util/Base.hs | 1 - Data/OpenPGP/Util/Ed25519.hs | 51 ++++++++++++++++++++++++++++++ Data/OpenPGP/Util/Verify.hs | 4 ++- openpgp-util.cabal | 1 + 6 files changed, 136 insertions(+), 38 deletions(-) create mode 100644 Data/OpenPGP/Util/Ed25519.hs diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 35298c8..4627d4e 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs @@ -64,7 +64,9 @@ module Data.OpenPGP ( signature_issuer, public_key_fields, secret_key_fields, - eccOID + eccOID, + encode_public_key_material, + decode_public_key_material ) where import Control.Applicative @@ -80,6 +82,7 @@ import Data.Maybe import Data.Monoid import Data.OpenPGP.Internal import Data.Word +import GHC.Stack import Numeric #ifdef CEREAL @@ -345,8 +348,8 @@ public_key_fields RSA_S = public_key_fields RSA public_key_fields ELGAMAL = ['p', 'g', 'y'] public_key_fields DSA = ['p', 'q', 'g', 'y'] public_key_fields ECDSA = ['c','l','x', 'y', 'f'] -public_key_fields Ed25519 = ['c','l','x', 'y', 'f'] -public_key_fields ECC = ['c','l','x', 'y', 'f'] +public_key_fields Ed25519 = ['c','l','x', 'y', 'n', 'f'] +public_key_fields ECC = ['c','l','x', 'y', 'n', 'f', 'e'] public_key_fields alg = error ("Unknown key fields for "++show alg) -- Nothing in the spec. Maybe empty -- http://tools.ietf.org/html/rfc4880#section-5.5.3 @@ -359,8 +362,10 @@ secret_key_fields DSA = ['x'] secret_key_fields ECDSA = ['d'] secret_key_fields alg = error ("Unkown secret fields for "++show alg) -- Nothing in the spec. Maybe empty -(!) :: (Eq k) => [(k,v)] -> k -> v -(!) xs k = let Just x = lookup k xs in x +(!) :: (HasCallStack, Show k, Eq k) => [(k,v)] -> k -> v +(!) xs k = case lookup k xs of + Just v -> v + Nothing -> error ("Missing field "++show k++" at "++prettyCallStack callStack) -- Need this seperate for trailer calculation signature_packet_start :: Packet -> B.ByteString @@ -420,19 +425,28 @@ eccOID SecretKeyPacket { key = k } = lookup 'c' k >>= \(MPI oid) -> Just (snd $ eccOID _ = Nothing encode_public_key_material :: Packet -> [B.ByteString] -encode_public_key_material k | key_algorithm k `elem` [ECDSA,Ed25519] = do +encode_public_key_material k | key_algorithm k `elem` [ECDSA,Ed25519,ECC] = do -- http://tools.ietf.org/html/rfc6637 c <- maybeToList $ lookup 'c' (key k) MPI l <- maybeToList $ lookup 'l' (key k) - MPI x <- maybeToList $ lookup 'x' (key k) - MPI y <- maybeToList $ lookup 'y' (key k) MPI flag <- maybeToList $ lookup 'f' (key k) let (bitlen,oid) = B.splitAt 2 (encode c) len16 = decode bitlen :: Word16 (fullbytes,rembits) = len16 `quotRem` 8 len8 = fromIntegral (fullbytes + if rembits/=0 then 1 else 0) :: Word8 - xy = flag*(4^l) + x*(2^l) + y -- flag could be 0x04 or 0x40 - [ len8 `B.cons` oid, encode (MPI xy) ] + eccstuff = case lookup 'e' (key k) of + Just stuff -> encode stuff + Nothing -> B.empty + case flag of + 0x40 -> do + MPI n <- maybeToList $ lookup 'n' (key k) + let xy = flag*(4^l) + n + [ len8 `B.cons` oid, encode (MPI xy), eccstuff ] + _ -> do + MPI x <- maybeToList $ lookup 'x' (key k) + MPI y <- maybeToList $ lookup 'y' (key k) + let xy = flag*(4^l) + x*(2^l) + y + [ len8 `B.cons` oid, encode (MPI xy), eccstuff ] encode_public_key_material k = map (encode . (key k !)) (public_key_fields $ key_algorithm k) decode_public_key_material :: KeyAlgorithm -> Get [(Char,MPI)] @@ -442,30 +456,42 @@ decode_public_key_material algorithm | algorithm `elem` [ECDSA, Ed25519] = do oidbytes <- getSomeByteString (fromIntegral oidlen) let mpiFromBytes bytes = MPI (getBigNum $ B.toStrict bytes) oid = mpiFromBytes oidbytes - MPI xy <- get + MPI fxy <- get let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2 - width = ( integerBytesize xy - 1 ) `div` 2 - (fx,y) = xy `quotRem` (256^width) - (flag,x) = fx `quotRem` (256^width) + width = ( integerBytesize fxy - 1 ) `div` 2 l = width*8 - return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y), ('f',MPI flag)] + (flag,xy) = fxy `quotRem` (256^(2*width)) + return $ case flag of + 0x40 -> [('c',oid), ('l',MPI l), ('n',MPI xy), ('f',MPI flag)] + _ -> let (x,y) = xy `quotRem` (256^width) + -- (fx,y) = xy `quotRem` (256^width) + -- (flag,x) = fx `quotRem` (256^width) + in [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y), ('f',MPI flag)] decode_public_key_material ECC = do -- http://tools.ietf.org/html/rfc6637 (9) Algorithm-Specific Fields for ECDH keys: oidlen <- get :: Get Word8 oidbytes <- getSomeByteString (fromIntegral oidlen) let mpiFromBytes bytes = MPI (getBigNum $ B.toStrict bytes) oid = mpiFromBytes oidbytes - MPI xy <- get - flen <- get :: Get Word8 - one <- get :: Get Word8 - hashid <- get :: Get Word8 - algoid <- get :: Get Word8 + MPI fxy <- get + eccstuff <- get :: Get Word32 + {- eccstuff is 4 one-byte fields: + flen <- get :: Get Word8 + one <- get :: Get Word8 -- always 0x01 + hashid <- get :: Get Word8 + algoid <- get :: Get Word8 + -} let integerBytesize i = fromIntegral $ LZ.length (encode (MPI i)) - 2 - width = ( integerBytesize xy - 1 ) `div` 2 - (fx,y) = xy `quotRem` (256^width) - (flag,x) = fx `quotRem` (256^width) + width = ( integerBytesize fxy - 1 ) `div` 2 l = width*8 - return [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y), ('f',MPI flag)] + (flag,xy) = fxy `quotRem` (256^(2*width)) + result = case flag of + 0x40 -> [('c',oid), ('l',MPI l), ('n',MPI xy), ('f',MPI flag)] + _ -> let (x,y) = xy `quotRem` (256^width) + -- (fx,y) = xy `quotRem` (256^width) + -- (flag,x) = fx `quotRem` (256^width) + in [('c',oid), ('l',MPI l), ('x',MPI x), ('y',MPI y), ('f',MPI flag)] + return $ result ++ [('e',MPI (fromIntegral eccstuff))] decode_public_key_material algorithm = mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm) put_packet :: Packet -> (B.ByteString, Word8) @@ -1130,6 +1156,7 @@ data SignatureSubpacket = hash :: B.ByteString } | EmbeddedSignaturePacket Packet | + -- TODO: IssuerFingerprintPacket (tag=33) UnsupportedSignatureSubpacket Word8 B.ByteString deriving (Show, Read, Eq) diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs index 175a62e..f9a8803 100644 --- a/Data/OpenPGP/Internal.hs +++ b/Data/OpenPGP/Internal.hs @@ -16,20 +16,20 @@ import System.IO.Unsafe decode_s2k_count :: Word8 -> Word32 -decode_s2k_count c = (16 + (fromIntegral c .&. 15)) `shiftL` - ((fromIntegral c `shiftR` 4) + 6) +decode_s2k_count c = shiftL (16 + (fromIntegral c .&. 15)) + ((fromIntegral c `shiftR` 4) + 6) encode_s2k_count :: Word32 -> Word8 encode_s2k_count iterations - | iterations >= 65011712 = 255 - | decode_s2k_count result < iterations = result+1 - | otherwise = result - where - result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16) - (count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8) - encode_s2k_count' count c - | count < 32 = (count, c) - | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1) + | iterations >= 65011712 = 255 + | decode_s2k_count result < iterations = result+1 + | otherwise = result + where + result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16) + (count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8) + encode_s2k_count' count c + | count < 32 = (count, c) + | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1) {- getBigNum :: BS.ByteString -> Integer @@ -70,8 +70,26 @@ putBigNum i = ( (fromIntegral (BS.length bytes) - 1) * 8 + sigBit sigBit = fromIntegral $ 8 - countLeadingZeros (BS.index bytes 0) bytes = integerToBS i +-- big-endian integerToBS :: Integer -> BS.ByteString integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do let Ptr addr = ptr - cnt <- exportIntegerToAddr i addr 1# + cnt <- exportIntegerToAddr i addr 1# -- 1# for big-endian (use 0# for little-endian) return () + +{- +getBigNumLE :: BS.ByteString -> Integer +getBigNumLE bytes = unsafeDupablePerformIO $ + let (fptr,offset,len) = BS.toForeignPtr bytes + in withForeignPtr fptr $ \ptr -> do + let Ptr addr = ptr `plusPtr` offset :: Ptr Word64 + I# n = len + importIntegerFromAddr addr (int2Word# n) 0# + +-- little-endian +integerToLE :: Integer -> BS.ByteString +integerToLE i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do + let Ptr addr = ptr + cnt <- exportIntegerToAddr i addr 0# + return () +-} diff --git a/Data/OpenPGP/Util/Base.hs b/Data/OpenPGP/Util/Base.hs index 5b3e159..0c888ca 100644 --- a/Data/OpenPGP/Util/Base.hs +++ b/Data/OpenPGP/Util/Base.hs @@ -85,7 +85,6 @@ find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet find_key = OpenPGP.find_key (show . fingerprint) - keyParam :: Char -> OpenPGP.Packet -> Integer keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k) where diff --git a/Data/OpenPGP/Util/Ed25519.hs b/Data/OpenPGP/Util/Ed25519.hs new file mode 100644 index 0000000..ed277c8 --- /dev/null +++ b/Data/OpenPGP/Util/Ed25519.hs @@ -0,0 +1,51 @@ +module Data.OpenPGP.Util.Ed25519 where + +import Crypto.Error +import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Data.OpenPGP.Internal -- (integerToBS,integerToLE,getBigNumLE) +import qualified Data.OpenPGP as OpenPGP +import Crypto.ECC.Edwards25519 + +import qualified Data.ByteArray as BA +import Control.Monad +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Data.List +import Data.Int +import Data.Word +import Data.OpenPGP.Util.Base + +import Text.Printf +import Numeric +import Data.Char +import System.IO + +import Foreign.Ptr +import System.IO.Unsafe + +import Crypto.Cipher.SBox + +ed25519Key :: OpenPGP.Packet -> Maybe Ed25519.PublicKey +ed25519Key k = case Ed25519.publicKey $ integerToBS $ keyParam 'n' k of + CryptoPassed ed25519 -> Just ed25519 + CryptoFailed err -> Nothing + +ed25519sig sig = + let [OpenPGP.MPI r,OpenPGP.MPI s] = OpenPGP.signature sig + -- rbs = BS.pack $ take 32 $ rbytes r ++ repeat 0 + -- sbs = BS.pack $ take 32 $ rbytes s ++ repeat 0 + rbs = let r' = integerToBS r in BS.replicate (32 - BS.length r') 0 <> r' + sbs = let s' = integerToBS s in BS.replicate (32 - BS.length s') 0 <> s' + in case Ed25519.signature (rbs <> sbs) of + CryptoPassed sig -> Just sig + CryptoFailed err -> Nothing + +ed25519Verify :: OpenPGP.Packet -> BS.ByteString -> OpenPGP.Packet -> Maybe Bool +ed25519Verify sig over k = do + let hashbs = hashBySymbol (OpenPGP.hash_algorithm sig) $ BL.fromChunks [over] + guard $ 0x2B06010401DA470F01 == keyParam 'c' k -- Only Ed25519 curve. + k' <- ed25519Key k -- SecretKeyPacket ??? + sig' <- ed25519sig sig + let result = Ed25519.verify k' hashbs sig' + Just result + diff --git a/Data/OpenPGP/Util/Verify.hs b/Data/OpenPGP/Util/Verify.hs index fd83485..5eea260 100644 --- a/Data/OpenPGP/Util/Verify.hs +++ b/Data/OpenPGP/Util/Verify.hs @@ -19,6 +19,7 @@ import Crypto.PubKey.HashDescr #endif import Data.OpenPGP.Util.Base +import Data.OpenPGP.Util.Ed25519 dsaKey :: OpenPGP.Packet -> Vincent.DSA.PublicKey @@ -43,6 +44,7 @@ verify :: verify keys over = over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs} where + sigs :: [(OpenPGP.Packet,BS.ByteString)] sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s)) (OpenPGP.signatures_over over) @@ -52,6 +54,7 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard verification = case OpenPGP.key_algorithm sig of OpenPGP.DSA -> dsaVerify OpenPGP.ECDSA -> ecdsaVerify + OpenPGP.Ed25519 -> ed25519Verify sig over alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify | otherwise -> const Nothing @@ -97,4 +100,3 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard hash_algo = OpenPGP.hash_algorithm sig maybeKey = OpenPGP.signature_issuer sig >>= find_key keys -- in trace ("maybeKey="++show (fmap OpenPGP.key_algorithm r)) r - diff --git a/openpgp-util.cabal b/openpgp-util.cabal index 33b5ff6..b0d7f53 100644 --- a/openpgp-util.cabal +++ b/openpgp-util.cabal @@ -136,6 +136,7 @@ library Data.OpenPGP.Util.Sign Data.OpenPGP.Util.Gen Data.OpenPGP.Util.DecryptSecretKey + Data.OpenPGP.Util.Ed25519 build-depends: base == 4.*, transformers, -- cgit v1.2.3