git.iko.soy/typeable/entropy
on 6034cdc help sign in
typeable/entropy/System/EntropyNix.hs
118 lines 3.1 kB history raw
1{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-}
2{-|
3 Maintainer: Thomas.DuBuisson@gmail.com
4 Stability: beta
5 Portability: portable
7 Obtain entropy from system sources or x86 RDRAND when available.
9-}
11module System.EntropyNix
12 ( CryptHandle
13 , openHandle
14 , hGetEntropy
15 , closeHandle
16 ) where
18import Control.Monad (liftM, when)
19import Data.ByteString as B
20import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString)
22import Foreign (allocaBytes)
23import Foreign.Ptr
24import Foreign.C.Types
25import Data.ByteString.Internal as B
27#ifdef arch_i386
28-- See .cabal wrt GCC 4.8.2 asm compilation bug
29#undef HAVE_RDRAND
30#endif
32#ifdef XEN
33#ifndef HAVE_RDRAND
34#error "The entropy package requires RDRAND support when using the halvm/Xen"
35#endif
36data CryptHandle = UseRdRand -- or die trying
37#else
39import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
41source :: FilePath
42source = "/dev/urandom"
44-- |Handle for manual resource mangement
45data CryptHandle
46 = CH Fd
47#ifdef HAVE_RDRAND
48 | UseRdRand
49#endif
50#endif
52-- |Open a `CryptHandle`
53openHandle :: IO CryptHandle
54openHandle = do
55#ifdef HAVE_RDRAND
56 b <- cpuHasRdRand
57 if b then return UseRdRand
58 else nonRDRandHandle
59#else
60 nonRDRandHandle
61#endif
62 where
63#ifdef XEN
64 nonRDRandHandle :: IO CryptHandle
65 nonRDRandHandle = error "entropy: On halvm there is no entropy other than RDRAND."
66#else
67 nonRDRandHandle :: IO CryptHandle
68 nonRDRandHandle = liftM CH (openFd source ReadOnly Nothing defaultFileFlags)
69#endif
71-- |Close the `CryptHandle`
72closeHandle :: CryptHandle -> IO ()
73#ifndef XEN
74closeHandle (CH h) = closeFd h
75#endif
76#ifdef HAVE_RDRAND
77closeHandle UseRdRand = return ()
78#endif
80-- |Read random data from a `CryptHandle`
81#ifdef XEN
82hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
83hGetEntropy UseRdRand = \n -> do
84 B.create n $ \ptr -> do
85 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
86 when (r /= 0)
87 (fail "RDRand failed to gather entropy")
88#else
89hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
90hGetEntropy (CH h) = fdReadBS h
91#ifdef HAVE_RDRAND
92hGetEntropy UseRdRand = \n -> do
93 B.create n $ \ptr -> do
94 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
95 when (r /= 0)
96 (fail "RDRand failed to gather entropy")
97#endif
99fdReadBS :: Fd -> Int -> IO B.ByteString
100fdReadBS fd n = do
101 allocaBytes n $ \buf -> do
102 rc <- fdReadBuf fd buf (fromIntegral n)
103 case rc of
104 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
105 n' -> B.packCStringLen (castPtr buf, fromIntegral n')
106#endif
109#ifdef HAVE_RDRAND
110foreign import ccall unsafe "cpu_has_rdrand"
111 c_cpu_has_rdrand :: IO CInt
113foreign import ccall unsafe "get_rand_bytes"
114 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
116cpuHasRdRand :: IO Bool
117cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
118#endif