packages feed

crypto-random (empty) → 0.0.1

raw patch · 13 files changed

+702/−0 lines, 13 filesdep +Win32dep +basedep +bytestringsetup-changed

Dependencies added: Win32, base, bytestring, securemem, unix, vector

Files

+ Crypto/Random.hs view
@@ -0,0 +1,54 @@+-- |+-- Module      : Crypto.Random+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+-- Provide a safe abstraction for cryptographic pseudo+-- random generator.+--+{-# LANGUAGE ExistentialQuantification #-}+module Crypto.Random+    (+    -- * Entropy+      EntropyPool+    , createEntropyPool+    , grabEntropy+    -- * Random generation+    , CPRG(..)+    , withRandomBytes+    -- * System generator+    , SystemRNG+    ) where++import Crypto.Random.Entropy+import Crypto.Random.Generator+import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as B (unsafeCreate)++-- | System entropy generator.+--+-- This generator doesn't use the entropy reseed level, as the only bytes+-- generated are comping from the entropy pool already.+--+-- This generator doesn't create reproducible output, and might be difficult to+-- use for testing and debugging purpose, but otherwise for real world use case+-- should be fine.+data SystemRNG = SystemRNG EntropyPool++instance CPRG SystemRNG where+    cprgCreate entPool                   = SystemRNG entPool+    cprgSetReseedThreshold _ r           = r+    cprgFork r@(SystemRNG entPool)       = (r, cprgCreate entPool)+    cprgGenerate n g@(SystemRNG entPool) = (B.unsafeCreate n (grabEntropyPtr n entPool), g)+    -- we don't need to do anything different when generating withEntropy, as the generated+    -- bytes are already stricly entropy bytes.+    cprgGenerateWithEntropy n g          = cprgGenerate n g++-- | generate @len random bytes and mapped the bytes to the function @f.+--+-- This is equivalent to use Control.Arrow 'first' with 'cprgGenerate'+withRandomBytes :: CPRG g => g -> Int -> (ByteString -> a) -> (a, g)+withRandomBytes rng len f = (f bs, rng')+  where (bs, rng') = cprgGenerate len rng
+ Crypto/Random/API.hs view
@@ -0,0 +1,56 @@+-- |+-- Module      : Crypto.Random.API+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+-- Deprecated interface for compatibility of crypto-random-api user+-- with crypto-random+--+module Crypto.Random.API+    ( CPRG(..)+    , cprgGenBytes+    , genRandomBytes+    , genRandomBytes'+    , withRandomBytes+    ) where++import Data.ByteString (ByteString)+import Crypto.Random++-- | Generate bytes using the CPRG and the number specified.+--+-- For user of the API, it's recommended to use genRandomBytes+-- instead of this method directly. the CPRG need to be able+-- to supply at minimum 2^20 bytes at a time.+cprgGenBytes :: CPRG g => Int -> g -> (ByteString, g)+cprgGenBytes n cprg = cprgGenerate n cprg++-- | Generate bytes using the cprg in parameter.+--+-- If the number of bytes requested is really high,+-- it's preferable to use 'genRandomBytes' for better memory efficiency.+{-# DEPRECATED genRandomBytes "use cprgGenerate from Crypto.Random instead" #-}+genRandomBytes :: CPRG g    +               => Int -- ^ number of bytes to return+               -> g   -- ^ CPRG to use+               -> (ByteString, g)  +genRandomBytes n cprg = cprgGenerate n cprg++-- | Generate bytes using the cprg in parameter.+--+-- This is not tail recursive and an excessive len (>= 2^29) parameter would+-- result in stack overflow.+genRandomBytes' :: CPRG g => Int -- ^ number of bytes to return+                          -> g   -- ^ CPRG to use+                          -> ([ByteString], g)+genRandomBytes' len rng+    | len < 0    = error "genBytes: cannot request negative amount of bytes."+    | otherwise  = loop rng len+            where loop g n+                    | n == 0  = ([], g)+                    | otherwise = let itBytes  = min (2^(20:: Int)) n+                                      (bs, g') = cprgGenBytes itBytes g+                                      (l, g'') = genRandomBytes' (n-itBytes) g'+                                   in (bs:l, g'')
+ Crypto/Random/Entropy.hs view
@@ -0,0 +1,120 @@+-- |+-- Module      : Crypto.Random.Entropy+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+module Crypto.Random.Entropy+    ( EntropyPool+    , createEntropyPool+    , grabEntropyPtr+    , grabEntropy+    ) where++import Control.Monad (when)+import Control.Concurrent.MVar+import System.IO.Unsafe (unsafePerformIO)+import Data.Maybe (catMaybes)+import Data.SecureMem+import Data.Word (Word8)+import Foreign.Marshal.Utils (copyBytes)+import Foreign.Ptr (plusPtr, Ptr)++import Crypto.Random.Entropy.Source+#ifdef SUPPORT_RDRAND+import Crypto.Random.Entropy.RDRand+#endif+#ifdef WINDOWS+import Crypto.Random.Entropy.Windows+#else+import Crypto.Random.Entropy.Unix+#endif++supportedBackends :: [IO (Maybe EntropyBackend)]+supportedBackends =+    [+#ifdef SUPPORT_RDRAND+    openBackend (undefined :: RDRand),+#endif+#ifdef WINDOWS+    openBackend (undefined :: WinCryptoAPI)+#else+    openBackend (undefined :: DevRandom), openBackend (undefined :: DevURandom)+#endif+    ]++data EntropyBackend = forall b . EntropySource b => EntropyBackend b++openBackend :: EntropySource b => b -> IO (Maybe EntropyBackend)+openBackend b = fmap EntropyBackend `fmap` callOpen b+  where callOpen :: EntropySource b => b -> IO (Maybe b)+        callOpen _ = entropyOpen++gatherBackend :: EntropyBackend -> Ptr Word8 -> Int -> IO Int+gatherBackend (EntropyBackend backend) ptr n = entropyGather backend ptr n++-- | Pool of Entropy. contains a self mutating pool of entropy,+-- that is always guarantee to contains data.+data EntropyPool = EntropyPool [EntropyBackend] (MVar Int) SecureMem++-- size of entropy pool by default+defaultPoolSize :: Int+defaultPoolSize = 4096++-- | Create a new entropy pool of a specific size+--+-- While you can create as many entropy pool as you want, the pool can be shared between multiples RNGs.+createEntropyPoolWith :: Int -> IO EntropyPool+createEntropyPoolWith poolSize = do+    backends <- catMaybes `fmap` sequence supportedBackends+    when (null backends) $ fail "cannot get any source of entropy on the system"+    sm <- allocateSecureMem poolSize+    m  <- newMVar 0+    withSecureMemPtr sm $ replenish poolSize backends+    return $ EntropyPool backends m sm++-- | Create a new entropy pool with a default size.+--+-- While you can create as many entropy pool as you want, the pool can be shared between multiples RNGs.+createEntropyPool :: IO EntropyPool+createEntropyPool = createEntropyPoolWith defaultPoolSize++-- | Put a chunk of the entropy pool into a buffer+grabEntropyPtr :: Int -> EntropyPool -> Ptr Word8 -> IO ()+grabEntropyPtr n (EntropyPool backends posM sm) outPtr =+    withSecureMemPtr sm $ \entropyPoolPtr ->+        modifyMVar_ posM $ \pos ->+            copyLoop outPtr entropyPoolPtr pos n+  where poolSize = secureMemGetSize sm+        copyLoop d s pos left+            | left == 0 = return pos+            | otherwise = do+                wrappedPos <-+                    if pos == poolSize+                        then replenish poolSize backends s >> return 0+                        else return pos+                let m = min (poolSize - wrappedPos) left +                copyBytes d (s `plusPtr` wrappedPos) m+                copyLoop (d `plusPtr` m) s (wrappedPos + m) (left - m)++-- | Grab a chunk of entropy from the entropy pool.+{-# NOINLINE grabEntropy #-}+grabEntropy :: Int -> EntropyPool -> SecureMem+grabEntropy n pool = unsafePerformIO $ do+    out <- allocateSecureMem n+    withSecureMemPtr out $ grabEntropyPtr n pool+    return $ out++replenish :: Int -> [EntropyBackend] -> Ptr Word8 -> IO ()+replenish poolSize backends ptr = loop 0 backends ptr poolSize+  where loop :: Int -> [EntropyBackend] -> Ptr Word8 -> Int -> IO ()+        loop retry [] p n | n == 0     = return ()+                          | retry == 3 = error "cannot fully replenish"+                          | otherwise  = loop (retry+1) backends p n+        loop _     (_:_)  _ 0 = return ()+        loop retry (b:bs) p n = do+            r <- gatherBackend b p n+            loop retry bs (p `plusPtr` r) (n - r)
+ Crypto/Random/Entropy/RDRand.hs view
@@ -0,0 +1,38 @@+-- |+-- Module      : Crypto.Random.Entropy.RDRand+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+{-# LANGUAGE ForeignFunctionInterface #-}+module Crypto.Random.Entropy.RDRand+    ( RDRand+    ) where++import Foreign.Ptr+import Foreign.C.Types+import Data.Word (Word8)+import Crypto.Random.Entropy.Source++foreign import ccall unsafe "crypto_random_cpu_has_rdrand"+   c_cpu_has_rdrand :: IO CInt++foreign import ccall unsafe "crypto_random_get_rand_bytes"+  c_get_rand_bytes :: Ptr Word8 -> CInt -> IO CInt++-- | fake handle to Intel RDRand entropy cpu instruction+data RDRand = RDRand++instance EntropySource RDRand where+    entropyOpen     = rdrandGrab+    entropyGather _ = rdrandGetBytes+    entropyClose  _ = return ()++rdrandGrab :: IO (Maybe RDRand)+rdrandGrab = supported `fmap` c_cpu_has_rdrand+  where supported 0 = Nothing+        supported _ = Just RDRand++rdrandGetBytes :: Ptr Word8 -> Int -> IO Int+rdrandGetBytes ptr sz = fromIntegral `fmap` c_get_rand_bytes ptr (fromIntegral sz)
+ Crypto/Random/Entropy/Source.hs view
@@ -0,0 +1,22 @@+-- |+-- Module      : Crypto.Random.Entropy.Source+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+module Crypto.Random.Entropy.Source where++import Foreign.Ptr+import Data.Word (Word8)++-- | A handle to an entropy maker, either a system capability+-- or a hardware generator.+class EntropySource a where+    -- | try to open an handle for this source+    entropyOpen   :: IO (Maybe a)+    -- | try to gather a number of entropy bytes into a buffer.+    -- return the number of actual bytes gathered+    entropyGather :: a -> Ptr Word8 -> Int -> IO Int+    -- | Close an open handle+    entropyClose  :: a -> IO ()
+ Crypto/Random/Entropy/Unix.hs view
@@ -0,0 +1,50 @@+-- |+-- Module      : Crypto.Random.Entropy.Unix+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+{-# LANGUAGE ScopedTypeVariables #-}+module Crypto.Random.Entropy.Unix+    ( DevRandom+    , DevURandom+    ) where++import Foreign.Ptr+import Data.Word (Word8)+import Crypto.Random.Entropy.Source+import Control.Exception+import System.Posix.Types (Fd)+import System.Posix.IO++type H = Fd++-- | Entropy device /dev/random on unix system +newtype DevRandom  = DevRandom H++-- | Entropy device /dev/urandom on unix system +newtype DevURandom = DevURandom H++instance EntropySource DevRandom where+    entropyOpen                 = fmap DevRandom `fmap` openDev "/dev/random"+    entropyGather (DevRandom h) = gatherDevEntropy h+    entropyClose (DevRandom h)  = closeDev h++instance EntropySource DevURandom where+    entropyOpen                  = fmap DevURandom `fmap` openDev "/dev/urandom"+    entropyGather (DevURandom h) = gatherDevEntropy h+    entropyClose (DevURandom h)  = closeDev h++openDev :: String -> IO (Maybe H)+openDev filepath = (Just `fmap` openFd filepath ReadOnly Nothing fileFlags)+    `catch` \(_ :: IOException) -> return Nothing+  where fileFlags = defaultFileFlags { nonBlock = True }++closeDev :: H -> IO ()+closeDev h = closeFd h++gatherDevEntropy :: H -> Ptr Word8 -> Int -> IO Int+gatherDevEntropy fd ptr sz =+     (fromIntegral `fmap` fdReadBuf fd ptr (fromIntegral sz))+    `catch` \(_ :: IOException) -> return 0
+ Crypto/Random/Entropy/Windows.hs view
@@ -0,0 +1,73 @@+-- |+-- Module      : Crypto.Random.Entropy.Windows+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+-- code originally from the entropy package and thus is:+--   Copyright (c) Thomas DuBuisson.+--+{-# LANGUAGE ForeignFunctionInterface #-}+module Crypto.Random.Entropy.Windows+    ( WinCryptoAPI+    ) where++import Data.Int (Int32)+import Data.Word (Word32, Word8)+import Foreign.C.String (CString, withCString)+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Utils (toBool)+import Foreign.Storable (peek)++import Crypto.Random.Entropy.Source++-- Define the constants we need from WinCrypt.h +msDefProv :: String+msDefProv = "Microsoft Base Cryptographic Provider v1.0"++provRSAFull :: Word32+provRSAFull = 1++cryptVerifyContext :: Word32+cryptVerifyContext = 0xF0000000++-- | handle to windows crypto API for random generation+newtype WinCryptoAPI = WinCryptoAPI CryptCtx++instance EntropySource WinCryptoAPI where+    entropyOpen                    = fmap WinCryptoAPI `fmap` cryptAcquireCtx+    entropyGather (WinCryptoAPI h) = cryptGenRandom h+    entropyClose  (WinCryptoAPI h) = cryptReleaseCtx h++type CryptCtx = Word32++-- Declare the required CryptoAPI imports +foreign import stdcall unsafe "CryptAcquireContextA"+   c_cryptAcquireCtx :: Ptr Word32 -> CString -> CString -> Word32 -> Word32 -> IO CryptCtx+foreign import stdcall unsafe "CryptGenRandom"+   c_cryptGenRandom :: CryptCtx -> Word32 -> Ptr Word8 -> IO Int32+foreign import stdcall unsafe "CryptReleaseContext"+   c_cryptReleaseCtx :: CryptCtx -> Word32 -> IO Int32++cryptAcquireCtx :: IO (Maybe CryptCtx)+cryptAcquireCtx = +    alloca $ \handlePtr -> +    withCString msDefProv $ \provName -> do+        r <- toBool `fmap` c_cryptAcquireCtx handlePtr nullPtr provName provRSAFull cryptVerifyContext+        if r+            then Just `fmap` peek handlePtr+            else return Nothing++cryptGenRandom :: CryptCtx -> Ptr Word8 -> Int -> IO Int+cryptGenRandom h buf n = do+    success <- toBool `fmap` c_cryptGenRandom h (fromIntegral n) buf+    return $ if success then n else 0++cryptReleaseCtx :: CryptCtx -> IO ()+cryptReleaseCtx h = do+    success <- toBool `fmap` c_cryptReleaseCtx h 0+    if success+        then return ()+        else fail "cryptReleaseCtx"
+ Crypto/Random/Generator.hs view
@@ -0,0 +1,50 @@+-- |+-- Module      : Crypto.Random.Generator+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+module Crypto.Random.Generator+    ( CPRG(..)+    ) where++import Data.ByteString (ByteString)+import Crypto.Random.Entropy (EntropyPool)++-- | Cryptographic Pseudo Random Generator+class CPRG gen where+    -- | Create a new CPRG using an object of the CryptoGenerator class+    -- and with an explicit reference to an EntropyPool.+    cprgCreate :: EntropyPool -> gen++    -- | Give the ability to set a threshold of byte generated that after+    -- being exceeded will result in a reseed with some stateful entropy+    -- after a call to 'cprgGenerate'+    --+    -- If this threshold is exceeded during the set operation, the+    -- rng should be reseeded here.+    --+    -- If this value is set to 0, no reseeding will be done and the+    -- output will be completely predicable. This is not a recommended+    -- level except for debugging and testing purpose.+    cprgSetReseedThreshold :: Int -> gen -> gen++    -- | Fork a CPRG into a new independent CPRG.+    --+    -- As entropy is mixed to generate safely a new generator,+    -- 2 calls with the same CPRG will not produce the same output.+    cprgFork :: gen -> (gen, gen)++    -- | Generate a number of bytes using the CPRG.+    --+    -- Given one CPRG, the generated bytes will always be the same.+    --+    -- However the returned CPRG might have been reseeded with entropy bits,+    -- so 2 calls with the same CPRG will not necessarily result in the same next CPRG.+    cprgGenerate :: Int -> gen -> (ByteString, gen)++    -- | Similar to cprgGenerate except that the random data is mixed with pure entropy,+    -- so the result is not reproducible after use, but it provides more guarantee,+    -- theorically speaking, in term of the randomness generated.+    cprgGenerateWithEntropy :: Int -> gen -> (ByteString, gen)
+ Crypto/Random/Test.hs view
@@ -0,0 +1,87 @@+-- |+-- Module      : Crypto.Random.Test+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : Good+--+-- Provide way to test usual simple statisticals test for randomness+--+module Crypto.Random.Test+    ( RandomTestState+    , RandomTestResult(..)+    , randomTestInitialize+    , randomTestAppend+    , randomTestFinalize+    ) where++import Data.Word+import Data.Int (Int64)+import qualified Data.ByteString.Lazy as L+import Control.Applicative+import Data.List (foldl')++import qualified Data.Vector.Mutable as M+import qualified Data.Vector as V++-- | Randomness various result relative to random bytes+data RandomTestResult = RandomTestResult+    { res_totalChars         :: Word64 -- ^ Total number of characters+    , res_entropy            :: Double -- ^ Entropy per byte+    , res_chi_square         :: Double -- ^ Chi Square+    , res_mean               :: Double -- ^ Arithmetic Mean+    , res_compressionPercent :: Double -- ^ Theorical Compression percent+    , res_probs              :: [Double] -- ^ Probability of every bucket+    } deriving (Show,Eq)++-- | Mutable random test State+newtype RandomTestState = RandomTestState (M.IOVector Word64)++-- | Initialize new state to run tests+randomTestInitialize :: IO RandomTestState+randomTestInitialize = RandomTestState <$> M.replicate 256 0++-- | Append random data to the test state+randomTestAppend :: RandomTestState -> L.ByteString -> IO ()+randomTestAppend (RandomTestState buckets) = loop+  where loop bs+            | L.null bs = return ()+            | otherwise = do+                let (b1,b2) = L.splitAt monteN bs+                mapM_ (addVec 1 . fromIntegral) $ L.unpack b1+                loop b2+        addVec a i = M.read buckets i >>= \d -> M.write buckets i $! d+a++-- | Finalize random test state into some result+randomTestFinalize :: RandomTestState -> IO RandomTestResult+randomTestFinalize (RandomTestState buckets) = (calculate . V.toList) `fmap` V.freeze buckets++monteN :: Int64+monteN = 6++calculate :: [Word64] -> RandomTestResult+calculate buckets = RandomTestResult+    { res_totalChars = totalChars+    , res_entropy    = entropy+    , res_chi_square = chisq+    , res_mean       = fromIntegral datasum / fromIntegral totalChars+    , res_compressionPercent = 100.0 * (8 - entropy) / 8.0+    , res_probs      = probs+    }+  where totalChars = sum buckets+        probs = map (\v -> fromIntegral v / fromIntegral totalChars :: Double) buckets+        entropy = foldl' accEnt 0.0 probs+        cexp    = fromIntegral totalChars / 256.0 :: Double+        (datasum, chisq) = foldl' accMeanChi (0, 0.0) [0..255]+        --chip' = abs (sqrt (2.0 * chisq) - sqrt (2.0 * 255.0 - 1.0))++        accEnt ent pr+            | pr > 0.0  = ent + (pr * xlog (1 / pr))+            | otherwise = ent+        xlog v = logBase 10 v * (log 10 / log 2)++        accMeanChi :: (Word64, Double) -> Int -> (Word64, Double)+        accMeanChi (dataSum, chiSq) i =+            let ccount = buckets !! i+                a      = fromIntegral ccount - cexp+             in (dataSum + fromIntegral i * ccount, chiSq + (a * a / cexp))
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2013 Vincent Hanquez <vincent@snarc.org>++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 REGENTS AND 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/rdrand.c view
@@ -0,0 +1,79 @@+/*+ * Copyright (C) Thomas DuBuisson+ * Copyright (C) 2013 Vincent Hanquez <tab@snarc.org>+ *+ * 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 REGENTS AND 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.+ */++#include <stdint.h>+#include <stdlib.h>+#include <stdio.h>+#include <string.h>++int crypto_random_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 */+static inline int crypto_random_rdrand64_step(uint64_t *buffer)+{+	unsigned char err;+	asm volatile("rdrand %0 ; setc %1" : "=r" (*buffer), "=qm" (err));+	return (int) err;+}++/* Returns the number of bytes succesfully generated */+int crypto_random_get_rand_bytes(uint8_t *buffer, size_t len)+{+	uint64_t tmp;+	int aligned = (unsigned long) buffer % 8;+	int orig_len = len;++	if (aligned != 0) {+		int to_alignment = 8 - aligned;+		if (!crypto_random_rdrand64_step(&tmp))+			return 0;+		memcpy(buffer, (uint8_t *) &tmp, to_alignment);+		buffer += to_alignment;+		len -= to_alignment;+	}++	for (; len >= 8; buffer += 8, len -= 8) {+		if (!crypto_random_rdrand64_step((uint64_t *) buffer))+			return (orig_len - len);+	}++	if (len > 0) {+		if (!crypto_random_rdrand64_step(&tmp))+			return (orig_len - len);+		memcpy(buffer, (uint8_t *) &tmp, len);+	}+	return orig_len;+}
+ crypto-random.cabal view
@@ -0,0 +1,44 @@+Name:                crypto-random+Version:             0.0.1+Description:         Simple cryptographic random related types+License:             BSD3+License-file:        LICENSE+Copyright:           Vincent Hanquez <vincent@snarc.org>+Author:              Vincent Hanquez <vincent@snarc.org>+Maintainer:          Vincent Hanquez <vincent@snarc.org>+Synopsis:            Simple cryptographic random related types+Category:            Cryptography+Build-Type:          Simple+Homepage:            http://github.com/vincenthz/hs-crypto-random+Cabal-Version:       >=1.6++Library+  Build-depends:     base >= 4 && < 5+                   , bytestring+                   , securemem+                   , vector+  Exposed-modules:   Crypto.Random+                   , Crypto.Random.Test+                   , Crypto.Random.API+  Other-modules:     Crypto.Random.Generator+                   , Crypto.Random.Entropy+                   , Crypto.Random.Entropy.Source+  ghc-options:       -Wall+  if os(windows)+    cpp-options:    -DWINDOWS+    Build-Depends:  Win32+    Other-modules:  Crypto.Random.Entropy.Windows+    extra-libraries: advapi32+  else+    Build-Depends:  unix+    Other-modules:  Crypto.Random.Entropy.Unix+    +  if arch(x86_64)+    cpp-options:    -DSUPPORT_RDRAND+    Other-modules:  Crypto.Random.Entropy.RDRand+    c-sources:      cbits/rdrand.c++source-repository head+  type:     git+  location: git://github.com/vincenthz/hs-crypto-random+  subdir:   types