HsOpenSSL 0.11.3.2 → 0.11.4

raw patch · 14 files changed

+354/−198 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog +6/−0
• HsOpenSSL.cabal +1/−15
• OpenSSL.hs +4/−4
• OpenSSL/Cipher.hsc +10/−4
• OpenSSL/DSA.hsc +93/−31
• OpenSSL/EVP/Internal.hsc +40/−24
• OpenSSL/EVP/PKey.hsc +15/−4
• OpenSSL/RSA.hsc +79/−11
• OpenSSL/SSL.hs +0/−16
• OpenSSL/Session.hsc +4/−0
• OpenSSL/X509/Revocation.hsc +23/−2
• Test/OpenSSL/Cipher.hs +0/−74
• cbits/HsOpenSSL.c +74/−8
• cbits/HsOpenSSL.h +5/−5

@@ -1,3 +1,9 @@+2017-01-24  Vladimir Shabanov  <vshabanoff@gmail.com>++	* HsOpenSSL.cabal (Version): Bump version to 0.11.4++	* Updated for OpenSSL 1.1.0 (#15)+ 2016-10-17  Vladimir Shabanov  <vshabanoff@gmail.com>  	* HsOpenSSL.cabal (Version): Bump version to 0.11.3.2

@@ -12,7 +12,7 @@     <http://hackage.haskell.org/package/tls>, which is a pure Haskell     implementation of SSL.     .-Version:       0.11.3.2+Version:       0.11.4 License:       PublicDomain License-File:  COPYING Author:        Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen@@ -127,7 +127,6 @@         OpenSSL.BIO         OpenSSL.ERR         OpenSSL.Objects-        OpenSSL.SSL         OpenSSL.SSL.Option         OpenSSL.Stack         OpenSSL.Utils@@ -143,19 +142,6 @@         cbits     Includes:         openssl/asn1.h--Test-Suite test-cipher-    Type:    exitcode-stdio-1.0-    Main-Is: Test/OpenSSL/Cipher.hs-    Other-Modules: Test.OpenSSL.TestUtils-    Build-Depends:-        HsOpenSSL,-        base                 >= 4.4 && < 5,-        bytestring           >= 0.9 && < 0.11-    Default-Language:-        Haskell2010-    GHC-Options:-        -Wall  Test-Suite test-dsa     Type:    exitcode-stdio-1.0

@@ -46,13 +46,15 @@     where import Control.Concurrent.MVar import Control.Monad-import OpenSSL.SSL import System.IO.Unsafe  #if !MIN_VERSION_base(4,6,0) import Control.Exception (onException, mask_) #endif +foreign import ccall "HsOpenSSL_init"+        initSSL :: IO ()+ foreign import ccall "HsOpenSSL_setupMutex"         setupMutex :: IO () @@ -81,9 +83,7 @@     -- We don't want our initialisation sequence to be interrupted     -- halfway.     = do modifyMVarMasked_ isInitialised $ \ done ->-             do unless done $ do loadErrorStrings-                                 addAllAlgorithms-                                 libraryInit+             do unless done $ do initSSL                                  setupMutex                 return True          io

@@ -16,7 +16,10 @@     , AESCtx     , newAESCtx     , aesCBC-    , aesCTR)+#if OPENSSL_VERSION_NUMBER < 0x10100000L+    , aesCTR+#endif+    )     where #include "HsOpenSSL.h" #include "openssl/aes.h"@@ -56,9 +59,6 @@ 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 ()) @@ -99,6 +99,11 @@     BSI.create (BS.length input) $ \out ->     _AES_cbc_encrypt ptr out (fromIntegral len) ctxPtr ivPtr $ modeToInt mode +#if OPENSSL_VERSION_NUMBER < 0x10100000L+-- seems that AES_ctr128_encrypt was removed in recent OpenSSL versions+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 ()+ -- | Encrypt some number of bytes using CTR mode. This is an IO function --   because the context is destructivly updated. aesCTR :: AESCtx  -- ^ context@@ -117,3 +122,4 @@       _AES_ctr_encrypt ptr out (fromIntegral len) ctxPtr ivPtr ecptr nptr       n' <- peek nptr       writeIORef nref n'+#endif

