diff --git a/Crypto/Random/Entropy.hs b/Crypto/Random/Entropy.hs index f6864e6..a3c314a 100644 --- a/Crypto/Random/Entropy.hs +++ b/Crypto/Random/Entropy.hs @@ -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 diff --git a/Crypto/Random/Entropy/Unix.hs b/Crypto/Random/Entropy/Unix.hs index 42e7d8c..b480d7d 100644 --- a/Crypto/Random/Entropy/Unix.hs +++ b/Crypto/Random/Entropy/Unix.hs @@ -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 diff --git a/Crypto/Random/Types.hs b/Crypto/Random/Types.hs new file mode 100644 index 0000000..3ad0c43 --- /dev/null +++ b/Crypto/Random/Types.hs @@ -0,0 +1,17 @@ +-- | +-- Module : Crypto.Random.Types +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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) diff --git a/cryptonite.cabal b/cryptonite.cabal index 460d0c7..d564584 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -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