entropy-0.4.1.6/0000755000000000000000000000000007346545000011551 5ustar0000000000000000entropy-0.4.1.6/LICENSE0000644000000000000000000000266307346545000012565 0ustar0000000000000000Copyright (c) Thomas DuBuisson All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. entropy-0.4.1.6/README.md0000755000000000000000000000246007346545000013035 0ustar0000000000000000# 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 `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) entropy-0.4.1.6/Setup.hs0000644000000000000000000001404307346545000013207 0ustar0000000000000000{-# LANGUAGE CPP #-} import Control.Monad import Distribution.Simple import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Setup import Distribution.PackageDescription import Distribution.Simple.Utils import Distribution.Simple.Program import Distribution.Verbosity import System.Process 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 mConf = lookupProgram ghcProgram (withPrograms lbi) err = error "Could not determine C compiler" cc = locationPath . programLocation . maybe err id $ mConf lbiNew <- checkRDRAND cc lbi >>= checkGetrandom cc >>= checkGetentropy cc buildHook simpleUserHooks pd lbiNew uh bf } 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) 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 checkRDRAND :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo checkRDRAND cc lbi = do b <- compileCheck cc "testRDRAND" "Result of RDRAND Test: " (unlines [ "#include " , "int main() {" , " uint64_t therand;" , " unsigned char err;" , " asm volatile(\"rdrand %0 ; setc %1\"" , " : \"=r\" (therand), \"=qm\" (err));" , " return (!err);" , "}" ]) 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 __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 entropy-0.4.1.6/System/0000755000000000000000000000000007346545000013035 5ustar0000000000000000entropy-0.4.1.6/System/Entropy.hs0000644000000000000000000000474107346545000015037 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-} {-| Maintainer: Thomas.DuBuisson@gmail.com Stability: beta Portability: portable Obtain entropy from system sources or x86 RDRAND when available. Currently supporting: - 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, getHardwareEntropy, CryptHandle, openHandle, hGetEntropy, closeHandle ) where #ifdef ghcjs_HOST_OS import System.EntropyGhcjs #elif defined(isWindows) import System.EntropyWindows #elif XEN import System.EntropyXen #else import System.EntropyNix #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* sources. -- (As of 0.4. Verions <0.4 mixed system and hardware sources) -- -- The returned random value is considered cryptographically secure but not true entropy. -- -- On some platforms this requies 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 entropy-0.4.1.6/System/EntropyGhcjs.hs0000644000000000000000000000244707346545000016017 0ustar0000000000000000{-| 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 (currentWindowUnchecked) 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 w <- currentWindowUnchecked CH <$> getCrypto w -- |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 entropy-0.4.1.6/System/EntropyNix.hs0000644000000000000000000001025507346545000015513 0ustar0000000000000000{-# 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) 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 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) 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 entropy-0.4.1.6/System/EntropyWindows.hs0000644000000000000000000001024207346545000016403 0ustar0000000000000000{-# 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 entropy-0.4.1.6/System/EntropyXen.hs0000644000000000000000000000410407346545000015503 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-} {-| Maintainer: Thomas.DuBuisson@gmail.com Stability: beta Portability: portable Obtain entropy from RDRAND when available. -} module System.EntropyXen ( CryptHandle , openHandle , hGetEntropy , closeHandle , hardwareRandom ) 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 () -- | 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) hardwareRandom sz = Just <$> hGetEntropy UseRdRand sz -- |Read random data from a `CryptHandle`, which uses RDRAND (when on 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") 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 entropy-0.4.1.6/cbits/0000755000000000000000000000000007346545000012655 5ustar0000000000000000entropy-0.4.1.6/cbits/getrandom.c0000644000000000000000000000167107346545000015006 0ustar0000000000000000#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 entropy-0.4.1.6/cbits/getrandom.c0000755000000000000000000000167107346545000015011 0ustar0000000000000000#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 entropy-0.4.1.6/cbits/random_initialized.c0000644000000000000000000000215207346545000016666 0ustar0000000000000000#define _GNU_SOURCE #include #include #include #include #include #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-0.4.1.6/cbits/random_initialized.c0000755000000000000000000000215207346545000016671 0ustar0000000000000000#define _GNU_SOURCE #include #include #include #include #include #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-0.4.1.6/cbits/rdrand.c0000644000000000000000000000444107346545000014276 0ustar0000000000000000#ifdef HAVE_RDRAND #include #include int cpu_has_rdrand() { uint32_t ax,bx,cx,dx,func=1; __asm__ volatile ("cpuid":\ "=a" (ax), "=b" (bx), "=c" (cx), "=d" (dx) : "a" (func)); return (cx & 0x40000000); } #ifdef arch_x86_64 // Returns 1 on success static inline int _rdrand64_step(uint64_t *therand) { unsigned char err; asm volatile("rdrand %0 ; setc %1" : "=r" (*therand), "=qm" (err)); return (int) err; } // Returns 0 on success, non-zero on failure. 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((uint64_t)p%8 != 0) { uint64_t tmp; fail |= !_rdrand64_step(&tmp); while((uint64_t)p%8 != 0 && p != end) { *p = (uint8_t)(tmp & 0xFF); tmp = tmp >> 8; p++; } } for(; p <= end - sizeof(uint64_t); p+=sizeof(uint64_t)) { fail |= !_rdrand64_step((uint64_t *)p); } if(p != end) { uint64_t tmp; int cnt; fail |= !_rdrand64_step(&tmp); while(p != end) { *p = (uint8_t)(tmp & 0xFF); tmp = tmp >> 8; p++; } } 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 entropy-0.4.1.6/cbits/rdrand.c0000755000000000000000000000444107346545000014301 0ustar0000000000000000#ifdef HAVE_RDRAND #include #include int cpu_has_rdrand() { uint32_t ax,bx,cx,dx,func=1; __asm__ volatile ("cpuid":\ "=a" (ax), "=b" (bx), "=c" (cx), "=d" (dx) : "a" (func)); return (cx & 0x40000000); } #ifdef arch_x86_64 // Returns 1 on success static inline int _rdrand64_step(uint64_t *therand) { unsigned char err; asm volatile("rdrand %0 ; setc %1" : "=r" (*therand), "=qm" (err)); return (int) err; } // Returns 0 on success, non-zero on failure. 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((uint64_t)p%8 != 0) { uint64_t tmp; fail |= !_rdrand64_step(&tmp); while((uint64_t)p%8 != 0 && p != end) { *p = (uint8_t)(tmp & 0xFF); tmp = tmp >> 8; p++; } } for(; p <= end - sizeof(uint64_t); p+=sizeof(uint64_t)) { fail |= !_rdrand64_step((uint64_t *)p); } if(p != end) { uint64_t tmp; int cnt; fail |= !_rdrand64_step(&tmp); while(p != end) { *p = (uint8_t)(tmp & 0xFF); tmp = tmp >> 8; p++; } } 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 entropy-0.4.1.6/cbits/rdrand.h0000755000000000000000000000032707346545000014305 0ustar0000000000000000#ifndef rdrand_h #ifdef HAVE_RDRAND #include int cpu_has_rdrand() // Returns 0 on success, non-zero on failure. int get_rand_bytes(uint8_t *therand, size_t len) #endif // HAVE_RDRAND #endif // rdrand_h entropy-0.4.1.6/entropy.cabal0000644000000000000000000000567707346545000014254 0ustar0000000000000000name: entropy 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 sound) PRNGs should see the 'DRBG' package too. synopsis: A platform independent entropy source license: BSD3 license-file: LICENSE copyright: Thomas DuBuisson author: Thomas DuBuisson maintainer: Thomas DuBuisson category: Data, Cryptography 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 == 8.2.2 -- data-files: 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 -- runs GHC to determine if the compiler supports RDRAND before proceeding. flag halvm description: Build for the HaLVM default: False custom-setup setup-depends: Cabal >= 1.10 && < 3.3 , base < 5 , filepath < 1.5 , directory < 1.4 , process < 1.7 library ghc-options: -O2 exposed-modules: System.Entropy if impl(ghcjs) || os(ghcjs) other-modules: System.EntropyGhcjs else { if os(windows) other-modules: System.EntropyWindows else { if os(halvm) other-modules: System.EntropyXen else other-modules: System.EntropyNix } } other-extensions: CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables build-depends: base >= 4.8 && < 5, bytestring default-language: Haskell2010 if impl(ghcjs) || os(ghcjs) { build-depends: ghcjs-dom , jsaddle } else { 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) build-depends: Win32 >= 2.5 cpp-options: -DisWindows cc-options: -DisWindows extra-libraries: advapi32 else if !os(halvm) Build-Depends: unix c-sources: cbits/getrandom.c cbits/random_initialized.c } source-repository head type: git location: https://github.com/TomMD/entropy