entropy 0.3.8 → 0.4.1.11
raw patch · 10 files changed
Files
- README.md +39/−3
- Setup.hs +75/−18
- System/Entropy.hs +47/−16
- System/EntropyGhcjs.hs +51/−0
- System/EntropyNix.hs +69/−22
- System/EntropyWindows.hs +52/−51
- System/EntropyXen.hs +0/−66
- cbits/getrandom.c +52/−0
- cbits/random_initialized.c +58/−0
- entropy.cabal +72/−46
README.md view
@@ -1,9 +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
@@ -17,27 +17,29 @@ 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 = cArgs ++ 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;"@@ -47,12 +49,67 @@ , " return (!err);" , "}" ])- ec <- myRawSystemExitCode 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 __GLASGOW_HASKELL__ >= 704+#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
System/Entropy.hs view
@@ -11,35 +11,66 @@ - Windows via CryptoAPI - *nix systems via @\/dev\/urandom@ - Includes QNX- - Xen (only when RDRAND is available)+ - ghcjs/browser via JavaScript crypto API. -} module System.Entropy ( getEntropy,-#if defined(isWindows)- module System.EntropyWindows+ getHardwareEntropy,+ CryptHandle,+ openHandle,+ hGetEntropy,+ closeHandle ) where++#ifdef ghcjs_HOST_OS+import System.EntropyGhcjs+#elif defined(isWindows) import System.EntropyWindows #else-#ifdef XEN- module System.EntropyXen- ) where-import System.EntropyXen-#else- module System.EntropyNix- ) where import System.EntropyNix #endif-#endif import qualified Data.ByteString as B import Control.Exception (bracket) -- |Get a specific number of bytes of cryptographically--- secure random data using the system-specific facilities.+-- secure random data using the *system-specific* sources.+-- (As of 0.4. Versions <0.4 mixed system and hardware sources) ----- Use RDRAND if available and XOR with '/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+-- 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++-- |Get a specific number of bytes of cryptographically+-- secure random data using a supported *hardware* random bit generator.+--+-- 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
@@ -13,15 +13,19 @@ , 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 @@ -30,7 +34,7 @@ #undef HAVE_RDRAND #endif -import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd, OpenFileFlags(..)) source :: FilePath source = "/dev/urandom"@@ -38,42 +42,63 @@ -- |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- | UseRdRand Fd+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 = do-#ifdef HAVE_RDRAND- b <- cpuHasRdRand- if b then UseRdRand `fmap` nonRDRandHandle- else CH `fmap` nonRDRandHandle+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- CH `fmap` nonRDRandHandle+ openFd source ReadOnly Nothing defaultFileFlags #endif- where- nonRDRandHandle :: IO Fd- nonRDRandHandle = openFd source ReadOnly Nothing defaultFileFlags -- |Close the `CryptHandle` closeHandle :: CryptHandle -> IO () closeHandle (CH h) = closeFd h-#ifdef HAVE_RDRAND-closeHandle (UseRdRand 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) = fdReadBS h-#ifdef HAVE_RDRAND-hGetEntropy (UseRdRand h) = \n ->- do bsURandom <- fdReadBS h n- bsRDRAND <- B.create n $ \ptr -> do- r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)- when (r /= 0)- (fail "RDRand failed to gather entropy")- return $ B.pack $ B.zipWith xor bsURandom bsRDRAND+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@@ -87,6 +112,28 @@ 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"
System/EntropyWindows.hs view
@@ -4,7 +4,7 @@ Stability: beta Portability: portable - Obtain entropy from system sources or x86 RDRAND when available.+ Obtain entropy from system sources. -} module System.EntropyWindows@@ -12,10 +12,12 @@ , 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@@ -29,21 +31,20 @@ 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);--}+-- 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@@ -62,13 +63,31 @@ cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand #endif +type HCRYPTPROV = ULONG_PTR data CryptHandle- = CH Word32+ = 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- | UseRdRand Word32+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 +-- Define the constants we need from WinCrypt.h msDefProv :: String msDefProv = "Microsoft Base Cryptographic Provider v1.0" provRSAFull :: Word32@@ -76,64 +95,46 @@ cryptVerifyContext :: Word32 cryptVerifyContext = fromIntegral 0xF0000000 --- Declare the required CryptoAPI imports +-- Declare the required CryptoAPI imports foreign import stdcall unsafe "CryptAcquireContextA"- c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32+ c_cryptAcquireCtx :: Ptr HCRYPTPROV -> CString -> CString -> Word32 -> Word32 -> IO Int32 foreign import stdcall unsafe "CryptGenRandom"- c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32+ c_cryptGenRandom :: HCRYPTPROV -> Word32 -> Ptr Word8 -> IO Int32 foreign import stdcall unsafe "CryptReleaseContext"- c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32+ c_cryptReleaseCtx :: HCRYPTPROV -> Word32 -> IO Int32 -cryptAcquireCtx :: IO Word32+cryptAcquireCtx :: IO HCRYPTPROV cryptAcquireCtx =- alloca $ \handlePtr -> + alloca $ \handlePtr -> withCString msDefProv $ \provName -> do stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext if (toBool stat) then peek handlePtr- else fail "c_cryptAcquireCtx"+ else errorWin "c_cryptAcquireCtx" -cryptGenRandom :: Word32 -> Int -> IO B.ByteString-cryptGenRandom h i = +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 fail "c_cryptGenRandom"+ else errorWin "c_cryptGenRandom" -cryptReleaseCtx :: Word32 -> IO ()+cryptReleaseCtx :: HCRYPTPROV -> IO () cryptReleaseCtx h = do stat <- c_cryptReleaseCtx h 0 if (toBool stat) then return ()- else fail "c_cryptReleaseCtx"+ else errorWin "c_cryptReleaseCtx" -- |Open a handle from which random data can be read openHandle :: IO CryptHandle-openHandle = do-#ifdef HAVE_RDRAND- b <- cpuHasRdRand- if b then UseRdRand `fmap` cryptAcquireCtx- else do-#endif- CH `fmap` cryptAcquireCtx+openHandle = CH `fmap` cryptAcquireCtx -- |Close the `CryptHandle` closeHandle :: CryptHandle -> IO () closeHandle (CH h) = cryptReleaseCtx h-#ifdef HAVE_RDRAND-closeHandle (UseRdRand h) = cryptReleaseCtx h-#endif -- |Read from `CryptHandle`-hGetEntropy :: CryptHandle -> Int -> IO B.ByteString +hGetEntropy :: CryptHandle -> Int -> IO B.ByteString hGetEntropy (CH h) n = cryptGenRandom h n-#ifdef HAVE_RDRAND-hGetEntropy (UseRdRand h) n =- do bsRDRAND <- BI.create n $ \ptr -> do- r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)- when (r /= 0)- (fail "RDRand failed to gather entropy")- bsWinCrypt <- cryptGenRandom h n- return $ B.pack $ B.zipWith xor bsRDRAND bsWinCrypt-#endif
− System/EntropyXen.hs
@@ -1,66 +0,0 @@-{-# 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.EntropyXen- ( CryptHandle- , openHandle- , hGetEntropy- , closeHandle- ) where--import Control.Monad (liftM, when)-import Data.ByteString as B-import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)--import Foreign (allocaBytes)-import Foreign.Ptr-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--#ifndef HAVE_RDRAND-#error "The entropy package requires RDRAND support when using the halvm/Xen"-#endif-data CryptHandle = UseRdRand -- or die trying---- |Open a `CryptHandle`-openHandle :: IO CryptHandle-openHandle = do- b <- cpuHasRdRand- if b then return UseRdRand- else nonRDRandHandle- where- nonRDRandHandle :: IO CryptHandle- nonRDRandHandle = error "entropy: On halvm there is no entropy other than RDRAND."---- |Close the `CryptHandle`-closeHandle :: CryptHandle -> IO ()-closeHandle UseRdRand = return ()---- |Read random data from a `CryptHandle`-hGetEntropy :: CryptHandle -> Int -> IO B.ByteString-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")--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
+ 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();+}
entropy.cabal view
@@ -1,7 +1,8 @@+cabal-version: >=1.10 name: entropy-version: 0.3.8-description: A platform independent method to obtain cryptographically strong entropy- (RDRAND when available anywhere, urandom on nix, 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. synopsis: A platform independent entropy source@@ -14,63 +15,88 @@ homepage: https://github.com/TomMD/entropy bug-reports: https://github.com/TomMD/entropy/issues stability: stable--- build-type: Simple--- ^^ Used for HaLVM-build-type: Custom--- ^^ Test for RDRAND support using 'ghc'-cabal-version: >=1.10-tested-with: GHC == 7.8.2--- data-files:-extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md --- Notice to compile with HaLVM the above 'build-type' must be changed--- to 'Simple' instead of 'Custom'. The current build system naively--- runs GHC to determine if the compiler supports RDRAND before proceeding.-flag halvm- description: Build for the HaLVM- default: False+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 && < 2.2+ setup-depends: Cabal >= 1.10 && < 3.15 , base < 5- , filepath < 1.5+ , filepath < 1.6 , directory < 1.4 , process < 1.7 library ghc-options: -O2 exposed-modules: System.Entropy- if os(windows)- other-modules: System.EntropyWindows+ if impl(ghcjs) || os(ghcjs)+ other-modules: System.EntropyGhcjs else {- if os(halvm)- other-modules: System.EntropyXen- else- other-modules: System.EntropyNix+ if os(windows)+ other-modules: System.EntropyWindows+ else {+ other-modules: System.EntropyNix+ } }- other-extensions: CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables- build-depends: base >= 4.3 && < 5, bytestring+ other-extensions: CPP, ForeignFunctionInterface, BangPatterns,+ ScopedTypeVariables+ build-depends: base >= 4.8 && < 5, bytestring+ default-language: Haskell2010- if(os(halvm))- cpp-options: -DXEN -DHAVE_RDRAND- cc-options: -DXEN -DHAVE_RDRAND- 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)- cpp-options: -DisWindows- cc-options: -DisWindows- extra-libraries: advapi32- else- if !os(halvm)- 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