@@ -8,69 +8,242 @@
88
99 Currently supporting:
1010
11− - Windows via CryptoAPI
11+ - Windows via CryptoAPO
1212 - *nix systems via @\/dev\/urandom@
13− - Includes QNX
14− - ghcjs/browser via JavaScript crypto API.
13+ - QNX
14+ - Xen only when RDRAND is available.
1515-}
1616
1717module System.Entropy
18− ( getEntropy,
19− getHardwareEntropy,
20− CryptHandle,
21− openHandle,
22− hGetEntropy,
23− closeHandle
18+ ( getEntropy
19+ , CryptHandle
20+ , openHandle
21+ , hGetEntropy
22+ , closeHandle
2423 ) where
2524
26−#ifdef ghcjs_HOST_OS
27−import System.EntropyGhcjs
28−#elif defined(isWindows)
29−import System.EntropyWindows
30−#else
31−import System.EntropyNix
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
3266#endif
3367
34−import qualified Data.ByteString as B
35−import Control.Exception (bracket)
68+data CryptHandle
69+ = CH Word32
70+#ifdef HAVE_RDRAND
71+ | UseRdRand
72+#endif
3673
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)
40−--
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':
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.
64116--
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−-- @
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
214+#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
222+#endif
223+{- XEN -}
224+
225+#ifdef HAVE_RDRAND
226+foreign import ccall unsafe "cpu_has_rdrand"
227+ c_cpu_has_rdrand :: IO CInt
228+
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.
71238--
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
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 -}