04319d2 · typeable/entropy

git.iko.soy/typeable/entropy

on main help sign in

Merge pull request #51 from ldr709/master

04319d2Thomas M. DuBuisson7 years ago

README.md+2−2

compare with main

unifiedsplit

@@ -2,8 +2,8 @@

3This package allows Haskell users to easily acquire entropy for use in critical

4security applications by calling out to either windows crypto api, unix/linux's

5−`/dev/urandom`. Hardware RNGs (currently RDRAND, patches welcome) are supported

5+`getrandom` and `/dev/urandom`. Hardware RNGs (currently RDRAND, patches

6−via the `hardwareRNG` function.

6+welcome) are supported via the `hardwareRNG` function.

8## Quick Start

Setup.hs+70−15

@@ -20,23 +20,26 @@ main = defaultMainWithHooks hk

20 let mConf = lookupProgram ghcProgram (withPrograms lbi)

21 err = error "Could not determine C compiler"

22 cc = locationPath . programLocation . maybe err id $ mConf

23− b <- canUseRDRAND cc

23+ lbiNew <- checkRDRAND cc lbi >>= checkGetrandom cc >>= checkGetentropy cc

24− let newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)

25− newWithPrograms = userSpecifyArgs "ghc" cArgsHC newWithPrograms1

26− lbiNew = if b then (lbi {withPrograms = newWithPrograms }) else lbi

27 buildHook simpleUserHooks pd lbiNew uh bf

24 buildHook simpleUserHooks pd lbiNew uh bf

28 }

25 }

30−cArgs :: [String]

27+compileCheck :: FilePath -> String -> String -> String -> IO Bool

31−cArgs = ["-DHAVE_RDRAND"]

28+compileCheck cc testName message sourceCode = do

29+ withTempDirectory normal "" testName $ \tmpDir -> do

30+ writeFile (tmpDir ++ "/" ++ testName ++ ".c") sourceCode

31+ ec <- myRawSystemExitCode normal cc [tmpDir </> testName ++ ".c", "-o", tmpDir ++ "/a","-no-hs-main"]

32+ notice normal $ message ++ show (ec == ExitSuccess)

33+ return (ec == ExitSuccess)

33−cArgsHC :: [String]

35+addOptions :: [String] -> [String] -> LocalBuildInfo -> LocalBuildInfo

34−cArgsHC = cArgs ++ map ("-optc" ++) cArgs

36+addOptions cArgs hsArgs lbi = lbi {withPrograms = newWithPrograms }

37+ where newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)

38+ newWithPrograms = userSpecifyArgs "ghc" (hsArgs ++ map ("-optc" ++) cArgs) newWithPrograms1

36−canUseRDRAND :: FilePath -> IO Bool

40+checkRDRAND :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo

37−canUseRDRAND cc = do

41+checkRDRAND cc lbi = do

38− withTempDirectory normal "" "testRDRAND" $ \tmpDir -> do

42+ b <- compileCheck cc "testRDRAND" "Result of RDRAND Test: "

39− writeFile (tmpDir ++ "/testRDRAND.c")

40 (unlines [ "#include <stdint.h>"

43 (unlines [ "#include <stdint.h>"

41 , "int main() {"

44 , "int main() {"

42 , " uint64_t therand;"

45 , " uint64_t therand;"

@@ -46,9 +49,61 @@ canUseRDRAND cc = do

46 , " return (!err);"

49 , " return (!err);"

47 , "}"

50 , "}"

48 ])

51 ])

49− ec <- myRawSystemExitCode normal cc [tmpDir </> "testRDRAND.c", "-o", tmpDir ++ "/a.o","-c"]

52+ return $ if b then addOptions cArgs cArgs lbi else lbi

50− notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess)

53+ where cArgs = ["-DHAVE_RDRAND"]

51− return (ec == ExitSuccess)

54+

55+checkGetrandom :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo

56+checkGetrandom cc lbi = do

57+ libcGetrandom <- compileCheck cc "testLibcGetrandom" "Result of libc getrandom() Test: "

