Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Bindings to some of the X509_STORE_CTX functions. #12

Merged
merged 1 commit into from

3 participants

@mvv

Now you can do something meaningful in VerifyPeer callbacks.

@phonohawk phonohawk merged commit 2d35e24 into phonohawk:master
@gregorycollins

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. @mvv
This page is out of date. Refresh to see the latest.
View
2  OpenSSL/Session.hsc
@@ -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
View
51 OpenSSL/X509/Store.hsc
@@ -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
+
View
7 cbits/HsOpenSSL.c
@@ -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.