HsOpenSSL 0.11 → 0.11.1

raw patch · 9 files changed

+357/−40 lines, 9 filesdep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• ChangeLog +26/−5
• HsOpenSSL.cabal +5/−2
• OpenSSL/ASN1.hsc +11/−0
• OpenSSL/SSL/Option.hsc +179/−0
• OpenSSL/Session.hsc +98/−31
• cbits/HsOpenSSL.c +29/−0
• cbits/HsOpenSSL.h +6/−0
• examples/Makefile +1/−1
• examples/Server.hs +2/−1

@@ -1,3 +1,24 @@+2014-12-23  PHO  <pho@cielonegro.org>++	* 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  <pho@cielonegro.org>  	* 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  <pho@cielonegro.org> -        * 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  <pho@cielonegro.org> 

@@ -12,7 +12,7 @@     <http://hackage.haskell.org/package/tls>, 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

@@ -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                }  

@@ -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 <openssl/ssl.h>++-- | 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+      -- <http://tools.ietf.org/html/rfc4507 RFC 4507> 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+      -- <https://www.openssl.org/docs/ssl/SSL_CTX_set_options.html#secure_renegotiation SECURE RENEGOTIATION>+      -- 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+      -- <https://www.openssl.org/docs/ssl/SSL_CTX_set_options.html#secure_renegotiation SECURE RENEGOTIATION>+      -- 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

@@ -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_) 

@@ -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+}

@@ -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

@@ -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

@@ -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-