diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. + +[![Build Status](https://travis-ci.org/TomMD/entropy.svg?branch=master)](https://travis-ci.org/TomMD/entropy) diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -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 " , "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 " + , "#include " + + , "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 " + , "#include " + , "#include " + , "#include " + , "#include " + + , "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 " + + , "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 diff --git a/System/Entropy.hs b/System/Entropy.hs --- a/System/Entropy.hs +++ b/System/Entropy.hs @@ -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 - #include - ... - // - // 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 diff --git a/System/EntropyGhcjs.hs b/System/EntropyGhcjs.hs new file mode 100644 --- /dev/null +++ b/System/EntropyGhcjs.hs @@ -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 diff --git a/System/EntropyNix.hs b/System/EntropyNix.hs new file mode 100644 --- /dev/null +++ b/System/EntropyNix.hs @@ -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 diff --git a/System/EntropyWindows.hs b/System/EntropyWindows.hs new file mode 100644 --- /dev/null +++ b/System/EntropyWindows.hs @@ -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 +-- #include +-- ... +-- // +-- // 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 diff --git a/cbits/getrandom.c b/cbits/getrandom.c new file mode 100644 --- /dev/null +++ b/cbits/getrandom.c @@ -0,0 +1,52 @@ +#ifdef HAVE_GETRANDOM + +#define _GNU_SOURCE +#include + +#ifdef HAVE_LIBC_GETRANDOM +#include +#else + +#include +#include +#include +#include + +#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 diff --git a/cbits/random_initialized.c b/cbits/random_initialized.c new file mode 100644 --- /dev/null +++ b/cbits/random_initialized.c @@ -0,0 +1,58 @@ +#define _GNU_SOURCE +#include +#include +#include +#include +#include + +#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(); +} diff --git a/cbits/rdrand.c b/cbits/rdrand.c --- a/cbits/rdrand.c +++ b/cbits/rdrand.c @@ -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 diff --git a/cbits/rdrand.h b/cbits/rdrand.h --- a/cbits/rdrand.h +++ b/cbits/rdrand.h @@ -2,11 +2,9 @@ #ifdef HAVE_RDRAND #include -#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 diff --git a/entropy.cabal b/entropy.cabal --- a/entropy.cabal +++ b/entropy.cabal @@ -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