58+ (unlines [ "#define _GNU_SOURCE"

59+ , "#include <errno.h>"

60+ , "#include <sys/random.h>"

61+

62+ , "int main()"

63+ , "{"

64+ , " char tmp;"

65+ , " return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1;"

66+ , "}"

67+ ])

68+ if libcGetrandom then return $ addOptions cArgsLibc cArgsLibc lbi

69+ else do

70+ syscallGetrandom <- compileCheck cc "testSyscallGetrandom" "Result of syscall getrandom() Test: "

71+ (unlines [ "#define _GNU_SOURCE"

72+ , "#include <errno.h>"

73+ , "#include <unistd.h>"

74+ , "#include <sys/syscall.h>"

75+ , "#include <sys/types.h>"

76+ , "#include <linux/random.h>"

77+

78+ , "static ssize_t getrandom(void* buf, size_t buflen, unsigned int flags)"

79+ , "{"

80+ , " return syscall(SYS_getrandom, buf, buflen, flags);"

81+ , "}"

82+

83+ , "int main()"

84+ , "{"

85+ , " char tmp;"

86+ , " return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1;"

87+ , "}"

88+ ])

89+ return $ if syscallGetrandom then addOptions cArgs cArgs lbi else lbi

90+ where cArgs = ["-DHAVE_GETRANDOM"]

91+ cArgsLibc = cArgs ++ ["-DHAVE_LIBC_GETRANDOM"]

92+

93+checkGetentropy :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo

94+checkGetentropy cc lbi = do

95+ b <- compileCheck cc "testGetentropy" "Result of getentropy() Test: "

96+ (unlines [ "#define _GNU_SOURCE"

97+ , "#include <unistd.h>"

98+

99+ , "int main()"

100+ , "{"

101+ , " char tmp;"

102+ , " return getentropy(&tmp, sizeof(tmp));"

103+ , "}"

104+ ])

105+ return $ if b then addOptions cArgs cArgs lbi else lbi

106+ where cArgs = ["-DHAVE_GETENTROPY"]

107

53myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode

108myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode

54#if __GLASGOW_HASKELL__ >= 704

109#if __GLASGOW_HASKELL__ >= 704

System/EntropyNix.hs+52−7

@@ -16,13 +16,16 @@ module System.EntropyNix

16 , hardwareRandom

17 ) where

19+import Control.Exception

19import Control.Monad (liftM, when)

20import Control.Monad (liftM, when)

20import Data.ByteString as B

21import Data.ByteString as B

21import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)

22import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)

23+import System.IO.Unsafe

22import Data.Bits (xor)

24import Data.Bits (xor)

24import Foreign (allocaBytes)

26import Foreign (allocaBytes)

25import Foreign.Ptr

27import Foreign.Ptr

28+import Foreign.C.Error

26import Foreign.C.Types

29import Foreign.C.Types

27import Data.ByteString.Internal as B

30import Data.ByteString.Internal as B

@@ -39,6 +42,9 @@ source = "/dev/urandom"

39-- |Handle for manual resource management

42-- |Handle for manual resource management

40data CryptHandle

43data CryptHandle

41 = CH Fd

44 = CH Fd

45+#ifdef HAVE_GETRANDOM

46+ | UseGetRandom

47+#endif

43-- | Get random values from the hardward RNG or return Nothing if no

49-- | Get random values from the hardward RNG or return Nothing if no

44-- supported hardware RNG is available.

50-- supported hardware RNG is available.

@@ -50,8 +56,7 @@ hardwareRandom :: Int -> IO (Maybe B.ByteString)

50#ifdef HAVE_RDRAND

56#ifdef HAVE_RDRAND

51hardwareRandom n =

57hardwareRandom n =

52 do b <- cpuHasRdRand

58 do b <- cpuHasRdRand

53− if b

54− then Just <$> B.create n (\ptr ->

59+ if b then Just <$> B.create n (\ptr ->

55 do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)

60 do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)

56 when (r /= 0) (fail "RDRand failed to gather entropy"))

61 when (r /= 0) (fail "RDRand failed to gather entropy"))

