diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -6,7 +6,7 @@ generate message digests, sign and verify messages, encrypt and decrypt messages. It also has some capabilities of creating SSL clients and servers. -Version: 0.10.1 +Version: 0.10.1.1 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,5 +1,22 @@ -*- coding: utf-8 -*- +Changes from 0.10.1 to 0.10.1.1 +----------------------------------- +* Applied a patch by Peter Gammie: + - GHC 6.12.3 friendliness: don't use Control.Monad.void + +* Applied a patch by Peter Gammie and David Terei: + - Placate LLVM in GHC 7.3.x HEAD: give memcpy the right + type. Courtesy of David Terei. + +* Applied a patch by Mikhail Vorozhtsov: + - Use throwIO instead of throw to raise SSL exceptions. + +* Fixed breakage on OpenSSL 0.9.8: + - DHparams_dup() is a function in OpenSSL 1.0.0 but is a macro in 0.9.8. + - OpenSSL 0.9.8 doesn't provide X509_CRL_get0_by_serial(). + + Changes from 0.10 to 0.10.1 --------------------------- * Applied patches by Mikhail Vorozhtsov: diff --git a/OpenSSL/BN.hsc b/OpenSSL/BN.hsc --- a/OpenSSL/BN.hsc +++ b/OpenSSL/BN.hsc @@ -147,10 +147,10 @@ -- to foreign import ccall unsafe "memcpy" - _copy_in :: ByteArray## -> Ptr () -> CSize -> IO () + _copy_in :: ByteArray## -> Ptr () -> CSize -> IO (Ptr ()) foreign import ccall unsafe "memcpy" - _copy_out :: Ptr () -> ByteArray## -> CSize -> IO () + _copy_out :: Ptr () -> ByteArray## -> CSize -> IO (Ptr ()) -- These are taken from Data.Binary's disabled fast Integer support data ByteArray = BA !ByteArray## @@ -183,7 +183,7 @@ (MBA arr) <- newByteArray (nlimbsi *## limbsize) (BA ba) <- freezeByteArray arr limbs <- (#peek BIGNUM, d) (unwrapBN bn) - _copy_in ba limbs $ fromIntegral $ nlimbs * (#size unsigned long) + _ <- _copy_in ba limbs $ fromIntegral $ nlimbs * (#size unsigned long) negative <- (#peek BIGNUM, neg) (unwrapBN bn) :: IO CInt if negative == 0 then return $ J## nlimbsi ba @@ -228,7 +228,7 @@ limbs <- mallocBytes ((#size unsigned long) * nlimbs) (#poke BIGNUM, d) bnptr limbs (#poke BIGNUM, flags) bnptr (1 :: CInt) - _copy_out limbs bytearray (fromIntegral $ (#size unsigned long) * nlimbs) + _ <- _copy_out limbs bytearray (fromIntegral $ (#size unsigned long) * nlimbs) (#poke BIGNUM, top) bnptr ((fromIntegral nlimbs) :: CInt) (#poke BIGNUM, dmax) bnptr ((fromIntegral nlimbs) :: CInt) (#poke BIGNUM, neg) bnptr (0 :: CInt) diff --git a/OpenSSL/Cipher.hsc b/OpenSSL/Cipher.hsc --- a/OpenSSL/Cipher.hsc +++ b/OpenSSL/Cipher.hsc @@ -43,7 +43,7 @@ Mode foreign import ccall unsafe "memcpy" - _memcpy :: Ptr CUChar -> Ptr CChar -> CSize -> IO () + _memcpy :: Ptr CUChar -> Ptr CChar -> CSize -> IO (Ptr ()) foreign import ccall unsafe "memset" _memset :: Ptr CUChar -> CChar -> CSize -> IO () @@ -83,7 +83,7 @@ withForeignPtr ecounter (\ecptr -> _memset ecptr 0 16) withForeignPtr ivbytes $ \ivPtr -> BS.useAsCStringLen iv $ \(ptr, _) -> - do _memcpy ivPtr ptr 16 + 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 diff --git a/OpenSSL/DH.hsc b/OpenSSL/DH.hsc --- a/OpenSSL/DH.hsc +++ b/OpenSSL/DH.hsc @@ -84,7 +84,7 @@ _DH_check :: Ptr DH_ -> Ptr CInt -> IO Bool foreign import ccall unsafe "DH_size" _DH_size :: Ptr DH_ -> IO CInt -foreign import ccall unsafe "DHparams_dup" +foreign import ccall unsafe "HsOpenSSL_DHparams_dup" _DH_dup :: Ptr DH_ -> IO (Ptr DH_) foreign import ccall unsafe "HsOpenSSL_DH_get_pub_key" _DH_get_pub_key :: Ptr DH_ -> IO (Ptr BIGNUM) diff --git a/OpenSSL/Session.hsc b/OpenSSL/Session.hsc --- a/OpenSSL/Session.hsc +++ b/OpenSSL/Session.hsc @@ -65,13 +65,13 @@ import Control.Concurrent.QSem import Control.Exception import Control.Applicative ((<$>), (<$)) -import Control.Monad (void, unless) +import Control.Monad (unless) import Data.Typeable import Data.Foldable (Foldable, mapM_, forM_) import Data.Traversable (Traversable, mapM, forM) import Data.Maybe (fromMaybe) import Data.IORef -import Foreign hiding (void) +import Foreign import Foreign.C import qualified Foreign.Concurrent as FC import qualified Data.ByteString as B @@ -224,7 +224,7 @@ contextSetVerificationMode :: SSLContext -> VerificationMode -> IO () contextSetVerificationMode context VerifyNone = withContext context $ \ctx -> - void $ _ssl_set_verify_mode ctx (#const SSL_VERIFY_NONE) nullFunPtr + _ssl_set_verify_mode ctx (#const SSL_VERIFY_NONE) nullFunPtr >> return () contextSetVerificationMode context (VerifyPeer reqp oncep cbp) = do let mode = (#const SSL_VERIFY_PEER) .|. @@ -237,7 +237,8 @@ oldCb <- readIORef cbRef writeIORef cbRef newCb forM_ oldCb freeHaskellFunPtr - void $ _ssl_set_verify_mode ctx mode $ fromMaybe nullFunPtr newCb + _ssl_set_verify_mode ctx mode $ fromMaybe nullFunPtr newCb + return () foreign import ccall unsafe "SSL_CTX_load_verify_locations" _ssl_load_verify_locations :: Ptr SSLContext_ -> Ptr CChar -> Ptr CChar -> IO CInt @@ -287,8 +288,8 @@ -- waiting for the RTS to wake the Haskell thread. data SSL = SSL { sslSem :: QSem , sslPtr :: ForeignPtr SSL_ - , sslFd :: Fd - , sslSocket :: Maybe Socket + , sslFd :: Fd -- ^ Get the underlying socket Fd + , sslSocket :: Maybe Socket -- ^ Get the socket underlying an SSL connection } foreign import ccall unsafe "SSL_new" _ssl_new :: Ptr SSLContext_ -> IO (Ptr SSL_) @@ -331,13 +332,13 @@ foreign import ccall unsafe "SSL_get_error" _ssl_get_error :: Ptr SSL_ -> CInt -> IO CInt throwSSLException :: CInt -> IO a -throwSSLException (#const SSL_ERROR_ZERO_RETURN ) = throw ConnectionCleanlyClosed -throwSSLException (#const SSL_ERROR_WANT_CONNECT ) = throw WantConnect -throwSSLException (#const SSL_ERROR_WANT_ACCEPT ) = throw WantAccept -throwSSLException (#const SSL_ERROR_WANT_X509_LOOKUP) = throw WantX509Lookup -throwSSLException (#const SSL_ERROR_SYSCALL ) = throw SSLIOError -throwSSLException (#const SSL_ERROR_SSL ) = throw ProtocolError -throwSSLException x = throw (UnknownError (fromIntegral x)) +throwSSLException (#const SSL_ERROR_ZERO_RETURN ) = throwIO ConnectionCleanlyClosed +throwSSLException (#const SSL_ERROR_WANT_CONNECT ) = throwIO WantConnect +throwSSLException (#const SSL_ERROR_WANT_ACCEPT ) = throwIO WantAccept +throwSSLException (#const SSL_ERROR_WANT_X509_LOOKUP) = throwIO WantX509Lookup +throwSSLException (#const SSL_ERROR_SYSCALL ) = throwIO SSLIOError +throwSSLException (#const SSL_ERROR_SSL ) = throwIO ProtocolError +throwSSLException x = throwIO (UnknownError (fromIntegral x)) -- | This is the type of an SSL IO operation. EOF and termination are handled -- by exceptions while everything else is one of these. Note that reading @@ -453,7 +454,7 @@ -- | Write a given ByteString to the SSL connection. Either all the data is -- written or an exception is raised because of an error write :: SSL -> B.ByteString -> IO () -write ssl bs = void $ sslBlock (`tryWrite` bs) ssl +write ssl bs = sslBlock (`tryWrite` bs) ssl >> return () -- | Try to write a given ByteString to the SSL connection without blocking. tryWrite :: SSL -> B.ByteString -> IO (SSLResult ()) @@ -539,12 +540,6 @@ withSSL ssl $ \ssl -> do r <- _ssl_get_verify_result ssl return $ r == (#const X509_V_OK) - --- | Get the socket underlying an SSL connection -sslSocket :: SSL -> Maybe Socket - --- | Get the underlying socket Fd -sslFd :: SSL -> Fd -- | The root exception type for all SSL exceptions. data SomeSSLException diff --git a/OpenSSL/X509/Revocation.hsc b/OpenSSL/X509/Revocation.hsc --- a/OpenSSL/X509/Revocation.hsc +++ b/OpenSSL/X509/Revocation.hsc @@ -42,20 +42,22 @@ , getRevoked ) where - -import Control.Monad -import Data.Time.Clock -import Data.Typeable -import Foreign -import Foreign.C -import OpenSSL.ASN1 -import OpenSSL.BIO -import OpenSSL.EVP.Digest hiding (digest) -import OpenSSL.EVP.PKey -import OpenSSL.EVP.Verify -import OpenSSL.Stack -import OpenSSL.Utils -import OpenSSL.X509.Name +import Control.Monad +#if OPENSSL_VERSION_NUMBER < 0x10000000 +import Data.List +#endif +import Data.Time.Clock +import Data.Typeable +import Foreign +import Foreign.C +import OpenSSL.ASN1 +import OpenSSL.BIO +import OpenSSL.EVP.Digest hiding (digest) +import OpenSSL.EVP.PKey +import OpenSSL.EVP.Verify +import OpenSSL.Stack +import OpenSSL.Utils +import OpenSSL.X509.Name -- |@'CRL'@ is an opaque object that represents Certificate Revocation -- List. @@ -120,9 +122,12 @@ foreign import ccall unsafe "X509_CRL_add0_revoked" _add0_revoked :: Ptr X509_CRL -> Ptr X509_REVOKED -> IO CInt +#if OPENSSL_VERSION_NUMBER >= 0x10000000 +-- This function is only available on OpenSSL 1.0.0 or later. foreign import ccall unsafe "X509_CRL_get0_by_serial" _get0_by_serial :: Ptr X509_CRL -> Ptr (Ptr X509_REVOKED) -> Ptr ASN1_INTEGER -> IO CInt +#endif foreign import ccall unsafe "X509_CRL_sort" _sort :: Ptr X509_CRL -> IO CInt @@ -321,6 +326,7 @@ -- |@'getRevoked' crl serial@ looks up the corresponding revocation. getRevoked :: CRL -> Integer -> IO (Maybe RevokedCertificate) +#if OPENSSL_VERSION_NUMBER >= 0x10000000 getRevoked crl serial = withCRLPtr crl $ \crlPtr -> alloca $ \revPtr -> @@ -329,6 +335,12 @@ if r == 1 then fmap Just $ peek revPtr >>= peekRevoked else return Nothing +#else +getRevoked crl serial = find p `fmap` getRevokedList crl + where + p :: RevokedCertificate -> Bool + p = ((==) serial) . revSerialNumber +#endif -- |@'sortCRL' crl@ sorts the certificates in the revocation list. sortCRL :: CRL -> IO () diff --git a/cbits/HsOpenSSL.c b/cbits/HsOpenSSL.c --- a/cbits/HsOpenSSL.c +++ b/cbits/HsOpenSSL.c @@ -44,6 +44,11 @@ return BIO_FLAGS_BASE64_NO_NL; } +/* DH *************************************************************************/ +DH* HsOpenSSL_DHparams_dup(DH* dh) { + return DHparams_dup(dh); +} + /* EVP ************************************************************************/ int HsOpenSSL_EVP_MD_size(EVP_MD* md) { return EVP_MD_size(md); diff --git a/cbits/HsOpenSSL.h b/cbits/HsOpenSSL.h --- a/cbits/HsOpenSSL.h +++ b/cbits/HsOpenSSL.h @@ -3,12 +3,14 @@ #include #include #include +#include #include #include #include #include #include #include +#include #include #include #include @@ -31,6 +33,9 @@ int HsOpenSSL_BIO_set_buffer_size(BIO* bio, int bufSize); int HsOpenSSL_BIO_should_retry(BIO* bio); int HsOpenSSL_BIO_FLAGS_BASE64_NO_NL(); + +/* DH *************************************************************************/ +DH* HsOpenSSL_DHparams_dup(DH* dh); /* EVP ************************************************************************/ int HsOpenSSL_EVP_MD_size(EVP_MD* md);