git.iko.soy/typeable/entropy
on main help sign in
14 files changed+1041−283
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+264 .gitignore+2 README.md+41−3 Setup.hs+101−17 System/Entropy.hs+55−228 System/EntropyGhcjs.hs+51 System/EntropyNix.hs+147 System/EntropyWindows.hs+140 cabal.haskell-ci+3 cbits/getrandom.c+52 cbits/random_initialized.c+58 cbits/rdrand.c+45−1 cbits/rdrand.h−2 entropy.cabal+82−32
.github/workflows/haskell-ci.ymlnew file+264
@@ -0,0 +1,264 @@
1+# This GitHub workflow config has been generated by a script via
2+#
3+# haskell-ci 'github' 'entropy.cabal'
4+#
5+# To regenerate the script (for example after adjusting tested-with) run
6+#
7+# haskell-ci regenerate
8+#
9+# For more information, see https://github.com/andreasabel/haskell-ci
10+#
11+# version: 0.19.20241219
12+#
13+# REGENDATA ("0.19.20241219",["github","entropy.cabal"])
14+#
15+name: Haskell-CI
16+on:
17+ push:
18+ branches:
19+ - main
20+ pull_request:
21+ branches:
22+ - main
23+jobs:
24+ linux:
25+ name: Haskell-CI - Linux - ${{ matrix.compiler }}
26+ runs-on: ubuntu-20.04
27+ timeout-minutes:
28+ 60
29+ container:
30+ image: buildpack-deps:jammy
31+ continue-on-error: ${{ matrix.allow-failure }}
32+ strategy:
33+ matrix:
34+ include:
35+ - compiler: ghc-9.12.1
36+ compilerKind: ghc
37+ compilerVersion: 9.12.1
38+ setup-method: ghcup
39+ allow-failure: false
40+ - compiler: ghc-9.10.1
41+ compilerKind: ghc
42+ compilerVersion: 9.10.1
43+ setup-method: ghcup
44+ allow-failure: false
45+ - compiler: ghc-9.8.4
46+ compilerKind: ghc
47+ compilerVersion: 9.8.4
48+ setup-method: ghcup
49+ allow-failure: false
50+ - compiler: ghc-9.6.6
51+ compilerKind: ghc
52+ compilerVersion: 9.6.6
53+ setup-method: ghcup
54+ allow-failure: false
55+ - compiler: ghc-9.4.8
56+ compilerKind: ghc
57+ compilerVersion: 9.4.8
58+ setup-method: ghcup
59+ allow-failure: false
60+ - compiler: ghc-9.2.8
61+ compilerKind: ghc
62+ compilerVersion: 9.2.8
63+ setup-method: ghcup
64+ allow-failure: false
65+ - compiler: ghc-9.0.2
66+ compilerKind: ghc
67+ compilerVersion: 9.0.2
68+ setup-method: ghcup
69+ allow-failure: false
70+ - compiler: ghc-8.10.7
71+ compilerKind: ghc
72+ compilerVersion: 8.10.7
73+ setup-method: ghcup
74+ allow-failure: false
75+ - compiler: ghc-8.8.4
76+ compilerKind: ghc
77+ compilerVersion: 8.8.4
78+ setup-method: ghcup
79+ allow-failure: false
80+ - compiler: ghc-8.6.5
81+ compilerKind: ghc
82+ compilerVersion: 8.6.5
83+ setup-method: ghcup
84+ allow-failure: false
85+ - compiler: ghc-8.4.4
86+ compilerKind: ghc
87+ compilerVersion: 8.4.4
88+ setup-method: ghcup
89+ allow-failure: false
90+ - compiler: ghc-8.2.2
91+ compilerKind: ghc
92+ compilerVersion: 8.2.2
93+ setup-method: ghcup
94+ allow-failure: false
95+ fail-fast: false
96+ steps:
97+ - name: apt-get install
98+ run: |
99+ apt-get update
100+ apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev
101+ - name: Install GHCup
102+ run: |
103+ mkdir -p "$HOME/.ghcup/bin"
104+ curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup"
105+ chmod a+x "$HOME/.ghcup/bin/ghcup"
106+ - name: Install cabal-install (prerelease)
107+ run: |
108+ "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml;
109+ "$HOME/.ghcup/bin/ghcup" install cabal 3.15.0.0.2024.10.3 || (cat "$HOME"/.ghcup/logs/*.* && false)
110+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.15.0.0.2024.10.3 -vnormal+nowrap" >> "$GITHUB_ENV"
111+ - name: Install GHC (GHCup)
112+ if: matrix.setup-method == 'ghcup'
113+ run: |
114+ "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
115+ HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
116+ HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
117+ HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
118+ echo "HC=$HC" >> "$GITHUB_ENV"
119+ echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
120+ echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
121+ env:
122+ HCKIND: ${{ matrix.compilerKind }}
123+ HCNAME: ${{ matrix.compiler }}
124+ HCVER: ${{ matrix.compilerVersion }}
125+ - name: Set PATH and environment variables
126+ run: |
127+ echo "$HOME/.cabal/bin" >> $GITHUB_PATH
128+ echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
129+ echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
130+ echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
131+ HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
132+ echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
133+ echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
134+ echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
135+ if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi
136+ echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
137+ env:
138+ HCKIND: ${{ matrix.compilerKind }}
139+ HCNAME: ${{ matrix.compiler }}
140+ HCVER: ${{ matrix.compilerVersion }}
141+ - name: env
142+ run: |
143+ env
144+ - name: write cabal config
145+ run: |
146+ mkdir -p $CABAL_DIR
147+ cat >> $CABAL_CONFIG <<EOF
148+ remote-build-reporting: anonymous
149+ write-ghc-environment-files: never
150+ remote-repo-cache: $CABAL_DIR/packages
151+ logs-dir: $CABAL_DIR/logs
152+ world-file: $CABAL_DIR/world
153+ extra-prog-path: $CABAL_DIR/bin
154+ symlink-bindir: $CABAL_DIR/bin
155+ installdir: $CABAL_DIR/bin
156+ build-summary: $CABAL_DIR/logs/build.log
157+ store-dir: $CABAL_DIR/store
158+ install-dirs user
159+ prefix: $CABAL_DIR
160+ repository hackage.haskell.org
161+ url: http://hackage.haskell.org/
162+ EOF
163+ if $HEADHACKAGE; then
164+ cat >> $CABAL_CONFIG <<EOF
165+ repository head.hackage.ghc.haskell.org
166+ url: https://ghc.gitlab.haskell.org/head.hackage/
167+ secure: True
168+ root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d
169+ 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329
170+ f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89
171+ key-threshold: 3
172+ active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override
173+ EOF
174+ fi
175+ cat >> $CABAL_CONFIG <<EOF
176+ program-default-options
177+ ghc-options: $GHCJOBS +RTS -M3G -RTS
178+ EOF
179+ cat $CABAL_CONFIG
180+ - name: versions
181+ run: |
182+ $HC --version || true
183+ $HC --print-project-git-commit-id || true
184+ $CABAL --version || true
185+ - name: update cabal index
186+ run: |
187+ $CABAL v2-update -v
188+ - name: install cabal-plan
189+ run: |
190+ mkdir -p $HOME/.cabal/bin
191+ curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
192+ echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
193+ xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
194+ rm -f cabal-plan.xz
195+ chmod a+x $HOME/.cabal/bin/cabal-plan
196+ cabal-plan --version
197+ - name: checkout
198+ uses: actions/checkout@v4
199+ with:
200+ path: source
201+ - name: initial cabal.project for sdist
202+ run: |
203+ touch cabal.project
204+ echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
205+ cat cabal.project
206+ - name: sdist
207+ run: |
208+ mkdir -p sdist
209+ $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
210+ - name: unpack
211+ run: |
212+ mkdir -p unpacked
213+ find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
214+ - name: generate cabal.project
215+ run: |
216+ PKGDIR_entropy="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/entropy-[0-9.]*')"
217+ echo "PKGDIR_entropy=${PKGDIR_entropy}" >> "$GITHUB_ENV"
218+ rm -f cabal.project cabal.project.local
219+ touch cabal.project
220+ touch cabal.project.local
221+ echo "packages: ${PKGDIR_entropy}" >> cabal.project
222+ echo "package entropy" >> cabal.project
223+ echo " ghc-options: -Werror=missing-methods" >> cabal.project
224+ cat >> cabal.project <<EOF
225+ EOF
226+ if $HEADHACKAGE; then
227+ echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> cabal.project
228+ fi
229+ $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(entropy)$/; }' >> cabal.project.local
230+ cat cabal.project
231+ cat cabal.project.local
232+ - name: dump install plan
233+ run: |
234+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
235+ cabal-plan
236+ - name: restore cache
237+ uses: actions/cache/restore@v4
238+ with:
239+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
240+ path: ~/.cabal/store
241+ restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
242+ - name: install dependencies
243+ run: |
244+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
245+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
246+ - name: build w/o tests
247+ run: |
248+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
249+ - name: build
250+ run: |
251+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
252+ - name: haddock
253+ run: |
254+ $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
255+ - name: unconstrained build
256+ run: |
257+ rm -f cabal.project.local
258+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
259+ - name: save cache
260+ if: always()
261+ uses: actions/cache/save@v4
262+ with:
263+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
264+ path: ~/.cabal/store
.gitignorenew file+2
@@ -0,0 +1,2 @@
1+dist
2+dist-newstyle
README.md+41−3
@@ -1,7 +1,45 @@
11# Introduction
22
3−This package allows Haskell users to easily acquire entropy for use in
4−critical security applications by calling out to either windows crypto api,
5−unix/linux's `/dev/urandom`, or the RDRAND instruction.
3+This package allows Haskell users to easily acquire entropy for use in critical
4+security applications by calling out to either windows crypto api, unix/linux's
5+`getrandom` and `/dev/urandom`. Hardware RNGs (currently RDRAND, patches
6+welcome) are supported via the `hardwareRNG` function.
7+
8+## Quick Start
9+
10+To simply get random bytes use `getEntropy`:
11+
12+```
13+#!/usr/bin/env cabal
14+{- cabal:
15+ build-depends: base, entropy, bytestring
16+-}
17+import qualified Data.ByteString as BS
18+import System.Entropy
19+
20+main :: IO ()
21+main = print . BS.unpack =<< getEntropy 16
22+-- Example output: [241,191,215,193,225,27,121,244,16,155,252,41,131,38,6,100]
23+```
24+
25+## Faster Randoms from Hardware
26+
27+Most x86 systems include a hardware random number generator. These can be
28+faster but require more trust in the platform:
29+
30+```
31+import qualified Data.ByteString as B
32+import System.Entropy
33+
34+eitherRNG :: Int -> IO B.ByteString
35+eitherRNG sz = maybe (getEntropy sz) pure =<< getHardwareEntropy sz
36+
37+main :: IO ()
38+main = print . B.unpack =<< eitherRNG 32
39+```
640
741This package supports Windows, {li,u}nix, QNX, and has preliminary support for HaLVM.
42+
43+Typically tested on Linux and OSX - testers are as welcome as patches.
44+
45+[![Build Status](https://travis-ci.org/TomMD/entropy.svg?branch=master)](https://travis-ci.org/TomMD/entropy)
Setup.hs+101−17
@@ -1,3 +1,5 @@
1+{-# LANGUAGE CPP #-}
2+import Control.Monad
13import Distribution.Simple
24import Distribution.Simple.LocalBuildInfo
35import Distribution.Simple.Setup
@@ -9,32 +11,35 @@ import System.Process
911import System.Directory
1012import System.FilePath
1113import System.Exit
14+import System.IO
1215
1316main = defaultMainWithHooks hk
1417 where
1518 hk = simpleUserHooks { buildHook = \pd lbi uh bf -> do
1619 -- let ccProg = Program "gcc" undefined undefined undefined
17− let hcProg = Program "ghc" undefined undefined undefined
18− mConf = lookupProgram hcProg (withPrograms lbi)
20+ let mConf = lookupProgram ghcProgram (withPrograms lbi)
1921 err = error "Could not determine C compiler"
2022 cc = locationPath . programLocation . maybe err id $ mConf
21− b <- canUseRDRAND cc
22− let newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi)
23− newWithPrograms = userSpecifyArgs "ghc" cArgsHC newWithPrograms1
24− lbiNew = if b then (lbi {withPrograms = newWithPrograms }) else lbi
23+ lbiNew <- checkRDRAND cc lbi >>= checkGetrandom cc >>= checkGetentropy cc
2524 buildHook simpleUserHooks pd lbiNew uh bf
2625 }
2726
28−cArgs :: [String]
29−cArgs = ["-DHAVE_RDRAND"]
27+compileCheck :: FilePath -> String -> String -> String -> IO Bool
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)
3034
31−cArgsHC :: [String]
32−cArgsHC = map ("-optc" ++) cArgs
35+addOptions :: [String] -> [String] -> LocalBuildInfo -> LocalBuildInfo
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
3339
34−canUseRDRAND :: FilePath -> IO Bool
35−canUseRDRAND cc = do
36− withTempDirectory normal "" "testRDRAND" $ \tmpDir -> do
37− writeFile (tmpDir ++ "/testRDRAND.c")
40+checkRDRAND :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo
41+checkRDRAND cc lbi = do
42+ b <- compileCheck cc "testRDRAND" "Result of RDRAND Test: "
3843 (unlines [ "#include <stdint.h>"
3944 , "int main() {"
4045 , " uint64_t therand;"
@@ -44,6 +49,85 @@ canUseRDRAND cc = do
4449 , " return (!err);"
4550 , "}"
4651 ])
47− ec <- rawSystemExitCode normal cc [tmpDir </> "testRDRAND.c", "-o", tmpDir ++ "/a.o","-c"]
48− notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess)
49− return (ec == ExitSuccess)
52+ return $ if b then addOptions cArgs cArgs lbi else lbi
53+ where cArgs = ["-DHAVE_RDRAND"]
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+
108+myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode
109+#if MIN_VERSION_Cabal(3,14,0)
110+myRawSystemExitCode verbosity program arguments =
111+ rawSystemExitCode verbosity Nothing program arguments Nothing
112+#elif __GLASGOW_HASKELL__ >= 704
113+-- We know for sure, that if GHC >= 7.4 implies Cabal >= 1.14
114+myRawSystemExitCode = rawSystemExitCode
115+#else
116+-- Legacy branch:
117+-- We implement our own 'rawSystemExitCode', this will even work if
118+-- the user happens to have Cabal >= 1.14 installed with GHC 7.0 or
119+-- 7.2
120+myRawSystemExitCode verbosity path args = do
121+ printRawCommandAndArgs verbosity path args
122+ hFlush stdout
123+ exitcode <- rawSystem path args
124+ unless (exitcode == ExitSuccess) $ do
125+ debug verbosity $ path ++ " returned " ++ show exitcode
126+ return exitcode
127+ where
128+ printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO ()
129+ printRawCommandAndArgs verbosity path args
130+ | verbosity >= deafening = print (path, args)
131+ | verbosity >= verbose = putStrLn $ unwords (path : args)
132+ | otherwise = return ()
133+#endif
System/Entropy.hs+55−228
@@ -8,242 +8,69 @@
88
99 Currently supporting:
1010
11− - Windows via CryptoAPO
11+ - Windows via CryptoAPI
1212 - *nix systems via @\/dev\/urandom@
13− - QNX
14− - Xen only when RDRAND is available.
13+ - Includes QNX
14+ - ghcjs/browser via JavaScript crypto API.
1515-}
1616
1717module System.Entropy
18− ( getEntropy
19− , CryptHandle
20− , openHandle
21− , hGetEntropy
22− , closeHandle
18+ ( getEntropy,
19+ getHardwareEntropy,
20+ CryptHandle,
21+ openHandle,
22+ hGetEntropy,
23+ closeHandle
2324 ) where
2425
25−import Control.Monad (liftM, when)
26−import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
27−import Foreign (allocaBytes)
28−import Data.ByteString as B
29−
30−#if defined(isWindows)
31−{- C example for windows rng - taken from a blog, can't recall which one but thank you!
32− #include <Windows.h>
33− #include <Wincrypt.h>
34− ...
35− //
36− // DISCLAIMER: Don't forget to check your error codes!!
37− // I am not checking as to make the example simple...
38− //
39− HCRYPTPROV hCryptCtx = NULL;
40− BYTE randomArray[128];
41−
42− CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
43− CryptGenRandom(hCryptCtx, 128, randomArray);
44− CryptReleaseContext(hCryptCtx, 0);
45−-}
46−
47−import Data.ByteString.Internal as BI
48−import Data.Int (Int32)
49−import Data.Word (Word32, Word8)
50−import Foreign.C.String (CString, withCString)
51−import Foreign.C.Types
52−import Foreign.Ptr (Ptr, nullPtr, castPtr)
53−import Foreign.Marshal.Alloc (alloca)
54−import Foreign.Marshal.Utils (toBool)
55−import Foreign.Storable (peek)
56−
57−#ifdef HAVE_RDRAND
58−foreign import ccall unsafe "cpu_has_rdrand"
59− c_cpu_has_rdrand :: IO CInt
60−
61−foreign import ccall unsafe "get_rand_bytes"
62− c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
63−
64−cpuHasRdRand :: IO Bool
65−cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
66−#endif
67−
68−data CryptHandle
69− = CH Word32
70−#ifdef HAVE_RDRAND
71− | UseRdRand
72−#endif
73−
74−-- Define the constants we need from WinCrypt.h
75−msDefProv :: String
76−msDefProv = "Microsoft Base Cryptographic Provider v1.0"
77−provRSAFull :: Word32
78−provRSAFull = fromIntegral 1
79−cryptVerifyContext :: Word32
80−cryptVerifyContext = fromIntegral 0xF0000000
81−
82−-- Declare the required CryptoAPI imports
83−foreign import stdcall unsafe "CryptAcquireContextA"
84− c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
85−foreign import stdcall unsafe "CryptGenRandom"
86− c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
87−foreign import stdcall unsafe "CryptReleaseContext"
88− c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
89−
90−cryptAcquireCtx :: IO Word32
91−cryptAcquireCtx =
92− alloca $ \handlePtr ->
93− withCString msDefProv $ \provName -> do
94− stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
95− if (toBool stat)
96− then peek handlePtr
97− else fail "c_cryptAcquireCtx"
98−
99−cryptGenRandom :: Word32 -> Int -> IO B.ByteString
100−cryptGenRandom h i =
101− BI.create i $ \c_buffer -> do
102− stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
103− if (toBool stat)
104− then return ()
105− else fail "c_cryptGenRandom"
106−
107−cryptReleaseCtx :: Word32 -> IO ()
108−cryptReleaseCtx h = do
109− stat <- c_cryptReleaseCtx h 0
110− if (toBool stat)
111− then return ()
112− else fail "c_cryptReleaseCtx"
113−
114−-- |Inefficiently get a specific number of bytes of cryptographically
115−-- secure random data using the system-specific facilities.
116−--
117−-- This function will return zero bytes
118−-- on platforms without a secure RNG!
119−getEntropy :: Int -> IO B.ByteString
120−getEntropy n = do
121−#ifdef HAVE_RDRAND
122− b <- cpuHasRdRand
123− if b then hGetEntropy UseRdRand n
124− else do
125−#endif
126− h <- cryptAcquireCtx
127− bs <- cryptGenRandom h n
128− let !bs' = bs
129− cryptReleaseCtx h
130− return bs'
131−
132−-- |Open a handle from which random data can be read
133−openHandle :: IO CryptHandle
134−openHandle = do
135−#ifdef HAVE_RDRAND
136− b <- cpuHasRdRand
137− if b then return UseRdRand
138− else do
139−#endif
140− liftM CH cryptAcquireCtx
141−
142−-- |Close the `CryptHandle`
143−closeHandle (CH h) = cryptReleaseCtx h
144−
145−-- |Read from `CryptHandle`
146−hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
147−hGetEntropy (CH h) n = cryptGenRandom h n
148−#ifdef HAVE_RDRAND
149−hGetEntropy UseRdRand n =
150− B.create n $ \ptr -> do
151− r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
152− when (r /= 0)
153− (fail "RDRand failed to gather entropy")
154−#endif
155−
156−#else
157−{- Not windows, assuming nix with a /dev/urandom -}
158−import Foreign.Ptr
159−import Foreign.C.Types
160−import Data.ByteString.Internal as B
161−#ifdef XEN
162−data CryptHandle = UseRdRand -- or die trying
163−#else
164−import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
165−
166−source :: FilePath
167−source = "/dev/urandom"
168−
169−-- |Handle for manual resource mangement
170−data CryptHandle
171− = CH Fd
172−#ifdef HAVE_RDRAND
173− | UseRdRand
174−#endif
175−#endif
176−
177−-- |Open a `CryptHandle`
178−openHandle :: IO CryptHandle
179−openHandle = do
180−#ifdef HAVE_RDRAND
181− b <- cpuHasRdRand
182− if b then return UseRdRand
183− else do
184−#endif
185−#ifdef XEN
186− error "entropy: On halvm there is no entropy other than RDRAND."
187−#else
188− liftM CH (openFd source ReadOnly Nothing defaultFileFlags)
189−#endif
190−
191−-- |Close the `CryptHandle`
192−closeHandle :: CryptHandle -> IO ()
193−#ifndef XEN
194−closeHandle (CH h) = closeFd h
195−#endif
196−#ifdef HAVE_RDRAND
197−closeHandle UseRdRand = return ()
198−#endif
199−
200−#ifndef XEN
201−fdReadBS :: Fd -> Int -> IO B.ByteString
202−fdReadBS fd n = do
203− allocaBytes n $ \buf -> do
204− rc <- fdReadBuf fd buf (fromIntegral n)
205− case rc of
206− 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
207− n' -> B.packCStringLen (castPtr buf, fromIntegral n')
208−#endif
209−
210−-- |Read random data from a `CryptHandle`
211−hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
212−#ifndef XEN
213−hGetEntropy (CH h) = fdReadBS h
26+#ifdef ghcjs_HOST_OS
27+import System.EntropyGhcjs
28+#elif defined(isWindows)
29+import System.EntropyWindows
21430#else
215−#ifdef HAVE_RDRAND
216−hGetEntropy UseRdRand = \n -> do
217− B.create n $ \ptr -> do
218− r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
219− when (r /= 0)
220− (fail "RDRand failed to gather entropy")
221−#endif
31+import System.EntropyNix
22232#endif
223−{- XEN -}
22433
225−#ifdef HAVE_RDRAND
226−foreign import ccall unsafe "cpu_has_rdrand"
227− c_cpu_has_rdrand :: IO CInt
34+import qualified Data.ByteString as B
35+import Control.Exception (bracket)
22836
229−foreign import ccall unsafe "get_rand_bytes"
230− c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
231−
232−cpuHasRdRand :: IO Bool
233−cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
234−#endif
235−
236−-- |Inefficiently get a specific number of bytes of cryptographically
237−-- secure random data using the system-specific facilities.
37+-- |Get a specific number of bytes of cryptographically
38+-- secure random data using the *system-specific* sources.
39+-- (As of 0.4. Versions <0.4 mixed system and hardware sources)
23840--
239−-- Use '/dev/urandom' on *nix and CryptAPI when on Windows. In short,
240−-- this entropy is considered cryptographically secure but not true
241−-- entropy.
242−getEntropy :: Int -> IO B.ByteString
243−getEntropy n = do
244− h <- openHandle
245− e <- hGetEntropy h n
246− closeHandle h
247− return e
248−#endif
249−{- OS Test -}
41+-- The returned random value is considered cryptographically secure but not true entropy.
42+--
43+-- On some platforms this requires a file handle which can lead to resource
44+-- exhaustion in some situations.
45+getEntropy :: Int -- ^ Number of bytes
46+ -> IO B.ByteString
47+getEntropy = bracket openHandle closeHandle . flip hGetEntropy
48+
49+-- |Get a specific number of bytes of cryptographically
50+-- secure random data using a supported *hardware* random bit generator.
51+--
52+-- If there is no hardware random number generator then @Nothing@ is returned.
53+-- If any call returns non-Nothing then it should never be @Nothing@ unless
54+-- there has been a hardware failure.
55+--
56+-- If trust of the CPU allows it and no context switching is important,
57+-- a bias to the hardware rng with system rng as fall back is trivial:
58+--
59+-- @
60+-- let fastRandom nr = maybe (getEntropy nr) pure =<< getHardwareEntropy nr
61+-- @
62+--
63+-- The old, @<0.4@, behavior is possible using @xor@ from 'Data.Bits':
64+--
65+-- @
66+-- let oldRandom nr =
67+-- do hwRnd <- maybe (replicate nr 0) BS.unpack <$> getHardwareEntropy nr
68+-- sysRnd <- BS.unpack <$> getEntropy nr
69+-- pure $ BS.pack $ zipWith xor sysRnd hwRnd
70+-- @
71+--
72+-- A less maliable mixing can be accomplished by replacing `xor` with a
73+-- composition of concat and cryptographic hash.
74+getHardwareEntropy :: Int -- ^ Number of bytes
75+ -> IO (Maybe B.ByteString)
76+getHardwareEntropy = hardwareRandom
System/EntropyGhcjs.hsnew file+51
@@ -0,0 +1,51 @@
1+{-|
2+ Maintainer: Thomas.DuBuisson@gmail.com
3+ Stability: beta
4+ Portability: portable
5+
6+ Obtain entropy from system sources or x86 RDRAND when available.
7+
8+-}
9+
10+module System.EntropyGhcjs
11+ ( CryptHandle
12+ , openHandle
13+ , hGetEntropy
14+ , closeHandle
15+ , hardwareRandom
16+ ) where
17+
18+import Data.ByteString as B
19+import GHCJS.DOM.Crypto as Crypto
20+import GHCJS.DOM.Types (ArrayBufferView (..), fromJSValUnchecked)
21+import GHCJS.DOM.GlobalCrypto (getCrypto)
22+import GHCJS.DOM (globalThisUnchecked)
23+import Language.Javascript.JSaddle.Object as JS
24+
25+
26+-- |Handle for manual resource management
27+newtype CryptHandle = CH Crypto
28+
29+-- | Get random values from the hardware RNG or return Nothing if no
30+-- supported hardware RNG is available.
31+--
32+-- Not supported on ghcjs.
33+hardwareRandom :: Int -> IO (Maybe B.ByteString)
34+hardwareRandom _ = pure Nothing
35+
36+-- |Open a `CryptHandle`
37+openHandle :: IO CryptHandle
38+openHandle = do
39+ this <- globalThisUnchecked
40+ CH <$> getCrypto this
41+
42+-- |Close the `CryptHandle`
43+closeHandle :: CryptHandle -> IO ()
44+closeHandle _ = pure ()
45+
46+-- |Read random data from a `CryptHandle`
47+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
48+hGetEntropy (CH h) n = do
49+ arr <- JS.new (jsg "Int8Array") [n]
50+ getRandomValues_ h (ArrayBufferView arr)
51+ B.pack <$> fromJSValUnchecked arr
System/EntropyNix.hsnew file+147
@@ -0,0 +1,147 @@
1+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}
2+{-|
3+ Maintainer: Thomas.DuBuisson@gmail.com
4+ Stability: beta
5+ Portability: portable
6+
7+ Obtain entropy from system sources or x86 RDRAND when available.
8+
9+-}
10+
11+module System.EntropyNix
12+ ( CryptHandle
13+ , openHandle
14+ , hGetEntropy
15+ , closeHandle
16+ , hardwareRandom
17+ ) where
18+
19+import Control.Exception
20+import Control.Monad (liftM, when)
21+import Data.ByteString as B
22+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
23+import System.IO.Unsafe
24+import Data.Bits (xor)
25+
26+import Foreign (allocaBytes)
27+import Foreign.Ptr
28+import Foreign.C.Error
29+import Foreign.C.Types
30+import Data.ByteString.Internal as B
31+
32+#ifdef arch_i386
33+-- See .cabal wrt GCC 4.8.2 asm compilation bug
34+#undef HAVE_RDRAND
35+#endif
36+
37+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd, OpenFileFlags(..))
38+
39+source :: FilePath
40+source = "/dev/urandom"
41+
42+-- |Handle for manual resource management
43+data CryptHandle
44+ = CH Fd
45+#ifdef HAVE_GETRANDOM
46+ | UseGetRandom
47+#endif
48+
49+-- | Get random values from the hardware RNG or return Nothing if no
50+-- supported hardware RNG is available.
51+--
52+-- Supported hardware:
53+-- * RDRAND
54+-- * Patches welcome
55+hardwareRandom :: Int -> IO (Maybe B.ByteString)
56+#ifdef HAVE_RDRAND
57+hardwareRandom n =
58+ do b <- cpuHasRdRand
59+ if b then Just <$> B.create n (\ptr ->
60+ do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
61+ when (r /= 0) (fail "RDRand failed to gather entropy"))
62+ else pure Nothing
63+#else
64+hardwareRandom _ = pure Nothing
65+#endif
66+
67+-- |Open a `CryptHandle`
68+openHandle :: IO CryptHandle
69+openHandle =
70+#ifdef HAVE_GETRANDOM
71+ if systemHasGetRandom then return UseGetRandom else
72+#endif
73+ fmap CH openRandomFile
74+
75+openRandomFile :: IO Fd
76+openRandomFile = do
77+ evaluate ensurePoolInitialized
78+#if MIN_VERSION_unix(2,8,0)
79+ openFd source ReadOnly defaultFileFlags { creat = Nothing }
80+#else
81+ openFd source ReadOnly Nothing defaultFileFlags
82+#endif
83+
84+-- |Close the `CryptHandle`
85+closeHandle :: CryptHandle -> IO ()
86+closeHandle (CH h) = closeFd h
87+#ifdef HAVE_GETRANDOM
88+closeHandle UseGetRandom = return ()
89+#endif
90+
91+-- |Read random data from a `CryptHandle`
92+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
93+hGetEntropy (CH h) n = fdReadBS h n
94+#ifdef HAVE_GETRANDOM
95+hGetEntropy UseGetRandom n = do
96+ bs <- B.createUptoN n (\ptr -> do
97+ r <- c_entropy_getrandom (castPtr ptr) (fromIntegral n)
98+ return $ if r == 0 then n else 0)
99+ if B.length bs == n then return bs
100+ -- getrandom somehow failed. Fall back on /dev/urandom instead.
101+ else bracket openRandomFile closeFd $ flip fdReadBS n
102+#endif
103+
104+fdReadBS :: Fd -> Int -> IO B.ByteString
105+fdReadBS fd n =
106+ allocaBytes n $ \buf -> go buf n
107+ where
108+ go buf 0 = B.packCStringLen (castPtr buf, fromIntegral n)
109+ go buf cnt | cnt <= n = do
110+ rc <- fdReadBuf fd (plusPtr buf (n - cnt)) (fromIntegral cnt)
111+ case rc of
112+ 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
113+ n' -> go buf (cnt - fromIntegral n')
114+ go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!"
115+
116+#ifdef HAVE_GETRANDOM
117+foreign import ccall unsafe "system_has_getrandom"
118+ c_system_has_getrandom :: IO CInt
119+foreign import ccall safe "entropy_getrandom"
120+ c_entropy_getrandom :: Ptr CUChar -> CSize -> IO CInt
121+
122+-- NOINLINE and unsafePerformIO are not totally necessary as getrandom will be
123+-- consistently either present or not, but it is cheaper not to check multiple
124+-- times.
125+systemHasGetRandom :: Bool
126+{-# NOINLINE systemHasGetRandom #-}
127+systemHasGetRandom = unsafePerformIO $ fmap (/= 0) c_system_has_getrandom
128+#endif
129+
130+foreign import ccall safe "ensure_pool_initialized"
131+ c_ensure_pool_initialized :: IO CInt
132+
133+-- Similarly to systemHasGetRandom, NOINLINE is just an optimization.
134+ensurePoolInitialized :: CInt
135+{-# NOINLINE ensurePoolInitialized #-}
136+ensurePoolInitialized = unsafePerformIO $ throwErrnoIfMinus1 "ensurePoolInitialized" $ c_ensure_pool_initialized
137+
138+#ifdef HAVE_RDRAND
139+foreign import ccall unsafe "cpu_has_rdrand"
140+ c_cpu_has_rdrand :: IO CInt
141+
142+foreign import ccall unsafe "get_rand_bytes"
143+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
144+
145+cpuHasRdRand :: IO Bool
146+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
147+#endif
System/EntropyWindows.hsnew file+140
@@ -0,0 +1,140 @@
1+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}
2+{-|
3+ Maintainer: Thomas.DuBuisson@gmail.com
4+ Stability: beta
5+ Portability: portable
6+
7+ Obtain entropy from system sources.
8+-}
9+
10+module System.EntropyWindows
11+ ( CryptHandle
12+ , openHandle
13+ , hGetEntropy
14+ , closeHandle
15+ , hardwareRandom
16+ ) where
17+
18+import Control.Monad (liftM, when)
19+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
20+import System.Win32.Types (ULONG_PTR, errorWin)
21+import Foreign (allocaBytes)
22+import Data.ByteString as B
23+import Data.ByteString.Internal as BI
24+import Data.Int (Int32)
25+import Data.Bits (xor)
26+import Data.Word (Word32, Word8)
27+import Foreign.C.String (CString, withCString)
28+import Foreign.C.Types
29+import Foreign.Ptr (Ptr, nullPtr, castPtr)
30+import Foreign.Marshal.Alloc (alloca)
31+import Foreign.Marshal.Utils (toBool)
32+import Foreign.Storable (peek)
33+
34+-- C example for windows rng - taken from a blog, can't recall which one but thank you!
35+-- #include <Windows.h>
36+-- #include <Wincrypt.h>
37+-- ...
38+-- //
39+-- // DISCLAIMER: Don't forget to check your error codes!!
40+-- // I am not checking as to make the example simple...
41+-- //
42+-- HCRYPTPROV hCryptCtx = NULL;
43+-- BYTE randomArray[128];
44+--
45+-- CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
46+-- CryptGenRandom(hCryptCtx, 128, randomArray);
47+-- CryptReleaseContext(hCryptCtx, 0);
48+
49+
50+#ifdef arch_i386
51+-- See .cabal wrt GCC 4.8.2 asm compilation bug
52+#undef HAVE_RDRAND
53+#endif
54+
55+#ifdef HAVE_RDRAND
56+foreign import ccall unsafe "cpu_has_rdrand"
57+ c_cpu_has_rdrand :: IO CInt
58+
59+foreign import ccall unsafe "get_rand_bytes"
60+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
61+
62+cpuHasRdRand :: IO Bool
63+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
64+#endif
65+
66+type HCRYPTPROV = ULONG_PTR
67+data CryptHandle
68+ = CH HCRYPTPROV
69+
70+
71+-- | Get random values from the hardware RNG or return Nothing if no
72+-- supported hardware RNG is available.
73+--
74+-- Supported hardware:
75+-- * RDRAND
76+-- * Patches welcome
77+hardwareRandom :: Int -> IO (Maybe B.ByteString)
78+#ifdef HAVE_RDRAND
79+hardwareRandom n =
80+ do b <- cpuHasRdRand
81+ if b
82+ then Just <$> BI.create n (\ptr ->
83+ do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
84+ when (r /= 0) (fail "RDRand failed to gather entropy"))
85+ else pure Nothing
86+#else
87+hardwareRandom _ = pure Nothing
88+#endif
89+
90+-- Define the constants we need from WinCrypt.h
91+msDefProv :: String
92+msDefProv = "Microsoft Base Cryptographic Provider v1.0"
93+provRSAFull :: Word32
94+provRSAFull = 1
95+cryptVerifyContext :: Word32
96+cryptVerifyContext = fromIntegral 0xF0000000
97+
98+-- Declare the required CryptoAPI imports
99+foreign import stdcall unsafe "CryptAcquireContextA"
100+ c_cryptAcquireCtx :: Ptr HCRYPTPROV -> CString -> CString -> Word32 -> Word32 -> IO Int32
101+foreign import stdcall unsafe "CryptGenRandom"
102+ c_cryptGenRandom :: HCRYPTPROV -> Word32 -> Ptr Word8 -> IO Int32
103+foreign import stdcall unsafe "CryptReleaseContext"
104+ c_cryptReleaseCtx :: HCRYPTPROV -> Word32 -> IO Int32
105+
106+cryptAcquireCtx :: IO HCRYPTPROV
107+cryptAcquireCtx =
108+ alloca $ \handlePtr ->
109+ withCString msDefProv $ \provName -> do
110+ stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext
111+ if (toBool stat)
112+ then peek handlePtr
113+ else errorWin "c_cryptAcquireCtx"
114+
115+cryptGenRandom :: HCRYPTPROV -> Int -> IO B.ByteString
116+cryptGenRandom h i =
117+ BI.create i $ \c_buffer -> do
118+ stat <- c_cryptGenRandom h (fromIntegral i) c_buffer
119+ if (toBool stat)
120+ then return ()
121+ else errorWin "c_cryptGenRandom"
122+
123+cryptReleaseCtx :: HCRYPTPROV -> IO ()
124+cryptReleaseCtx h = do
125+ stat <- c_cryptReleaseCtx h 0
126+ if (toBool stat)
127+ then return ()
128+ else errorWin "c_cryptReleaseCtx"
129+
130+-- |Open a handle from which random data can be read
131+openHandle :: IO CryptHandle
132+openHandle = CH `fmap` cryptAcquireCtx
133+
134+-- |Close the `CryptHandle`
135+closeHandle :: CryptHandle -> IO ()
136+closeHandle (CH h) = cryptReleaseCtx h
137+
138+-- |Read from `CryptHandle`
139+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
140+hGetEntropy (CH h) n = cryptGenRandom h n
cabal.haskell-cinew file+3
@@ -0,0 +1,3 @@
1+branches: main
2+cabal-check: False
3+haddock: >=8.2
cbits/getrandom.cnew file+52
@@ -0,0 +1,52 @@
1+#ifdef HAVE_GETRANDOM
2+
3+#define _GNU_SOURCE
4+#include <errno.h>
5+
6+#ifdef HAVE_LIBC_GETRANDOM
7+#include <sys/random.h>
8+#else
9+
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+58
@@ -0,0 +1,58 @@
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>
7+
8+#ifdef HAVE_GETENTROPY
9+#ifndef DO_NOT_USE_GET_ENTROPY
10+static int ensure_pool_initialized_getentropy()
11+{
12+ char tmp;
13+ return getentropy(&tmp, sizeof(tmp));
14+}
15+#endif
16+#endif
17+
18+// Poll /dev/random to wait for randomness. This is a proxy for the /dev/urandom
19+// pool being initialized.
20+static int ensure_pool_initialized_poll()
21+{
22+ struct pollfd pfd;
23+ int dev_random = open("/dev/random", O_RDONLY);
24+ if (dev_random == -1)
25+ return -1;
26+
27+ pfd.fd = dev_random;
28+ pfd.events = POLLIN;
29+ pfd.revents = 0;
30+
31+ while (1) {
32+ int ret = poll(&pfd, 1, -1);
33+ if (ret < 0 && (errno == EAGAIN || errno == EINTR))
34+ continue;
35+ if (ret != 1) {
36+ close(dev_random);
37+ errno = EIO;
38+ return -1;
39+ }
40+
41+ break;
42+ }
43+
44+ return close(dev_random);
45+}
46+
47+// Returns 0 on success, non-zero on failure.
48+int ensure_pool_initialized()
49+{
50+#ifdef HAVE_GETENTROPY
51+#ifndef DO_NOT_USE_GET_ENTROPY
52+ if (ensure_pool_initialized_getentropy() == 0)
53+ return 0;
54+#endif
55+#endif
56+
57+ return ensure_pool_initialized_poll();
58+}
cbits/rdrand.c+45−1
@@ -11,8 +11,9 @@ int cpu_has_rdrand()
1111 return (cx & 0x40000000);
1212}
1313
14+#ifdef arch_x86_64
1415// Returns 1 on success
15−inline int _rdrand64_step(uint64_t *therand)
16+static inline int _rdrand64_step(uint64_t *therand)
1617{
1718 unsigned char err;
1819 asm volatile("rdrand %0 ; setc %1"
@@ -51,5 +52,48 @@ int get_rand_bytes(uint8_t *therand, size_t len)
5152 }
5253 return fail;
5354}
55+#endif /* x86-64 */
56+
57+#ifdef arch_i386
58+// Returns 1 on success
59+static inline int _rdrand32_step(uint32_t *therand)
60+{
61+ unsigned char err;
62+ asm volatile("rdrand %0 ; setc %1"
63+ : "=r" (*therand), "=qm" (err));
64+ return (int) err;
65+}
66+
67+int get_rand_bytes(uint8_t *therand, size_t len)
68+{
69+ int cnt;
70+ int fail=0;
71+ uint8_t *p = therand;
72+ uint8_t *end = therand + len;
73+ if((uint32_t)p % sizeof(uint32_t) != 0) {
74+ uint32_t tmp;
75+ fail |= !_rdrand32_step(&tmp);
76+ while((uint32_t)p % sizeof(uint32_t) != 0 && p != end) {
77+ *p = (uint8_t)(tmp & 0xFF);
78+ tmp = tmp >> 8;
79+ p++;
80+ }
81+ }
82+ for(; p <= end - sizeof(uint32_t); p+=sizeof(uint32_t)) {
83+ fail |= !_rdrand32_step((uint32_t *)p);
84+ }
85+ if(p != end) {
86+ uint32_t tmp;
87+ int cnt;
88+ fail |= !_rdrand32_step(&tmp);
89+ while(p != end) {
90+ *p = (uint8_t)(tmp & 0xFF);
91+ tmp = tmp >> 8;
92+ p++;
93+ }
94+ }
95+ return fail;
96+}
97+#endif /* i386 */
5498
5599#endif // RDRAND
cbits/rdrand.h−2
@@ -2,11 +2,9 @@
22#ifdef HAVE_RDRAND
33#include <stdint.h>
44
5−#ifdef arch_x86_64
65int cpu_has_rdrand()
76
87// Returns 0 on success, non-zero on failure.
98int get_rand_bytes(uint8_t *therand, size_t len)
10−#endif /* arch_x86_64 */
119#endif // HAVE_RDRAND
1210#endif // rdrand_h
entropy.cabal+82−32
@@ -1,9 +1,10 @@
1+cabal-version: >=1.10
12name: entropy
2−version: 0.3
3−description: A platform independent method to obtain cryptographically strong entropy
4− (urandom on Linux, CryptAPI on Windows, patches welcome).
3+version: 0.4.1.11
4+description: A mostly platform independent method to obtain cryptographically strong entropy
5+ (RDRAND, urandom, CryptAPI, and patches welcome)
56 Users looking for cryptographically strong (number-theoretically
6− sound) PRNGs should see the 'DRBG' package too!
7+ sound) PRNGs should see the 'DRBG' package too.
78synopsis: A platform independent entropy source
89license: BSD3
910license-file: LICENSE
@@ -14,39 +15,88 @@ category: Data, Cryptography
1415homepage: https://github.com/TomMD/entropy
1516bug-reports: https://github.com/TomMD/entropy/issues
1617stability: stable
17−-- build-type: Simple
18−-- ^^ Used for HaLVM
19−build-type: Custom
20−-- ^^ Test for RDRAND support using 'ghc'
21−cabal-version: >=1.10
22−tested-with: GHC == 7.6.3
23−-- data-files:
24−extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md
2518
26−-- Notice to compile with HaLVM the above 'build-type' must be changed
27−-- to 'Simple' instead of 'Custom'. The current build system naively
28−-- runs GHC to determine if the compiler supports RDRAND before proceeding.
29−flag halvm
30− description: Build for the HaLVM
19+build-type: Custom
20+
21+tested-with:
22+ GHC == 9.12.1
23+ GHC == 9.10.1
24+ GHC == 9.8.4
25+ GHC == 9.6.6
26+ GHC == 9.4.8
27+ GHC == 9.2.8
28+ GHC == 9.0.2
29+ GHC == 8.10.7
30+ GHC == 8.8.4
31+ GHC == 8.6.5
32+ GHC == 8.4.4
33+ GHC == 8.2.2
34+
35+extra-source-files:
36+ ./cbits/getrandom.c
37+ ./cbits/random_initialized.c
38+ ./cbits/rdrand.c
39+ ./cbits/rdrand.h
40+ README.md
41+
42+Flag DoNotGetEntropy
43+ Description: Avoid use of the getentropy() *nix function. By default getentropy will be used
44+ if detected during compilation (this plays poorly with cross compilation).
45+ Default: False
46+ Manual: True
47+
48+custom-setup
49+ setup-depends: Cabal >= 1.10 && < 3.17
50+ , base < 5
51+ , filepath < 1.6
52+ , directory < 1.4
53+ , process < 1.7
3154
3255library
33− ghc-options: -Wall -O2
56+ ghc-options: -O2
3457 exposed-modules: System.Entropy
35− other-extensions: CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables
36− build-depends: base == 4.*, bytestring
58+ if impl(ghcjs) || os(ghcjs) || arch(wasm32)
59+ other-modules: System.EntropyGhcjs
60+ else {
61+ if os(windows)
62+ other-modules: System.EntropyWindows
63+ else {
64+ other-modules: System.EntropyNix
65+ }
66+ }
67+ other-extensions: CPP, ForeignFunctionInterface, BangPatterns,
68+ ScopedTypeVariables
69+ build-depends: base >= 4.8 && < 5, bytestring
70+
3771 default-language: Haskell2010
38− if(flag(halvm))
39− cpp-options: -DXEN -DHAVE_RDRAND
40− if arch(x86_64)
41− cpp-options: -Darch_x86_64
42− c-sources: cbits/rdrand.c
43− include-dirs: cbits
44− if os(windows)
45− cpp-options: -DisWindows
46− extra-libraries: advapi32
47− else
48− if !flag(halvm)
49− Build-Depends: unix
72+
73+ if impl(ghcjs) || os(ghcjs) || arch(wasm32) {
74+ build-depends: ghcjs-dom >= 0.9.5.0 && < 1
75+ , jsaddle
76+ }
77+ else {
78+ if arch(x86_64)
79+ cpp-options: -Darch_x86_64
80+ cc-options: -Darch_x86_64 -O2
81+ -- gcc 4.8.2 on i386 fails to compile rdrand.c when using -fPIC!
82+ c-sources: cbits/rdrand.c
83+ include-dirs: cbits
84+ if arch(i386)
85+ cpp-options: -Darch_i386
86+ cc-options: -Darch_i386 -O2
87+ if os(windows)
88+ build-depends: Win32 >= 2.5
89+ cpp-options: -DisWindows
90+ cc-options: -DisWindows
91+ extra-libraries: advapi32
92+ else
93+ Build-Depends: unix
94+ c-sources: cbits/getrandom.c cbits/random_initialized.c
95+ }
96+ if flag(DoNotGetEntropy) {
97+ cc-options: -DDO_NOT_USE_GET_ENTROPY
98+ }
99+
50100
51101source-repository head
52102 type: git