entropy 0.3.2 → 0.4.1.11
raw patch · 10 files changed
Files
- README.md +41/−3
- Setup.hs +101/−17
- System/Entropy.hs +52/−18
- System/EntropyGhcjs.hs +51/−0
- System/EntropyNix.hs +76/−47
- System/EntropyWindows.hs +58/−46
- cbits/getrandom.c +52/−0
- cbits/random_initialized.c +58/−0
- cbits/rdrand.c +2/−2
- entropy.cabal +80/−42
README.md view
@@ -1,7 +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 = 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;"@@ -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
@@ -8,35 +8,69 @@ Currently supporting: - - Windows via CryptoAPO+ - Windows via CryptoAPI - *nix systems via @\/dev\/urandom@- - QNX- - Xen only when RDRAND is available.+ - Includes QNX+ - 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- module System.EntropyNix- ) where import System.EntropyNix #endif import qualified Data.ByteString as B+import Control.Exception (bracket) --- |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 the *system-specific* sources.+-- (As of 0.4. Versions <0.4 mixed system and hardware sources) ----- 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+-- 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,14 +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 @@ -29,82 +34,106 @@ #undef HAVE_RDRAND #endif -#ifdef XEN-#ifndef HAVE_RDRAND-#error "The entropy package requires RDRAND support when using the halvm/Xen"-#endif-data CryptHandle = UseRdRand -- or die trying-#else--import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd, OpenFileFlags(..)) source :: FilePath source = "/dev/urandom" --- |Handle for manual resource mangement+-- |Handle for manual resource management data CryptHandle = CH Fd-#ifdef HAVE_RDRAND- | UseRdRand+#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 = do-#ifdef HAVE_RDRAND- b <- cpuHasRdRand- if b then return UseRdRand- else nonRDRandHandle-#else- nonRDRandHandle+openHandle =+#ifdef HAVE_GETRANDOM+ if systemHasGetRandom then return UseGetRandom else #endif- where-#ifdef XEN- nonRDRandHandle :: IO CryptHandle- nonRDRandHandle = error "entropy: On halvm there is no entropy other than RDRAND."+ fmap CH openRandomFile++openRandomFile :: IO Fd+openRandomFile = do+ evaluate ensurePoolInitialized+#if MIN_VERSION_unix(2,8,0)+ openFd source ReadOnly defaultFileFlags { creat = Nothing } #else- nonRDRandHandle :: IO CryptHandle- nonRDRandHandle = liftM CH (openFd source ReadOnly Nothing defaultFileFlags)+ openFd source ReadOnly Nothing defaultFileFlags #endif -- |Close the `CryptHandle` closeHandle :: CryptHandle -> IO ()-#ifndef XEN closeHandle (CH h) = closeFd h-#endif-#ifdef HAVE_RDRAND-closeHandle UseRdRand = return ()+#ifdef HAVE_GETRANDOM+closeHandle UseGetRandom = return () #endif -- |Read random data from a `CryptHandle`-#ifdef XEN 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")-#else-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")+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 = do- allocaBytes n $ \buf -> do- rc <- fdReadBuf fd buf (fromIntegral n)+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' -> B.packCStringLen (castPtr buf, fromIntegral n')+ 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,14 +12,17 @@ , 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@@ -28,22 +31,26 @@ 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];+-- 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); - 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"@@ -56,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+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@@ -70,59 +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 return UseRdRand- else do-#endif- liftM CH cryptAcquireCtx+openHandle = CH `fmap` cryptAcquireCtx -- |Close the `CryptHandle` closeHandle :: CryptHandle -> IO ()-closeHandle (CH h) = cryptReleaseCtx h+closeHandle (CH h) = cryptReleaseCtx h -- |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 n =- BI.create n $ \ptr -> do- r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)- when (r /= 0)- (fail "RDRand failed to gather entropy")-#endif
+ 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
@@ -13,7 +13,7 @@ #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"@@ -56,7 +56,7 @@ #ifdef arch_i386 // Returns 1 on success-inline int _rdrand32_step(uint32_t *therand)+static inline int _rdrand32_step(uint32_t *therand) { unsigned char err; asm volatile("rdrand %0 ; setc %1"
entropy.cabal view
@@ -1,7 +1,8 @@+cabal-version: >=1.10 name: entropy-version: 0.3.2-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,51 +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 && < 3.15+ , base < 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- else- other-modules: System.EntropyNix- other-extensions: CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables- build-depends: base == 4.*, bytestring+ 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(flag(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- -- 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- if os(windows)- cpp-options: -DisWindows- cc-options: -DisWindows- extra-libraries: advapi32- else- if !flag(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