summaryrefslogtreecommitdiff
path: root/Data/OpenPGP/Util/Gen.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Data/OpenPGP/Util/Gen.hs')
-rw-r--r--Data/OpenPGP/Util/Gen.hs67
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
8import qualified Data.ByteString.Lazy as B 8import qualified Data.ByteString.Lazy as B
9import qualified Data.ByteString as S 9import qualified Data.ByteString as S
10 10
11import qualified Crypto.Random as Vincent 11import Crypto.Random as Vincent
12import qualified Crypto.PubKey.DSA as Vincent.DSA 12import qualified Crypto.PubKey.DSA as Vincent.DSA
13import qualified Crypto.PubKey.RSA as Vincent.RSA 13import qualified Crypto.PubKey.RSA as Vincent.RSA
14import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA 14import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA
15import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA 15import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA
16#if defined(VERSION_cryptonite)
17import Control.Arrow (second)
18import Data.Binary
19#endif
16 20
17import qualified Data.Time.Clock.POSIX 21import Data.OpenPGP.Util.Base
18 22
19data GenerateKeyParams = GenRSA Int -- keysize 23data 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.
35generateKey :: GenerateKeyParams -> IO Packet 39generateKey :: GenerateKeyParams -> IO Packet
36generateKey params = do 40generateKey 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)
43type RNG = Vincent.SystemRNG
44
45makeGen :: Maybe FilePath -> IO RNG
46makeGen 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
52rsaFields priv = [ ('n', MPI $ Vincent.RSA.public_n (Vincent.RSA.private_pub priv)) 46rsaFields 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)
65type RNG = Vincent.SystemRNG
66
67makeGen :: Maybe FilePath -> IO RNG
68makeGen 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
69generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG) 74generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG)
70generateKey' (GenRSA keysize) g = 75generateKey' (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
93makeGen noisefile = do 98makeGen 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
103instance 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
108generateKey' :: GenerateKeyParams -> RNG -> (PrivateKey,RNG) 108generateKey' :: GenerateKeyParams -> RNG -> ([(Char,MPI)],RNG)
109generateKey' (GenRSA keysize) g = 109generateKey' (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' )
113generateKey' (GenDSA mbparams) g = 113generateKey' (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
121currentTimeWord32 :: IO Word32
122currentTimeWord32 = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
123 122
124buildPacket :: KeyAlgorithm -> Word32 -> [(Char,MPI)] -> Packet 123buildPacket :: KeyAlgorithm -> Word32 -> [(Char,MPI)] -> Packet
125buildPacket alg stamp fields = 124buildPacket 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
138defaultDSAParams :: Vincent.DSA.Params 137defaultDSAParams :: Vincent.DSA.Params
139defaultDSAParams = Vincent.DSA.Params 138defaultDSAParams = Vincent.DSA.Params