entropy 0.2.2.4 → 0.4.1.11
raw patch · 11 files changed
Files
- README.md +43/−3
- Setup.hs +101/−17
- System/Entropy.hs +59/−208
- System/EntropyGhcjs.hs +51/−0
- System/EntropyNix.hs +147/−0
- System/EntropyWindows.hs +140/−0
- cbits/getrandom.c +52/−0
- cbits/random_initialized.c +58/−0
- cbits/rdrand.c +45/−1
- cbits/rdrand.h +0/−2
- entropy.cabal +83/−23
README.md view
@@ -1,5 +1,45 @@ # Introduction -This package allows Haskell users to easily acquire entropy for use in-critical security applications by calling out to either windows crypto api,-unix/linux's `/dev/urandom`, or the RDRAND instruction.+This package allows Haskell users to easily acquire entropy for use in critical+security applications by calling out to either windows crypto api, unix/linux's+`getrandom` and `/dev/urandom`. Hardware RNGs (currently RDRAND, patches+welcome) are supported via the `hardwareRNG` function.++## Quick Start++To simply get random bytes use `getEntropy`:++```+#!/usr/bin/env cabal+{- cabal:+ build-depends: base, entropy, bytestring+-}+import qualified Data.ByteString as BS+import System.Entropy++main :: IO ()+main = print . BS.unpack =<< getEntropy 16+-- Example output: [241,191,215,193,225,27,121,244,16,155,252,41,131,38,6,100]+```++## Faster Randoms from Hardware++Most x86 systems include a hardware random number generator. These can be+faster but require more trust in the platform:++```+import qualified Data.ByteString as B+import System.Entropy++eitherRNG :: Int -> IO B.ByteString+eitherRNG sz = maybe (getEntropy sz) pure =<< getHardwareEntropy sz++main :: IO ()+main = print . B.unpack =<< eitherRNG 32+```++This package supports Windows, {li,u}nix, QNX, and has preliminary support for HaLVM.++Typically tested on Linux and OSX - testers are as welcome as patches.++[](https://travis-ci.org/TomMD/entropy)
Setup.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+import Control.Monad import Distribution.Simple import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Setup@@ -9,32 +11,35 @@ import System.Directory import System.FilePath import System.Exit+import System.IO main = defaultMainWithHooks hk where hk = simpleUserHooks { buildHook = \pd lbi uh bf -> do -- let ccProg = Program "gcc" undefined undefined undefined- let hcProg = Program "ghc" undefined undefined undefined- mConf = lookupProgram hcProg (withPrograms lbi)+ let mConf = lookupProgram ghcProgram (withPrograms lbi) err = error "Could not determine C compiler" cc = locationPath . programLocation . maybe err id $ mConf- b <- canUseRDRAND cc- let newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)- newWithPrograms = userSpecifyArgs "ghc" cArgsHC newWithPrograms1- lbiNew = if b then (lbi {withPrograms = newWithPrograms }) else lbi+ lbiNew <- checkRDRAND cc lbi >>= checkGetrandom cc >>= checkGetentropy cc buildHook simpleUserHooks pd lbiNew uh bf } -cArgs :: [String]-cArgs = ["-DHAVE_RDRAND"]+compileCheck :: FilePath -> String -> String -> String -> IO Bool+compileCheck cc testName message sourceCode = do+ withTempDirectory normal "" testName $ \tmpDir -> do+ writeFile (tmpDir ++ "/" ++ testName ++ ".c") sourceCode+ ec <- myRawSystemExitCode normal cc [tmpDir </> testName ++ ".c", "-o", tmpDir ++ "/a","-no-hs-main"]+ notice normal $ message ++ show (ec == ExitSuccess)+ return (ec == ExitSuccess) -cArgsHC :: [String]-cArgsHC = map ("-optc" ++) cArgs+addOptions :: [String] -> [String] -> LocalBuildInfo -> LocalBuildInfo+addOptions cArgs hsArgs lbi = lbi {withPrograms = newWithPrograms }+ where newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)+ newWithPrograms = userSpecifyArgs "ghc" (hsArgs ++ map ("-optc" ++) cArgs) newWithPrograms1 -canUseRDRAND :: FilePath -> IO Bool-canUseRDRAND cc = do- withTempDirectory normal "" "testRDRAND" $ \tmpDir -> do- writeFile (tmpDir ++ "/testRDRAND.c")+checkRDRAND :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo+checkRDRAND cc lbi = do+ b <- compileCheck cc "testRDRAND" "Result of RDRAND Test: " (unlines [ "#include <stdint.h>" , "int main() {" , " uint64_t therand;"@@ -44,6 +49,85 @@ , " return (!err);" , "}" ])- ec <- rawSystemExitCode normal cc [tmpDir </> "testRDRAND.c", "-o", tmpDir ++ "/a.o","-c"]- notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess)- return (ec == ExitSuccess)+ return $ if b then addOptions cArgs cArgs lbi else lbi+ where cArgs = ["-DHAVE_RDRAND"]++checkGetrandom :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo+checkGetrandom cc lbi = do+ libcGetrandom <- compileCheck cc "testLibcGetrandom" "Result of libc getrandom() Test: "+ (unlines [ "#define _GNU_SOURCE"+ , "#include <errno.h>"+ , "#include <sys/random.h>"++ , "int main()"+ , "{"+ , " char tmp;"+ , " return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1;"+ , "}"+ ])+ if libcGetrandom then return $ addOptions cArgsLibc cArgsLibc lbi+ else do+ syscallGetrandom <- compileCheck cc "testSyscallGetrandom" "Result of syscall getrandom() Test: "+ (unlines [ "#define _GNU_SOURCE"+ , "#include <errno.h>"+ , "#include <unistd.h>"+ , "#include <sys/syscall.h>"+ , "#include <sys/types.h>"+ , "#include <linux/random.h>"++ , "static ssize_t getrandom(void* buf, size_t buflen, unsigned int flags)"+ , "{"+ , " return syscall(SYS_getrandom, buf, buflen, flags);"+ , "}"++ , "int main()"+ , "{"+ , " char tmp;"+ , " return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1;"+ , "}"+ ])+ return $ if syscallGetrandom then addOptions cArgs cArgs lbi else lbi+ where cArgs = ["-DHAVE_GETRANDOM"]+ cArgsLibc = cArgs ++ ["-DHAVE_LIBC_GETRANDOM"]++checkGetentropy :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo+checkGetentropy cc lbi = do+ b <- compileCheck cc "testGetentropy" "Result of getentropy() Test: "+ (unlines [ "#define _GNU_SOURCE"+ , "#include <unistd.h>"++ , "int main()"+ , "{"+ , " char tmp;"+ , " return getentropy(&tmp, sizeof(tmp));"+ , "}"+ ])+ return $ if b then addOptions cArgs cArgs lbi else lbi+ where cArgs = ["-DHAVE_GETENTROPY"]++myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode+#if MIN_VERSION_Cabal(3,14,0)+myRawSystemExitCode verbosity program arguments =+ rawSystemExitCode verbosity Nothing program arguments Nothing+#elif __GLASGOW_HASKELL__ >= 704+-- We know for sure, that if GHC >= 7.4 implies Cabal >= 1.14+myRawSystemExitCode = rawSystemExitCode+#else+-- Legacy branch:+-- We implement our own 'rawSystemExitCode', this will even work if+-- the user happens to have Cabal >= 1.14 installed with GHC 7.0 or+-- 7.2+myRawSystemExitCode verbosity path args = do+ printRawCommandAndArgs verbosity path args+ hFlush stdout+ exitcode <- rawSystem path args+ unless (exitcode == ExitSuccess) $ do+ debug verbosity $ path ++ " returned " ++ show exitcode+ return exitcode+ where+ printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO ()+ printRawCommandAndArgs verbosity path args+ | verbosity >= deafening = print (path, args)+ | verbosity >= verbose = putStrLn $ unwords (path : args)+ | otherwise = return ()+#endif
System/Entropy.hs view
@@ -4,222 +4,73 @@ Stability: beta Portability: portable - Obtain entropy from system sources.- Currently, windows and *nix systems with a @/dev/urandom@ are supported.--}--module System.Entropy- ( getEntropy- , CryptHandle- , openHandle- , hGetEntropy- , closeHandle- ) where--import Control.Monad (liftM)-import Data.ByteString as B-import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)-import Foreign (allocaBytes)+ Obtain entropy from system sources or x86 RDRAND when available. -#if defined(isWindows)-{- C example for windows rng - taken from a blog, can't recall which one but thank you!- #include <Windows.h>- #include <Wincrypt.h>- ...- //- // DISCLAIMER: Don't forget to check your error codes!!- // I am not checking as to make the example simple...- //- HCRYPTPROV hCryptCtx = NULL;- BYTE randomArray[128];+ Currently supporting: - CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);- CryptGenRandom(hCryptCtx, 128, randomArray);- CryptReleaseContext(hCryptCtx, 0);+ - Windows via CryptoAPI+ - *nix systems via @\/dev\/urandom@+ - Includes QNX+ - ghcjs/browser via JavaScript crypto API. -} -import Data.ByteString.Internal as BI-import Data.Int (Int32)-import Data.Word (Word32, Word8)-import Foreign.C.String (CString, withCString)-import Foreign.C.Types-import Foreign.Ptr (Ptr, nullPtr, castPtr)-import Foreign.Marshal.Alloc (alloca)-import Foreign.Marshal.Utils (toBool)-import Foreign.Storable (peek)--#ifdef HAVE_RDRAND-foreign import ccall unsafe "cpu_has_rdrand"- c_cpu_has_rdrand :: IO CInt--foreign import ccall unsafe "get_rand_bytes"- c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt--cpuHasRdRand :: IO Bool-cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand-#endif--data CryptHandle- = CH Word32-#ifdef HAVE_RDRAND- | UseRdRand-#endif---- Define the constants we need from WinCrypt.h -msDefProv :: String-msDefProv = "Microsoft Base Cryptographic Provider v1.0"-provRSAFull :: Word32-provRSAFull = fromIntegral 1-cryptVerifyContext :: Word32-cryptVerifyContext = fromIntegral 0xF0000000---- Declare the required CryptoAPI imports -foreign import stdcall unsafe "CryptAcquireContextA"- c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32-foreign import stdcall unsafe "CryptGenRandom"- c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32-foreign import stdcall unsafe "CryptReleaseContext"- c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32--cryptAcquireCtx :: IO Word32-cryptAcquireCtx = - alloca $ \handlePtr -> - withCString msDefProv $ \provName -> do- stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)- if (toBool stat)- then peek handlePtr- else fail "c_cryptAcquireCtx"--cryptGenRandom :: Word32 -> Int -> IO B.ByteString-cryptGenRandom h i = - BI.create i $ \c_buffer -> do- stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer- if (toBool stat)- then return ()- else fail "c_cryptGenRandom"--cryptReleaseCtx :: Word32 -> IO ()-cryptReleaseCtx h = do- stat <- c_cryptReleaseCtx h 0- if (toBool stat)- then return ()- else fail "c_cryptReleaseCtx"---- |Inefficiently get a specific number of bytes of cryptographically--- secure random data using the system-specific facilities.------ This function will return zero bytes--- on platforms without a secure RNG!-getEntropy :: Int -> IO B.ByteString-getEntropy n = do-#ifdef HAVE_RDRAND- b <- cpuHasRdRand- if b then hGetEntropy UseRdRand n- else do-#endif- h <- cryptAcquireCtx- bs <- cryptGenRandom h n- let !bs' = bs- cryptReleaseCtx h- return bs'---- |Open a handle from which random data can be read-openHandle :: IO CryptHandle-openHandle = do-#ifdef HAVE_RDRAND- b <- cpuHasRdRand- if b then return UseRdRand- else do-#endif- liftM CH cryptAcquireCtx---- |Close the `CryptHandle`-closeHandle (CH h) = cryptReleaseCtx h---- |Read from `CryptHandle`-hGetEntropy :: CryptHandle -> Int -> IO B.ByteString -hGetEntropy (CH h) = cryptGenRandom h-#ifdef HAVE_RDRAND-hGetEntropy UseRdRand =- B.create n $ \ptr -> do- r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)- when (r /= 0)- (fail "RDRand failed to gather entropy")-#endif+module System.Entropy+ ( getEntropy,+ getHardwareEntropy,+ CryptHandle,+ openHandle,+ hGetEntropy,+ closeHandle+ ) where +#ifdef ghcjs_HOST_OS+import System.EntropyGhcjs+#elif defined(isWindows)+import System.EntropyWindows #else-{- Not windows, assuming nix with a /dev/urandom -}-import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)-import Foreign.Ptr--source :: FilePath-source = "/dev/urandom"---- |Handle for manual resource mangement-data CryptHandle- = CH Fd-#ifdef HAVE_RDRAND- | UseRdRand-#endif---- |Open a `CryptHandle`-openHandle :: IO CryptHandle-openHandle = do-#ifdef HAVE_RDRAND- b <- cpuHasRdRand- if b then return UseRdRand- else do-#endif- liftM CH (openFd source ReadOnly Nothing defaultFileFlags)---- |Close the `CryptHandle`-closeHandle :: CryptHandle -> IO ()-closeHandle (CH h) = closeFd h-#ifdef HAVE_RDRAND-closeHandle UseRdRand = return ()-#endif--fdReadBS :: Fd -> Int -> IO B.ByteString-fdReadBS fd n = do- allocaBytes n $ \buf -> do- rc <- fdReadBuf fd buf (fromIntegral n)- case rc of- 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")- n' -> B.packCStringLen (castPtr buf, fromIntegral n')---- |Read random data from a `CryptHandle`-hGetEntropy :: CryptHandle -> Int -> IO B.ByteString-hGetEntropy (CH h) = fdReadBS h-#ifdef HAVE_RDRAND-hGetEntropy UseRdRand = \n -> do- B.create n $ \ptr -> do- r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)- when (r /= 0)- (fail "RDRand failed to gather entropy")+import System.EntropyNix #endif -#ifdef HAVE_RDRAND-foreign import ccall unsafe "cpu_has_rdrand"- c_cpu_has_rdrand :: IO CInt--foreign import ccall unsafe "get_rand_bytes"- c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt+import qualified Data.ByteString as B+import Control.Exception (bracket) -cpuHasRdRand :: IO Bool-cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand-#endif+-- |Get a specific number of bytes of cryptographically+-- secure random data using the *system-specific* sources.+-- (As of 0.4. Versions <0.4 mixed system and hardware sources)+--+-- The returned random value is considered cryptographically secure but not true entropy.+--+-- On some platforms this requires a file handle which can lead to resource+-- exhaustion in some situations.+getEntropy :: Int -- ^ Number of bytes+ -> IO B.ByteString+getEntropy = bracket openHandle closeHandle . flip hGetEntropy --- |Inefficiently get a specific number of bytes of cryptographically--- secure random data using the system-specific facilities.+-- |Get a specific number of bytes of cryptographically+-- secure random data using a supported *hardware* random bit generator. ----- Use '/dev/urandom' on *nix and CryptAPI when on Windows. In short,--- this entropy is considered "cryptographically secure" but not true--- entropy.-getEntropy :: Int -> IO B.ByteString-getEntropy n = do- h <- openHandle- e <- hGetEntropy h n- closeHandle h- return e-#endif-{- OS Test -}+-- If there is no hardware random number generator then @Nothing@ is returned.+-- If any call returns non-Nothing then it should never be @Nothing@ unless+-- there has been a hardware failure.+--+-- If trust of the CPU allows it and no context switching is important,+-- a bias to the hardware rng with system rng as fall back is trivial:+--+-- @+-- let fastRandom nr = maybe (getEntropy nr) pure =<< getHardwareEntropy nr+-- @+--+-- The old, @<0.4@, behavior is possible using @xor@ from 'Data.Bits':+--+-- @+-- let oldRandom nr =+-- do hwRnd <- maybe (replicate nr 0) BS.unpack <$> getHardwareEntropy nr+-- sysRnd <- BS.unpack <$> getEntropy nr+-- pure $ BS.pack $ zipWith xor sysRnd hwRnd+-- @+--+-- A less maliable mixing can be accomplished by replacing `xor` with a+-- composition of concat and cryptographic hash.+getHardwareEntropy :: Int -- ^ Number of bytes+ -> IO (Maybe B.ByteString)+getHardwareEntropy = hardwareRandom
+ System/EntropyGhcjs.hs view
@@ -0,0 +1,51 @@+{-|+ Maintainer: Thomas.DuBuisson@gmail.com+ Stability: beta+ Portability: portable++ Obtain entropy from system sources or x86 RDRAND when available.++-}++module System.EntropyGhcjs+ ( CryptHandle+ , openHandle+ , hGetEntropy+ , closeHandle+ , hardwareRandom+ ) where++import Data.ByteString as B+import GHCJS.DOM.Crypto as Crypto+import GHCJS.DOM.Types (ArrayBufferView (..), fromJSValUnchecked)+import GHCJS.DOM.GlobalCrypto (getCrypto)+import GHCJS.DOM (globalThisUnchecked)+import Language.Javascript.JSaddle.Object as JS+++-- |Handle for manual resource management+newtype CryptHandle = CH Crypto++-- | Get random values from the hardware RNG or return Nothing if no+-- supported hardware RNG is available.+--+-- Not supported on ghcjs.+hardwareRandom :: Int -> IO (Maybe B.ByteString)+hardwareRandom _ = pure Nothing++-- |Open a `CryptHandle`+openHandle :: IO CryptHandle+openHandle = do+ this <- globalThisUnchecked+ CH <$> getCrypto this++-- |Close the `CryptHandle`+closeHandle :: CryptHandle -> IO ()+closeHandle _ = pure ()++-- |Read random data from a `CryptHandle`+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString+hGetEntropy (CH h) n = do+ arr <- JS.new (jsg "Int8Array") [n]+ getRandomValues_ h (ArrayBufferView arr)+ B.pack <$> fromJSValUnchecked arr
+ System/EntropyNix.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}+{-|+ Maintainer: Thomas.DuBuisson@gmail.com+ Stability: beta+ Portability: portable++ Obtain entropy from system sources or x86 RDRAND when available.++-}++module System.EntropyNix+ ( CryptHandle+ , openHandle+ , hGetEntropy+ , closeHandle+ , hardwareRandom+ ) where++import Control.Exception+import Control.Monad (liftM, when)+import Data.ByteString as B+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)+import System.IO.Unsafe+import Data.Bits (xor)++import Foreign (allocaBytes)+import Foreign.Ptr+import Foreign.C.Error+import Foreign.C.Types+import Data.ByteString.Internal as B++#ifdef arch_i386+-- See .cabal wrt GCC 4.8.2 asm compilation bug+#undef HAVE_RDRAND+#endif++import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd, OpenFileFlags(..))++source :: FilePath+source = "/dev/urandom"++-- |Handle for manual resource management+data CryptHandle+ = CH Fd+#ifdef HAVE_GETRANDOM+ | UseGetRandom+#endif++-- | Get random values from the hardware RNG or return Nothing if no+-- supported hardware RNG is available.+--+-- Supported hardware:+-- * RDRAND+-- * Patches welcome+hardwareRandom :: Int -> IO (Maybe B.ByteString)+#ifdef HAVE_RDRAND+hardwareRandom n =+ do b <- cpuHasRdRand+ if b then Just <$> B.create n (\ptr ->+ do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)+ when (r /= 0) (fail "RDRand failed to gather entropy"))+ else pure Nothing+#else+hardwareRandom _ = pure Nothing+#endif++-- |Open a `CryptHandle`+openHandle :: IO CryptHandle+openHandle =+#ifdef HAVE_GETRANDOM+ if systemHasGetRandom then return UseGetRandom else+#endif+ fmap CH openRandomFile++openRandomFile :: IO Fd+openRandomFile = do+ evaluate ensurePoolInitialized+#if MIN_VERSION_unix(2,8,0)+ openFd source ReadOnly defaultFileFlags { creat = Nothing }+#else+ openFd source ReadOnly Nothing defaultFileFlags+#endif++-- |Close the `CryptHandle`+closeHandle :: CryptHandle -> IO ()+closeHandle (CH h) = closeFd h+#ifdef HAVE_GETRANDOM+closeHandle UseGetRandom = return ()+#endif++-- |Read random data from a `CryptHandle`+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString+hGetEntropy (CH h) n = fdReadBS h n+#ifdef HAVE_GETRANDOM+hGetEntropy UseGetRandom n = do+ bs <- B.createUptoN n (\ptr -> do+ r <- c_entropy_getrandom (castPtr ptr) (fromIntegral n)+ return $ if r == 0 then n else 0)+ if B.length bs == n then return bs+ -- getrandom somehow failed. Fall back on /dev/urandom instead.+ else bracket openRandomFile closeFd $ flip fdReadBS n+#endif++fdReadBS :: Fd -> Int -> IO B.ByteString+fdReadBS fd n =+ allocaBytes n $ \buf -> go buf n+ where+ go buf 0 = B.packCStringLen (castPtr buf, fromIntegral n)+ go buf cnt | cnt <= n = do+ rc <- fdReadBuf fd (plusPtr buf (n - cnt)) (fromIntegral cnt)+ case rc of+ 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")+ n' -> go buf (cnt - fromIntegral n')+ go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!"++#ifdef HAVE_GETRANDOM+foreign import ccall unsafe "system_has_getrandom"+ c_system_has_getrandom :: IO CInt+foreign import ccall safe "entropy_getrandom"+ c_entropy_getrandom :: Ptr CUChar -> CSize -> IO CInt++-- NOINLINE and unsafePerformIO are not totally necessary as getrandom will be+-- consistently either present or not, but it is cheaper not to check multiple+-- times.+systemHasGetRandom :: Bool+{-# NOINLINE systemHasGetRandom #-}+systemHasGetRandom = unsafePerformIO $ fmap (/= 0) c_system_has_getrandom+#endif++foreign import ccall safe "ensure_pool_initialized"+ c_ensure_pool_initialized :: IO CInt++-- Similarly to systemHasGetRandom, NOINLINE is just an optimization.+ensurePoolInitialized :: CInt+{-# NOINLINE ensurePoolInitialized #-}+ensurePoolInitialized = unsafePerformIO $ throwErrnoIfMinus1 "ensurePoolInitialized" $ c_ensure_pool_initialized++#ifdef HAVE_RDRAND+foreign import ccall unsafe "cpu_has_rdrand"+ c_cpu_has_rdrand :: IO CInt++foreign import ccall unsafe "get_rand_bytes"+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt++cpuHasRdRand :: IO Bool+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand+#endif
+ System/EntropyWindows.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}+{-|+ Maintainer: Thomas.DuBuisson@gmail.com+ Stability: beta+ Portability: portable++ Obtain entropy from system sources.+-}++module System.EntropyWindows+ ( CryptHandle+ , openHandle+ , hGetEntropy+ , closeHandle+ , hardwareRandom+ ) where++import Control.Monad (liftM, when)+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)+import System.Win32.Types (ULONG_PTR, errorWin)+import Foreign (allocaBytes)+import Data.ByteString as B+import Data.ByteString.Internal as BI+import Data.Int (Int32)+import Data.Bits (xor)+import Data.Word (Word32, Word8)+import Foreign.C.String (CString, withCString)+import Foreign.C.Types+import Foreign.Ptr (Ptr, nullPtr, castPtr)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Utils (toBool)+import Foreign.Storable (peek)++-- C example for windows rng - taken from a blog, can't recall which one but thank you!+-- #include <Windows.h>+-- #include <Wincrypt.h>+-- ...+-- //+-- // DISCLAIMER: Don't forget to check your error codes!!+-- // I am not checking as to make the example simple...+-- //+-- HCRYPTPROV hCryptCtx = NULL;+-- BYTE randomArray[128];+--+-- CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);+-- CryptGenRandom(hCryptCtx, 128, randomArray);+-- CryptReleaseContext(hCryptCtx, 0);+++#ifdef arch_i386+-- See .cabal wrt GCC 4.8.2 asm compilation bug+#undef HAVE_RDRAND+#endif++#ifdef HAVE_RDRAND+foreign import ccall unsafe "cpu_has_rdrand"+ c_cpu_has_rdrand :: IO CInt++foreign import ccall unsafe "get_rand_bytes"+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt++cpuHasRdRand :: IO Bool+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand+#endif++type HCRYPTPROV = ULONG_PTR+data CryptHandle+ = CH HCRYPTPROV+++-- | Get random values from the hardware RNG or return Nothing if no+-- supported hardware RNG is available.+--+-- Supported hardware:+-- * RDRAND+-- * Patches welcome+hardwareRandom :: Int -> IO (Maybe B.ByteString)+#ifdef HAVE_RDRAND+hardwareRandom n =+ do b <- cpuHasRdRand+ if b+ then Just <$> BI.create n (\ptr ->+ do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)+ when (r /= 0) (fail "RDRand failed to gather entropy"))+ else pure Nothing+#else+hardwareRandom _ = pure Nothing+#endif++-- Define the constants we need from WinCrypt.h+msDefProv :: String+msDefProv = "Microsoft Base Cryptographic Provider v1.0"+provRSAFull :: Word32+provRSAFull = 1+cryptVerifyContext :: Word32+cryptVerifyContext = fromIntegral 0xF0000000++-- Declare the required CryptoAPI imports+foreign import stdcall unsafe "CryptAcquireContextA"+ c_cryptAcquireCtx :: Ptr HCRYPTPROV -> CString -> CString -> Word32 -> Word32 -> IO Int32+foreign import stdcall unsafe "CryptGenRandom"+ c_cryptGenRandom :: HCRYPTPROV -> Word32 -> Ptr Word8 -> IO Int32+foreign import stdcall unsafe "CryptReleaseContext"+ c_cryptReleaseCtx :: HCRYPTPROV -> Word32 -> IO Int32++cryptAcquireCtx :: IO HCRYPTPROV+cryptAcquireCtx =+ alloca $ \handlePtr ->+ withCString msDefProv $ \provName -> do+ stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext+ if (toBool stat)+ then peek handlePtr+ else errorWin "c_cryptAcquireCtx"++cryptGenRandom :: HCRYPTPROV -> Int -> IO B.ByteString+cryptGenRandom h i =+ BI.create i $ \c_buffer -> do+ stat <- c_cryptGenRandom h (fromIntegral i) c_buffer+ if (toBool stat)+ then return ()+ else errorWin "c_cryptGenRandom"++cryptReleaseCtx :: HCRYPTPROV -> IO ()+cryptReleaseCtx h = do+ stat <- c_cryptReleaseCtx h 0+ if (toBool stat)+ then return ()+ else errorWin "c_cryptReleaseCtx"++-- |Open a handle from which random data can be read+openHandle :: IO CryptHandle+openHandle = CH `fmap` cryptAcquireCtx++-- |Close the `CryptHandle`+closeHandle :: CryptHandle -> IO ()+closeHandle (CH h) = cryptReleaseCtx h++-- |Read from `CryptHandle`+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString+hGetEntropy (CH h) n = cryptGenRandom h n
+ cbits/getrandom.c view
@@ -0,0 +1,52 @@+#ifdef HAVE_GETRANDOM++#define _GNU_SOURCE+#include <errno.h>++#ifdef HAVE_LIBC_GETRANDOM+#include <sys/random.h>+#else++#include <unistd.h>+#include <sys/syscall.h>+#include <sys/types.h>+#include <linux/random.h>++#ifndef SYS_getrandom+#define SYS_getrandom __NR_getrandom+#endif++static ssize_t getrandom(void* buf, size_t buflen, unsigned int flags)+{+ return syscall(SYS_getrandom, buf, buflen, flags);+}++#endif++int system_has_getrandom()+{+ char tmp;+ return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1 || errno != ENOSYS;+}++// Returns 0 on success, non-zero on failure.+int entropy_getrandom(unsigned char* buf, size_t len)+{+ while (len) {+ ssize_t bytes_read = getrandom(buf, len, 0);++ if (bytes_read == -1) {+ if (errno != EINTR)+ return -1;+ else+ continue;+ }++ len -= bytes_read;+ buf += bytes_read;+ }++ return 0;+}++#endif
+ cbits/random_initialized.c view
@@ -0,0 +1,58 @@+#define _GNU_SOURCE+#include <errno.h>+#include <fcntl.h>+#include <poll.h>+#include <sys/stat.h>+#include <unistd.h>++#ifdef HAVE_GETENTROPY+#ifndef DO_NOT_USE_GET_ENTROPY+static int ensure_pool_initialized_getentropy()+{+ char tmp;+ return getentropy(&tmp, sizeof(tmp));+}+#endif+#endif++// Poll /dev/random to wait for randomness. This is a proxy for the /dev/urandom+// pool being initialized.+static int ensure_pool_initialized_poll()+{+ struct pollfd pfd;+ int dev_random = open("/dev/random", O_RDONLY);+ if (dev_random == -1)+ return -1;++ pfd.fd = dev_random;+ pfd.events = POLLIN;+ pfd.revents = 0;++ while (1) {+ int ret = poll(&pfd, 1, -1);+ if (ret < 0 && (errno == EAGAIN || errno == EINTR))+ continue;+ if (ret != 1) {+ close(dev_random);+ errno = EIO;+ return -1;+ }++ break;+ }++ return close(dev_random);+}++// Returns 0 on success, non-zero on failure.+int ensure_pool_initialized()+{+#ifdef HAVE_GETENTROPY+#ifndef DO_NOT_USE_GET_ENTROPY+ if (ensure_pool_initialized_getentropy() == 0)+ return 0;+#endif+#endif++ return ensure_pool_initialized_poll();+}
cbits/rdrand.c view
@@ -11,8 +11,9 @@ return (cx & 0x40000000); } +#ifdef arch_x86_64 // Returns 1 on success-inline int _rdrand64_step(uint64_t *therand)+static inline int _rdrand64_step(uint64_t *therand) { unsigned char err; asm volatile("rdrand %0 ; setc %1"@@ -51,5 +52,48 @@ } return fail; }+#endif /* x86-64 */++#ifdef arch_i386+// Returns 1 on success+static inline int _rdrand32_step(uint32_t *therand)+{+ unsigned char err;+ asm volatile("rdrand %0 ; setc %1"+ : "=r" (*therand), "=qm" (err));+ return (int) err;+}++int get_rand_bytes(uint8_t *therand, size_t len)+{+ int cnt;+ int fail=0;+ uint8_t *p = therand;+ uint8_t *end = therand + len;+ if((uint32_t)p % sizeof(uint32_t) != 0) {+ uint32_t tmp;+ fail |= !_rdrand32_step(&tmp);+ while((uint32_t)p % sizeof(uint32_t) != 0 && p != end) {+ *p = (uint8_t)(tmp & 0xFF);+ tmp = tmp >> 8;+ p++;+ }+ }+ for(; p <= end - sizeof(uint32_t); p+=sizeof(uint32_t)) {+ fail |= !_rdrand32_step((uint32_t *)p);+ }+ if(p != end) {+ uint32_t tmp;+ int cnt;+ fail |= !_rdrand32_step(&tmp);+ while(p != end) {+ *p = (uint8_t)(tmp & 0xFF);+ tmp = tmp >> 8;+ p++;+ }+ }+ return fail;+}+#endif /* i386 */ #endif // RDRAND
cbits/rdrand.h view
@@ -2,11 +2,9 @@ #ifdef HAVE_RDRAND #include <stdint.h> -#ifdef arch_x86_64 int cpu_has_rdrand() // Returns 0 on success, non-zero on failure. int get_rand_bytes(uint8_t *therand, size_t len)-#endif /* arch_x86_64 */ #endif // HAVE_RDRAND #endif // rdrand_h
entropy.cabal view
@@ -1,9 +1,10 @@+cabal-version: >=1.10 name: entropy-version: 0.2.2.4-description: A platform independent method to obtain cryptographically strong entropy - (urandom on Linux, CryptAPI on Windows, patches welcome). +version: 0.4.1.11+description: A mostly platform independent method to obtain cryptographically strong entropy+ (RDRAND, urandom, CryptAPI, and patches welcome) Users looking for cryptographically strong (number-theoretically- sound) PRNGs should see the 'DRBG' package too!+ sound) PRNGs should see the 'DRBG' package too. synopsis: A platform independent entropy source license: BSD3 license-file: LICENSE@@ -14,29 +15,88 @@ homepage: https://github.com/TomMD/entropy bug-reports: https://github.com/TomMD/entropy/issues stability: stable-build-type: Custom-cabal-version: >=1.10-tested-with: GHC == 7.6.3--- data-files:-extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md +build-type: Custom++tested-with:+ GHC == 9.12.1+ GHC == 9.10.1+ GHC == 9.8.4+ GHC == 9.6.6+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2++extra-source-files:+ ./cbits/getrandom.c+ ./cbits/random_initialized.c+ ./cbits/rdrand.c+ ./cbits/rdrand.h+ README.md++Flag DoNotGetEntropy+ Description: Avoid use of the getentropy() *nix function. By default getentropy will be used+ if detected during compilation (this plays poorly with cross compilation).+ Default: False+ Manual: True++custom-setup+ setup-depends: Cabal >= 1.10 && < 3.15+ , base < 5+ , filepath < 1.6+ , directory < 1.4+ , process < 1.7+ library- ghc-options: -Wall -O2+ ghc-options: -O2 exposed-modules: System.Entropy- other-extensions: CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables- build-depends: base == 4.*, bytestring- -- hs-source-dirs:- -- other-modules:+ if impl(ghcjs) || os(ghcjs)+ other-modules: System.EntropyGhcjs+ else {+ if os(windows)+ other-modules: System.EntropyWindows+ else {+ other-modules: System.EntropyNix+ }+ }+ other-extensions: CPP, ForeignFunctionInterface, BangPatterns,+ ScopedTypeVariables+ build-depends: base >= 4.8 && < 5, bytestring+ default-language: Haskell2010- if arch(x86_64)- cpp-options: -Darch_x86_64- c-sources: cbits/rdrand.c- include-dirs: cbits- if os(windows)- cpp-options: -DisWindows- extra-libraries: advapi32- else- Build-Depends: unix++ if impl(ghcjs) || os(ghcjs) {+ build-depends: ghcjs-dom >= 0.9.5.0 && < 1+ , jsaddle+ }+ else {+ if arch(x86_64)+ cpp-options: -Darch_x86_64+ cc-options: -Darch_x86_64 -O2+ -- gcc 4.8.2 on i386 fails to compile rdrand.c when using -fPIC!+ c-sources: cbits/rdrand.c+ include-dirs: cbits+ if arch(i386)+ cpp-options: -Darch_i386+ cc-options: -Darch_i386 -O2+ if os(windows)+ build-depends: Win32 >= 2.5+ cpp-options: -DisWindows+ cc-options: -DisWindows+ extra-libraries: advapi32+ else+ Build-Depends: unix+ c-sources: cbits/getrandom.c cbits/random_initialized.c+ }+ if flag(DoNotGetEntropy) {+ cc-options: -DDO_NOT_USE_GET_ENTROPY+ }+ source-repository head type: git