Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Bindings to some of the X509_STORE_CTX functions. #12

Merged
merged 1 commit into from

3 participants

Mikhail Vorozhtsov Gregory Collins PHO
Mikhail Vorozhtsov

Now you can do something meaningful in VerifyPeer callbacks.

PHO phonohawk merged commit 2d35e24 into from
Gregory Collins

What version of the OpenSSL library are these new functions targeting? My version of OSX ships with 0.9.8r, and I installed 0.9.8s from Homebrew, and neither have the following symbols:

Undefined symbols for architecture x86_64:
"_X509_STORE_CTX_get0_current_issuer", referenced from:
_HsOpenSSLzm0zi10zi3_OpenSSLziX509ziStore_zdwa4_info in libHSHsOpenSSL-0.10.3.a(Store.o)
"_X509_STORE_CTX_get0_current_crl", referenced from:
_HsOpenSSLzm0zi10zi3_OpenSSLziX509ziStore_zdwa2_info in libHSHsOpenSSL-0.10.3.a(Store.o)
ld: symbol(s) not found for architecture x86_64

Could you please guard these new definitions with a flag or some CPP or something?

Sorry for the inconvenience. I'm using Arch Linux which means that I always have the latest version of OpenSSL (1.0.1a atm). I'll write a workaround for 0.9.x today.

Please test this branch. If the fix works for you I'll make a pull request.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Apr 16, 2012
  1. Mikhail Vorozhtsov
This page is out of date. Refresh to see the latest.
2  OpenSSL/Session.hsc
View
@@ -231,7 +231,7 @@ contextSetVerificationMode context (VerifyPeer reqp oncep cbp) = do
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
51 OpenSSL/X509/Store.hsc
View
@@ -21,15 +21,22 @@ module OpenSSL.X509.Store
, 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,6 +95,24 @@ addCRLToStore store crl
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
@@ -95,3 +120,29 @@ 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
+
7 cbits/HsOpenSSL.c
View
@@ -103,6 +103,13 @@ STACK_OF(X509_REVOKED)* HsOpenSSL_X509_CRL_get_REVOKED(X509_CRL* crl) {
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) {
Something went wrong with that request. Please try again.