diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,48 @@ import Distribution.Simple -main = defaultMain +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Setup +import Distribution.PackageDescription +import Distribution.Simple.Utils +import Distribution.Simple.Program +import Distribution.Verbosity +import System.Process +import System.Directory +import System.FilePath +import System.Exit + +main = defaultMainWithHooks hk + where + hk = simpleUserHooks { buildHook = \pd lbi uh bf -> do + let ccProg = Program "gcc" undefined undefined undefined + mConf = lookupProgram ccProg (withPrograms lbi) + err = error "Could not determine C compiler" + cc = locationPath . programLocation . maybe err id $ mConf + b <- canUseRDRAND cc + let newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi) + newWithPrograms = userSpecifyArgs "ghc" cArgsHC newWithPrograms1 + lbiNew = if b then (lbi {withPrograms = newWithPrograms }) else lbi + buildHook simpleUserHooks pd lbiNew uh bf + } + +cArgs :: [String] +cArgs = ["-DHAVE_RDRAND"] + +cArgsHC :: [String] +cArgsHC = map ("-optc" ++) cArgs + +canUseRDRAND :: FilePath -> IO Bool +canUseRDRAND cc = do + withTempDirectory normal "" "testRDRAND" $ \tmpDir -> do + writeFile (tmpDir ++ "/testRDRAND.c") + (unlines [ "#include " + , "int main() {" + , " uint64_t therand;" + , " unsigned char err;" + , " asm volatile(\"rdrand %0 ; setc %1\"" + , " : \"=r\" (therand), \"=qm\" (err));" + , " return (!err);" + , "}" + ]) + ec <- rawSystemExitCode normal cc [tmpDir "testRDRAND.c", "-o" ++ tmpDir ++ "/a.out"] + notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess) + return (ec == ExitSuccess) diff --git a/System/Entropy.hs b/System/Entropy.hs --- a/System/Entropy.hs +++ b/System/Entropy.hs @@ -16,9 +16,8 @@ , closeHandle ) where -import Control.Monad (liftM) +import Control.Monad (liftM, when) import Data.ByteString as B -import Data.ByteString.Lazy as L import System.IO (openFile, hClose, IOMode(..), Handle, withBinaryFile) #if defined(isWindows) @@ -42,13 +41,29 @@ import Data.Int (Int32) import Data.Word (Word32, Word8) import Foreign.C.String (CString, withCString) -import Foreign.Ptr (Ptr, nullPtr) +import Foreign.C.Types +import Foreign.Ptr (Ptr, nullPtr, castPtr) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (toBool) import Foreign.Storable (peek) -newtype CryptHandle = CH Word32 +#ifdef HAVE_RDRAND +foreign import ccall unsafe "cpu_has_rdrand" + c_cpu_has_rdrand :: IO CInt +foreign import ccall unsafe "get_rand_bytes" + c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt + +cpuHasRdRand :: IO Bool +cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand +#endif + +data CryptHandle + = CH Word32 +#ifdef HAVE_RDRAND + | UseRdRand +#endif + -- Define the constants we need from WinCrypt.h msDefProv :: String msDefProv = "Microsoft Base Cryptographic Provider v1.0" @@ -96,6 +111,11 @@ -- on platforms without a secure RNG! getEntropy :: Int -> IO B.ByteString getEntropy n = do +#ifdef HAVE_RDRAND + b <- cpuHasRdRand + if b then hGetEntropy UseRdRand n + else do +#endif h <- cryptAcquireCtx bs <- cryptGenRandom h n let !bs' = bs @@ -104,7 +124,13 @@ -- |Open a handle from which random data can be read openHandle :: IO CryptHandle -openHandle = liftM CH cryptAcquireCtx +openHandle = do +#ifdef HAVE_RDRAND + b <- cpuHasRdRand + if b then return UseRdRand + else do +#endif + liftM CH cryptAcquireCtx -- |Close the `CryptHandle` closeHandle (CH h) = cryptReleaseCtx h @@ -112,25 +138,68 @@ -- |Read from `CryptHandle` hGetEntropy :: CryptHandle -> Int -> IO B.ByteString hGetEntropy (CH h) = cryptGenRandom h +#ifdef HAVE_RDRAND +hGetEntropy UseRdRand = + B.create n $ \ptr -> do + r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n) + when (r /= 0) + (fail "RDRand failed to gather entropy") +#endif #else +{- Not windows, assuming nix with a /dev/urandom -} +import Foreign.C.Types +import Foreign.Ptr + +source :: FilePath source = "/dev/urandom" -- |Handle for manual resource mangement -newtype CryptHandle = CH Handle +data CryptHandle + = CH Handle +#ifdef HAVE_RDRAND + | UseRdRand +#endif -- |Open a `CryptHandle` openHandle :: IO CryptHandle -openHandle = liftM CH (openFile source ReadMode) +openHandle = do +#ifdef HAVE_RDRAND + b <- cpuHasRdRand + if b then return UseRdRand + else do +#endif + liftM CH (openFile source ReadMode) -- |Close the `CryptHandle` closeHandle :: CryptHandle -> IO () closeHandle (CH h) = hClose h +#ifdef HAVE_RDRAND +closeHandle UseRdRand = return () +#endif -- |Read random data from a `CryptHandle` hGetEntropy :: CryptHandle -> Int -> IO B.ByteString hGetEntropy (CH h) = B.hGet h +#ifdef HAVE_RDRAND +hGetEntropy UseRdRand = \n -> do + B.create n $ \ptr -> do + r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n) + when (r /= 0) + (fail "RDRand failed to gather entropy") +#endif +#ifdef HAVE_RDRAND +foreign import ccall unsafe "cpu_has_rdrand" + c_cpu_has_rdrand :: IO CInt + +foreign import ccall unsafe "get_rand_bytes" + c_get_rand_bytes :: Ptr CUChar -> CSize -> IO CInt + +cpuHasRdRand :: IO Bool +cpuHasRdRand = (/= 0) `fmap` c_cpu_has_rdrand +#endif + -- |Inefficiently get a specific number of bytes of cryptographically -- secure random data using the system-specific facilities. -- @@ -138,6 +207,14 @@ -- this entropy is considered "cryptographically secure" but not true -- entropy. getEntropy :: Int -> IO B.ByteString -getEntropy n = withBinaryFile source ReadMode (`B.hGet` n) +getEntropy n = do +#ifdef HAVE_RDRAND + b <- cpuHasRdRand + if b then hGetEntropy UseRdRand n + else do #endif +{- arch_x86 -} + withBinaryFile source ReadMode (`B.hGet` n) +#endif +{- OS Test -} diff --git a/cbits/rdrand.c b/cbits/rdrand.c new file mode 100644 --- /dev/null +++ b/cbits/rdrand.c @@ -0,0 +1,55 @@ +#ifdef HAVE_RDRAND + +#include +#include + +int cpu_has_rdrand() +{ + uint32_t ax,bx,cx,dx,func=1; + __asm__ volatile ("cpuid":\ + "=a" (ax), "=b" (bx), "=c" (cx), "=d" (dx) : "a" (func)); + return (cx & 0x40000000); +} + +// Returns 1 on success +inline int _rdrand64_step(uint64_t *therand) +{ + unsigned char err; + asm volatile("rdrand %0 ; setc %1" + : "=r" (*therand), "=qm" (err)); + return (int) err; +} + +// Returns 0 on success, non-zero on failure. +int get_rand_bytes(uint8_t *therand, size_t len) +{ + int cnt; + int fail=0; + uint8_t *p = therand; + uint8_t *end = therand + len; + if((uint64_t)p%8 != 0) { + uint64_t tmp; + fail |= !_rdrand64_step(&tmp); + while((uint64_t)p%8 != 0 && p != end) { + *p = (uint8_t)(tmp & 0xFF); + tmp = tmp >> 8; + p++; + } + } + for(; p <= end - sizeof(uint64_t); p+=sizeof(uint64_t)) { + fail |= !_rdrand64_step((uint64_t *)p); + } + if(p != end) { + uint64_t tmp; + int cnt; + fail |= !_rdrand64_step(&tmp); + while(p != end) { + *p = (uint8_t)(tmp & 0xFF); + tmp = tmp >> 8; + p++; + } + } + return fail; +} + +#endif // RDRAND diff --git a/cbits/rdrand.h b/cbits/rdrand.h new file mode 100644 --- /dev/null +++ b/cbits/rdrand.h @@ -0,0 +1,12 @@ +#ifndef rdrand_h +#ifdef HAVE_RDRAND +#include + +#ifdef arch_x86_64 +int cpu_has_rdrand() + +// Returns 0 on success, non-zero on failure. +int get_rand_bytes(uint8_t *therand, size_t len) +#endif /* arch_x86_64 */ +#endif // HAVE_RDRAND +#endif // rdrand_h diff --git a/entropy.cabal b/entropy.cabal --- a/entropy.cabal +++ b/entropy.cabal @@ -1,5 +1,5 @@ name: entropy -version: 0.2.1 +version: 0.2.2 license: BSD3 license-file: LICENSE copyright: Thomas DuBuisson @@ -11,21 +11,30 @@ sound) PRNGs should see the 'DRBG' package too! synopsis: A platform independent entropy source category: Data, Cryptography -homepage: http://trac.haskell.org/crypto-api/wiki -bug-reports: http://trac.haskell.org/crypto-api/report/1 +homepage: https://github.com/TomMD/entropy +bug-reports: https://github.com/TomMD/entropy/issues stability: stable -build-type: Simple +build-type: Custom cabal-version: >= 1.6 tested-with: GHC == 6.12.1 data-files: -extra-source-files: +extra-source-files: ./cbits/rdrand.c + , ./cbits/rdrand.h Library Build-Depends: base == 4.*, bytestring - ghc-options: + ghc-options: -Wall -O2 hs-source-dirs: exposed-modules: System.Entropy other-modules: + if arch(x86_64) + cpp-options: -Darch_x86_64 + c-sources: cbits/rdrand.c + include-dirs: cbits if os(windows) cpp-options: -DisWindows extra-libraries: advapi32 + +source-repository head + type: git + location: https://github.com/TomMD/entropy