entropy-0.3.8/0000755000000000000000000000000013123303762011410 5ustar0000000000000000entropy-0.3.8/entropy.cabal0000644000000000000000000000506613123303762014103 0ustar0000000000000000name: entropy version: 0.3.8 description: A platform independent method to obtain cryptographically strong entropy (RDRAND when available anywhere, urandom on nix, CryptAPI on Windows, patches welcome) Users looking for cryptographically strong (number-theoretically sound) PRNGs should see the 'DRBG' package too. synopsis: A platform independent entropy source license: BSD3 license-file: LICENSE copyright: Thomas DuBuisson author: Thomas DuBuisson maintainer: Thomas DuBuisson category: Data, Cryptography homepage: https://github.com/TomMD/entropy bug-reports: https://github.com/TomMD/entropy/issues stability: stable -- build-type: Simple -- ^^ Used for HaLVM build-type: Custom -- ^^ Test for RDRAND support using 'ghc' cabal-version: >=1.10 tested-with: GHC == 7.8.2 -- data-files: extra-source-files: ./cbits/rdrand.c, ./cbits/rdrand.h, README.md -- Notice to compile with HaLVM the above 'build-type' must be changed -- to 'Simple' instead of 'Custom'. The current build system naively -- runs GHC to determine if the compiler supports RDRAND before proceeding. flag halvm description: Build for the HaLVM default: False custom-setup setup-depends: Cabal >= 1.10 && < 2.2 , base < 5 , filepath < 1.5 , directory < 1.4 , process < 1.7 library ghc-options: -O2 exposed-modules: System.Entropy if os(windows) other-modules: System.EntropyWindows else { if os(halvm) other-modules: System.EntropyXen else other-modules: System.EntropyNix } other-extensions: CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables build-depends: base >= 4.3 && < 5, bytestring default-language: Haskell2010 if(os(halvm)) cpp-options: -DXEN -DHAVE_RDRAND cc-options: -DXEN -DHAVE_RDRAND if arch(x86_64) cpp-options: -Darch_x86_64 cc-options: -Darch_x86_64 -O2 -- gcc 4.8.2 on i386 fails to compile rdrand.c when using -fPIC! c-sources: cbits/rdrand.c include-dirs: cbits if arch(i386) cpp-options: -Darch_i386 cc-options: -Darch_i386 -O2 if os(windows) cpp-options: -DisWindows cc-options: -DisWindows extra-libraries: advapi32 else if !os(halvm) Build-Depends: unix source-repository head type: git location: https://github.com/TomMD/entropy entropy-0.3.8/LICENSE0000644000000000000000000000266313123303762012424 0ustar0000000000000000Copyright (c) Thomas DuBuisson All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. entropy-0.3.8/README.md0000644000000000000000000000064113123303762012670 0ustar0000000000000000# Introduction This package allows Haskell users to easily acquire entropy for use in critical security applications by calling out to either windows crypto api, unix/linux's `/dev/urandom`, or the RDRAND instruction. This package supports Windows, {li,u}nix, QNX, and has preliminary support for HaLVM. [![Build Status](https://travis-ci.org/TomMD/entropy.svg?branch=master)](https://travis-ci.org/TomMD/entropy) entropy-0.3.8/Setup.hs0000644000000000000000000000647313123303762013056 0ustar0000000000000000{-# LANGUAGE CPP #-} import Control.Monad import Distribution.Simple 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 import System.IO main = defaultMainWithHooks hk where hk = simpleUserHooks { buildHook = \pd lbi uh bf -> do -- let ccProg = Program "gcc" undefined undefined undefined let hcProg = Program "ghc" undefined undefined undefined mConf = lookupProgram hcProg (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 = cArgs ++ 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 <- myRawSystemExitCode normal cc [tmpDir "testRDRAND.c", "-o", tmpDir ++ "/a.o","-c"] notice normal $ "Result of RDRAND Test: " ++ show (ec == ExitSuccess) return (ec == ExitSuccess) myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode #if __GLASGOW_HASKELL__ >= 704 -- We know for sure, that if GHC >= 7.4 implies Cabal >= 1.14 myRawSystemExitCode = rawSystemExitCode #else -- Legacy branch: -- We implement our own 'rawSystemExitCode', this will even work if -- the user happens to have Cabal >= 1.14 installed with GHC 7.0 or -- 7.2 myRawSystemExitCode verbosity path args = do printRawCommandAndArgs verbosity path args hFlush stdout exitcode <- rawSystem path args unless (exitcode == ExitSuccess) $ do debug verbosity $ path ++ " returned " ++ show exitcode return exitcode where printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO () printRawCommandAndArgs verbosity path args | verbosity >= deafening = print (path, args) | verbosity >= verbose = putStrLn $ unwords (path : args) | otherwise = return () #endif entropy-0.3.8/cbits/0000755000000000000000000000000013123303762012514 5ustar0000000000000000entropy-0.3.8/cbits/rdrand.c0000644000000000000000000000444113123303762014135 0ustar0000000000000000#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); } #ifdef arch_x86_64 // Returns 1 on success static 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 /* x86-64 */ #ifdef arch_i386 // Returns 1 on success static inline int _rdrand32_step(uint32_t *therand) { unsigned char err; asm volatile("rdrand %0 ; setc %1" : "=r" (*therand), "=qm" (err)); return (int) err; } 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((uint32_t)p % sizeof(uint32_t) != 0) { uint32_t tmp; fail |= !_rdrand32_step(&tmp); while((uint32_t)p % sizeof(uint32_t) != 0 && p != end) { *p = (uint8_t)(tmp & 0xFF); tmp = tmp >> 8; p++; } } for(; p <= end - sizeof(uint32_t); p+=sizeof(uint32_t)) { fail |= !_rdrand32_step((uint32_t *)p); } if(p != end) { uint32_t tmp; int cnt; fail |= !_rdrand32_step(&tmp); while(p != end) { *p = (uint8_t)(tmp & 0xFF); tmp = tmp >> 8; p++; } } return fail; } #endif /* i386 */ #endif // RDRAND entropy-0.3.8/cbits/rdrand.h0000644000000000000000000000032713123303762014141 0ustar0000000000000000#ifndef rdrand_h #ifdef HAVE_RDRAND #include int cpu_has_rdrand() // Returns 0 on success, non-zero on failure. int get_rand_bytes(uint8_t *therand, size_t len) #endif // HAVE_RDRAND #endif // rdrand_h entropy-0.3.8/System/0000755000000000000000000000000013123303762012674 5ustar0000000000000000entropy-0.3.8/System/Entropy.hs0000644000000000000000000000227113123303762014672 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-} {-| Maintainer: Thomas.DuBuisson@gmail.com Stability: beta Portability: portable Obtain entropy from system sources or x86 RDRAND when available. Currently supporting: - Windows via CryptoAPI - *nix systems via @\/dev\/urandom@ - Includes QNX - Xen (only when RDRAND is available) -} module System.Entropy ( getEntropy, #if defined(isWindows) module System.EntropyWindows ) where import System.EntropyWindows #else #ifdef XEN module System.EntropyXen ) where import System.EntropyXen #else module System.EntropyNix ) where import System.EntropyNix #endif #endif import qualified Data.ByteString as B import Control.Exception (bracket) -- |Get a specific number of bytes of cryptographically -- secure random data using the system-specific facilities. -- -- Use RDRAND if available and XOR with '/dev/urandom' on *nix and CryptAPI when on -- Windows. In short, this entropy is considered cryptographically secure -- but not true entropy. getEntropy :: Int -> IO B.ByteString getEntropy = bracket openHandle closeHandle . flip hGetEntropy entropy-0.3.8/System/EntropyNix.hs0000644000000000000000000000533713123303762015357 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-} {-| Maintainer: Thomas.DuBuisson@gmail.com Stability: beta Portability: portable Obtain entropy from system sources or x86 RDRAND when available. -} module System.EntropyNix ( CryptHandle , openHandle , hGetEntropy , closeHandle ) where import Control.Monad (liftM, when) import Data.ByteString as B import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString) import Data.Bits (xor) import Foreign (allocaBytes) import Foreign.Ptr import Foreign.C.Types import Data.ByteString.Internal as B #ifdef arch_i386 -- See .cabal wrt GCC 4.8.2 asm compilation bug #undef HAVE_RDRAND #endif import System.Posix (openFd, closeFd, fdReadBuf, OpenMode(..), defaultFileFlags, Fd) source :: FilePath source = "/dev/urandom" -- |Handle for manual resource management data CryptHandle = CH Fd #ifdef HAVE_RDRAND | UseRdRand Fd #endif -- |Open a `CryptHandle` openHandle :: IO CryptHandle openHandle = do #ifdef HAVE_RDRAND b <- cpuHasRdRand if b then UseRdRand `fmap` nonRDRandHandle else CH `fmap` nonRDRandHandle #else CH `fmap` nonRDRandHandle #endif where nonRDRandHandle :: IO Fd nonRDRandHandle = openFd source ReadOnly Nothing defaultFileFlags -- |Close the `CryptHandle` closeHandle :: CryptHandle -> IO () closeHandle (CH h) = closeFd h #ifdef HAVE_RDRAND closeHandle (UseRdRand h) = closeFd h #endif -- |Read random data from a `CryptHandle` hGetEntropy :: CryptHandle -> Int -> IO B.ByteString hGetEntropy (CH h) = fdReadBS h #ifdef HAVE_RDRAND hGetEntropy (UseRdRand h) = \n -> do bsURandom <- fdReadBS h n bsRDRAND <- B.create n $ \ptr -> do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n) when (r /= 0) (fail "RDRand failed to gather entropy") return $ B.pack $ B.zipWith xor bsURandom bsRDRAND #endif fdReadBS :: Fd -> Int -> IO B.ByteString fdReadBS fd n = allocaBytes n $ \buf -> go buf n where go buf 0 = B.packCStringLen (castPtr buf, fromIntegral n) go buf cnt | cnt <= n = do rc <- fdReadBuf fd (plusPtr buf (n - cnt)) (fromIntegral cnt) case rc of 0 -> ioError (ioeSetErrorString (mkIOError eofErrorType "fdRead" Nothing Nothing) "EOF") n' -> go buf (cnt - fromIntegral n') go _ _ = error "Impossible! The count of bytes left to read is greater than the request or less than zero!" #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 entropy-0.3.8/System/EntropyWindows.hs0000644000000000000000000001013213123303762016240 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-} {-| Maintainer: Thomas.DuBuisson@gmail.com Stability: beta Portability: portable Obtain entropy from system sources or x86 RDRAND when available. -} module System.EntropyWindows ( CryptHandle , openHandle , hGetEntropy , closeHandle ) where import Control.Monad (liftM, when) import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString) import Foreign (allocaBytes) import Data.ByteString as B import Data.ByteString.Internal as BI import Data.Int (Int32) import Data.Bits (xor) import Data.Word (Word32, Word8) import Foreign.C.String (CString, withCString) import Foreign.C.Types import Foreign.Ptr (Ptr, nullPtr, castPtr) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (toBool) import Foreign.Storable (peek) {- C example for windows rng - taken from a blog, can't recall which one but thank you! #include #include ... // // DISCLAIMER: Don't forget to check your error codes!! // I am not checking as to make the example simple... // HCRYPTPROV hCryptCtx = NULL; BYTE randomArray[128]; CryptAcquireContext(&hCryptCtx, NULL, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT); CryptGenRandom(hCryptCtx, 128, randomArray); CryptReleaseContext(hCryptCtx, 0); -} #ifdef arch_i386 -- See .cabal wrt GCC 4.8.2 asm compilation bug #undef HAVE_RDRAND #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 data CryptHandle = CH Word32 #ifdef HAVE_RDRAND | UseRdRand Word32 #endif -- Define the constants we need from WinCrypt.h msDefProv :: String msDefProv = "Microsoft Base Cryptographic Provider v1.0" provRSAFull :: Word32 provRSAFull = 1 cryptVerifyContext :: Word32 cryptVerifyContext = fromIntegral 0xF0000000 -- Declare the required CryptoAPI imports foreign import stdcall unsafe "CryptAcquireContextA" c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO Int32 foreign import stdcall unsafe "CryptGenRandom" c_cryptGenRandom :: Word32 -> Word32 -> Ptr Word8 -> IO Int32 foreign import stdcall unsafe "CryptReleaseContext" c_cryptReleaseCtx :: Word32 -> Word32 -> IO Int32 cryptAcquireCtx :: IO Word32 cryptAcquireCtx = alloca $ \handlePtr -> withCString msDefProv $ \provName -> do stat <- c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext if (toBool stat) then peek handlePtr else fail "c_cryptAcquireCtx" cryptGenRandom :: Word32 -> Int -> IO B.ByteString cryptGenRandom h i = BI.create i $ \c_buffer -> do stat <- c_cryptGenRandom h (fromIntegral i) c_buffer if (toBool stat) then return () else fail "c_cryptGenRandom" cryptReleaseCtx :: Word32 -> IO () cryptReleaseCtx h = do stat <- c_cryptReleaseCtx h 0 if (toBool stat) then return () else fail "c_cryptReleaseCtx" -- |Open a handle from which random data can be read openHandle :: IO CryptHandle openHandle = do #ifdef HAVE_RDRAND b <- cpuHasRdRand if b then UseRdRand `fmap` cryptAcquireCtx else do #endif CH `fmap` cryptAcquireCtx -- |Close the `CryptHandle` closeHandle :: CryptHandle -> IO () closeHandle (CH h) = cryptReleaseCtx h #ifdef HAVE_RDRAND closeHandle (UseRdRand h) = cryptReleaseCtx h #endif -- |Read from `CryptHandle` hGetEntropy :: CryptHandle -> Int -> IO B.ByteString hGetEntropy (CH h) n = cryptGenRandom h n #ifdef HAVE_RDRAND hGetEntropy (UseRdRand h) n = do bsRDRAND <- BI.create n $ \ptr -> do r <- c_get_rand_bytes (castPtr ptr) (fromIntegral n) when (r /= 0) (fail "RDRand failed to gather entropy") bsWinCrypt <- cryptGenRandom h n return $ B.pack $ B.zipWith xor bsRDRAND bsWinCrypt #endif entropy-0.3.8/System/EntropyXen.hs0000644000000000000000000000340613123303762015346 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns, ScopedTypeVariables #-} {-| Maintainer: Thomas.DuBuisson@gmail.com Stability: beta Portability: portable Obtain entropy from system sources or x86 RDRAND when available. -} module System.EntropyXen ( CryptHandle , openHandle , hGetEntropy , closeHandle ) where import Control.Monad (liftM, when) import Data.ByteString as B import System.IO.Error (mkIOError, eofErrorType, ioeSetErrorString) import Foreign (allocaBytes) import Foreign.Ptr import Foreign.C.Types import Data.ByteString.Internal as B #ifdef arch_i386 -- See .cabal wrt GCC 4.8.2 asm compilation bug #undef HAVE_RDRAND #endif #ifndef HAVE_RDRAND #error "The entropy package requires RDRAND support when using the halvm/Xen" #endif data CryptHandle = UseRdRand -- or die trying -- |Open a `CryptHandle` openHandle :: IO CryptHandle openHandle = do b <- cpuHasRdRand if b then return UseRdRand else nonRDRandHandle where nonRDRandHandle :: IO CryptHandle nonRDRandHandle = error "entropy: On halvm there is no entropy other than RDRAND." -- |Close the `CryptHandle` closeHandle :: CryptHandle -> IO () closeHandle UseRdRand = return () -- |Read random data from a `CryptHandle` hGetEntropy :: CryptHandle -> Int -> IO B.ByteString 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") 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