entropy 0.2.1 → 0.2.2
raw patch · 5 files changed
+214/−15 lines, 5 filesbuild-type:Customsetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Setup.hs +47/−1
- System/Entropy.hs +85/−8
- cbits/rdrand.c +55/−0
- cbits/rdrand.h +12/−0
- entropy.cabal +15/−6
Setup.hs view
@@ -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 <stdint.h>"+ , "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)
System/Entropy.hs view
@@ -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 -}
+ cbits/rdrand.c view
@@ -0,0 +1,55 @@+#ifdef HAVE_RDRAND++#include <stdint.h>+#include <stdlib.h>++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
+ cbits/rdrand.h view
@@ -0,0 +1,12 @@+#ifndef rdrand_h+#ifdef HAVE_RDRAND+#include <stdint.h>++#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
entropy.cabal view
@@ -1,5 +1,5 @@ name: entropy-version: 0.2.1+version: 0.2.2 license: BSD3 license-file: LICENSE copyright: Thomas DuBuisson <thomas.dubuisson@gmail.com>@@ -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