HsOpenSSL 0.10.2.1 → 0.10.3

raw patch · 5 files changed

+83/−7 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HsOpenSSL.cabal +1/−1
• NEWS +15/−0
• OpenSSL/Session.hsc +9/−6
• OpenSSL/X509/Store.hsc +51/−0
• cbits/HsOpenSSL.c +7/−0

@@ -15,7 +15,7 @@     encourages you to use and improve the tls package instead as long     as possible.     .-Version:       0.10.2.1+Version:       0.10.3 License:       PublicDomain License-File:  COPYING Author:        Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen

@@ -1,5 +1,20 @@ -*- coding: utf-8 -*- +Changes from 0.10.2.1 to 0.10.3+-------------------------------+* Merged #12 "Bindings to some of the X509_STORE_CTX functions" by+  Mikhail Vorozhtsov:++  - New functions in OpenSSL.X509.Store:+    - getStoreCtxCert+    - getStoreCtxIssuer+    - getStoreCtxCRL+    - getStoreCtxChain++* Merged #13 "Fixed early verification callback deallocation crash" by+  Mikhail Vorozhtsov.++ Changes from 0.10.2 to 0.10.2.1 ------------------------------- * Merged #10 "Fix X509 PEM reading/writing" by Mikhail Vorozhtsov:

@@ -231,7 +231,7 @@   let mode = (#const SSL_VERIFY_PEER) .|.              (if reqp then (#const SSL_VERIFY_FAIL_IF_NO_PEER_CERT) else 0) .|.              (if oncep then (#const SSL_VERIFY_CLIENT_ONCE) else 0)-  withContext context $ \ctx -> do+  withContext context $ \ctx -> mask_ $ do     let cbRef = ctxVfCb context     newCb <- mapM mkVerifyCb $ (<$> cbp) $ \cb pvf pStoreCtx ->       cb pvf =<< wrapX509StoreCtx (return ()) pStoreCtx@@ -288,6 +288,7 @@ --   object at a time, because they aren't really in the SSL object, they are --   waiting for the RTS to wake the Haskell thread. data SSL = SSL { sslSem    :: QSem+               , sslCtx    :: SSLContext                , sslPtr    :: ForeignPtr SSL_                , sslFd     :: Fd -- ^ Get the underlying socket Fd                , sslSocket :: Maybe Socket -- ^ Get the socket underlying an SSL connection@@ -301,12 +302,14 @@ connection' :: SSLContext -> Fd -> Maybe Socket -> IO SSL connection' context fd@(Fd fdInt) sock = do   sem <- newQSem 1-  ssl <- withContext context $ \ctx -> do-    ssl <- _ssl_new ctx >>= failIfNull-    _ssl_set_fd ssl fdInt-    return ssl-  fpssl <- newForeignPtr _ssl_free ssl+  fpssl <- mask_ $ do+    ssl <- withContext context $ \ctx -> do+      ssl <- _ssl_new ctx >>= failIfNull+      _ssl_set_fd ssl fdInt+      return ssl+    newForeignPtr _ssl_free ssl   return $ SSL { sslSem    = sem+               , sslCtx    = context                , sslPtr    = fpssl                , sslFd     = fd                , sslSocket = sock

@@ -21,15 +21,22 @@      , withX509StoreCtxPtr -- private     , wrapX509StoreCtx -- private++    , getStoreCtxCert+    , getStoreCtxIssuer+    , getStoreCtxCRL+    , getStoreCtxChain     )     where  import Control.Applicative ((<$>))+import Control.Exception (throwIO, mask_) import Foreign import Foreign.C import Foreign.Concurrent as FC import OpenSSL.X509 import OpenSSL.X509.Revocation+import OpenSSL.Stack import OpenSSL.Utils  -- |@'X509Store'@ is an opaque object that represents X.509@@ -88,10 +95,54 @@ data    X509_STORE_CTX newtype X509StoreCtx = X509StoreCtx (ForeignPtr X509_STORE_CTX) +foreign import ccall unsafe "X509_STORE_CTX_get_current_cert"+  _store_ctx_get_current_cert :: Ptr X509_STORE_CTX -> IO (Ptr X509_)++foreign import ccall unsafe "X509_STORE_CTX_get0_current_issuer"+  _store_ctx_get0_current_issuer :: Ptr X509_STORE_CTX -> IO (Ptr X509_)++foreign import ccall unsafe "X509_STORE_CTX_get0_current_crl"+  _store_ctx_get0_current_crl :: Ptr X509_STORE_CTX -> IO (Ptr X509_CRL)++foreign import ccall unsafe "X509_STORE_CTX_get_chain"+  _store_ctx_get_chain :: Ptr X509_STORE_CTX -> IO (Ptr STACK)++foreign import ccall unsafe "HsOpenSSL_X509_ref"+  _x509_ref :: Ptr X509_ -> IO ()++foreign import ccall unsafe "HsOpenSSL_X509_CRL_ref"+  _crl_ref :: Ptr X509_CRL -> IO ()+ withX509StoreCtxPtr :: X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a withX509StoreCtxPtr (X509StoreCtx fp) = withForeignPtr fp  wrapX509StoreCtx :: IO () -> Ptr X509_STORE_CTX -> IO X509StoreCtx wrapX509StoreCtx finaliser ptr =   X509StoreCtx <$> FC.newForeignPtr ptr finaliser++getStoreCtxCert :: X509StoreCtx -> IO X509+getStoreCtxCert ctx = withX509StoreCtxPtr ctx $ \pCtx -> do+  pCert <- _store_ctx_get_current_cert pCtx+  if pCert == nullPtr+    then throwIO $ userError "BUG: NULL certificate in X509_STORE_CTX"+    else mask_ $ _x509_ref pCert >> wrapX509 pCert++getStoreCtxIssuer :: X509StoreCtx -> IO (Maybe X509)+getStoreCtxIssuer ctx = withX509StoreCtxPtr ctx $ \pCtx -> do+  pCert <- _store_ctx_get0_current_issuer pCtx+  if pCert == nullPtr+    then return Nothing+    else fmap Just $ mask_ $ _x509_ref pCert >> wrapX509 pCert++getStoreCtxCRL :: X509StoreCtx -> IO (Maybe CRL)+getStoreCtxCRL ctx = withX509StoreCtxPtr ctx $ \pCtx -> do+  pCrl <- _store_ctx_get0_current_crl pCtx+  if pCrl == nullPtr+    then return Nothing+    else fmap Just $ mask_ $ _crl_ref pCrl >> wrapCRL pCrl++getStoreCtxChain :: X509StoreCtx -> IO [X509]+getStoreCtxChain ctx = withX509StoreCtxPtr ctx $ \pCtx -> do+  stack <- _store_ctx_get_chain pCtx+  (`mapStack` stack) $ \pCert -> mask_ $ _x509_ref pCert >> wrapX509 pCert 

@@ -103,6 +103,13 @@     return X509_CRL_get_REVOKED(crl); } +void HsOpenSSL_X509_ref(X509* x509) {+    CRYPTO_add(&x509->references, 1, CRYPTO_LOCK_X509);+}++void HsOpenSSL_X509_CRL_ref(X509_CRL* crl) {+    CRYPTO_add(&crl->references, 1, CRYPTO_LOCK_X509_CRL);+}  /* PKCS#7 *********************************************************************/ long HsOpenSSL_PKCS7_is_detached(PKCS7* pkcs7) {