packages feed

HsOpenSSL 0.2 → 0.3

raw patch · 12 files changed

+462/−59 lines, 12 files

Files

HsOpenSSL.cabal view
@@ -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 <phonohawk at ps dot sakura dot ne dot jp>@@ -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
NEWS view
@@ -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:
OpenSSL.hsc view
@@ -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. --
OpenSSL/ASN1.hsc view
@@ -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
OpenSSL/BN.hsc view
@@ -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)
+ OpenSSL/Cipher.hsc view
@@ -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'
OpenSSL/DSA.hsc view
@@ -1,5 +1,7 @@ {- -*- haskell -*- -} +-- #prune+ -- | The Digital Signature Algorithm (FIPS 186-2). --   See <http://www.openssl.org/docs/crypto/dsa.html> @@ -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)))))
OpenSSL/EVP/Digest.hsc view
@@ -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)
OpenSSL/EVP/PKey.hsc view
@@ -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
OpenSSL/RSA.hsc view
@@ -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
+ OpenSSL/Random.hsc view
@@ -0,0 +1,56 @@+{- -*- haskell -*- -}++-- | PRNG services+--   See <http://www.openssl.org/docs/crypto/rand.html>+--   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)
cbits/HsOpenSSL.h view
@@ -5,6 +5,8 @@ #include <openssl/bn.h> #include <openssl/err.h> #include <openssl/evp.h>+#include <openssl/hmac.h>+#include <openssl/rand.h> #include <openssl/objects.h> #include <openssl/opensslconf.h> #include <openssl/pem.h>