make the entropy gathering simpler for certain setup, and cleanup a bit

This commit is contained in:
Vincent Hanquez 2014-07-19 15:06:39 +01:00
parent 4e955ad505
commit 6005eca7bd
4 changed files with 50 additions and 20 deletions

View File

@ -10,11 +10,11 @@
module Crypto.Random.Entropy
( EntropyPool
, createEntropyPool
, grabEntropyPtr
, grabEntropy
, getEntropyPtr
, getEntropyFrom
, getEntropy
) where
import Control.Monad (when)
import Control.Concurrent.MVar
import Data.Maybe (catMaybes)
import Data.SecureMem
@ -22,6 +22,8 @@ import Data.Word (Word8)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (plusPtr, Ptr)
import Crypto.Random.Types
import Crypto.Random.Entropy.Source
#ifdef SUPPORT_RDRAND
import Crypto.Random.Entropy.RDRand
@ -68,7 +70,6 @@ defaultPoolSize = 4096
-- While you can create as many entropy pool as you want, the pool can be shared between multiples RNGs.
createEntropyPoolWith :: Int -> [EntropyBackend] -> IO EntropyPool
createEntropyPoolWith poolSize backends = do
when (null backends) $ fail "cannot get any source of entropy on this system"
sm <- allocateSecureMem poolSize
m <- newMVar 0
withSecureMemPtr sm $ replenish poolSize backends
@ -83,8 +84,8 @@ createEntropyPool = do
createEntropyPoolWith defaultPoolSize backends
-- | Put a chunk of the entropy pool into a buffer
grabEntropyPtr :: Int -> EntropyPool -> Ptr Word8 -> IO ()
grabEntropyPtr n (EntropyPool backends posM sm) outPtr =
getEntropyPtr :: EntropyPool -> Int -> Ptr Word8 -> IO ()
getEntropyPtr (EntropyPool backends posM sm) n outPtr =
withSecureMemPtr sm $ \entropyPoolPtr ->
modifyMVar_ posM $ \pos ->
copyLoop outPtr entropyPoolPtr pos n
@ -101,17 +102,27 @@ grabEntropyPtr n (EntropyPool backends posM sm) outPtr =
copyLoop (d `plusPtr` m) s (wrappedPos + m) (left - m)
-- | Grab a chunk of entropy from the entropy pool.
grabEntropy :: Int -> EntropyPool -> IO SecureMem
grabEntropy n pool = do
getEntropyFrom :: EntropyPool -> Int -> IO Random
getEntropyFrom pool n = do
out <- allocateSecureMem n
withSecureMemPtr out $ grabEntropyPtr n pool
return $ out
withSecureMemPtr out $ getEntropyPtr pool n
return $ Random out
-- | Get some entropy from the system source of entropy
getEntropy :: Int -> IO Random
getEntropy n = do
backends <- catMaybes `fmap` sequence supportedBackends
out <- allocateSecureMem n
withSecureMemPtr out $ replenish n backends
return $ Random out
-- Refill the entropy in a buffer
replenish :: Int -> [EntropyBackend] -> Ptr Word8 -> IO ()
replenish _ [] _ = fail "cryptonite: random: cannot get any source of entropy on this system"
replenish poolSize backends ptr = loop 0 backends ptr poolSize
where loop :: Int -> [EntropyBackend] -> Ptr Word8 -> Int -> IO ()
loop retry [] p n | n == 0 = return ()
| retry == 3 = error "cannot fully replenish"
| retry == 3 = error "cryptonite: random: cannot fully replenish"
| otherwise = loop (retry+1) backends p n
loop _ (_:_) _ 0 = return ()
loop retry (b:bs) p n = do

View File

@ -16,10 +16,10 @@ import Data.Word (Word8)
import Crypto.Random.Entropy.Source
import Control.Exception as E
import System.Posix.Types (Fd)
import System.Posix.IO
--import System.Posix.Types (Fd)
import System.IO
type H = Fd
type H = Handle
type DeviceName = String
-- | Entropy device /dev/random on unix system
@ -48,9 +48,11 @@ testOpen filepath = do
Just h -> closeDev h >> return (Just filepath)
openDev :: String -> IO (Maybe H)
openDev filepath = (Just `fmap` openFd filepath ReadOnly Nothing fileFlags)
`E.catch` \(_ :: IOException) -> return Nothing
where fileFlags = defaultFileFlags { nonBlock = True }
openDev filepath = (Just `fmap` openAndNoBuffering) `E.catch` \(_ :: IOException) -> return Nothing
where openAndNoBuffering = do
h <- openBinaryFile filepath ReadMode
hSetBuffering h NoBuffering
return h
withDev :: String -> (H -> IO a) -> IO a
withDev filepath f = openDev filepath >>= \h ->
@ -59,9 +61,9 @@ withDev filepath f = openDev filepath >>= \h ->
Just fd -> f fd >>= \r -> (closeDev fd >> return r)
closeDev :: H -> IO ()
closeDev h = closeFd h
closeDev h = hClose h
gatherDevEntropy :: H -> Ptr Word8 -> Int -> IO Int
gatherDevEntropy h ptr sz =
(fromIntegral `fmap` fdReadBuf h ptr (fromIntegral sz))
(fromIntegral `fmap` hGetBufSome h ptr (fromIntegral sz))
`E.catch` \(_ :: IOException) -> return 0

17
Crypto/Random/Types.hs Normal file
View File

@ -0,0 +1,17 @@
-- |
-- Module : Crypto.Random.Types
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : Good
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.Random.Types
( Random(..)
) where
import Data.Byteable
import Data.SecureMem
newtype Random = Random SecureMem
deriving (Eq, Byteable)

View File

@ -23,6 +23,7 @@ Library
Exposed-modules: Crypto.Cipher.ChaCha
Crypto.Cipher.Salsa
Crypto.MAC.Poly1305
Crypto.Random.Types
Crypto.Random.Entropy
Other-modules: Crypto.Random.Entropy.Source
Build-depends: base >= 4 && < 5
@ -48,7 +49,6 @@ Library
Other-modules: Crypto.Random.Entropy.Windows
extra-libraries: advapi32
else
Build-Depends: unix
Other-modules: Crypto.Random.Entropy.Unix
Test-Suite test-cryptonite