57 else pure Nothing

62 else pure Nothing

@@ -61,18 +66,36 @@ hardwareRandom _ = pure Nothing

62-- |Open a `CryptHandle`

67-- |Open a `CryptHandle`

63openHandle :: IO CryptHandle

68openHandle :: IO CryptHandle

64−openHandle = do CH `fmap` nonRDRandHandle

69+openHandle =

65− where

70+#ifdef HAVE_GETRANDOM

66− nonRDRandHandle :: IO Fd

71+ if systemHasGetRandom then return UseGetRandom else

72+#endif

73+ fmap CH openRandomFile

74+

75+openRandomFile :: IO Fd

76+openRandomFile = do

77+ evaluate ensurePoolInitialized

67− nonRDRandHandle = openFd source ReadOnly Nothing defaultFileFlags

78+ openFd source ReadOnly Nothing defaultFileFlags

69-- |Close the `CryptHandle`

80-- |Close the `CryptHandle`

70closeHandle :: CryptHandle -> IO ()

81closeHandle :: CryptHandle -> IO ()

71closeHandle (CH h) = closeFd h

82closeHandle (CH h) = closeFd h

83+#ifdef HAVE_GETRANDOM

84+closeHandle UseGetRandom = return ()

85+#endif

73-- |Read random data from a `CryptHandle`

87-- |Read random data from a `CryptHandle`

74hGetEntropy :: CryptHandle -> Int -> IO B.ByteString

88hGetEntropy :: CryptHandle -> Int -> IO B.ByteString

75−hGetEntropy (CH h) = fdReadBS h

89+hGetEntropy (CH h) n = fdReadBS h n

90+#ifdef HAVE_GETRANDOM

91+hGetEntropy UseGetRandom n = do

92+ bs <- B.createUptoN n (\ptr -> do

93+ r <- c_entropy_getrandom (castPtr ptr) (fromIntegral n)

94+ return $ if r == 0 then n else 0)

95+ if B.length bs == n then return bs

96+ -- getrandom somehow failed. Fall back on /dev/urandom instead.

97+ else bracket openRandomFile closeFd $ flip fdReadBS n

98+#endif

77fdReadBS :: Fd -> Int -> IO B.ByteString

100fdReadBS :: Fd -> Int -> IO B.ByteString

78fdReadBS fd n =

101fdReadBS fd n =

@@ -86,6 +109,28 @@ fdReadBS fd n =

86 n' -> go buf (cnt - fromIntegral n')

109 n' -> go buf (cnt - fromIntegral n')

87 go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!"

110 go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!"

111

112+#ifdef HAVE_GETRANDOM

113+foreign import ccall unsafe "system_has_getrandom"

114+ c_system_has_getrandom :: IO CInt

115+foreign import ccall safe "entropy_getrandom"

116+ c_entropy_getrandom :: Ptr CUChar -> CSize -> IO CInt

117+

118+-- NOINLINE and unsafePerformIO are not totally necessary as getrandom will be

119+-- consistently either present or not, but it is cheaper not to check multiple

120+-- times.

121+systemHasGetRandom :: Bool

