git.iko.soy/typeable/entropy
on 17469e6 help sign in
typeable/entropy/System/EntropyNix.hs
111 lines 2.9 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 XEN
28data CryptHandle = UseRdRand -- or die trying
29#else
31import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd)
33source :: FilePath
34source = "/dev/urandom"
36-- |Handle for manual resource mangement
37data CryptHandle
38 = CH Fd
39#ifdef HAVE_RDRAND
40 | UseRdRand
41#endif
42#endif
44-- |Open a `CryptHandle`
45openHandle :: IO CryptHandle
46openHandle = do
47#ifdef HAVE_RDRAND
48 b <- cpuHasRdRand
49 if b then return UseRdRand
50 else nonRDRandHandle
51#else
52 nonRDRandHandle
53#endif
54 where
55#ifdef XEN
56 nonRDRandHandle :: IO CryptHandle
57 nonRDRandHandle = error "entropy: On halvm there is no entropy other than RDRAND."
58#else
59 nonRDRandHandle :: IO CryptHandle
60 nonRDRandHandle = liftM CH (openFd source ReadOnly Nothing defaultFileFlags)
61#endif
63-- |Close the `CryptHandle`
64closeHandle :: CryptHandle -> IO ()
65#ifndef XEN
66closeHandle (CH h) = closeFd h
67#endif
68#ifdef HAVE_RDRAND
69closeHandle UseRdRand = return ()
70#endif
72-- |Read random data from a `CryptHandle`
73#ifdef XEN
74hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
75hGetEntropy UseRdRand = \n -> do
76 B.create n $ \ptr -> do
77 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
78 when (r /= 0)
79 (fail "RDRand failed to gather entropy")
80#else
81hGetEntropy :: CryptHandle -> Int -> IO B.ByteString
82hGetEntropy (CH h) = fdReadBS h
83#ifdef HAVE_RDRAND
84hGetEntropy UseRdRand = \n -> do
85 B.create n $ \ptr -> do
86 r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n)
87 when (r /= 0)
88 (fail "RDRand failed to gather entropy")
89#endif
91fdReadBS :: Fd -> Int -> IO B.ByteString
92fdReadBS fd n = do
93 allocaBytes n $ \buf -> do
94 rc <- fdReadBuf fd buf (fromIntegral n)
95 case rc of
96 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF")
97 n' -> B.packCStringLen (castPtr buf, fromIntegral n')
98#endif
101#ifdef HAVE_RDRAND
102foreign import ccall unsafe "cpu_has_rdrand"
103 c_cpu_has_rdrand :: IO CInt
105foreign import ccall unsafe "get_rand_bytes"
106 c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt
108cpuHasRdRand :: IO Bool
109cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand
110#endif