diff options
Diffstat (limited to 'Data/OpenPGP/Util/Gen.hs')
-rw-r--r-- | Data/OpenPGP/Util/Gen.hs | 67 |
1 files changed, 33 insertions, 34 deletions
diff --git a/Data/OpenPGP/Util/Gen.hs b/Data/OpenPGP/Util/Gen.hs index b64517f..c5d0159 100644 --- a/Data/OpenPGP/Util/Gen.hs +++ b/Data/OpenPGP/Util/Gen.hs | |||
@@ -8,13 +8,17 @@ import Control.Applicative | |||
8 | import qualified Data.ByteString.Lazy as B | 8 | import qualified Data.ByteString.Lazy as B |
9 | import qualified Data.ByteString as S | 9 | import qualified Data.ByteString as S |
10 | 10 | ||
11 | import qualified Crypto.Random as Vincent | 11 | import Crypto.Random as Vincent |
12 | import qualified Crypto.PubKey.DSA as Vincent.DSA | 12 | import qualified Crypto.PubKey.DSA as Vincent.DSA |
13 | import qualified Crypto.PubKey.RSA as Vincent.RSA | 13 | import qualified Crypto.PubKey.RSA as Vincent.RSA |
14 | import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA | 14 | import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA |
15 | import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA | 15 | import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA |
16 | #if defined(VERSION_cryptonite) | ||
17 | import Control.Arrow (second) | ||
18 | import Data.Binary | ||
19 | #endif | ||
16 | 20 | ||
17 | import qualified Data.Time.Clock.POSIX | 21 | import Data.OpenPGP.Util.Base |
18 | 22 | ||
19 | data GenerateKeyParams = GenRSA Int -- keysize | 23 | data GenerateKeyParams = GenRSA Int -- keysize |
20 | | GenDSA (Maybe DSAParams) | 24 | | GenDSA (Maybe DSAParams) |
@@ -34,20 +38,10 @@ genKeyAlg (GenDSA _) = DSA | |||
34 | -- | Generate a secret key pgp packet from system entropy. | 38 | -- | Generate a secret key pgp packet from system entropy. |
35 | generateKey :: GenerateKeyParams -> IO Packet | 39 | generateKey :: GenerateKeyParams -> IO Packet |
36 | generateKey params = do | 40 | generateKey params = do |
37 | now <- currentTimeWord32 | 41 | now <- currentTime |
38 | g <- makeGen Nothing | 42 | g <- makeGen Nothing |
39 | let (fields,g') = generateKey' params g | 43 | let (fields,g') = generateKey' params g |
40 | return $ buildPacket (genKeyAlg params) now fields | 44 | return $ buildPacket (genKeyAlg params) now fields |
41 | |||
42 | #if defined(VERSION_crypto_random) | ||
43 | type RNG = Vincent.SystemRNG | ||
44 | |||
45 | makeGen :: Maybe FilePath -> IO RNG | ||
46 | makeGen noisefile = do | ||
47 | pool <- fromMaybe Vincent.createEntropyPool $ do | ||
48 | path <- noisefile | ||
49 | Just $ Vincent.createTestEntropyPool `fmap` S.readFile path | ||
50 | return (Vincent.cprgCreate pool :: Vincent.SystemRNG) | ||
51 | 45 | ||
52 | rsaFields priv = [ ('n', MPI $ Vincent.RSA.public_n (Vincent.RSA.private_pub priv)) | 46 | rsaFields priv = [ ('n', MPI $ Vincent.RSA.public_n (Vincent.RSA.private_pub priv)) |
53 | , ('e', MPI $ Vincent.RSA.public_e (Vincent.RSA.private_pub priv)) | 47 | , ('e', MPI $ Vincent.RSA.public_e (Vincent.RSA.private_pub priv)) |
@@ -66,6 +60,17 @@ dsaFields priv = [ ('p', MPI p) | |||
66 | g = Vincent.DSA.params_g $ Vincent.DSA.private_params priv | 60 | g = Vincent.DSA.params_g $ Vincent.DSA.private_params priv |
67 | p = Vincent.DSA.params_p $ Vincent.DSA.private_params priv | 61 | p = Vincent.DSA.params_p $ Vincent.DSA.private_params priv |
68 | 62 | ||
63 | |||
64 | #if defined(VERSION_crypto_random) | ||
65 | type RNG = Vincent.SystemRNG | ||
66 | |||
67 | makeGen :: Maybe FilePath -> IO RNG | ||
68 | makeGen noisefile = do | ||
69 | pool <- fromMaybe Vincent.createEntropyPool $ do | ||
70 | path <- noisefile | ||
71 | Just $ Vincent.createTestEntropyPool `fmap` S.readFile path | ||
72 | return (Vincent.cprgCreate pool :: Vincent.SystemRNG) | ||
73 | |||
69 | generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG) | 74 | generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG) |
70 | generateKey' (GenRSA keysize) g = | 75 | generateKey' (GenRSA keysize) g = |
71 | let -- http://crypto.stackexchange.com/questions/3110/impacts-of-not-using-rsa-exponent-of-65537 | 76 | let -- http://crypto.stackexchange.com/questions/3110/impacts-of-not-using-rsa-exponent-of-65537 |
@@ -93,33 +98,27 @@ makeGen :: Maybe FilePath -> IO RNG | |||
93 | makeGen noisefile = do | 98 | makeGen noisefile = do |
94 | drg <- fromMaybe (Left <$> getSystemDRG) $ do | 99 | drg <- fromMaybe (Left <$> getSystemDRG) $ do |
95 | path <- noisefile | 100 | path <- noisefile |
96 | Just $ Right . drgNewTest . decodeSeed <$> L.readFile path | 101 | Just $ Right . drgNewTest . decodeSeed <$> B.readFile path |
97 | return $ RNG drg | 102 | return $ RNG drg |
98 | where | 103 | where |
99 | decodeSeed :: L.ByteString -> (Word64, Word64, Word64, Word64, Word64) | 104 | decodeSeed :: B.ByteString -> (Word64, Word64, Word64, Word64, Word64) |
100 | decodeSeed bs | L.null bs = (0,0,0,0,0) | 105 | decodeSeed bs | B.null bs = (0,0,0,0,0) |
101 | | otherwise = decode $ L.cycle bs | 106 | | otherwise = decode $ B.cycle bs |
102 | |||
103 | instance MonadRandom DB where | ||
104 | getRandomBytes n = DB 4 $ \DBParams { dbRNG=rngv } _ -> do | ||
105 | bs <- modifyMVar rngv (return . swap . randomBytesGenerate n) | ||
106 | return $ Right bs | ||
107 | 107 | ||
108 | generateKey' :: GenerateKeyParams -> RNG -> (PrivateKey,RNG) | 108 | generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG) |
109 | generateKey' (GenRSA keysize) g = | 109 | generateKey' (GenRSA keysize) g = |
110 | let rsa_exponent = 65537 | 110 | let rsa_exponent = 65537 |
111 | ((_,priv),g') = withDRG g $ RSA.generate keysize rsa_exponent | 111 | ((_,priv),g') = withDRG g $ Vincent.RSA.generate keysize rsa_exponent |
112 | in ( PrivateRSA priv, g' ) | 112 | in ( rsaFields priv, g' ) |
113 | generateKey' (GenDSA mbparams) g = | 113 | generateKey' (GenDSA mbparams) g = |
114 | let dsa_params = fromMaybe defaultDSAParams mbparams | 114 | let dsa_params = maybe defaultDSAParams vincent mbparams |
115 | (priv,g') = withDRG g $ DSA.generatePrivate dsa_params | 115 | vincent (DSAParams p g q) = Vincent.DSA.Params p g q |
116 | in ( PrivateDSA (DSA.PrivateKey dsa_params priv), g' ) | 116 | (priv,g') = withDRG g $ Vincent.DSA.generatePrivate dsa_params |
117 | in ( dsaFields (Vincent.DSA.PrivateKey dsa_params priv), g' ) | ||
117 | 118 | ||
118 | #endif | 119 | #endif |
119 | 120 | ||
120 | 121 | ||
121 | currentTimeWord32 :: IO Word32 | ||
122 | currentTimeWord32 = floor <$> Data.Time.Clock.POSIX.getPOSIXTime | ||
123 | 122 | ||
124 | buildPacket :: KeyAlgorithm -> Word32 -> [(Char,MPI)] -> Packet | 123 | buildPacket :: KeyAlgorithm -> Word32 -> [(Char,MPI)] -> Packet |
125 | buildPacket alg stamp fields = | 124 | buildPacket alg stamp fields = |
@@ -133,7 +132,7 @@ buildPacket alg stamp fields = | |||
133 | symmetric_algorithm = Unencrypted :: SymmetricAlgorithm, | 132 | symmetric_algorithm = Unencrypted :: SymmetricAlgorithm, |
134 | encrypted_data = B.empty :: B.ByteString, | 133 | encrypted_data = B.empty :: B.ByteString, |
135 | is_subkey = True :: Bool | 134 | is_subkey = True :: Bool |
136 | } | 135 | } |
137 | 136 | ||
138 | defaultDSAParams :: Vincent.DSA.Params | 137 | defaultDSAParams :: Vincent.DSA.Params |
139 | defaultDSAParams = Vincent.DSA.Params | 138 | defaultDSAParams = Vincent.DSA.Params |