122+{-# NOINLINE systemHasGetRandom #-}

123+systemHasGetRandom = unsafePerformIO $ fmap (/= 0) c_system_has_getrandom

124+#endif

125+

126+foreign import ccall safe "ensure_pool_initialized"

127+ c_ensure_pool_initialized :: IO CInt

128+

129+-- Similarly to systemHasGetRandom, NOINLINE is just an optimization.

130+ensurePoolInitialized :: CInt

131+{-# NOINLINE ensurePoolInitialized #-}

132+ensurePoolInitialized = unsafePerformIO $ throwErrnoIfMinus1 "ensurePoolInitialized" $ c_ensure_pool_initialized

133+

89#ifdef HAVE_RDRAND

134#ifdef HAVE_RDRAND

90foreign import ccall unsafe "cpu_has_rdrand"

135foreign import ccall unsafe "cpu_has_rdrand"

91 c_cpu_has_rdrand :: IO CInt

136 c_cpu_has_rdrand :: IO CInt

cbits/getrandom.cnew file+52

@@ -0,0 +1,52 @@

1+#ifdef HAVE_GETRANDOM

3+#define _GNU_SOURCE

4+#include <errno.h>

6+#ifdef HAVE_LIBC_GETRANDOM

7+#include <sys/random.h>

8+#else

10+#include <unistd.h>

11+#include <sys/syscall.h>

12+#include <sys/types.h>

13+#include <linux/random.h>

14+

15+#ifndef SYS_getrandom

16+#define SYS_getrandom __NR_getrandom

17+#endif

18+

19+static ssize_t getrandom(void* buf, size_t buflen, unsigned int flags)

20+{

21+ return syscall(SYS_getrandom, buf, buflen, flags);

22+}

23+

24+#endif

25+

26+int system_has_getrandom()

27+{

28+ char tmp;

29+ return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1 || errno != ENOSYS;

30+}

31+

32+// Returns 0 on success, non-zero on failure.

33+int entropy_getrandom(unsigned char* buf, size_t len)

34+{

35+ while (len) {

36+ ssize_t bytes_read = getrandom(buf, len, 0);

37+

38+ if (bytes_read == -1) {

39+ if (errno != EINTR)

40+ return -1;

41+ else

42+ continue;

43+ }

44+

45+ len -= bytes_read;

46+ buf += bytes_read;

47+ }

48+

49+ return 0;

50+}

51+

52+#endif

cbits/random_initialized.cnew file+54

@@ -0,0 +1,54 @@

1+#define _GNU_SOURCE

2+#include <errno.h>

3+#include <fcntl.h>

4+#include <poll.h>

5+#include <sys/stat.h>

6+#include <unistd.h>

8+#ifdef HAVE_GETENTROPY

9+static int ensure_pool_initialized_getentropy()

10+{

11+ char tmp;

12+ return getentropy(&tmp, sizeof(tmp));

13+}

14+#endif

15+

16+// Poll /dev/random to wait for randomness. This is a proxy for the /dev/urandom

17+// pool being initialized.

18+static int ensure_pool_initialized_poll()

19+{

20+ struct pollfd pfd;

21+ int dev_random = open("/dev/random", O_RDONLY);

22+ if (dev_random == -1)

23+ return -1;

24+

25+ pfd.fd = dev_random;

26+ pfd.events = POLLIN;

27+ pfd.revents = 0;

28+

29+ while (1) {

30+ int ret = poll(&pfd, 1, -1);

31+ if (ret < 0 && (errno == EAGAIN || errno == EINTR))

32+ continue;

33+ if (ret != 1) {

34+ close(dev_random);

35+ errno = EIO;

36+ return -1;

37+ }

38+

39+ break;

40+ }

41+

42+ return close(dev_random);

43+}

44+

45+// Returns 0 on success, non-zero on failure.

46+int ensure_pool_initialized()

47+{

48+#ifdef HAVE_GETENTROPY

49+ if (ensure_pool_initialized_getentropy() == 0)

50+ return 0;

51+#endif

52+

53+ return ensure_pool_initialized_poll();

54+}

entropy.cabal+3−2

@@ -23,7 +23,7 @@ build-type: Custom

23cabal-version: >=1.10

24tested-with: GHC == 8.2.2

25-- data-files:

26−extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md

26+extra-source-files: ./cbits/getrandom.c ./cbits/random_initialized.c ./cbits/rdrand.c, ./cbits/rdrand.h, README.md

28-- Notice to compile with HaLVM the above 'build-type' must be changed

29-- to 'Simple' instead of 'Custom'. The current build system naively

@@ -60,7 +60,7 @@ library

60 build-depends: base >= 4.8 && < 5, bytestring

62 default-language: Haskell2010

63−

63+

64 if impl(ghcjs) {

65 build-depends: ghcjs-dom

66 , jsaddle

@@ -86,6 +86,7 @@ library

86 else

87 if !os(halvm)

88 Build-Depends: unix

89+ c-sources: cbits/getrandom.c cbits/random_initialized.c

89 }

90 }