{-# LINE 1 "src/Hookup/OpenSSL.hsc" #-}
{-# Language CApiFFI #-}
{-# LINE 17 "src/Hookup/OpenSSL.hsc" #-}
module Hookup.OpenSSL (withDefaultPassword, installVerification, getPubKeyDer) where
import Control.Exception (bracket, bracket_)
import Control.Monad (unless)
import Foreign.C (CStringLen, CString(..), CSize(..), CUInt(..), CInt(..), withCStringLen, CChar(..))
import Foreign.Ptr (FunPtr, Ptr, castPtr, nullPtr, nullFunPtr)
import Foreign.StablePtr (StablePtr, deRefStablePtr, castPtrToStablePtr)
import Foreign.Marshal (with)
import OpenSSL.Session (SSLContext, SSLContext_, withContext)
import OpenSSL.X509 (withX509Ptr, X509, X509_)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as Unsafe
foreign import ccall unsafe "hookup_new_userdata"
hookup_new_userdata :: CString -> CInt -> IO (Ptr ())
foreign import ccall unsafe "hookup_free_userdata"
hookup_free_userdata :: Ptr () -> IO ()
foreign import ccall "&hookup_pem_passwd_cb"
hookup_pem_passwd_cb :: FunPtr PemPasswdCb
type PemPasswdCb = Ptr CChar -> CInt -> CInt -> Ptr () -> IO CInt
foreign import ccall unsafe "SSL_CTX_set_default_passwd_cb"
sslCtxSetDefaultPasswdCb :: Ptr SSLContext_ -> FunPtr PemPasswdCb -> IO ()
foreign import ccall unsafe "SSL_CTX_set_default_passwd_cb_userdata"
sslCtxSetDefaultPasswdCbUserdata ::
Ptr SSLContext_ -> Ptr a -> IO ()
withDefaultPassword :: SSLContext -> Maybe ByteString -> IO a -> IO a
withDefaultPassword ctx mbBs m =
withCPassword mbBs $ \ptr len ->
bracket (hookup_new_userdata ptr len) hookup_free_userdata $ \ud ->
bracket_ (setup hookup_pem_passwd_cb ud) (setup nullFunPtr nullPtr) m
where
withCPassword Nothing k = k nullPtr (-1)
withCPassword (Just bs) k = Unsafe.unsafeUseAsCStringLen bs $ \(ptr, len) -> k ptr (fromIntegral len)
setup cb ud =
withContext ctx $ \ctxPtr ->
do sslCtxSetDefaultPasswdCb ctxPtr cb
sslCtxSetDefaultPasswdCbUserdata ctxPtr ud
data X509_VERIFY_PARAM_
data {-# CTYPE "openssl/ssl.h" "X509_PUBKEY" #-} X509_PUBKEY_
data {-# CTYPE "openssl/ssl.h" "X509" #-} X509__
foreign import ccall unsafe "SSL_CTX_get0_param"
sslGet0Param ::
Ptr SSLContext_ ->
IO (Ptr X509_VERIFY_PARAM_)
foreign import ccall unsafe "X509_VERIFY_PARAM_set_hostflags"
x509VerifyParamSetHostflags ::
Ptr X509_VERIFY_PARAM_ ->
CUInt ->
IO ()
foreign import ccall unsafe "X509_VERIFY_PARAM_set1_host"
x509VerifyParamSet1Host ::
Ptr X509_VERIFY_PARAM_ ->
CString ->
CSize ->
IO CInt
foreign import capi unsafe "openssl/x509.h X509_get_X509_PUBKEY"
x509getX509Pubkey ::
Ptr X509__ -> IO (Ptr X509_PUBKEY_)
foreign import ccall unsafe "i2d_X509_PUBKEY"
i2dX509Pubkey ::
Ptr X509_PUBKEY_ ->
Ptr CString ->
IO CInt
getPubKeyDer :: X509 -> IO ByteString
getPubKeyDer x509 =
withX509Ptr x509 $ \x509ptr ->
do pubkey <- x509getX509Pubkey (castPtr x509ptr)
len <- fromIntegral <$> i2dX509Pubkey pubkey nullPtr
B.create len $ \bsPtr ->
with (castPtr bsPtr) $ \ptrPtr ->
() <$ i2dX509Pubkey pubkey ptrPtr
installVerification :: SSLContext -> String -> IO ()
installVerification ctx host =
withContext ctx $ \ctxPtr ->
withCStringLen host $ \(ptr,len) ->
do param <- sslGet0Param ctxPtr
x509VerifyParamSetHostflags param
(4)
{-# LINE 132 "src/Hookup/OpenSSL.hsc" #-}
success <- x509VerifyParamSet1Host param ptr (fromIntegral len)
unless (success == 1) (fail "Unable to set verification host")