diff options
Diffstat (limited to 'Data/OpenPGP')
-rw-r--r-- | Data/OpenPGP/Internal.hs | 42 | ||||
-rw-r--r-- | Data/OpenPGP/Util/Base.hs | 1 | ||||
-rw-r--r-- | Data/OpenPGP/Util/Ed25519.hs | 51 | ||||
-rw-r--r-- | Data/OpenPGP/Util/Verify.hs | 4 |
4 files changed, 84 insertions, 14 deletions
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 | |||
16 | 16 | ||
17 | 17 | ||
18 | decode_s2k_count :: Word8 -> Word32 | 18 | decode_s2k_count :: Word8 -> Word32 |
19 | decode_s2k_count c = (16 + (fromIntegral c .&. 15)) `shiftL` | 19 | decode_s2k_count c = shiftL (16 + (fromIntegral c .&. 15)) |
20 | ((fromIntegral c `shiftR` 4) + 6) | 20 | ((fromIntegral c `shiftR` 4) + 6) |
21 | 21 | ||
22 | encode_s2k_count :: Word32 -> Word8 | 22 | encode_s2k_count :: Word32 -> Word8 |
23 | encode_s2k_count iterations | 23 | encode_s2k_count iterations |
24 | | iterations >= 65011712 = 255 | 24 | | iterations >= 65011712 = 255 |
25 | | decode_s2k_count result < iterations = result+1 | 25 | | decode_s2k_count result < iterations = result+1 |
26 | | otherwise = result | 26 | | otherwise = result |
27 | where | 27 | where |
28 | result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16) | 28 | result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16) |
29 | (count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8) | 29 | (count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8) |
30 | encode_s2k_count' count c | 30 | encode_s2k_count' count c |
31 | | count < 32 = (count, c) | 31 | | count < 32 = (count, c) |
32 | | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1) | 32 | | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1) |
33 | 33 | ||
34 | {- | 34 | {- |
35 | getBigNum :: BS.ByteString -> Integer | 35 | getBigNum :: BS.ByteString -> Integer |
@@ -70,8 +70,26 @@ putBigNum i = ( (fromIntegral (BS.length bytes) - 1) * 8 + sigBit | |||
70 | sigBit = fromIntegral $ 8 - countLeadingZeros (BS.index bytes 0) | 70 | sigBit = fromIntegral $ 8 - countLeadingZeros (BS.index bytes 0) |
71 | bytes = integerToBS i | 71 | bytes = integerToBS i |
72 | 72 | ||
73 | -- big-endian | ||
73 | integerToBS :: Integer -> BS.ByteString | 74 | integerToBS :: Integer -> BS.ByteString |
74 | integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do | 75 | integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do |
75 | let Ptr addr = ptr | 76 | let Ptr addr = ptr |
76 | cnt <- exportIntegerToAddr i addr 1# | 77 | cnt <- exportIntegerToAddr i addr 1# -- 1# for big-endian (use 0# for little-endian) |
77 | return () | 78 | return () |
79 | |||
80 | {- | ||
81 | getBigNumLE :: BS.ByteString -> Integer | ||
82 | getBigNumLE bytes = unsafeDupablePerformIO $ | ||
83 | let (fptr,offset,len) = BS.toForeignPtr bytes | ||
84 | in withForeignPtr fptr $ \ptr -> do | ||
85 | let Ptr addr = ptr `plusPtr` offset :: Ptr Word64 | ||
86 | I# n = len | ||
87 | importIntegerFromAddr addr (int2Word# n) 0# | ||
88 | |||
89 | -- little-endian | ||
90 | integerToLE :: Integer -> BS.ByteString | ||
91 | integerToLE i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do | ||
92 | let Ptr addr = ptr | ||
93 | cnt <- exportIntegerToAddr i addr 0# | ||
94 | return () | ||
95 | -} | ||
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 | |||
85 | find_key = OpenPGP.find_key (show . fingerprint) | 85 | find_key = OpenPGP.find_key (show . fingerprint) |
86 | 86 | ||
87 | 87 | ||
88 | |||
89 | keyParam :: Char -> OpenPGP.Packet -> Integer | 88 | keyParam :: Char -> OpenPGP.Packet -> Integer |
90 | keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k) | 89 | keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k) |
91 | where | 90 | 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 @@ | |||
1 | module Data.OpenPGP.Util.Ed25519 where | ||
2 | |||
3 | import Crypto.Error | ||
4 | import qualified Crypto.PubKey.Ed25519 as Ed25519 | ||
5 | import Data.OpenPGP.Internal -- (integerToBS,integerToLE,getBigNumLE) | ||
6 | import qualified Data.OpenPGP as OpenPGP | ||
7 | import Crypto.ECC.Edwards25519 | ||
8 | |||
9 | import qualified Data.ByteArray as BA | ||
10 | import Control.Monad | ||
11 | import qualified Data.ByteString as BS | ||
12 | import qualified Data.ByteString.Lazy as BL | ||
13 | import Data.List | ||
14 | import Data.Int | ||
15 | import Data.Word | ||
16 | import Data.OpenPGP.Util.Base | ||
17 | |||
18 | import Text.Printf | ||
19 | import Numeric | ||
20 | import Data.Char | ||
21 | import System.IO | ||
22 | |||
23 | import Foreign.Ptr | ||
24 | import System.IO.Unsafe | ||
25 | |||
26 | import Crypto.Cipher.SBox | ||
27 | |||
28 | ed25519Key :: OpenPGP.Packet -> Maybe Ed25519.PublicKey | ||
29 | ed25519Key k = case Ed25519.publicKey $ integerToBS $ keyParam 'n' k of | ||
30 | CryptoPassed ed25519 -> Just ed25519 | ||
31 | CryptoFailed err -> Nothing | ||
32 | |||
33 | ed25519sig sig = | ||
34 | let [OpenPGP.MPI r,OpenPGP.MPI s] = OpenPGP.signature sig | ||
35 | -- rbs = BS.pack $ take 32 $ rbytes r ++ repeat 0 | ||
36 | -- sbs = BS.pack $ take 32 $ rbytes s ++ repeat 0 | ||
37 | rbs = let r' = integerToBS r in BS.replicate (32 - BS.length r') 0 <> r' | ||
38 | sbs = let s' = integerToBS s in BS.replicate (32 - BS.length s') 0 <> s' | ||
39 | in case Ed25519.signature (rbs <> sbs) of | ||
40 | CryptoPassed sig -> Just sig | ||
41 | CryptoFailed err -> Nothing | ||
42 | |||
43 | ed25519Verify :: OpenPGP.Packet -> BS.ByteString -> OpenPGP.Packet -> Maybe Bool | ||
44 | ed25519Verify sig over k = do | ||
45 | let hashbs = hashBySymbol (OpenPGP.hash_algorithm sig) $ BL.fromChunks [over] | ||
46 | guard $ 0x2B06010401DA470F01 == keyParam 'c' k -- Only Ed25519 curve. | ||
47 | k' <- ed25519Key k -- SecretKeyPacket ??? | ||
48 | sig' <- ed25519sig sig | ||
49 | let result = Ed25519.verify k' hashbs sig' | ||
50 | Just result | ||
51 | |||
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 | |||
19 | #endif | 19 | #endif |
20 | 20 | ||
21 | import Data.OpenPGP.Util.Base | 21 | import Data.OpenPGP.Util.Base |
22 | import Data.OpenPGP.Util.Ed25519 | ||
22 | 23 | ||
23 | 24 | ||
24 | dsaKey :: OpenPGP.Packet -> Vincent.DSA.PublicKey | 25 | dsaKey :: OpenPGP.Packet -> Vincent.DSA.PublicKey |
@@ -43,6 +44,7 @@ verify :: | |||
43 | verify keys over = | 44 | verify keys over = |
44 | over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs} | 45 | over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs} |
45 | where | 46 | where |
47 | sigs :: [(OpenPGP.Packet,BS.ByteString)] | ||
46 | sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s)) | 48 | sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s)) |
47 | (OpenPGP.signatures_over over) | 49 | (OpenPGP.signatures_over over) |
48 | 50 | ||
@@ -52,6 +54,7 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard | |||
52 | verification = case OpenPGP.key_algorithm sig of | 54 | verification = case OpenPGP.key_algorithm sig of |
53 | OpenPGP.DSA -> dsaVerify | 55 | OpenPGP.DSA -> dsaVerify |
54 | OpenPGP.ECDSA -> ecdsaVerify | 56 | OpenPGP.ECDSA -> ecdsaVerify |
57 | OpenPGP.Ed25519 -> ed25519Verify sig over | ||
55 | alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify | 58 | alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify |
56 | | otherwise -> const Nothing | 59 | | otherwise -> const Nothing |
57 | 60 | ||
@@ -97,4 +100,3 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard | |||
97 | hash_algo = OpenPGP.hash_algorithm sig | 100 | hash_algo = OpenPGP.hash_algorithm sig |
98 | maybeKey = OpenPGP.signature_issuer sig >>= find_key keys | 101 | maybeKey = OpenPGP.signature_issuer sig >>= find_key keys |
99 | -- in trace ("maybeKey="++show (fmap OpenPGP.key_algorithm r)) r | 102 | -- in trace ("maybeKey="++show (fmap OpenPGP.key_algorithm r)) r |
100 | |||