diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,24 @@ +2014-12-23 PHO + + * OpenSSL/ASN1.hsc (peekASN1Time): Support time-1.5, + Patch by Herbert Valerio Riedel (#35). + + * OpenSSL/Session.hsc (context, connection'): Replace + addMVarFinalizer with mkWeakMVar to suppress deprecation warnings, + Patch by Ryan Desfosses (#33). + + * OpenSSL/Session.hsc (tryShutdown): "shutdown Bidirectional" + always resulted in an exception "thread blocked indefinitely in an + MVar operation" because of the way we were using withMVar in + OpenSSL.Session.tryShutdown. Reported by Andreas Voellmy (#32). + + * OpenSSL/Session.hsc (contextAddOption, contextRemoveOption) + (addOption, removeOption, SSLOption): New functions and a data + type to disable SSLv3 vulnerable to the POODLE attack. + Suggested by Maxim Dikun (#34). + + * HsOpenSSL.cabal (Version): Bump version to 0.11.1 + 2014-07-13 PHO * OpenSSL/EVP/Base64.hsc (encodeBase64, decodeBase64): Mark as @@ -42,16 +63,16 @@ a strict ByteString instead of String. This is a backward-incompatible change. - * HsOpenSSL.cabal (Version): Bump version to 0.11 + * HsOpenSSL.cabal (Version): Bump version to 0.11 2014-07-13 PHO - * OpenSSL/EVP/Cipher.hsc: Expose cipherInit, Patch by rons. + * OpenSSL/EVP/Cipher.hsc: Expose cipherInit, Patch by rnons (#31). - * HsOpenSSL.cabal (Exposed-Modules): Expose OpenSSL.EVP.Internal, - Patch by rnos. + * HsOpenSSL.cabal (Exposed-Modules): Expose OpenSSL.EVP.Internal, + Patch by rnons (#31). - * HsOpenSSL.cabal (Version): Bump version to 0.10.5 + * HsOpenSSL.cabal (Version): Bump version to 0.10.5 2013-12-25 PHO diff --git a/HsOpenSSL.cabal b/HsOpenSSL.cabal --- a/HsOpenSSL.cabal +++ b/HsOpenSSL.cabal @@ -12,7 +12,7 @@ , which is a pure Haskell implementation of SSL. . -Version: 0.11 +Version: 0.11.1 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen @@ -59,7 +59,9 @@ ghc-prim, network >= 2.1.0.0, old-locale, - time >= 1.1.1 + time >= 1.1.1 && < 1.6 + -- old-locale is only needed if time >= 1.5, but Cabal does not + -- allow us to express conditional dependencies like this. if flag(fast-bignum) CPP-Options: -DFAST_BIGNUM @@ -109,6 +111,7 @@ OpenSSL.ERR OpenSSL.Objects OpenSSL.SSL + OpenSSL.SSL.Option OpenSSL.Stack OpenSSL.Utils OpenSSL.X509.Name diff --git a/OpenSSL/ASN1.hsc b/OpenSSL/ASN1.hsc --- a/OpenSSL/ASN1.hsc +++ b/OpenSSL/ASN1.hsc @@ -29,7 +29,9 @@ import OpenSSL.BIO import OpenSSL.BN import OpenSSL.Utils +#if !MIN_VERSION_time(1,5,0) import System.Locale +#endif {- ASN1_OBJECT --------------------------------------------------------------- -} @@ -127,7 +129,11 @@ _ASN1_TIME_print bioPtr time >>= failIf_ (/= 1) timeStr <- bioRead bio +#if MIN_VERSION_time(1,5,0) + case parseTimeM True locale "%b %e %H:%M:%S %Y %Z" timeStr of +#else case parseTime locale "%b %e %H:%M:%S %Y %Z" timeStr of +#endif Just utc -> return utc Nothing -> fail ("peekASN1Time: failed to parse time string: " ++ timeStr) where @@ -139,12 +145,17 @@ , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ] ] +#if !MIN_VERSION_time(1,5,0) , intervals = undefined +#endif , amPm = undefined , dateTimeFmt = undefined , dateFmt = undefined , timeFmt = undefined , time12Fmt = undefined +#if MIN_VERSION_time(1,5,0) + , knownTimeZones = [] +#endif } diff --git a/OpenSSL/SSL/Option.hsc b/OpenSSL/SSL/Option.hsc new file mode 100644 --- /dev/null +++ b/OpenSSL/SSL/Option.hsc @@ -0,0 +1,179 @@ +-- See https://www.openssl.org/docs/ssl/SSL_CTX_set_options.html +module OpenSSL.SSL.Option + ( SSLOption(..) + , optionToIntegral + ) + where +import Data.Typeable + +#include + +-- | The behaviour of the SSL library can be changed by setting +-- several options. During a handshake, the option settings of the +-- 'OpenSSL.Session.SSL' object are used. When a new +-- 'OpenSSL.Session.SSL' object is created from a +-- 'OpenSSL.Session.SSLContext', the current option setting is +-- copied. Changes to 'OpenSSL.Session.SSLContext' do not affect +-- already created 'OpenSSL.Session.SSL' objects. +data SSLOption + = -- | As of OpenSSL 1.0.0 this option has no effect. + SSL_OP_MICROSOFT_SESS_ID_BUG + -- | As of OpenSSL 1.0.0 this option has no effect. + | SSL_OP_NETSCAPE_CHALLENGE_BUG + -- | As of OpenSSL 0.9.8q and 1.0.0c, this option has no effect. + | SSL_OP_NETSCAPE_REUSE_CIPHER_CHANGE_BUG + | SSL_OP_SSLREF2_REUSE_CERT_TYPE_BUG + | SSL_OP_MICROSOFT_BIG_SSLV3_BUFFER + -- | Don't prefer ECDHE-ECDSA ciphers when the client appears to + -- be Safari on OS X. OS X 10.8..10.8.3 has broken support for + -- ECDHE-ECDSA ciphers. + | SSL_OP_SAFARI_ECDHE_ECDSA_BUG + | SSL_OP_SSLEAY_080_CLIENT_DH_BUG + | SSL_OP_TLS_D5_BUG + | SSL_OP_TLS_BLOCK_PADDING_BUG +#if defined(SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS) + -- | Disables a countermeasure against a SSL 3.0/TLS 1.0 + -- protocol vulnerability affecting CBC ciphers, which cannot be + -- handled by some broken SSL implementations. This option has + -- no effect for connections using other ciphers. + | SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS +#endif +#if defined(SSL_OP_TLSEXT_PADDING) + -- | Adds a padding extension to ensure the ClientHello size is + -- never between 256 and 511 bytes in length. This is needed as + -- a workaround for some implementations. + | SSL_OP_TLSEXT_PADDING +#endif + -- | All of the above bug workarounds. + | SSL_OP_ALL +#if defined(SSL_OP_TLS_ROLLBACK_BUG) + -- | Disable version rollback attack detection. + -- + -- During the client key exchange, the client must send the same + -- information about acceptable SSL/TLS protocol levels as + -- during the first hello. Some clients violate this rule by + -- adapting to the server's answer. (Example: the client sends a + -- SSLv2 hello and accepts up to SSLv3.1=TLSv1, the server only + -- understands up to SSLv3. In this case the client must still + -- use the same SSLv3.1=TLSv1 announcement. Some clients step + -- down to SSLv3 with respect to the server's answer and violate + -- the version rollback protection.) + | SSL_OP_TLS_ROLLBACK_BUG +#endif + -- | Always create a new key when using temporary/ephemeral DH + -- parameters. This option must be used to prevent small + -- subgroup attacks, when the DH parameters were not generated + -- using \"strong\" primes (e.g. when using DSA-parameters). If + -- \"strong\" primes were used, it is not strictly necessary to + -- generate a new DH key during each handshake but it is also + -- recommended. 'SSL_OP_SINGLE_DH_USE' should therefore be enabled + -- whenever temporary/ephemeral DH parameters are used. + | SSL_OP_SINGLE_DH_USE + -- | Always use ephemeral (temporary) RSA key when doing RSA + -- operations. According to the specifications this is only + -- done, when a RSA key can only be used for signature + -- operations (namely under export ciphers with restricted RSA + -- keylength). By setting this option, ephemeral RSA keys are + -- always used. This option breaks compatibility with the + -- SSL/TLS specifications and may lead to interoperability + -- problems with clients and should therefore never be + -- used. Ciphers with DHE (ephemeral Diffie-Hellman) key + -- exchange should be used instead. + | SSL_OP_EPHEMERAL_RSA +#if defined(SSL_OP_CIPHER_SERVER_PREFERENCE) + -- | When choosing a cipher, use the server's preferences + -- instead of the client preferences. When not set, the SSL + -- server will always follow the clients preferences. When set, + -- the SSLv3/TLSv1 server will choose following its own + -- preferences. Because of the different protocol, for SSLv2 the + -- server will send its list of preferences to the client and + -- the client chooses. + | SSL_OP_CIPHER_SERVER_PREFERENCE +#endif + | SSL_OP_PKCS1_CHECK_1 + | SSL_OP_PKCS1_CHECK_2 + -- | If we accept a netscape connection, demand a client cert, + -- have a non-self-signed CA which does not have its CA in + -- netscape, and the browser has a cert, it will + -- crash/hang. Works for 3.x and 4.xbeta + | SSL_OP_NETSCAPE_CA_DN_BUG + | SSL_OP_NETSCAPE_DEMO_CIPHER_CHANGE_BUG + -- | Do not use the SSLv2 protocol. + | SSL_OP_NO_SSLv2 + -- | Do not use the SSLv3 protocol. + | SSL_OP_NO_SSLv3 + -- | Do not use the TLSv1 protocol. + | SSL_OP_NO_TLSv1 +#if defined(SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION) + -- | When performing renegotiation as a server, always start a + -- new session (i.e., session resumption requests are only + -- accepted in the initial handshake). This option is not needed + -- for clients. + | SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION +#endif + -- | Normally clients and servers will, where possible, + -- transparently make use of + -- tickets for + -- stateless session resumption. + -- + -- If this option is set this functionality is disabled and + -- tickets will not be used by clients or servers. + | SSL_OP_NO_TICKET +#if defined(SSL_OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION) + -- | Allow legacy insecure renegotiation between OpenSSL and + -- unpatched clients or servers. See + -- + -- for more details. + | SSL_OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION +#endif +#if defined(SSL_OP_LEGACY_SERVER_CONNECT) + -- | Allow legacy insecure renegotiation between OpenSSL and + -- unpatched servers _only_. See + -- + -- for more details. + | SSL_OP_LEGACY_SERVER_CONNECT +#endif + deriving (Eq, Ord, Show, Typeable) + +optionToIntegral :: Integral a => SSLOption -> a +optionToIntegral SSL_OP_MICROSOFT_SESS_ID_BUG = #const SSL_OP_MICROSOFT_SESS_ID_BUG +optionToIntegral SSL_OP_NETSCAPE_CHALLENGE_BUG = #const SSL_OP_NETSCAPE_CHALLENGE_BUG +optionToIntegral SSL_OP_NETSCAPE_REUSE_CIPHER_CHANGE_BUG = #const SSL_OP_NETSCAPE_REUSE_CIPHER_CHANGE_BUG +optionToIntegral SSL_OP_SSLREF2_REUSE_CERT_TYPE_BUG = #const SSL_OP_SSLREF2_REUSE_CERT_TYPE_BUG +optionToIntegral SSL_OP_MICROSOFT_BIG_SSLV3_BUFFER = #const SSL_OP_MICROSOFT_BIG_SSLV3_BUFFER +optionToIntegral SSL_OP_SAFARI_ECDHE_ECDSA_BUG = #const SSL_OP_SAFARI_ECDHE_ECDSA_BUG +optionToIntegral SSL_OP_SSLEAY_080_CLIENT_DH_BUG = #const SSL_OP_SSLEAY_080_CLIENT_DH_BUG +optionToIntegral SSL_OP_TLS_D5_BUG = #const SSL_OP_TLS_D5_BUG +optionToIntegral SSL_OP_TLS_BLOCK_PADDING_BUG = #const SSL_OP_TLS_BLOCK_PADDING_BUG +#if defined(SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS) +optionToIntegral SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS = #const SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS +#endif +#if defined(SSL_OP_TLSEXT_PADDING) +optionToIntegral SSL_OP_TLSEXT_PADDING = #const SSL_OP_TLSEXT_PADDING +#endif +optionToIntegral SSL_OP_ALL = #const SSL_OP_ALL +#if defined(SSL_OP_TLS_ROLLBACK_BUG) +optionToIntegral SSL_OP_TLS_ROLLBACK_BUG = #const SSL_OP_TLS_ROLLBACK_BUG +#endif +optionToIntegral SSL_OP_SINGLE_DH_USE = #const SSL_OP_SINGLE_DH_USE +optionToIntegral SSL_OP_EPHEMERAL_RSA = #const SSL_OP_EPHEMERAL_RSA +#if defined(SSL_OP_CIPHER_SERVER_PREFERENCE) +optionToIntegral SSL_OP_CIPHER_SERVER_PREFERENCE = #const SSL_OP_CIPHER_SERVER_PREFERENCE +#endif +optionToIntegral SSL_OP_PKCS1_CHECK_1 = #const SSL_OP_PKCS1_CHECK_1 +optionToIntegral SSL_OP_PKCS1_CHECK_2 = #const SSL_OP_PKCS1_CHECK_2 +optionToIntegral SSL_OP_NETSCAPE_CA_DN_BUG = #const SSL_OP_NETSCAPE_CA_DN_BUG +optionToIntegral SSL_OP_NETSCAPE_DEMO_CIPHER_CHANGE_BUG = #const SSL_OP_NETSCAPE_DEMO_CIPHER_CHANGE_BUG +optionToIntegral SSL_OP_NO_SSLv2 = #const SSL_OP_NO_SSLv2 +optionToIntegral SSL_OP_NO_SSLv3 = #const SSL_OP_NO_SSLv3 +optionToIntegral SSL_OP_NO_TLSv1 = #const SSL_OP_NO_TLSv1 +#if defined(SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION) +optionToIntegral SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION = #const SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION +#endif +optionToIntegral SSL_OP_NO_TICKET = #const SSL_OP_NO_TICKET +#if defined(SSL_OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION) +optionToIntegral SSL_OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION = #const SSL_OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION +#endif +#if defined(SSL_OP_LEGACY_SERVER_CONNECT) +optionToIntegral SSL_OP_LEGACY_SERVER_CONNECT = #const SSL_OP_LEGACY_SERVER_CONNECT +#endif diff --git a/OpenSSL/Session.hsc b/OpenSSL/Session.hsc --- a/OpenSSL/Session.hsc +++ b/OpenSSL/Session.hsc @@ -10,6 +10,8 @@ ( -- * Contexts SSLContext , context + , contextAddOption + , contextRemoveOption , contextSetPrivateKey , contextSetCertificate , contextSetPrivateKeyFile @@ -29,6 +31,8 @@ , SSLResult(..) , connection , fdConnection + , addOption + , removeOption , accept , tryAccept , connect @@ -51,6 +55,9 @@ , sslSocket , sslFd + -- * Protocol Options + , SSLOption(..) + -- * SSL Exceptions , SomeSSLException , ConnectionAbruptlyTerminated @@ -88,6 +95,7 @@ import OpenSSL.ERR import OpenSSL.EVP.PKey import OpenSSL.EVP.Internal +import OpenSSL.SSL.Option import OpenSSL.Utils import OpenSSL.X509 (X509, X509_, wrapX509, withX509Ptr) import OpenSSL.X509.Store @@ -119,9 +127,13 @@ ctx <- _ssl_method >>= _ssl_ctx_new cbRef <- newIORef Nothing mvar <- newMVar ctx - addMVarFinalizer mvar $ do - _ssl_ctx_free ctx - readIORef cbRef >>= mapM_ freeHaskellFunPtr +#if MIN_VERSION_base(4,6,0) + _ <- mkWeakMVar mvar +#else + _ <- addMVarFinalizer mvar +#endif + $ do _ssl_ctx_free ctx + readIORef cbRef >>= mapM_ freeHaskellFunPtr return $ SSLContext { ctxMVar = mvar, ctxVfCb = cbRef } -- | Run the given action with the raw context pointer and obtain the lock @@ -132,6 +144,24 @@ touchContext :: SSLContext -> IO () touchContext = (>> return ()) . isEmptyMVar . ctxMVar +foreign import ccall unsafe "HsOpenSSL_SSL_CTX_set_options" + _SSL_CTX_set_options :: Ptr SSLContext_ -> CLong -> IO CLong + +foreign import ccall unsafe "HsOpenSSL_SSL_CTX_clear_options" + _SSL_CTX_clear_options :: Ptr SSLContext_ -> CLong -> IO CLong + +-- | Add a protocol option to the context. +contextAddOption :: SSLContext -> SSLOption -> IO () +contextAddOption ctx opt = + withContext ctx $ \ctxPtr -> + _SSL_CTX_set_options ctxPtr (optionToIntegral opt) >> return () + +-- | Remove a protocol option from the context. +contextRemoveOption :: SSLContext -> SSLOption -> IO () +contextRemoveOption ctx opt = + withContext ctx $ \ctxPtr -> + _SSL_CTX_clear_options ctxPtr (optionToIntegral opt) >> return () + contextLoadFile :: (Ptr SSLContext_ -> CString -> CInt -> IO CInt) -> SSLContext -> String -> IO () contextLoadFile f context path = @@ -312,7 +342,11 @@ _ssl_set_fd ssl fdInt return ssl mvar <- newMVar ssl - addMVarFinalizer mvar $ _ssl_free ssl +#if MIN_VERSION_base(4,6,0) + _ <- mkWeakMVar mvar $ _ssl_free ssl +#else + _ <- addMVarFinalizer mvar $ _ssl_free ssl +#endif return mvar return $ SSL { sslCtx = context , sslMVar = mvar @@ -335,6 +369,24 @@ withSSL :: SSL -> (Ptr SSL_ -> IO a) -> IO a withSSL = withMVar . sslMVar +foreign import ccall unsafe "HsOpenSSL_SSL_set_options" + _SSL_set_options :: Ptr SSL_ -> CLong -> IO CLong + +foreign import ccall unsafe "HsOpenSSL_SSL_clear_options" + _SSL_clear_options :: Ptr SSL_ -> CLong -> IO CLong + +-- | Add a protocol option to the SSL connection. +addOption :: SSL -> SSLOption -> IO () +addOption ssl opt = + withSSL ssl $ \sslPtr -> + _SSL_set_options sslPtr (optionToIntegral opt) >> return () + +-- | Remove a protocol option from the SSL connection. +removeOption :: SSL -> SSLOption -> IO () +removeOption ssl opt = + withSSL ssl $ \sslPtr -> + _SSL_clear_options sslPtr (optionToIntegral opt) >> return () + foreign import ccall "SSL_accept" _ssl_accept :: Ptr SSL_ -> IO CInt foreign import ccall "SSL_connect" _ssl_connect :: Ptr SSL_ -> IO CInt foreign import ccall unsafe "SSL_get_error" _ssl_get_error :: Ptr SSL_ -> CInt -> IO CInt @@ -538,33 +590,48 @@ -- | Try to cleanly shutdown an SSL connection without blocking. tryShutdown :: SSL -> ShutdownType -> IO (SSLResult ()) -tryShutdown ssl ty - = runInBoundThread $ - withSSL ssl $ \sslPtr -> - do n <- _ssl_shutdown sslPtr - case n of - 1 -> return $ SSLDone () - 0 -> if ty == Bidirectional then - tryShutdown ssl ty - else - return $ SSLDone () - _ -> do err <- _ssl_get_error sslPtr n - case err of - (#const SSL_ERROR_WANT_READ ) -> return WantRead - (#const SSL_ERROR_WANT_WRITE) -> return WantWrite - -- SSL_ERROR_SYSCALL/-1 happens when we are - -- trying to send the remote peer a "close - -- notify" alert but the underlying socket was - -- closed at the time. We don't treat this an - -- error /if and only if/ we have already - -- received a "close notify" from the peer. - (#const SSL_ERROR_SYSCALL) - -> do sd <- _ssl_get_shutdown sslPtr - if sd .&. (#const SSL_RECEIVED_SHUTDOWN) == 0 then - throwSSLException "SSL_shutdown" n - else - return $ SSLDone () - _ -> throwSSLException "SSL_shutdown" n +tryShutdown ssl ty = runInBoundThread $ withSSL ssl loop + where + loop :: Ptr SSL_ -> IO (SSLResult ()) + loop sslPtr + = do n <- _ssl_shutdown sslPtr + case n of + 0 | ty == Bidirectional -> + -- We successfully sent a close notify alert to + -- the peer but haven't got a reply + -- yet. Complete the bidirectional shutdown by + -- calling SSL_shutdown(3) again. + loop sslPtr + | otherwise -> + -- Unidirection shutdown is enough for us. + return $ SSLDone () + 1 -> + -- Shutdown has succeeded, either bidirectionally + -- or unidirectionally. + return $ SSLDone () + 2 -> + -- SSL_shutdown(2) can return 2 according to its + -- documentation. It says we have to retry + -- calling SSL_shutdown(3) in this case. + loop sslPtr + _ -> do err <- _ssl_get_error sslPtr n + case err of + (#const SSL_ERROR_WANT_READ ) -> return WantRead + (#const SSL_ERROR_WANT_WRITE) -> return WantWrite + -- SSL_ERROR_SYSCALL/-1 happens when we are + -- trying to send the remote peer a "close + -- notify" alert but the underlying socket + -- was closed at the time. We don't treat + -- this an error /if and only if/ we have + -- already received a "close notify" from + -- the peer. + (#const SSL_ERROR_SYSCALL) + -> do sd <- _ssl_get_shutdown sslPtr + if sd .&. (#const SSL_RECEIVED_SHUTDOWN) == 0 then + throwSSLException "SSL_shutdown" n + else + return $ SSLDone () + _ -> throwSSLException "SSL_shutdown" n foreign import ccall "SSL_get_peer_certificate" _ssl_get_peer_cert :: Ptr SSL_ -> IO (Ptr X509_) diff --git a/cbits/HsOpenSSL.c b/cbits/HsOpenSSL.c --- a/cbits/HsOpenSSL.c +++ b/cbits/HsOpenSSL.c @@ -262,3 +262,32 @@ DSA* HsOpenSSL_DSAPrivateKey_dup(const DSA* dsa) { return DSAPrivateKey_dup(dsa); } + +/* SSL ************************************************************************/ +long HsOpenSSL_SSL_CTX_set_options(SSL_CTX* ctx, long options) { + return SSL_CTX_set_options(ctx, options); +} + +/* OpenSSL < 0.9.8m does not have SSL_CTX_clear_options() */ +long HsOpenSSL_SSL_CTX_clear_options(SSL_CTX* ctx, long options) { +#if defined(SSL_CTX_clear_options) + return SSL_CTX_clear_options(ctx, options); +#else + long tmp = SSL_CTX_get_options(ctx); + return SSL_CTX_set_options(ctx, tmp & ~options); +#endif +} + +long HsOpenSSL_SSL_set_options(SSL* ssl, long options) { + return SSL_set_options(ssl, options); +} + +/* OpenSSL < 0.9.8m does not have SSL_clear_options() */ +long HsOpenSSL_SSL_clear_options(SSL* ssl, long options) { +#if defined(SSL_clear_options) + return SSL_clear_options(ssl, options); +#else + long tmp = SSL_get_options(ssl); + return SSL_set_options(ssl, tmp & ~options); +#endif +} diff --git a/cbits/HsOpenSSL.h b/cbits/HsOpenSSL.h --- a/cbits/HsOpenSSL.h +++ b/cbits/HsOpenSSL.h @@ -88,4 +88,10 @@ DSA* HsOpenSSL_DSAPublicKey_dup(const DSA* dsa); DSA* HsOpenSSL_DSAPrivateKey_dup(const DSA* dsa); +/* SSL ************************************************************************/ +long HsOpenSSL_SSL_CTX_set_options(SSL_CTX* ctx, long options); +long HsOpenSSL_SSL_CTX_clear_options(SSL_CTX* ctx, long options); +long HsOpenSSL_SSL_set_options(SSL* ssl, long options); +long HsOpenSSL_SSL_clear_options(SSL* ssl, long options); + #endif diff --git a/examples/Makefile b/examples/Makefile --- a/examples/Makefile +++ b/examples/Makefile @@ -4,7 +4,7 @@ ghc $(GHCFLAGS) --make GenRSAKey ghc $(GHCFLAGS) --make HelloWorld ghc $(GHCFLAGS) --make PKCS7 - ghc $(GHCFLAGS) --make Server + ghc $(GHCFLAGS) --make -threaded Server run: build ./PKCS7 diff --git a/examples/Server.hs b/examples/Server.hs --- a/examples/Server.hs +++ b/examples/Server.hs @@ -32,6 +32,8 @@ print $ "Accepted connection from " ++ show sockaddr ctx <- SSL.context + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2 + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3 SSL.contextSetPrivateKeyFile ctx "server.pem" SSL.contextSetCertificateFile ctx "server.crt" SSL.contextSetCiphers ctx "DEFAULT" @@ -41,4 +43,3 @@ b <- SSL.read conn 1024 SSL.write conn b SSL.shutdown conn SSL.Bidirectional -