From 4e955ad5053fd8e773c3ad19c315645661d63ed6 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Wed, 9 Jul 2014 08:12:34 +0100 Subject: [PATCH] merge entropy from crypto-random --- Crypto/Random/Entropy.hs | 119 +++++++++++++++++++++++++++++++ Crypto/Random/Entropy/RDRand.hs | 38 ++++++++++ Crypto/Random/Entropy/Source.hs | 22 ++++++ Crypto/Random/Entropy/Unix.hs | 67 +++++++++++++++++ Crypto/Random/Entropy/Windows.hs | 82 +++++++++++++++++++++ cbits/cryptonite_rdrand.c | 100 ++++++++++++++++++++++++++ cryptonite.cabal | 16 +++++ 7 files changed, 444 insertions(+) create mode 100644 Crypto/Random/Entropy.hs create mode 100644 Crypto/Random/Entropy/RDRand.hs create mode 100644 Crypto/Random/Entropy/Source.hs create mode 100644 Crypto/Random/Entropy/Unix.hs create mode 100644 Crypto/Random/Entropy/Windows.hs create mode 100644 cbits/cryptonite_rdrand.c diff --git a/Crypto/Random/Entropy.hs b/Crypto/Random/Entropy.hs new file mode 100644 index 0000000..f6864e6 --- /dev/null +++ b/Crypto/Random/Entropy.hs @@ -0,0 +1,119 @@ +-- | +-- 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 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 -> [EntropyBackend] -> IO EntropyPool +createEntropyPoolWith poolSize backends = do + when (null backends) $ fail "cannot get any source of entropy on this 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 = do + backends <- catMaybes `fmap` sequence supportedBackends + createEntropyPoolWith defaultPoolSize backends + +-- | 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. +grabEntropy :: Int -> EntropyPool -> IO SecureMem +grabEntropy n pool = 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 index 0000000..d3d3866 --- /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 "cryptonite_cpu_has_rdrand" + c_cpu_has_rdrand :: IO CInt + +foreign import ccall unsafe "cryptonite_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 index 0000000..49d7f61 --- /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 index 0000000..42e7d8c --- /dev/null +++ b/Crypto/Random/Entropy/Unix.hs @@ -0,0 +1,67 @@ +-- | +-- 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 as E + +import System.Posix.Types (Fd) +import System.Posix.IO + +type H = Fd +type DeviceName = String + +-- | Entropy device /dev/random on unix system +newtype DevRandom = DevRandom DeviceName + +-- | Entropy device /dev/urandom on unix system +newtype DevURandom = DevURandom DeviceName + +instance EntropySource DevRandom where + entropyOpen = fmap DevRandom `fmap` testOpen "/dev/random" + entropyGather (DevRandom name) ptr n = + withDev name $ \h -> gatherDevEntropy h ptr n + entropyClose (DevRandom _) = return () + +instance EntropySource DevURandom where + entropyOpen = fmap DevURandom `fmap` testOpen "/dev/urandom" + entropyGather (DevURandom name) ptr n = + withDev name $ \h -> gatherDevEntropy h ptr n + entropyClose (DevURandom _) = return () + +testOpen :: DeviceName -> IO (Maybe DeviceName) +testOpen filepath = do + d <- openDev filepath + case d of + Nothing -> return Nothing + Just h -> closeDev h >> return (Just filepath) + +openDev :: String -> IO (Maybe H) +openDev filepath = (Just `fmap` openFd filepath ReadOnly Nothing fileFlags) + `E.catch` \(_ :: IOException) -> return Nothing + where fileFlags = defaultFileFlags { nonBlock = True } + +withDev :: String -> (H -> IO a) -> IO a +withDev filepath f = openDev filepath >>= \h -> + case h of + Nothing -> error ("device " ++ filepath ++ " cannot be grabbed") + Just fd -> f fd >>= \r -> (closeDev fd >> return r) + +closeDev :: H -> IO () +closeDev h = closeFd h + +gatherDevEntropy :: H -> Ptr Word8 -> Int -> IO Int +gatherDevEntropy h ptr sz = + (fromIntegral `fmap` fdReadBuf h ptr (fromIntegral sz)) + `E.catch` \(_ :: IOException) -> return 0 diff --git a/Crypto/Random/Entropy/Windows.hs b/Crypto/Random/Entropy/Windows.hs new file mode 100644 index 0000000..88e3151 --- /dev/null +++ b/Crypto/Random/Entropy/Windows.hs @@ -0,0 +1,82 @@ +-- | +-- 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 +data WinCryptoAPI = WinCryptoAPI + +instance EntropySource WinCryptoAPI where + entropyOpen = do + mctx <- cryptAcquireCtx + maybe (return Nothing) (\ctx -> cryptReleaseCtx ctx >> return (Just WinCryptoAPI)) mctx + entropyGather WinCryptoAPI ptr n = do + mctx <- cryptAcquireCtx + case mctx of + Nothing -> error "cannot re-grab win crypto api" + Just ctx -> do + r <- cryptGenRandom ctx ptr n + cryptReleaseCtx ctx + return r + entropyClose WinCryptoAPI = return () + +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/cbits/cryptonite_rdrand.c b/cbits/cryptonite_rdrand.c new file mode 100644 index 0000000..f25d30e --- /dev/null +++ b/cbits/cryptonite_rdrand.c @@ -0,0 +1,100 @@ +/* + * 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 cryptonite_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); +} + +/* sadly many people are still using an old binutils, + * leading to report that instruction is not recognized. + */ +#if 0 +/* 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; +} +#endif + +/* inline encoding of 'rdrand %rax' to cover old binutils + * - no inputs + * - 'cc' to the clobber list as we modify condition code. + * - output of rdrand in rax and have a 8 bit error condition + */ +#define inline_rdrand_rax(val, err) \ + asm(".byte 0x48,0x0f,0xc7,0xf0; setc %1" \ + : "=a" (val), "=q" (err) \ + : \ + : "cc") + +/* Returns the number of bytes succesfully generated */ +int cryptonite_get_rand_bytes(uint8_t *buffer, size_t len) +{ + uint64_t tmp; + int aligned = (unsigned long) buffer % 8; + int orig_len = len; + int to_alignment = 8 - aligned; + uint8_t ok; + + if (aligned != 0) { + inline_rdrand_rax(tmp, ok); + if (!ok) + return 0; + memcpy(buffer, (uint8_t *) &tmp, to_alignment); + buffer += to_alignment; + len -= to_alignment; + } + + for (; len >= 8; buffer += 8, len -= 8) { + inline_rdrand_rax(tmp, ok); + if (!ok) + return (orig_len - len); + *((uint64_t *) buffer) = tmp; + } + + if (len > 0) { + inline_rdrand_rax(tmp, ok); + if (!ok) + return (orig_len - len); + memcpy(buffer, (uint8_t *) &tmp, len); + } + return orig_len; +} diff --git a/cryptonite.cabal b/cryptonite.cabal index a46d315..460d0c7 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -23,6 +23,8 @@ Library Exposed-modules: Crypto.Cipher.ChaCha Crypto.Cipher.Salsa Crypto.MAC.Poly1305 + Crypto.Random.Entropy + Other-modules: Crypto.Random.Entropy.Source Build-depends: base >= 4 && < 5 , bytestring , securemem @@ -35,6 +37,20 @@ Library if (arch(i386) || arch(x86_64)) CPP-options: -DARCH_IS_LITTLE_ENDIAN + if arch(x86_64) + cpp-options: -DSUPPORT_RDRAND + Other-modules: Crypto.Random.Entropy.RDRand + c-sources: cbits/cryptonite_rdrand.c + + 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 + Test-Suite test-cryptonite type: exitcode-stdio-1.0 hs-source-dirs: tests