diff --git a/Crypto/Random.hs b/Crypto/Random.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random.hs @@ -0,0 +1,54 @@ +-- | +-- Module : Crypto.Random +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 diff --git a/Crypto/Random/API.hs b/Crypto/Random/API.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/API.hs @@ -0,0 +1,56 @@ +-- | +-- Module : Crypto.Random.API +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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'') diff --git a/Crypto/Random/Entropy.hs b/Crypto/Random/Entropy.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/Entropy.hs @@ -0,0 +1,120 @@ +-- | +-- Module : Crypto.Random.Entropy +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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) diff --git a/Crypto/Random/Entropy/RDRand.hs b/Crypto/Random/Entropy/RDRand.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/Entropy/RDRand.hs @@ -0,0 +1,38 @@ +-- | +-- Module : Crypto.Random.Entropy.RDRand +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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) diff --git a/Crypto/Random/Entropy/Source.hs b/Crypto/Random/Entropy/Source.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/Entropy/Source.hs @@ -0,0 +1,22 @@ +-- | +-- Module : Crypto.Random.Entropy.Source +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 () diff --git a/Crypto/Random/Entropy/Unix.hs b/Crypto/Random/Entropy/Unix.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/Entropy/Unix.hs @@ -0,0 +1,50 @@ +-- | +-- Module : Crypto.Random.Entropy.Unix +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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 diff --git a/Crypto/Random/Entropy/Windows.hs b/Crypto/Random/Entropy/Windows.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/Entropy/Windows.hs @@ -0,0 +1,73 @@ +-- | +-- Module : Crypto.Random.Entropy.Windows +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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" diff --git a/Crypto/Random/Generator.hs b/Crypto/Random/Generator.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/Generator.hs @@ -0,0 +1,50 @@ +-- | +-- Module : Crypto.Random.Generator +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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) diff --git a/Crypto/Random/Test.hs b/Crypto/Random/Test.hs new file mode 100644 --- /dev/null +++ b/Crypto/Random/Test.hs @@ -0,0 +1,87 @@ +-- | +-- Module : Crypto.Random.Test +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- 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)) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2013 Vincent Hanquez + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/rdrand.c b/cbits/rdrand.c new file mode 100644 --- /dev/null +++ b/cbits/rdrand.c @@ -0,0 +1,79 @@ +/* + * Copyright (C) Thomas DuBuisson + * Copyright (C) 2013 Vincent Hanquez + * + * 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 +#include +#include +#include + +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; +} diff --git a/crypto-random.cabal b/crypto-random.cabal new file mode 100644 --- /dev/null +++ b/crypto-random.cabal @@ -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 +Author: Vincent Hanquez +Maintainer: Vincent Hanquez +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