entropy 0.4.1.5 → 0.4.1.6
raw patch · 9 files changed
+242/−35 lines, 9 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +2/−2
- Setup.hs +70/−15
- System/EntropyGhcjs.hs +1/−1
- System/EntropyNix.hs +53/−8
- System/EntropyWindows.hs +1/−1
- System/EntropyXen.hs +2/−2
- cbits/getrandom.c +52/−0
- cbits/random_initialized.c +54/−0
- entropy.cabal +7/−6
README.md view
@@ -2,8 +2,8 @@ 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`. Hardware RNGs (currently RDRAND, patches welcome) are supported-via the `hardwareRNG` function.+`getrandom` and `/dev/urandom`. Hardware RNGs (currently RDRAND, patches+welcome) are supported via the `hardwareRNG` function. ## Quick Start
Setup.hs view
@@ -20,23 +20,26 @@ 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;"@@ -46,9 +49,61 @@ , " 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
System/EntropyGhcjs.hs view
@@ -26,7 +26,7 @@ -- |Handle for manual resource management newtype CryptHandle = CH Crypto --- | Get random values from the hardward RNG or return Nothing if no+-- | Get random values from the hardware RNG or return Nothing if no -- supported hardware RNG is available. -- -- Not supported on ghcjs.
System/EntropyNix.hs view
@@ -16,13 +16,16 @@ , 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 @@ -39,8 +42,11 @@ -- |Handle for manual resource management data CryptHandle = CH Fd+#ifdef HAVE_GETRANDOM+ | UseGetRandom+#endif --- | Get random values from the hardward RNG or return Nothing if no+-- | Get random values from the hardware RNG or return Nothing if no -- supported hardware RNG is available. -- -- Supported hardware:@@ -50,8 +56,7 @@ #ifdef HAVE_RDRAND hardwareRandom n = do b <- cpuHasRdRand- if b- then Just <$> B.create n (\ptr ->+ 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@@ -61,18 +66,36 @@ -- |Open a `CryptHandle` openHandle :: IO CryptHandle-openHandle = do CH `fmap` nonRDRandHandle- where- nonRDRandHandle :: IO Fd- nonRDRandHandle = openFd source ReadOnly Nothing defaultFileFlags+openHandle =+#ifdef HAVE_GETRANDOM+ if systemHasGetRandom then return UseGetRandom else+#endif+ fmap CH openRandomFile +openRandomFile :: IO Fd+openRandomFile = do+ evaluate ensurePoolInitialized+ openFd source ReadOnly Nothing defaultFileFlags+ -- |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) = fdReadBS h+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 =@@ -85,6 +108,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
@@ -69,7 +69,7 @@ = CH HCRYPTPROV --- | Get random values from the hardward RNG or return Nothing if no+-- | Get random values from the hardware RNG or return Nothing if no -- supported hardware RNG is available. -- -- Supported hardware:
System/EntropyXen.hs view
@@ -13,7 +13,7 @@ , openHandle , hGetEntropy , closeHandle- , hardwardRNG+ , hardwareRandom ) where import Control.Monad (liftM, when)@@ -49,7 +49,7 @@ closeHandle :: CryptHandle -> IO () closeHandle UseRdRand = return () --- | Get random values from the hardward RNG or return Nothing if no+-- | Get random values from the hardware RNG or return Nothing if no -- supported hardware RNG is available. -- -- Supported hardware:
+ 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,54 @@+#define _GNU_SOURCE+#include <errno.h>+#include <fcntl.h>+#include <poll.h>+#include <sys/stat.h>+#include <unistd.h>++#ifdef HAVE_GETENTROPY+static int ensure_pool_initialized_getentropy()+{+ char tmp;+ return getentropy(&tmp, sizeof(tmp));+}+#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+ if (ensure_pool_initialized_getentropy() == 0)+ return 0;+#endif++ return ensure_pool_initialized_poll();+}
entropy.cabal view
@@ -1,5 +1,5 @@ name: entropy-version: 0.4.1.5+version: 0.4.1.6 description: A mostly platform independent method to obtain cryptographically strong entropy (RDRAND, urandom, CryptAPI, and patches welcome) Users looking for cryptographically strong (number-theoretically@@ -23,7 +23,7 @@ cabal-version: >=1.10 tested-with: GHC == 8.2.2 -- data-files:-extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md+extra-source-files: ./cbits/getrandom.c ./cbits/random_initialized.c ./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@@ -34,7 +34,7 @@ custom-setup- setup-depends: Cabal >= 1.10 && < 3.1+ setup-depends: Cabal >= 1.10 && < 3.3 , base < 5 , filepath < 1.5 , directory < 1.4@@ -43,7 +43,7 @@ library ghc-options: -O2 exposed-modules: System.Entropy- if impl(ghcjs)+ if impl(ghcjs) || os(ghcjs) other-modules: System.EntropyGhcjs else { if os(windows)@@ -60,8 +60,8 @@ build-depends: base >= 4.8 && < 5, bytestring default-language: Haskell2010- - if impl(ghcjs) {++ if impl(ghcjs) || os(ghcjs) { build-depends: ghcjs-dom , jsaddle }@@ -86,6 +86,7 @@ else if !os(halvm) Build-Depends: unix+ c-sources: cbits/getrandom.c cbits/random_initialized.c }