@@ -8,69 +8,246 @@
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
25+#ifndef XEN
26+import Control.Monad (liftM, when)
27+import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
28+import Foreign (allocaBytes)
3029#else
31−import System.EntropyNix
30+import Control.Monad (when)
3231#endif
32+import Data.ByteString as B
3333
34−import qualified Data.ByteString as B
35−import Control.Exception (bracket)
34+#if defined(isWindows)
35+{- C example for windows rng - taken from a blog, can't recall which one but thank you!
36+ #include <Windows.h>
37+ #include <Wincrypt.h>
38+ ...
39+ //
40+ // DISCLAIMER: Don't forget to check your error codes!!
41+ // I am not checking as to make the example simple...
42+ //
43+ HCRYPTPROV hCryptCtx = NULL;
44+ BYTE randomArray[128];
3645
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':
46+ CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
47+ CryptGenRandom(hCryptCtx, 128, randomArray);
48+ CryptReleaseContext(hCryptCtx, 0);
49+-}
50+
51+import Data.ByteString.Internal as BI
52+import Data.Int (Int32)
53+import Data.Word (Word32, Word8)
54+import Foreign.C.String (CString, withCString)
55+import Foreign.C.Types
56+import Foreign.Ptr (Ptr, nullPtr, castPtr)
57+import Foreign.Marshal.Alloc (alloca)
58+import Foreign.Marshal.Utils (toBool)
59+import Foreign.Storable (peek)
60+
61+#ifdef HAVE_RDRAND
62+foreign import ccall unsafe "cpu_has_rdrand"
63+ c_cpu_has_rdrand :: IO CInt
64+
65+foreign import ccall unsafe "get_rand_bytes"
66+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
67+
68+cpuHasRdRand :: IO Bool
69+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
70+#endif
71+
72+data CryptHandle
73+ = CH Word32
74+#ifdef HAVE_RDRAND
75+ | UseRdRand
76+#endif
77+
78+-- Define the constants we need from WinCrypt.h
79+msDefProv :: String
80+msDefProv = "Microsoft Base Cryptographic Provider v1.0"
81+provRSAFull :: Word32
82+provRSAFull = fromIntegral 1
83+cryptVerifyContext :: Word32
84+cryptVerifyContext = fromIntegral 0xF0000000
85+
86+-- Declare the required CryptoAPI imports
87+foreign import stdcall unsafe "CryptAcquireContextA"
88+ c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32
89+foreign import stdcall unsafe "CryptGenRandom"
90+ c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32
91+foreign import stdcall unsafe "CryptReleaseContext"
92+ c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32
93+
94+cryptAcquireCtx :: IO Word32
95+cryptAcquireCtx =
96+ alloca $ \handlePtr ->
97+ withCString msDefProv $ \provName -> do
98+ stat <- c_cryptAcquireCtx handlePtr nullPtr provName (fromIntegral 1) (fromIntegral cryptVerifyContext)
99+ if (toBool stat)
100+ then peek handlePtr
101+ else fail "c_cryptAcquireCtx"
102+
103+cryptGenRandom :: Word32 -> Int -> IO B.ByteString
104+cryptGenRandom h i =
105+ BI.create i $ \c_buffer -> do
106+ stat <- c_cryptGenRandom (fromIntegral h) (fromIntegral i) c_buffer
107+ if (toBool stat)
108+ then return ()
109+ else fail "c_cryptGenRandom"
110+
111+cryptReleaseCtx :: Word32 -> IO ()
112+cryptReleaseCtx h = do
113+ stat <- c_cryptReleaseCtx h 0
114+ if (toBool stat)
115+ then return ()
116+ else fail "c_cryptReleaseCtx"
117+
118+-- |Inefficiently get a specific number of bytes of cryptographically
119+-- secure random data using the system-specific facilities.
64120--
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−-- @
121+-- This function will return zero bytes
122+-- on platforms without a secure RNG!
123+getEntropy :: Int -> IO B.ByteString
124+getEntropy n = do
125+#ifdef HAVE_RDRAND
126+ b <- cpuHasRdRand
127+ if b then hGetEntropy UseRdRand n
128+ else do
129+#endif
130+ h <- cryptAcquireCtx
131+ bs <- cryptGenRandom h n
132+ let !bs' = bs
133+ cryptReleaseCtx h
134+ return bs'
135+
136+-- |Open a handle from which random data can be read
137+openHandle :: IO CryptHandle
138+openHandle = do
139+#ifdef HAVE_RDRAND
140+ b <- cpuHasRdRand
141+ if b then return UseRdRand
142+ else do
143+#endif
144+ liftM CH cryptAcquireCtx
145+
146+-- |Close the `CryptHandle`
147+closeHandle (CH h) = cryptReleaseCtx h
148+
149+-- |Read from `CryptHandle`
150+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
151+hGetEntropy (CH h) = cryptGenRandom h
152+#ifdef HAVE_RDRAND
153+hGetEntropy UseRdRand =
154+ B.create n $ \ptr -> do
155+ r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
156+ when (r /= 0)
157+ (fail "RDRand failed to gather entropy")
158+#endif
159+
160+#else
161+{- Not windows, assuming nix with a /dev/urandom -}
162+import Foreign.Ptr
163+import Foreign.C.Types
164+import Data.ByteString.Internal as B
165+#ifdef XEN
166+data CryptHandle = UseRdRand -- or die trying
167+#else
168+import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
169+
170+source :: FilePath
171+source = "/dev/urandom"
172+
173+-- |Handle for manual resource mangement
174+data CryptHandle
175+ = CH Fd
176+#ifdef HAVE_RDRAND
177+ | UseRdRand
178+#endif
179+#endif
180+
181+-- |Open a `CryptHandle`
182+openHandle :: IO CryptHandle
183+openHandle = do
184+#ifdef HAVE_RDRAND
185+ b <- cpuHasRdRand
186+ if b then return UseRdRand
187+ else do
188+#endif
189+#ifdef XEN
190+ error "entropy: On halvm there is no entropy other than RDRAND."
191+#else
192+ liftM CH (openFd source ReadOnly Nothing defaultFileFlags)
193+#endif
194+
195+-- |Close the `CryptHandle`
196+closeHandle :: CryptHandle -> IO ()
197+#ifndef XEN
198+closeHandle (CH h) = closeFd h
199+#endif
200+#ifdef HAVE_RDRAND
201+closeHandle UseRdRand = return ()
202+#endif
203+
204+#ifndef XEN
205+fdReadBS :: Fd -> Int -> IO B.ByteString
206+fdReadBS fd n = do
207+ allocaBytes n $ \buf -> do
208+ rc <- fdReadBuf fd buf (fromIntegral n)
209+ case rc of
210+ 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
211+ n' -> B.packCStringLen (castPtr buf, fromIntegral n')
212+#endif
213+
214+-- |Read random data from a `CryptHandle`
215+hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
216+#ifndef XEN
217+hGetEntropy (CH h) = fdReadBS h
218+#else
219+#ifdef HAVE_RDRAND
220+hGetEntropy UseRdRand = \n -> do
221+ B.create n $ \ptr -> do
222+ r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
223+ when (r /= 0)
224+ (fail "RDRand failed to gather entropy")
225+#endif
226+#endif
227+{- XEN -}
228+
229+#ifdef HAVE_RDRAND
230+foreign import ccall unsafe "cpu_has_rdrand"
231+ c_cpu_has_rdrand :: IO CInt
232+
233+foreign import ccall unsafe "get_rand_bytes"
234+ c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
235+
236+cpuHasRdRand :: IO Bool
237+cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
238+#endif
239+
240+-- |Inefficiently get a specific number of bytes of cryptographically
241+-- secure random data using the system-specific facilities.
71242--
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
243+-- Use '/dev/urandom' on *nix and CryptAPI when on Windows. In short,
244+-- this entropy is considered cryptographically secure but not true
245+-- entropy.
246+getEntropy :: Int -> IO B.ByteString
247+getEntropy n = do
248+ h <- openHandle
249+ e <- hGetEntropy h n
250+ closeHandle h
251+ return e
252+#endif
253+{- OS Test -}