@@ -68,19 +68,19 @@      -- |Return the public prime number of the key.     dsaP :: k -> Integer-    dsaP = peekI (#peek DSA, p)+    dsaP = peekI dsa_p      -- |Return the public 160-bit subprime, @q | p - 1@ of the key.     dsaQ :: k -> Integer-    dsaQ = peekI (#peek DSA, q)+    dsaQ = peekI dsa_q      -- |Return the public generator of subgroup of the key.     dsaG :: k -> Integer-    dsaG = peekI (#peek DSA, g)+    dsaG = peekI dsa_g      -- |Return the public key @y = g^x@.     dsaPublic :: k -> Integer-    dsaPublic = peekI (#peek DSA, pub_key)+    dsaPublic = peekI dsa_pub_key      -- private     withDSAPtr   :: k -> (Ptr DSA -> IO a) -> IO a@@ -112,7 +112,7 @@  hasDSAPrivateKey :: Ptr DSA -> IO Bool hasDSAPrivateKey dsaPtr-    = fmap (/= nullPtr) ((#peek DSA, priv_key) dsaPtr)+    = fmap (/= nullPtr) (dsa_priv_key dsaPtr)   foreign import ccall unsafe "&DSA_free"@@ -148,6 +148,73 @@ foreign import ccall unsafe "DSA_size"         _size :: Ptr DSA -> IO CInt +dsa_p, dsa_q, dsa_g, dsa_pub_key, dsa_priv_key :: Ptr DSA -> IO (Ptr BIGNUM)+setPQG :: Ptr DSA -> Integer -> Integer -> Integer -> IO ()+setKey :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO ()++#if OPENSSL_VERSION_NUMBER >= 0x10100000L++foreign import ccall unsafe "DSA_get0_pqg"+        _get0_pqg :: Ptr DSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO ()++foreign import ccall unsafe "DSA_get0_key"+        _get0_key :: Ptr DSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO ()++foreign import ccall unsafe "DSA_set0_pqg"+        _set0_pqg :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt++foreign import ccall unsafe "DSA_set0_key"+        _set0_key :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt++withPQG :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a)+        -> Ptr DSA -> IO a+withPQG f dsa = alloca $ \ p -> alloca $ \ q -> alloca $ \ g -> do+    poke p nullPtr+    poke q nullPtr+    poke g nullPtr+    _get0_pqg dsa p q g+    f p q g++dsa_p = withPQG $ \ p _ _ -> peek p+dsa_q = withPQG $ \ _ q _ -> peek q+dsa_g = withPQG $ \ _ _ g -> peek g++withKey :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a) -> Ptr DSA -> IO a+withKey f dsa = alloca $ \ pub -> alloca $ \ priv -> do+    poke pub nullPtr+    poke priv nullPtr+    _get0_key dsa pub priv+    f pub priv+dsa_pub_key  = withKey $ \ p _ -> peek p+dsa_priv_key = withKey $ \ _ p -> peek p++setPQG ptr p q g = do+  p' <- fmap unwrapBN (newBN p)+  q' <- fmap unwrapBN (newBN q)+  g' <- fmap unwrapBN (newBN g)+  void $ _set0_pqg ptr p' q' g'++setKey ptr pub priv = void $ _set0_key ptr pub priv++#else++dsa_p = (#peek DSA, p)+dsa_q = (#peek DSA, q)+dsa_g = (#peek DSA, g)+dsa_pub_key  = (#peek DSA, pub_key)+dsa_priv_key = (#peek DSA, priv_key)++setPQG ptr p q g = do+  fmap unwrapBN (newBN p) >>= (#poke DSA, p) ptr+  fmap unwrapBN (newBN q) >>= (#poke DSA, q) ptr+  fmap unwrapBN (newBN g) >>= (#poke DSA, g) ptr++setKey ptr pub priv = do+  (#poke DSA, pub_key ) ptr pub+  (#poke DSA, priv_key) ptr priv++#endif+ peekI :: DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer peekI peeker dsa     = unsafePerformIO $@@ -173,9 +240,9 @@         failIfNull_ ptr         itcount <- peek i1         gencount <- peek i2-        p <- (#peek DSA, p) ptr >>= peekBN . wrapBN-        q <- (#peek DSA, q) ptr >>= peekBN . wrapBN-        g <- (#peek DSA, g) ptr >>= peekBN . wrapBN+        p <- dsa_p ptr >>= peekBN . wrapBN+        q <- dsa_q ptr >>= peekBN . wrapBN+        g <- dsa_g ptr >>= peekBN . wrapBN         dsa_free ptr         return (fromIntegral itcount, fromIntegral gencount, p, q, g)))) @@ -206,24 +273,22 @@                -> IO DSAKeyPair generateDSAKey p q g = do   ptr <- _dsa_new-  fmap unwrapBN (newBN p) >>= (#poke DSA, p) ptr-  fmap unwrapBN (newBN q) >>= (#poke DSA, q) ptr-  fmap unwrapBN (newBN g) >>= (#poke DSA, g) ptr+  setPQG ptr p q g   _dsa_generate_key ptr   fmap DSAKeyPair (newForeignPtr _free ptr)  -- |Return the private key @x@. dsaPrivate :: DSAKeyPair -> Integer-dsaPrivate = peekI (#peek DSA, priv_key)+dsaPrivate = peekI dsa_priv_key  -- | Convert a DSAPubKey object to a tuple of its members in the --   order p, q, g, and public. dsaPubKeyToTuple :: DSAKeyPair -> (Integer, Integer, Integer, Integer) dsaPubKeyToTuple dsa-    = let p   = peekI (#peek DSA, p) dsa-          q   = peekI (#peek DSA, q) dsa-          g   = peekI (#peek DSA, g) dsa-          pub = peekI (#peek DSA, pub_key) dsa+    = let p   = peekI dsa_p dsa+          q   = peekI dsa_q dsa+          g   = peekI dsa_g dsa+          pub = peekI dsa_pub_key dsa       in         (p, q, g, pub) @@ -231,11 +296,11 @@ --   order p, q, g, public and private. dsaKeyPairToTuple :: DSAKeyPair -> (Integer, Integer, Integer, Integer, Integer) dsaKeyPairToTuple dsa-    = let p   = peekI (#peek DSA, p) dsa-          q   = peekI (#peek DSA, q) dsa-          g   = peekI (#peek DSA, g) dsa-          pub = peekI (#peek DSA, pub_key ) dsa-          pri = peekI (#peek DSA, priv_key) dsa+    = let p   = peekI dsa_p dsa+          q   = peekI dsa_q dsa+          g   = peekI dsa_g dsa+          pub = peekI dsa_pub_key  dsa+          pri = peekI dsa_priv_key dsa       in         (p, q, g, pub, pri) @@ -244,11 +309,9 @@ tupleToDSAPubKey :: (Integer, Integer, Integer, Integer) -> DSAPubKey tupleToDSAPubKey (p, q, g, pub) = unsafePerformIO $ do   ptr <- _dsa_new-  fmap unwrapBN (newBN p  ) >>= (#poke DSA, p) ptr-  fmap unwrapBN (newBN q  ) >>= (#poke DSA, q) ptr-  fmap unwrapBN (newBN g  ) >>= (#poke DSA, g) ptr-  fmap unwrapBN (newBN pub) >>= (#poke DSA, pub_key) ptr-  (#poke DSA, priv_key) ptr nullPtr+  setPQG ptr p q g+  pub' <- fmap unwrapBN (newBN pub)+  setKey ptr pub' nullPtr   fmap DSAPubKey (newForeignPtr _free ptr)  -- | Convert a tuple of members (in the same format as from@@ -256,11 +319,10 @@ tupleToDSAKeyPair :: (Integer, Integer, Integer, Integer, Integer) -> DSAKeyPair tupleToDSAKeyPair (p, q, g, pub, pri) = unsafePerformIO $ do   ptr <- _dsa_new-  fmap unwrapBN (newBN p  ) >>= (#poke DSA, p) ptr-  fmap unwrapBN (newBN q  ) >>= (#poke DSA, q) ptr-  fmap unwrapBN (newBN g  ) >>= (#poke DSA, g) ptr-  fmap unwrapBN (newBN pub) >>= (#poke DSA, pub_key ) ptr-  fmap unwrapBN (newBN pri) >>= (#poke DSA, priv_key) ptr+  setPQG ptr p q g+  pub' <- fmap unwrapBN (newBN pub)+  priv' <- fmap unwrapBN (newBN pri)+  setKey ptr pub' priv'   fmap DSAKeyPair (newForeignPtr _free ptr)  -- | A utility function to generate both the parameters and the key pair at the

@@ -56,7 +56,7 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif-import Control.Exception (mask, mask_, bracket_, onException)+import Control.Exception (mask, mask_, bracket, onException) import Foreign.C.Types (CChar) #if MIN_VERSION_base(4,5,0) import Foreign.C.Types (CInt(..), CUInt(..), CSize(..))@@ -72,7 +72,7 @@ import Foreign.ForeignPtr as Unsafe #endif import Foreign.Storable (Storable(..))-import Foreign.Marshal.Alloc (alloca, allocaBytes)+import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array (allocaArray) import System.IO.Unsafe (unsafeInterleaveIO) import OpenSSL.Utils@@ -98,24 +98,30 @@ newtype CipherCtx      = CipherCtx (ForeignPtr EVP_CIPHER_CTX) data    EVP_CIPHER_CTX +foreign import ccall unsafe "EVP_CIPHER_CTX_new"+  _cipher_ctx_new :: IO (Ptr EVP_CIPHER_CTX)++#if OPENSSL_VERSION_NUMBER >= 0x10100000L+foreign import ccall unsafe "EVP_CIPHER_CTX_reset"+  _cipher_ctx_reset :: Ptr EVP_CIPHER_CTX -> IO ()+#else foreign import ccall unsafe "EVP_CIPHER_CTX_init"-  _cipher_ctx_init :: Ptr EVP_CIPHER_CTX -> IO ()+  _cipher_ctx_reset :: Ptr EVP_CIPHER_CTX -> IO ()+#endif -foreign import ccall unsafe "&EVP_CIPHER_CTX_cleanup"-  _cipher_ctx_cleanup :: FunPtr (Ptr EVP_CIPHER_CTX -> IO ())+foreign import ccall unsafe "&EVP_CIPHER_CTX_free"+  _cipher_ctx_free :: FunPtr (Ptr EVP_CIPHER_CTX -> IO ()) -foreign import ccall unsafe "EVP_CIPHER_CTX_cleanup"-  _cipher_ctx_cleanup' :: Ptr EVP_CIPHER_CTX -> IO ()+foreign import ccall unsafe "EVP_CIPHER_CTX_free"+  _cipher_ctx_free' :: Ptr EVP_CIPHER_CTX -> IO ()  foreign import ccall unsafe "HsOpenSSL_EVP_CIPHER_CTX_block_size"   _cipher_ctx_block_size :: Ptr EVP_CIPHER_CTX -> CInt  newCipherCtx :: IO CipherCtx-newCipherCtx = do-  ctx <- mallocForeignPtrBytes (#size EVP_CIPHER_CTX)-  mask_ $ do-    withForeignPtr ctx _cipher_ctx_init-    addForeignPtrFinalizer _cipher_ctx_cleanup ctx+newCipherCtx = mask_ $ do+  ctx <- newForeignPtr _cipher_ctx_free =<< failIfNull =<< _cipher_ctx_new+  withForeignPtr ctx _cipher_ctx_reset   return $ CipherCtx ctx  withCipherCtxPtr :: CipherCtx -> (Ptr EVP_CIPHER_CTX -> IO a) -> IO a@@ -123,8 +129,9 @@  withNewCipherCtxPtr :: (Ptr EVP_CIPHER_CTX -> IO a) -> IO a withNewCipherCtxPtr f =-  allocaBytes (#size EVP_CIPHER_CTX) $ \ptr ->-    bracket_ (_cipher_ctx_init ptr) (_cipher_ctx_cleanup' ptr) (f ptr)+  bracket (failIfNull =<< _cipher_ctx_new) _cipher_ctx_free' $ \ p -> do+    _cipher_ctx_reset p+    f p  {- encrypt/decrypt ----------------------------------------------------------- -} @@ -139,7 +146,7 @@   _SetPadding :: Ptr EVP_CIPHER_CTX -> CInt -> IO CInt  cipherSetPadding :: CipherCtx -> Int -> IO CipherCtx-cipherSetPadding ctx pad +cipherSetPadding ctx pad   = do withCipherCtxPtr ctx $ \ctxPtr ->            _SetPadding ctxPtr (fromIntegral pad)                >>= failIf_ (/= 1)@@ -225,18 +232,27 @@ newtype DigestCtx  = DigestCtx (ForeignPtr EVP_MD_CTX) data    EVP_MD_CTX -foreign import ccall unsafe "EVP_MD_CTX_init"-  _md_ctx_init :: Ptr EVP_MD_CTX -> IO () -foreign import ccall unsafe "&EVP_MD_CTX_cleanup"-  _md_ctx_cleanup :: FunPtr (Ptr EVP_MD_CTX -> IO ())+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+foreign import ccall unsafe "EVP_MD_CTX_new"+  _md_ctx_new :: IO (Ptr EVP_MD_CTX)+foreign import ccall unsafe "EVP_MD_CTX_reset"+  _md_ctx_reset :: Ptr EVP_MD_CTX -> IO ()+foreign import ccall unsafe "&EVP_MD_CTX_free"+  _md_ctx_free :: FunPtr (Ptr EVP_MD_CTX -> IO ())+#else+foreign import ccall unsafe "EVP_MD_CTX_create"+  _md_ctx_new :: IO (Ptr EVP_MD_CTX)+foreign import ccall unsafe "EVP_MD_CTX_init"+  _md_ctx_reset :: Ptr EVP_MD_CTX -> IO ()+foreign import ccall unsafe "&EVP_MD_CTX_destroy"+  _md_ctx_free :: FunPtr (Ptr EVP_MD_CTX -> IO ())+#endif  newDigestCtx :: IO DigestCtx-newDigestCtx = do-  ctx <- mallocForeignPtrBytes (#size EVP_MD_CTX)-  mask_ $ do-    withForeignPtr ctx _md_ctx_init-    addForeignPtrFinalizer _md_ctx_cleanup ctx+newDigestCtx = mask_ $ do+  ctx <- newForeignPtr _md_ctx_free =<< failIfNull =<< _md_ctx_new+  withForeignPtr ctx _md_ctx_reset   return $ DigestCtx ctx  withDigestCtxPtr :: DigestCtx -> (Ptr EVP_MD_CTX -> IO a) -> IO a

@@ -49,11 +49,22 @@     toKeyPair :: SomeKeyPair -> Maybe a     toKeyPair (SomeKeyPair pk) = cast pk ++getType :: Ptr EVP_PKEY -> IO CInt++#if OPENSSL_VERSION_NUMBER >= 0x10100000L+foreign import ccall unsafe "EVP_PKEY_base_id"+        _base_id :: Ptr EVP_PKEY -> IO CInt+getType = _base_id+#else+getType = (#peek EVP_PKEY, type)+#endif+ -- Reconstruct the concrete public-key type from an EVP_PKEY. withConcretePubKey :: VaguePKey -> (forall k. PublicKey k => k -> IO a) -> IO a withConcretePubKey pk f     = withPKeyPtr pk $ \ pkeyPtr ->-          do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt+          do pkeyType <- getType pkeyPtr              case pkeyType of #if !defined(OPENSSL_NO_RSA)                (#const EVP_PKEY_RSA)@@ -73,7 +84,7 @@ withConcreteKeyPair :: VaguePKey -> (forall k. KeyPair k => k -> IO a) -> IO a withConcreteKeyPair pk f     = withPKeyPtr pk $ \ pkeyPtr ->-          do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt+          do pkeyType <- getType pkeyPtr              case pkeyType of #if !defined(OPENSSL_NO_RSA)                (#const EVP_PKEY_RSA)@@ -162,7 +173,7 @@ rsaFromPKey :: RSAKey k => VaguePKey -> IO (Maybe k) rsaFromPKey pk         = withPKeyPtr pk $ \ pkeyPtr ->-          do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt+          do pkeyType <- getType pkeyPtr              case pkeyType of                (#const EVP_PKEY_RSA)                    -> _get1_RSA pkeyPtr >>= absorbRSAPtr@@ -201,7 +212,7 @@ dsaFromPKey :: DSAKey k => VaguePKey -> IO (Maybe k) dsaFromPKey pk         = withPKeyPtr pk $ \ pkeyPtr ->-          do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt+          do pkeyType <- getType pkeyPtr              case pkeyType of                (#const EVP_PKEY_DSA)                    -> _get1_DSA pkeyPtr >>= absorbDSAPtr

@@ -41,6 +41,9 @@ import Foreign.ForeignPtr (ForeignPtr, finalizeForeignPtr, newForeignPtr, withForeignPtr) import Foreign.Ptr (FunPtr, Ptr, freeHaskellFunPtr, nullFunPtr, nullPtr) import Foreign.Storable (Storable(..))+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+import Foreign.Marshal.Alloc (alloca)+#endif import OpenSSL.BN import OpenSSL.Utils import System.IO.Unsafe (unsafePerformIO)@@ -68,11 +71,11 @@      -- |@'rsaN' key@ returns the public modulus of the key.     rsaN :: k -> Integer-    rsaN = peekI (#peek RSA, n)+    rsaN = peekI rsa_n      -- |@'rsaE' key@ returns the public exponent of the key.     rsaE :: k -> Integer-    rsaE = peekI (#peek RSA, e)+    rsaE = peekI rsa_e      -- private     withRSAPtr   :: k -> (Ptr RSA -> IO a) -> IO a@@ -104,9 +107,9 @@  hasRSAPrivateKey :: Ptr RSA -> IO Bool hasRSAPrivateKey rsaPtr-    = do d <- (#peek RSA, d) rsaPtr-         p <- (#peek RSA, p) rsaPtr-         q <- (#peek RSA, q) rsaPtr+    = do d <- rsa_d rsaPtr+         p <- rsa_p rsaPtr+         q <- rsa_q rsaPtr          return (d /= nullPtr && p /= nullPtr && q /= nullPtr)  @@ -195,6 +198,71 @@  {- exploration -------------------------------------------------------------- -} +rsa_n, rsa_e, rsa_d, rsa_p, rsa_q :: Ptr RSA -> IO (Ptr BIGNUM)+rsa_dmp1, rsa_dmq1, rsa_iqmp :: Ptr RSA -> IO (Ptr BIGNUM)++#if OPENSSL_VERSION_NUMBER >= 0x10100000L++foreign import ccall unsafe "RSA_get0_key"+        _get0_key :: Ptr RSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO ()++foreign import ccall unsafe "RSA_get0_factors"+        _get0_factors :: Ptr RSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO ()++foreign import ccall unsafe "RSA_get0_crt_params"+        _get0_crt_params :: Ptr RSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO ()++withNED :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO b)+        -> Ptr RSA -> IO b+withNED f rsa = alloca $ \ n -> alloca $ \ e -> alloca $ \ d -> do+    poke n nullPtr+    poke e nullPtr+    poke d nullPtr+    _get0_key rsa n e d+    f n e d++rsa_n = withNED $ \ n _ _ -> peek n+rsa_e = withNED $ \ _ e _ -> peek e+rsa_d = withNED $ \ _ _ d -> peek d++withFactors+    :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a) -> Ptr RSA -> IO a+withFactors f rsa = alloca $ \ p -> alloca $ \ q -> do+    poke p nullPtr+    poke q nullPtr+    _get0_factors rsa p q+    f p q++rsa_p = withFactors $ \ p _ -> peek p+rsa_q = withFactors $ \ _ q -> peek q++withCrtParams+    :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO b)+    -> Ptr RSA -> IO b+withCrtParams f rsa = alloca $ \ dmp1 -> alloca $ \ dmq1 -> alloca $ \ iqmp -> do+    poke dmp1 nullPtr+    poke dmq1 nullPtr+    poke iqmp nullPtr+    _get0_crt_params rsa dmp1 dmq1 iqmp+    f dmp1 dmq1 iqmp++rsa_dmp1 = withCrtParams $ \ dmp1 _ _ -> peek dmp1+rsa_dmq1 = withCrtParams $ \ _ dmq1 _ -> peek dmq1+rsa_iqmp = withCrtParams $ \ _ _ iqmp -> peek iqmp++#else++rsa_n = (#peek RSA, n)+rsa_e = (#peek RSA, e)+rsa_d = (#peek RSA, d)+rsa_p = (#peek RSA, p)+rsa_q = (#peek RSA, q)+rsa_dmp1 = (#peek RSA, dmp1)+rsa_dmq1 = (#peek RSA, dmq1)+rsa_iqmp = (#peek RSA, iqmp)++#endif+ peekI :: RSAKey a => (Ptr RSA -> IO (Ptr BIGNUM)) -> a -> Integer peekI peeker rsa     = unsafePerformIO $@@ -215,27 +283,27 @@  -- |@'rsaD' privKey@ returns the private exponent of the key. rsaD :: RSAKeyPair -> Integer-rsaD = peekI (#peek RSA, d)+rsaD = peekI rsa_d  -- |@'rsaP' privkey@ returns the secret prime factor @p@ of the key. rsaP :: RSAKeyPair -> Integer-rsaP = peekI (#peek RSA, p)+rsaP = peekI rsa_p  -- |@'rsaQ' privkey@ returns the secret prime factor @q@ of the key. rsaQ :: RSAKeyPair -> Integer-rsaQ = peekI (#peek RSA, q)+rsaQ = peekI rsa_q  -- |@'rsaDMP1' privkey@ returns @d mod (p-1)@ of the key. rsaDMP1 :: RSAKeyPair -> Maybe Integer-rsaDMP1 = peekMI (#peek RSA, dmp1)+rsaDMP1 = peekMI rsa_dmp1  -- |@'rsaDMQ1' privkey@ returns @d mod (q-1)@ of the key. rsaDMQ1 :: RSAKeyPair -> Maybe Integer-rsaDMQ1 = peekMI (#peek RSA, dmq1)+rsaDMQ1 = peekMI rsa_dmq1  -- |@'rsaIQMP' privkey@ returns @q^-1 mod p@ of the key. rsaIQMP :: RSAKeyPair -> Maybe Integer-rsaIQMP = peekMI (#peek RSA, iqmp)+rsaIQMP = peekMI rsa_iqmp  {- instances ---------------------------------------------------------------- -} 

@@ -1,16 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-module OpenSSL.SSL-    ( loadErrorStrings-    , addAllAlgorithms-    , libraryInit-    )-    where--foreign import ccall unsafe "SSL_load_error_strings"-        loadErrorStrings :: IO ()--foreign import ccall unsafe "HsOpenSSL_OpenSSL_add_all_algorithms"-        addAllAlgorithms :: IO ()--foreign import ccall unsafe "SSL_library_init"-        libraryInit :: IO ()

@@ -136,7 +136,11 @@  foreign import ccall unsafe "SSL_CTX_new" _ssl_ctx_new :: Ptr SSLMethod_ -> IO (Ptr SSLContext_) foreign import ccall unsafe "SSL_CTX_free" _ssl_ctx_free :: Ptr SSLContext_ -> IO ()+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+foreign import ccall unsafe "TLS_method" _ssl_method :: IO (Ptr SSLMethod_)+#else foreign import ccall unsafe "SSLv23_method" _ssl_method :: IO (Ptr SSLMethod_)+#endif  -- | Create a new SSL context. context :: IO SSLContext

@@ -289,10 +289,31 @@     = withCRLPtr crl $ \ crlPtr ->         _get_REVOKED crlPtr >>= mapStack peekRevoked +getSerialNumber :: Ptr X509_REVOKED -> IO (Ptr ASN1_INTEGER)+getRevocationDate :: Ptr X509_REVOKED -> IO (Ptr ASN1_TIME)++#if OPENSSL_VERSION_NUMBER >= 0x10100000L++foreign import ccall unsafe "X509_REVOKED_get0_serialNumber"+        _get0_serialNumber :: Ptr X509_REVOKED -> IO (Ptr ASN1_INTEGER)++foreign import ccall unsafe "X509_REVOKED_get0_revocationDate"+        _get0_revocationDate :: Ptr X509_REVOKED -> IO (Ptr ASN1_TIME)++getSerialNumber = _get0_serialNumber+getRevocationDate = _get0_revocationDate++#else++getSerialNumber = (#peek X509_REVOKED, serialNumber  )+getRevocationDate = (#peek X509_REVOKED, revocationDate)++#endif+ peekRevoked :: Ptr X509_REVOKED -> IO RevokedCertificate peekRevoked rev = do-  serial <- peekASN1Integer =<< (#peek X509_REVOKED, serialNumber  ) rev-  date   <- peekASN1Time    =<< (#peek X509_REVOKED, revocationDate) rev+  serial <- peekASN1Integer =<< getSerialNumber rev+  date   <- peekASN1Time    =<< getRevocationDate rev   return RevokedCertificate { revSerialNumber   = serial                             , revRevocationDate = date                             }

@@ -1,74 +0,0 @@--- | Tests for the non-EVP ciphers-module Main (main) where--import qualified Data.ByteString as BS-import OpenSSL.Cipher-import Test.OpenSSL.TestUtils---- | Convert a hex string to a ByteString (e.g. "0011" == BS.pack [0, 0x11])-hexToBS :: String -> BS.ByteString-hexToBS [] = BS.empty-hexToBS (a : b : rest) = BS.append (BS.singleton ((valueOfHexChar a * 16) + valueOfHexChar b))-                                         (hexToBS rest)-hexToBS xs = error ("hexToBS: invalid hex string: " ++ xs)--valueOfHexChar :: Integral a => Char -> a-valueOfHexChar '0' = 0-valueOfHexChar '1' = 1-valueOfHexChar '2' = 2-valueOfHexChar '3' = 3-valueOfHexChar '4' = 4-valueOfHexChar '5' = 5-valueOfHexChar '6' = 6-valueOfHexChar '7' = 7-valueOfHexChar '8' = 8-valueOfHexChar '9' = 9-valueOfHexChar 'a' = 10-valueOfHexChar 'b' = 11-valueOfHexChar 'c' = 12-valueOfHexChar 'd' = 13-valueOfHexChar 'e' = 14-valueOfHexChar 'f' = 15-valueOfHexChar 'A' = 10-valueOfHexChar 'B' = 11-valueOfHexChar 'C' = 12-valueOfHexChar 'D' = 13-valueOfHexChar 'E' = 14-valueOfHexChar 'F' = 15-valueOfHexChar x   = error ("valueOfHexChar: invalid char: " ++ show x)---- | A test containing counter mode test vectors-data CTRTest = CTRTest BS.ByteString  -- ^ key-                       BS.ByteString  -- ^ IV-                       BS.ByteString  -- ^ plaintext-                       BS.ByteString  -- ^ cipher text---- Test vectors from draft-ietf-ipsec-ciph-aes-ctr-05 section 6-ctrTests :: [CTRTest]-ctrTests = [-  CTRTest (hexToBS "AE6852F8121067CC4BF7A5765577F39E")-          (hexToBS "00000030000000000000000000000001")-          (hexToBS "53696E676C6520626C6F636B206D7367")-          (hexToBS "E4095D4FB7A7B3792D6175A3261311B8"),-  CTRTest (hexToBS "7691BE035E5020A8AC6E618529F9A0DC")-          (hexToBS "00E0017B27777F3F4A1786F000000001")-          (hexToBS "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F20212223")-          (hexToBS "C1CF48A89F2FFDD9CF4652E9EFDB72D74540A42BDE6D7836D59A5CEAAEF3105325B2072F"),-  CTRTest (hexToBS "16AF5B145FC9F579C175F93E3BFB0EED863D06CCFDB78515")-          (hexToBS "0000004836733C147D6D93CB00000001")-          (hexToBS "53696E676C6520626C6F636B206D7367")-          (hexToBS "4B55384FE259C9C84E7935A003CBE928"),-  CTRTest (hexToBS "FF7A617CE69148E4F1726E2F43581DE2AA62D9F805532EDFF1EED687FB54153D")-          (hexToBS "001CC5B751A51D70A1C1114800000001")-          (hexToBS "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F20212223")-          (hexToBS "EB6C52821D0BBBF7CE7594462ACA4FAAB407DF866569FD07F48CC0B583D6071F1EC0E6B8") ]--runCtrTest :: CTRTest -> IO ()-runCtrTest (CTRTest key iv plaintext ciphertext) = do-    ctx <- newAESCtx Encrypt key iv-    ct  <- aesCTR ctx plaintext-    assertEqual "" ciphertext ct--main :: IO ()-main =-    mapM_ runCtrTest ctrTests

@@ -4,8 +4,15 @@ #include "mutex.h"  /* OpenSSL ********************************************************************/-void HsOpenSSL_OpenSSL_add_all_algorithms() {+void HsOpenSSL_init() {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+    // OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS, NULL);+    // unnecessary in OpenSSL 1.1.0+#else+    SSL_load_error_strings();     OpenSSL_add_all_algorithms();+    SSL_library_init();+#endif }  void HsOpenSSL_OPENSSL_free(void* ptr) {@@ -88,12 +95,20 @@     return X509_CRL_get_version(crl); } -ASN1_TIME* HsOpenSSL_X509_CRL_get_lastUpdate(X509_CRL* crl) {+const ASN1_TIME* HsOpenSSL_X509_CRL_get_lastUpdate(const X509_CRL* crl) {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+    return X509_CRL_get0_lastUpdate(crl);+#else     return X509_CRL_get_lastUpdate(crl);+#endif } -ASN1_TIME* HsOpenSSL_X509_CRL_get_nextUpdate(X509_CRL* crl) {+const ASN1_TIME* HsOpenSSL_X509_CRL_get_nextUpdate(const X509_CRL* crl) {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+    return X509_CRL_get0_nextUpdate(crl);+#else     return X509_CRL_get_nextUpdate(crl);+#endif }  X509_NAME* HsOpenSSL_X509_CRL_get_issuer(X509_CRL* crl) {@@ -105,11 +120,19 @@ }  void HsOpenSSL_X509_ref(X509* x509) {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+    X509_up_ref(x509);+#else     CRYPTO_add(&x509->references, 1, CRYPTO_LOCK_X509);+#endif }  void HsOpenSSL_X509_CRL_ref(X509_CRL* crl) {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+    X509_CRL_up_ref(crl);+#else     CRYPTO_add(&crl->references, 1, CRYPTO_LOCK_X509_CRL);+#endif }  X509* HsOpenSSL_X509_STORE_CTX_get0_current_issuer(X509_STORE_CTX *ctx) {@@ -135,16 +158,41 @@   /* DH *************************************************************************/-BIGNUM *HsOpenSSL_DH_get_pub_key(DH *dh) {+const BIGNUM *HsOpenSSL_DH_get_pub_key(DH *dh) {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+    const BIGNUM** pub_key = 0;+    const BIGNUM** priv_key = 0;+    DH_get0_key(dh, pub_key, priv_key);+    return *pub_key;+#else     return dh->pub_key;+#endif }  int HsOpenSSL_DH_length(DH *dh) {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+    const BIGNUM** p = 0;+    const BIGNUM** q = 0;+    const BIGNUM** g = 0;+    DH_get0_pqg(dh, p, q, g);+    return BN_num_bits(*p);+#else     return BN_num_bits(dh->p);+#endif }   /* ASN1 ***********************************************************************/++#if OPENSSL_VERSION_NUMBER >= 0x10100000L+#define M_ASN1_INTEGER_new()    (ASN1_INTEGER *)\+    ASN1_STRING_type_new(V_ASN1_INTEGER)+#define M_ASN1_INTEGER_free(a)  ASN1_STRING_free((ASN1_STRING *)a)+#define M_ASN1_TIME_new()       (ASN1_TIME *)\+    ASN1_STRING_type_new(V_ASN1_UTCTIME)+#define M_ASN1_TIME_free(a)     ASN1_STRING_free((ASN1_STRING *)a)+#endif+ ASN1_INTEGER* HsOpenSSL_M_ASN1_INTEGER_new() {     return M_ASN1_INTEGER_new(); }@@ -226,21 +274,39 @@ /* OpenSSL sadly wants to ASN1 encode the resulting bignums so we use this  * function to skip that. Returns > 0 on success */ int HsOpenSSL_dsa_sign(DSA *dsa, const unsigned char *ddata, int dlen,-                       BIGNUM **r, BIGNUM **s) {+                       const BIGNUM **r, const BIGNUM **s) {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+  DSA_SIG *const sig = DSA_do_sign(ddata, dlen, dsa);+  if (!sig) return 0;+  DSA_SIG_get0(sig, r, s);+  *r = BN_dup(*r);+  *s = BN_dup(*s);+  DSA_SIG_free(sig);+  return 1;+#else   DSA_SIG *const sig = dsa->meth->dsa_do_sign(ddata, dlen, dsa);   if (!sig) return 0;   *r = sig->r;   *s = sig->s;   free(sig);   return 1;+#endif }  int HsOpenSSL_dsa_verify(DSA *dsa, const unsigned char *ddata, int dlen,-                         BIGNUM *r, BIGNUM *s) {+                         const BIGNUM *r, const BIGNUM *s) {+#if OPENSSL_VERSION_NUMBER >= 0x10100000L+  DSA_SIG* sig = DSA_SIG_new();+  DSA_SIG_set0(sig, BN_dup(r), BN_dup(s));+  int res = DSA_do_verify(ddata, dlen, sig, dsa);+  DSA_SIG_free(sig);+  return res;+#else   DSA_SIG sig;-  sig.r = r;-  sig.s = s;+  sig.r = (BIGNUM *)r;+  sig.s = (BIGNUM *)s;   return dsa->meth->dsa_do_verify(ddata, dlen, &sig, dsa);+#endif }  #if !defined(DSAPublicKey_dup)

@@ -33,7 +33,7 @@ #endif  /* OpenSSL ********************************************************************/-void HsOpenSSL_OpenSSL_add_all_algorithms();+void HsOpenSSL_init(); void HsOpenSSL_OPENSSL_free(void* ptr);  /* BIO ************************************************************************/@@ -63,8 +63,8 @@ X509_NAME* HsOpenSSL_X509_REQ_get_subject_name(X509_REQ* req);  long HsOpenSSL_X509_CRL_get_version(X509_CRL* crl);-ASN1_TIME* HsOpenSSL_X509_CRL_get_lastUpdate(X509_CRL* crl);-ASN1_TIME* HsOpenSSL_X509_CRL_get_nextUpdate(X509_CRL* crl);+const ASN1_TIME* HsOpenSSL_X509_CRL_get_lastUpdate(const X509_CRL* crl);+const ASN1_TIME* HsOpenSSL_X509_CRL_get_nextUpdate(const X509_CRL* crl); X509_NAME* HsOpenSSL_X509_CRL_get_issuer(X509_CRL* crl); STACK_OF(X509_REVOKED)* HsOpenSSL_X509_CRL_get_REVOKED(X509_CRL* crl); @@ -82,9 +82,9 @@  /* DSA ************************************************************************/ int HsOpenSSL_dsa_sign(DSA *dsa, const unsigned char *ddata, int len,-                       BIGNUM **r, BIGNUM **s);+                       const BIGNUM **r, const BIGNUM **s); int HsOpenSSL_dsa_verify(DSA *dsa, const unsigned char *ddata, int len,-                         BIGNUM *r, BIGNUM *s);+                         const BIGNUM *r, const BIGNUM *s); DSA* HsOpenSSL_DSAPublicKey_dup(const DSA* dsa); DSA* HsOpenSSL_DSAPrivateKey_dup(const DSA* dsa);