diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -5,7 +5,7 @@ generate RSA and DSA keys, read and write PEM files, generate message digests, sign and verify messages, encrypt and decrypt messages. -Version: 0.2 +Version: 0.3 License: PublicDomain License-File: COPYING Author: PHO @@ -18,6 +18,7 @@ base, time >= 1.1.1 Exposed-Modules: OpenSSL + OpenSSL.BN OpenSSL.EVP.Base64 OpenSSL.EVP.Cipher OpenSSL.EVP.Digest @@ -26,8 +27,10 @@ OpenSSL.EVP.Seal OpenSSL.EVP.Sign OpenSSL.EVP.Verify + OpenSSL.Cipher OpenSSL.PEM OpenSSL.PKCS7 + OpenSSL.Random OpenSSL.DSA OpenSSL.RSA OpenSSL.X509 @@ -37,7 +40,6 @@ Other-Modules: OpenSSL.ASN1 OpenSSL.BIO - OpenSSL.BN OpenSSL.ERR OpenSSL.Objects OpenSSL.SSL diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,17 @@ +Changes from 0.2 to 0.3 +-------------------------------------- +* Applied patches by Adam Langley: + - tests/DSA.hs: Add a DSA test: this just adds a binary which tests + a few simple DSA cases (and runs a timing test) and prints "PASS" + as the last line of stdout in the case that everything looks good. + It doesn't include any hooks nor framework for running these. + - Bug fix for fast Integer<->BN functions + - OpenSSL.Cipher: Add non-EVP cipher support + - OpenSSL.EVP.Digest: Add HMAC support in EVP + - OpenSSL.Random: Add OpenSSL.Random + - OpenSSL.BN: Additional utility functions in BN and exposing BN + + Changes from 0.1.1. to 0.2 -------------------------- * Applied patches by Adam Langley: diff --git a/OpenSSL.hsc b/OpenSSL.hsc --- a/OpenSSL.hsc +++ b/OpenSSL.hsc @@ -11,9 +11,9 @@ -- [/TLS\/SSL network connection/] ssl(3) functionalities are -- totally uncovered. They should be covered someday. -- --- [/Low-level API to symmetric ciphers/] Only high-level APIs (EVP --- and BIO) are available. But I believe no one will be lost without --- functions like @DES_set_odd_parity@. +-- [/Complete coverage of Low-level API to symmetric ciphers/] Only +-- high-level APIs (EVP and BIO) are fully available. But I believe +-- no one will be lost without functions like @DES_set_odd_parity@. -- -- [/Low-level API to asymmetric ciphers/] Only a high-level API -- (EVP) is available. But I believe no one will complain about the @@ -25,13 +25,8 @@ -- [/X.509 v3 extension handling/] It should be supported in the -- future. -- --- [/HMAC message authentication/] --- --- [/Low-level API to message digest functions/] Just use EVP or BIO +-- [/Low-level API to message digest functions/] Just use EVP -- instead of something like @MD5_Update@. --- --- [/pseudo-random number generator/] rand(3) functionalities are --- uncovered, but OpenSSL works very well by default. -- -- [/API to PKCS\#12 functionality/] It should be covered someday. -- diff --git a/OpenSSL/ASN1.hsc b/OpenSSL/ASN1.hsc --- a/OpenSSL/ASN1.hsc +++ b/OpenSSL/ASN1.hsc @@ -76,16 +76,16 @@ _ASN1_INTEGER_free :: Ptr ASN1_INTEGER -> IO () foreign import ccall unsafe "ASN1_INTEGER_to_BN" - _ASN1_INTEGER_to_BN :: Ptr ASN1_INTEGER -> BigNum -> IO BigNum + _ASN1_INTEGER_to_BN :: Ptr ASN1_INTEGER -> Ptr BIGNUM -> IO (Ptr BIGNUM) foreign import ccall unsafe "BN_to_ASN1_INTEGER" - _BN_to_ASN1_INTEGER :: BigNum -> Ptr ASN1_INTEGER -> IO (Ptr ASN1_INTEGER) + _BN_to_ASN1_INTEGER :: Ptr BIGNUM -> Ptr ASN1_INTEGER -> IO (Ptr ASN1_INTEGER) peekASN1Integer :: Ptr ASN1_INTEGER -> IO Integer peekASN1Integer intPtr = allocaBN $ \ bn -> - do _ASN1_INTEGER_to_BN intPtr bn + do _ASN1_INTEGER_to_BN intPtr (unwrapBN bn) >>= failIfNull peekBN bn @@ -99,7 +99,7 @@ withASN1Integer int m = withBN int $ \ bn -> allocaASN1Integer $ \ intPtr -> - do _BN_to_ASN1_INTEGER bn intPtr + do _BN_to_ASN1_INTEGER (unwrapBN bn) intPtr >>= failIfNull m intPtr diff --git a/OpenSSL/BN.hsc b/OpenSSL/BN.hsc --- a/OpenSSL/BN.hsc +++ b/OpenSSL/BN.hsc @@ -1,29 +1,52 @@ #include "HsOpenSSL.h" +-- #prune + +-- |BN - multiprecision integer arithmetics + module OpenSSL.BN - ( BigNum + ( -- * Type + BigNum , BIGNUM + -- * Allocation , allocaBN , withBN - , peekBN + , newBN + , wrapBN -- private + , unwrapBN -- private + -- * Conversion from\/to Integer + , peekBN #ifdef __GLASGOW_HASKELL__ , integerToBN , bnToInteger #endif + , integerToMPI + , mpiToInteger + + -- * Computation + , modexp + + -- * Random number generation + , randIntegerUptoNMinusOneSuchThat + , prandIntegerUptoNMinusOneSuchThat + , randIntegerZeroToNMinusOne + , prandIntegerZeroToNMinusOne + , randIntegerOneToNMinusOne + , prandIntegerOneToNMinusOne ) where import Control.Exception import Foreign - +import qualified Data.ByteString as BS +import OpenSSL.Utils #ifndef __GLASGOW_HASKELL__ import Control.Monad import Foreign.C -import OpenSSL.Utils #else import Foreign.C.Types import Data.Word (Word32) @@ -33,35 +56,47 @@ import GHC.IOBase (IO(..)) #endif -type BigNum = Ptr BIGNUM -data BIGNUM = BIGNUM +-- |'BigNum' is an opaque object representing a big number. +newtype BigNum = BigNum (Ptr BIGNUM) +data BIGNUM foreign import ccall unsafe "BN_new" - _new :: IO BigNum + _new :: IO (Ptr BIGNUM) foreign import ccall unsafe "BN_free" - _free :: BigNum -> IO () - + _free :: Ptr BIGNUM -> IO () +-- |@'allocaBN' f@ allocates a 'BigNum' and computes @f@. Then it +-- frees the 'BigNum'. allocaBN :: (BigNum -> IO a) -> IO a allocaBN m - = bracket _new _free m + = bracket _new _free (m . wrapBN) +unwrapBN :: BigNum -> Ptr BIGNUM +unwrapBN (BigNum p) = p + + +wrapBN :: Ptr BIGNUM -> BigNum +wrapBN = BigNum + + #ifndef __GLASGOW_HASKELL__ {- slow, safe functions ----------------------------------------------------- -} foreign import ccall unsafe "BN_bn2dec" - _bn2dec :: BigNum -> IO CString + _bn2dec :: Ptr BIGNUM -> IO CString foreign import ccall unsafe "BN_dec2bn" - _dec2bn :: Ptr BigNum -> CString -> IO Int + _dec2bn :: Ptr (Ptr BIGNUM) -> CString -> IO Int foreign import ccall unsafe "HsOpenSSL_OPENSSL_free" _openssl_free :: Ptr a -> IO () +-- |@'withBN' n f@ converts n to a 'BigNum' and computes @f@. Then it +-- frees the 'BigNum'. withBN :: Integer -> (BigNum -> IO a) -> IO a withBN dec m = withCString (show dec) $ \ strPtr -> @@ -71,7 +106,7 @@ >>= failIf (== 0) bracket (peek bnPtr) _free m - +-- |@'peekBN' bn@ converts a 'BigNum' to an 'Prelude.Integer'. peekBN :: BigNum -> IO Integer peekBN bn = do strPtr <- _bn2dec bn @@ -127,11 +162,11 @@ -- | Convert a BIGNUM to an Integer bnToInteger :: BigNum -> IO Integer bnToInteger bn = do - nlimbs <- (#peek BIGNUM, top) bn :: IO CSize + nlimbs <- (#peek BIGNUM, top) (unwrapBN bn) :: IO CSize case nlimbs of 0 -> return 0 - 1 -> do (I## i) <- (#peek BIGNUM, d) bn >>= peek - negative <- (#peek BIGNUM, neg) bn :: IO Word32 + 1 -> do (I## i) <- (#peek BIGNUM, d) (unwrapBN bn) >>= peek + negative <- (#peek BIGNUM, neg) (unwrapBN bn) :: IO Word32 if negative == 0 then return $ S## i else return $ 0 - (S## i) @@ -140,9 +175,9 @@ (I## limbsize) = (#size unsigned long) (MBA arr) <- newByteArray (nlimbsi *## limbsize) (BA ba) <- freezeByteArray arr - limbs <- (#peek BIGNUM, d) bn + limbs <- (#peek BIGNUM, d) (unwrapBN bn) _copy_in ba limbs $ fromIntegral $ nlimbs * (#size unsigned long) - negative <- (#peek BIGNUM, neg) bn :: IO Word32 + negative <- (#peek BIGNUM, neg) (unwrapBN bn) :: IO Word32 if negative == 0 then return $ J## nlimbsi ba else return $ 0 - (J## nlimbsi ba) @@ -150,6 +185,20 @@ -- | This is a GHC specific, fast conversion between Integers and OpenSSL -- bignums. It returns a malloced BigNum. integerToBN :: Integer -> IO BigNum +integerToBN 0 = do + bnptr <- mallocBytes (#size BIGNUM) + (#poke BIGNUM, d) bnptr nullPtr + -- This is needed to give GHC enough type information + let one :: Word32 + one = 1 + zero :: Word32 + zero = 0 + (#poke BIGNUM, flags) bnptr one + (#poke BIGNUM, top) bnptr zero + (#poke BIGNUM, dmax) bnptr zero + (#poke BIGNUM, neg) bnptr zero + return (wrapBN bnptr) + integerToBN (S## v) = do bnptr <- mallocBytes (#size BIGNUM) limbs <- malloc :: IO (Ptr Word32) @@ -163,7 +212,7 @@ (#poke BIGNUM, top) bnptr one (#poke BIGNUM, dmax) bnptr one (#poke BIGNUM, neg) bnptr (if (I## v) < 0 then one else 0) - return bnptr + return (wrapBN bnptr) integerToBN v@(J## nlimbs_ bytearray) | v >= 0 = do @@ -176,9 +225,9 @@ (#poke BIGNUM, top) bnptr ((fromIntegral nlimbs) :: Word32) (#poke BIGNUM, dmax) bnptr ((fromIntegral nlimbs) :: Word32) (#poke BIGNUM, neg) bnptr (0 :: Word32) - return bnptr + return (wrapBN bnptr) | otherwise = do bnptr <- integerToBN (0-v) - (#poke BIGNUM, neg) bnptr (1 :: Word32) + (#poke BIGNUM, neg) (unwrapBN bnptr) (1 :: Word32) return bnptr -- TODO: we could make a function which doesn't even allocate BN data if we @@ -186,12 +235,129 @@ -- Integer's data. However, I'm not sure about the semantics of the GC; which -- might move the Integer data around. +-- |@'withBN' n f@ converts n to a 'BigNum' and computes @f@. Then it +-- frees the 'BigNum'. withBN :: Integer -> (BigNum -> IO a) -> IO a -withBN dec m = bracket (integerToBN dec) _free m +withBN dec m = bracket (integerToBN dec) (_free . unwrapBN) m +-- |This is an alias to 'bnToInteger'. peekBN :: BigNum -> IO Integer peekBN = bnToInteger +-- |This is an alias to 'integerToBN'. +newBN :: Integer -> IO BigNum newBN = integerToBN +foreign import ccall unsafe "BN_bn2mpi" + _bn2mpi :: Ptr BIGNUM -> Ptr CChar -> IO CInt + +foreign import ccall unsafe "BN_mpi2bn" + _mpi2bn :: Ptr CChar -> CInt -> Ptr BIGNUM -> IO (Ptr BIGNUM) + #endif + +-- | Convert a BigNum to an MPI: a serialisation of large ints which has a +-- 4-byte, big endian length followed by the bytes of the number in +-- most-significant-first order. +bnToMPI :: BigNum -> IO BS.ByteString +bnToMPI bn = do + bytes <- _bn2mpi (unwrapBN bn) nullPtr + allocaBytes (fromIntegral bytes) (\buffer -> do + _bn2mpi (unwrapBN bn) buffer + BS.copyCStringLen (buffer, fromIntegral bytes)) + +-- | Convert an MPI into a BigNum. See bnToMPI for details of the format +mpiToBN :: BS.ByteString -> IO BigNum +mpiToBN mpi = do + BS.useAsCStringLen mpi (\(ptr, len) -> do + _mpi2bn ptr (fromIntegral len) nullPtr) >>= return . wrapBN + +-- | Convert an Integer to an MPI. SEe bnToMPI for the format +integerToMPI :: Integer -> IO BS.ByteString +integerToMPI v = bracket (integerToBN v) (_free . unwrapBN) bnToMPI + +-- | Convert an MPI to an Integer. SEe bnToMPI for the format +mpiToInteger :: BS.ByteString -> IO Integer +mpiToInteger mpi = do + bn <- mpiToBN mpi + v <- bnToInteger bn + _free (unwrapBN bn) + return v + +foreign import ccall unsafe "BN_mod_exp" + _mod_exp :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> BNCtx -> IO (Ptr BIGNUM) + +type BNCtx = Ptr BNCTX +data BNCTX = BNCTX + +foreign import ccall unsafe "BN_CTX_new" + _BN_ctx_new :: IO BNCtx + +foreign import ccall unsafe "BN_CTX_free" + _BN_ctx_free :: BNCtx -> IO () + +withBNCtx :: (BNCtx -> IO a) -> IO a +withBNCtx f = bracket _BN_ctx_new _BN_ctx_free f + +-- |@'modexp' a p m@ computes @a@ to the @p@-th power modulo @m@. +modexp :: Integer -> Integer -> Integer -> Integer +modexp a p m = unsafePerformIO (do + withBN a (\bnA -> (do + withBN p (\bnP -> (do + withBN m (\bnM -> (do + withBNCtx (\ctx -> (do + r <- newBN 0 + _mod_exp (unwrapBN r) (unwrapBN bnA) (unwrapBN bnP) (unwrapBN bnM) ctx + bnToInteger r >>= return))))))))) + +{- Random Integer generation ------------------------------------------------ -} + +foreign import ccall unsafe "BN_rand_range" + _BN_rand_range :: Ptr BIGNUM -> Ptr BIGNUM -> IO CInt + +foreign import ccall unsafe "BN_pseudo_rand_range" + _BN_pseudo_rand_range :: Ptr BIGNUM -> Ptr BIGNUM -> IO CInt + +-- | Return a strongly random number in the range 0 <= x < n where the given +-- filter function returns true. +randIntegerUptoNMinusOneSuchThat :: (Integer -> Bool) -- ^ a filter function + -> Integer -- ^ one plus the upper limit + -> IO Integer +randIntegerUptoNMinusOneSuchThat f range = withBN range (\bnRange -> (do + r <- newBN 0 + let try = do + _BN_rand_range (unwrapBN r) (unwrapBN bnRange) >>= failIf (/= 1) + i <- bnToInteger r + if f i + then return i + else try + try)) + +-- | Return a random number in the range 0 <= x < n where the given +-- filter function returns true. +prandIntegerUptoNMinusOneSuchThat :: (Integer -> Bool) -- ^ a filter function + -> Integer -- ^ one plus the upper limit + -> IO Integer +prandIntegerUptoNMinusOneSuchThat f range = withBN range (\bnRange -> (do + r <- newBN 0 + let try = do + _BN_rand_range (unwrapBN r) (unwrapBN bnRange) >>= failIf (/= 1) + i <- bnToInteger r + if f i + then return i + else try + try)) + +-- | Return a strongly random number in the range 0 <= x < n +randIntegerZeroToNMinusOne :: Integer -> IO Integer +randIntegerZeroToNMinusOne = randIntegerUptoNMinusOneSuchThat (const True) +-- | Return a strongly random number in the range 0 < x < n +randIntegerOneToNMinusOne :: Integer -> IO Integer +randIntegerOneToNMinusOne = randIntegerUptoNMinusOneSuchThat (/= 0) + +-- | Return a random number in the range 0 <= x < n +prandIntegerZeroToNMinusOne :: Integer -> IO Integer +prandIntegerZeroToNMinusOne = prandIntegerUptoNMinusOneSuchThat (const True) +-- | Return a random number in the range 0 < x < n +prandIntegerOneToNMinusOne :: Integer -> IO Integer +prandIntegerOneToNMinusOne = prandIntegerUptoNMinusOneSuchThat (/= 0) diff --git a/OpenSSL/Cipher.hsc b/OpenSSL/Cipher.hsc new file mode 100644 --- /dev/null +++ b/OpenSSL/Cipher.hsc @@ -0,0 +1,116 @@ +#include "HsOpenSSL.h" +#include "openssl/aes.h" + +-- | This module interfaces to some of the OpenSSL ciphers without using +-- EVP (see OpenSSL.EVP.Cipher). The EVP ciphers are easier to use, +-- however, in some cases you cannot do without using the OpenSSL +-- fuctions directly. +-- +-- One of these cases (and the motivating example +-- for this module) is that the EVP CBC functions try to encode the +-- length of the input string in the output (thus hiding the fact that the +-- cipher is, in fact, block based and needs padding). This means that the +-- EVP CBC functions cannot, in some cases, interface with other users +-- which don't use that system (like SSH). +module OpenSSL.Cipher + ( Mode(..) + , newAESCtx + , aesCBC + , aesCTR) + where + +import Control.Monad (when) +import Data.IORef +import Foreign +import Foreign.C.Types +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base as BSB +import OpenSSL.Utils + +data Mode = Encrypt | Decrypt deriving (Eq, Show) + +modeToInt Encrypt = 1 +modeToInt Decrypt = 0 + +data AES_KEY +data AESCtx = AESCtx + (ForeignPtr AES_KEY) -- the key schedule + (ForeignPtr CUChar) -- the IV / counter + (ForeignPtr CUChar) -- the encrypted counter (CTR mode) + (IORef CUInt) -- the number of bytes of the encrypted counter used + Mode + +foreign import ccall unsafe "memcpy" + _memcpy :: Ptr CUChar -> Ptr CChar -> CSize -> IO () + +foreign import ccall unsafe "memset" + _memset :: Ptr CUChar -> CChar -> CSize -> IO () + +foreign import ccall unsafe "AES_set_encrypt_key" + _AES_set_encrypt_key :: Ptr CChar -> CInt -> Ptr AES_KEY -> IO CInt +foreign import ccall unsafe "AES_set_decrypt_key" + _AES_set_decrypt_key :: Ptr CChar -> CInt -> Ptr AES_KEY -> IO CInt + +foreign import ccall unsafe "AES_cbc_encrypt" + _AES_cbc_encrypt :: Ptr CChar -> Ptr Word8 -> CULong -> Ptr AES_KEY -> Ptr CUChar -> CInt -> IO () + +foreign import ccall unsafe "AES_ctr128_encrypt" + _AES_ctr_encrypt :: Ptr CChar -> Ptr Word8 -> CULong -> Ptr AES_KEY -> Ptr CUChar -> Ptr CUChar -> Ptr CUInt -> IO () + +foreign import ccall unsafe "&free" + _free :: FunPtr (Ptr a -> IO ()) + +-- | Construct a new context which holds the key schedule and IV. +newAESCtx :: Mode -- ^ For CTR mode, this must always be Encrypt + -> BS.ByteString -- ^ Key: 128, 192 or 256 bits long + -> BS.ByteString -- ^ IV: 16 bytes long + -> IO AESCtx +newAESCtx mode key iv = do + let keyLen = BS.length key * 8 + when (not $ any ((==) keyLen) [128, 192, 256]) $ fail "Bad AES key length" + when (BS.length iv /= 16) $ fail "Bad AES128 iv length" + ctx <- mallocForeignPtrBytes (#size AES_KEY) + withForeignPtr ctx $ \ctxPtr -> + BS.useAsCStringLen key (\(ptr, len) -> + case mode of + Encrypt -> _AES_set_encrypt_key ptr (fromIntegral keyLen) ctxPtr >>= failIf (/= 0) + Decrypt -> _AES_set_decrypt_key ptr (fromIntegral keyLen) ctxPtr >>= failIf (/= 0)) + ivbytes <- mallocForeignPtrBytes 16 + ecounter <- mallocForeignPtrBytes 16 + nref <- newIORef 0 + withForeignPtr ecounter (\ecptr -> _memset ecptr 0 16) + withForeignPtr ivbytes $ \ivPtr -> + BS.useAsCStringLen iv $ \(ptr, len) -> + do _memcpy ivPtr ptr 16 + return $ AESCtx ctx ivbytes ecounter nref mode + +-- | Encrypt some number of blocks using CBC. This is an IO function because +-- the context is destructivly updated. +aesCBC :: AESCtx -- ^ context + -> BS.ByteString -- ^ input, must be multiple of block size (16 bytes) + -> IO BS.ByteString +aesCBC (AESCtx ctx iv _ _ mode) input = do + when (BS.length input `mod` 16 /= 0) $ fail "Bad input length to aesCBC" + withForeignPtr ctx $ \ctxPtr -> + withForeignPtr iv $ \ivPtr -> + BS.useAsCStringLen input $ \(ptr, len) -> + BSB.create (BS.length input) $ \out -> + _AES_cbc_encrypt ptr out (fromIntegral len) ctxPtr ivPtr $ modeToInt mode + +-- | Encrypt some number of bytes using CTR mode. This is an IO function +-- because the context is destructivly updated. +aesCTR :: AESCtx -- ^ context + -> BS.ByteString -- ^ input, any number of bytes + -> IO BS.ByteString +aesCTR (AESCtx ctx iv ecounter nref Encrypt) input = do + withForeignPtr ctx $ \ctxPtr -> + withForeignPtr iv $ \ivPtr -> + withForeignPtr ecounter $ \ecptr -> + BS.useAsCStringLen input $ \(ptr, len) -> + BSB.create (BS.length input) $ \out -> + alloca $ \nptr -> do + n <- readIORef nref + poke nptr n + _AES_ctr_encrypt ptr out (fromIntegral len) ctxPtr ivPtr ecptr nptr + n' <- peek nptr + writeIORef nref n' diff --git a/OpenSSL/DSA.hsc b/OpenSSL/DSA.hsc --- a/OpenSSL/DSA.hsc +++ b/OpenSSL/DSA.hsc @@ -1,5 +1,7 @@ {- -*- haskell -*- -} +-- #prune + -- | The Digital Signature Algorithm (FIPS 186-2). -- See @@ -8,6 +10,8 @@ module OpenSSL.DSA ( -- * Type DSA + , DSA_ -- private + , withDSAPtr -- private -- * Key and parameter generation , generateParameters @@ -48,7 +52,7 @@ dsa_free :: Ptr DSA_ -> IO () foreign import ccall unsafe "BN_free" - _bn_free :: BigNum -> IO () + _bn_free :: Ptr BIGNUM -> IO () foreign import ccall unsafe "DSA_new" _dsa_new :: IO (Ptr DSA_) @@ -57,10 +61,10 @@ _dsa_generate_key :: Ptr DSA_ -> IO () foreign import ccall unsafe "HsOpenSSL_dsa_sign" - _dsa_sign :: Ptr DSA_ -> CString -> Int -> Ptr BigNum -> Ptr BigNum -> IO Int + _dsa_sign :: Ptr DSA_ -> CString -> Int -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO Int foreign import ccall unsafe "HsOpenSSL_dsa_verify" - _dsa_verify :: Ptr DSA_ -> CString -> Int -> BigNum -> BigNum -> IO Int + _dsa_verify :: Ptr DSA_ -> CString -> Int -> Ptr BIGNUM -> Ptr BIGNUM -> IO Int withDSAPtr :: DSA -> (Ptr DSA_ -> IO a) -> IO a withDSAPtr (DSA ptr) = withForeignPtr ptr @@ -68,13 +72,13 @@ foreign import ccall safe "DSA_generate_parameters" _generate_params :: Int -> Ptr CChar -> Int -> Ptr CInt -> Ptr CInt -> Ptr () -> Ptr () -> IO (Ptr DSA_) -peekDSA :: (Ptr DSA_ -> IO BigNum) -> DSA -> IO (Maybe Integer) +peekDSA :: (Ptr DSA_ -> IO (Ptr BIGNUM)) -> DSA -> IO (Maybe Integer) peekDSA peeker (DSA dsa) = do withForeignPtr dsa (\ptr -> do bn <- peeker ptr if bn == nullPtr then return Nothing - else peekBN bn >>= return . Just) + else peekBN (wrapBN bn) >>= return . Just) -- | Generate DSA parameters (*not* a key, but required for a key). This is a -- compute intensive operation. See FIPS 186-2, app 2. This agrees with the @@ -93,9 +97,9 @@ failIfNull ptr itcount <- peek i1 gencount <- peek i2 - p <- (#peek DSA, p) ptr >>= peekBN - q <- (#peek DSA, q) ptr >>= peekBN - g <- (#peek DSA, g) ptr >>= peekBN + p <- (#peek DSA, p) ptr >>= peekBN . wrapBN + q <- (#peek DSA, q) ptr >>= peekBN . wrapBN + g <- (#peek DSA, g) ptr >>= peekBN . wrapBN dsa_free ptr return (fromIntegral itcount, fromIntegral gencount, p, q, g)))) @@ -126,24 +130,29 @@ -> IO DSA generateKey p q g = do ptr <- _dsa_new - newBN p >>= (#poke DSA, p) ptr - newBN q >>= (#poke DSA, q) ptr - newBN g >>= (#poke DSA, g) ptr + newBN p >>= return . unwrapBN >>= (#poke DSA, p) ptr + newBN q >>= return . unwrapBN >>= (#poke DSA, q) ptr + newBN g >>= return . unwrapBN >>= (#poke DSA, g) ptr _dsa_generate_key ptr newForeignPtr _free ptr >>= return . DSA +-- |Return the public prime number of the key. dsaP :: DSA -> IO (Maybe Integer) dsaP = peekDSA (#peek DSA, p) +-- |Return the public 160-bit subprime, @q | p-1@ of the key. dsaQ :: DSA -> IO (Maybe Integer) dsaQ = peekDSA (#peek DSA, q) +-- |Return the public generator of subgroup of the key. dsaG :: DSA -> IO (Maybe Integer) dsaG = peekDSA (#peek DSA, g) +-- |Return the public key @y = g^x@. dsaPublic :: DSA -> IO (Maybe Integer) dsaPublic = peekDSA (#peek DSA, pub_key) +-- |Return the private key @x@. dsaPrivate :: DSA -> IO (Maybe Integer) dsaPrivate = peekDSA (#peek DSA, priv_key) @@ -164,12 +173,12 @@ tupleToDSA :: (Integer, Integer, Integer, Integer, Maybe Integer) -> IO DSA tupleToDSA (p, q, g, pub, mpriv) = do ptr <- _dsa_new - newBN p >>= (#poke DSA, p) ptr - newBN q >>= (#poke DSA, q) ptr - newBN g >>= (#poke DSA, g) ptr - newBN pub >>= (#poke DSA, pub_key) ptr + newBN p >>= return . unwrapBN >>= (#poke DSA, p) ptr + newBN q >>= return . unwrapBN >>= (#poke DSA, q) ptr + newBN g >>= return . unwrapBN >>= (#poke DSA, g) ptr + newBN pub >>= return . unwrapBN >>= (#poke DSA, pub_key) ptr case mpriv of - Just priv -> newBN priv >>= (#poke DSA, priv_key) ptr + Just priv -> newBN priv >>= return . unwrapBN >>= (#poke DSA, priv_key) ptr Nothing -> (#poke DSA, priv_key) ptr nullPtr newForeignPtr _free ptr >>= return . DSA @@ -197,9 +206,9 @@ alloca (\sptr -> do withDSAPtr dsa (\dsaptr -> do _dsa_sign dsaptr ptr len rptr sptr >>= failIf (== 0) - r <- peek rptr >>= peekBN + r <- peek rptr >>= peekBN . wrapBN peek rptr >>= _bn_free - s <- peek sptr >>= peekBN + s <- peek sptr >>= peekBN . wrapBN peek sptr >>= _bn_free return (r, s))))) @@ -210,4 +219,4 @@ withBN r (\bnR -> do withBN s (\bnS -> do withDSAPtr dsa (\dsaptr -> do - _dsa_verify dsaptr ptr len bnR bnS >>= return . (== 1))))) + _dsa_verify dsaptr ptr len (unwrapBN bnR) (unwrapBN bnS) >>= return . (== 1))))) diff --git a/OpenSSL/EVP/Digest.hsc b/OpenSSL/EVP/Digest.hsc --- a/OpenSSL/EVP/Digest.hsc +++ b/OpenSSL/EVP/Digest.hsc @@ -24,11 +24,14 @@ , digest , digestBS , digestLBS + + , hmacBS ) where import Control.Monad import Data.ByteString.Base +import Data.ByteString (copyCStringLen) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8 import Foreign @@ -173,3 +176,24 @@ = unsafePerformIO $ do ctx <- digestLazily md input digestFinal ctx + +{- HMAC ---------------------------------------------------------------------- -} + +foreign import ccall unsafe "HMAC" + _HMAC :: Ptr EVP_MD -> Ptr CChar -> CInt -> Ptr CChar -> CInt + -> Ptr CChar -> Ptr CUInt -> IO () + +-- | Perform a private key signing using the HMAC template with a given hash +hmacBS :: Digest -- ^ the hash function to use in the HMAC calculation + -> ByteString -- ^ the HMAC key + -> ByteString -- ^ the data to be signed + -> ByteString -- ^ resulting HMAC +hmacBS (Digest md) key input = + unsafePerformIO $ + allocaArray (#const EVP_MAX_MD_SIZE) $ \bufPtr -> + alloca $ \bufLenPtr -> + unsafeUseAsCStringLen key $ \(keydata, keylen) -> + unsafeUseAsCStringLen input $ \(inputdata, inputlen) -> + do _HMAC md keydata (fromIntegral keylen) inputdata (fromIntegral inputlen) bufPtr bufLenPtr + bufLen <- liftM fromIntegral $ peek bufLenPtr + copyCStringLen (bufPtr, bufLen) diff --git a/OpenSSL/EVP/PKey.hsc b/OpenSSL/EVP/PKey.hsc --- a/OpenSSL/EVP/PKey.hsc +++ b/OpenSSL/EVP/PKey.hsc @@ -21,10 +21,14 @@ #ifndef OPENSSL_NO_RSA , newPKeyRSA #endif +#ifndef OPENSSL_NO_DSA + , newPKeyDSA +#endif ) where import Foreign +import OpenSSL.DSA import OpenSSL.EVP.Digest import OpenSSL.RSA import OpenSSL.Utils @@ -91,12 +95,27 @@ foreign import ccall unsafe "EVP_PKEY_set1_RSA" _set1_RSA :: Ptr EVP_PKEY -> Ptr RSA_ -> IO Int --- |@'newPKeyRSA' rsa@ encapsulates an 'RSA' key into 'PKey'. +-- |@'newPKeyRSA' rsa@ encapsulates an RSA key into 'PKey'. newPKeyRSA :: RSA -> PKey newPKeyRSA rsa = unsafePerformIO $ withRSAPtr rsa $ \ rsaPtr -> do pkeyPtr <- _pkey_new >>= failIfNull _set1_RSA pkeyPtr rsaPtr >>= failIf (/= 1) + wrapPKeyPtr pkeyPtr +#endif + + +#ifndef OPENSSL_NO_DSA +foreign import ccall unsafe "EVP_PKEY_set1_DSA" + _set1_DSA :: Ptr EVP_PKEY -> Ptr DSA_ -> IO Int + +-- |@'newPKeyDSA' dsa@ encapsulates an 'DSA' key into 'PKey'. +newPKeyDSA :: DSA -> PKey +newPKeyDSA dsa + = unsafePerformIO $ + withDSAPtr dsa $ \ dsaPtr -> + do pkeyPtr <- _pkey_new >>= failIfNull + _set1_DSA pkeyPtr dsaPtr >>= failIf (/= 1) wrapPKeyPtr pkeyPtr #endif diff --git a/OpenSSL/RSA.hsc b/OpenSSL/RSA.hsc --- a/OpenSSL/RSA.hsc +++ b/OpenSSL/RSA.hsc @@ -106,7 +106,7 @@ = withRSAPtr rsa $ \ rsaPtr -> do bn <- peeker rsaPtr when (bn == nullPtr) $ fail "peekRSAPublic: got a nullPtr" - peekBN bn + peekBN (wrapBN bn) peekRSAPrivate :: (Ptr RSA_ -> IO (Ptr BIGNUM)) -> RSA -> IO (Maybe Integer) @@ -116,7 +116,7 @@ if bn == nullPtr then return Nothing else - peekBN bn >>= return . Just + peekBN (wrapBN bn) >>= return . Just -- |@'rsaN' pubKey@ returns the public modulus of the key. rsaN :: RSA -> IO Integer diff --git a/OpenSSL/Random.hsc b/OpenSSL/Random.hsc new file mode 100644 --- /dev/null +++ b/OpenSSL/Random.hsc @@ -0,0 +1,56 @@ +{- -*- haskell -*- -} + +-- | PRNG services +-- See +-- For random Integer generation, see "OpenSSL.BN" + +#include "HsOpenSSL.h" + +module OpenSSL.Random + ( -- * Random byte generation + randBytes + , prandBytes + , add + ) where + +import Foreign +import Foreign.C.Types +import qualified Data.ByteString as BS +import OpenSSL.Utils + +foreign import ccall unsafe "RAND_bytes" + _RAND_bytes :: Ptr CChar -> CInt -> IO CInt + +foreign import ccall unsafe "RAND_pseudo_bytes" + _RAND_pseudo_bytes :: Ptr CChar -> CInt -> IO () + +foreign import ccall unsafe "RAND_add" + _RAND_add :: Ptr CChar -> CInt -> CInt -> IO () + +-- | Return a bytestring consisting of the given number of strongly random +-- bytes +randBytes :: Int -- ^ the number of bytes requested + -> IO BS.ByteString +randBytes n = + allocaArray n $ \bufPtr -> + do _RAND_bytes bufPtr (fromIntegral n) >>= failIf (/= 1) + BS.copyCStringLen (bufPtr, n) + +-- | Return a bytestring consisting of the given number of pseudo random +-- bytes +prandBytes :: Int -- ^ the number of bytes requested + -> IO BS.ByteString +prandBytes n = + allocaArray n $ \bufPtr -> + do _RAND_pseudo_bytes bufPtr (fromIntegral n) + BS.copyCStringLen (bufPtr, n) + +-- | Add data to the entropy pool. It's safe to add sensitive information +-- (e.g. user passwords etc) to the pool. Also, adding data with an entropy +-- of 0 can never hurt. +add :: BS.ByteString -- ^ random data to be added to the pool + -> Int -- ^ the number of bits of entropy in the first argument + -> IO () +add bs entropy = + BS.useAsCStringLen bs $ \(ptr, len) -> + _RAND_add ptr (fromIntegral len) (fromIntegral entropy) diff --git a/cbits/HsOpenSSL.h b/cbits/HsOpenSSL.h --- a/cbits/HsOpenSSL.h +++ b/cbits/HsOpenSSL.h @@ -5,6 +5,8 @@ #include #include #include +#include +#include #include #include #include