hookup 0.2.2 → 0.2.3

raw patch · 4 files changed

+101/−7 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• hookup.cabal +3/−3
• src/Hookup.hs +63/−2
• src/Hookup/OpenSSL.hsc +31/−2

@@ -1,5 +1,9 @@ # Revision history for hookup +## 0.2.3 -- 2019-05++* Added functions to get TLS peer certificate information+ ## 0.2.1 -- 2018-07  * Added `connectWithSocket`, `recv`, `putBuf`, `defaultTlsParams`

@@ -1,5 +1,5 @@ name:                hookup-version:             0.2.2+version:             0.2.3 synopsis:            Abstraction over creating network connections with SOCKS5 and TLS description:         This package provides an abstraction for communicating with line-oriented                      network services while abstracting over the use of SOCKS5 and TLS (via OpenSSL)@@ -26,8 +26,8 @@   other-modules:       Hookup.OpenSSL,                        Hookup.Socks5   extra-libraries:     ssl-  build-depends:       base                  >=4.9  && <4.12,-                       network               >=2.6  && <2.8,+  build-depends:       base                  >=4.9  && <4.13,+                       network               >=2.6  && <3.1,                        bytestring            >=0.10 && <0.11,                        attoparsec            >=0.13 && <0.14,                        HsOpenSSL             >=0.11.2.3 && <0.12,

@@ -48,6 +48,15 @@   -- * Errors   ConnectionFailure(..),   CommandReply(..)++  -- * SSL Information+  , getPeerCertificate+  , getPeerCertFingerprintSha1+  , getPeerCertFingerprintSha256+  , getPeerCertFingerprintSha512+  , getPeerPubkeyFingerprintSha1+  , getPeerPubkeyFingerprintSha256+  , getPeerPubkeyFingerprintSha512   ) where  import           Control.Concurrent@@ -64,13 +73,15 @@ import           OpenSSL.Session (SSL, SSLContext) import qualified OpenSSL as SSL import qualified OpenSSL.Session as SSL-import qualified OpenSSL.X509 as SSL import           OpenSSL.X509.SystemStore+import           OpenSSL.X509 (X509)+import qualified OpenSSL.X509 as X509 import qualified OpenSSL.PEM as PEM+import qualified OpenSSL.EVP.Digest as Digest import           Data.Attoparsec.ByteString (Parser) import qualified Data.Attoparsec.ByteString as Parser -import           Hookup.OpenSSL (installVerification)+import           Hookup.OpenSSL (installVerification, getPubKeyDer) import           Hookup.Socks5  @@ -515,3 +526,53 @@                   , SSL.vpClientOnce       = True                   , SSL.vpCallback         = Nothing                   }++-- | Get peer certificate if one exists.+getPeerCertificate :: Connection -> IO (Maybe X509.X509)+getPeerCertificate (Connection _ h) =+  case h of+    Socket{} -> return Nothing+    SSL ssl  -> SSL.getPeerCertificate ssl++getPeerCertFingerprintSha1 :: Connection -> IO (Maybe ByteString)+getPeerCertFingerprintSha1 = getPeerCertFingerprint "sha1"++getPeerCertFingerprintSha256 :: Connection -> IO (Maybe ByteString)+getPeerCertFingerprintSha256 = getPeerCertFingerprint "sha256"++getPeerCertFingerprintSha512 :: Connection -> IO (Maybe ByteString)+getPeerCertFingerprintSha512 = getPeerCertFingerprint "sha512"++getPeerCertFingerprint :: String -> Connection -> IO (Maybe ByteString)+getPeerCertFingerprint name h =+   do mb <- getPeerCertificate h+      case mb of+        Nothing -> return Nothing+        Just x509 ->+          do der <- X509.writeDerX509 x509+             mbdigest <- Digest.getDigestByName name+             case mbdigest of+               Nothing -> return Nothing+               Just digest -> return $! Just $! Digest.digestLBS digest der++getPeerPubkeyFingerprintSha1 :: Connection -> IO (Maybe ByteString)+getPeerPubkeyFingerprintSha1 = getPeerPubkeyFingerprint "sha1"++getPeerPubkeyFingerprintSha256 :: Connection -> IO (Maybe ByteString)+getPeerPubkeyFingerprintSha256 = getPeerPubkeyFingerprint "sha256"++getPeerPubkeyFingerprintSha512 :: Connection -> IO (Maybe ByteString)+getPeerPubkeyFingerprintSha512 = getPeerPubkeyFingerprint "sha512"+++getPeerPubkeyFingerprint :: String -> Connection -> IO (Maybe ByteString)+getPeerPubkeyFingerprint name h =+   do mb <- getPeerCertificate h+      case mb of+        Nothing -> return Nothing+        Just x509 ->+          do der <- getPubKeyDer x509+             mbdigest <- Digest.getDigestByName name+             case mbdigest of+               Nothing -> return Nothing+               Just digest -> return $! Just $! Digest.digestBS digest der

@@ -1,3 +1,4 @@+{-# Language CApiFFI #-} {-| Module      : Hookup.OpenSSL Description : Hack into the internals of OpenSSL to add missing functionality@@ -14,18 +15,24 @@ #error "OpenSSL 1.0.2 or later is required. This version was released in Jan 2015 and adds hostname verification" #endif -module Hookup.OpenSSL (installVerification) where+module Hookup.OpenSSL (installVerification, getPubKeyDer) where  import           Control.Monad (unless) import           Foreign.C (CString(..), CSize(..), CUInt(..), CInt(..), withCStringLen)-import           Foreign.Ptr (Ptr)+import           Foreign.Ptr (Ptr, castPtr, nullPtr)+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  ------------------------------------------------------------------------ -- Bindings to hostname verification interface ------------------------------------------------------------------------  data X509_VERIFY_PARAM_+data {-# CTYPE "openssl/ssl.h" "X509_PUBKEY" #-} X509_PUBKEY_+data {-# CTYPE "openssl/ssl.h" "X509" #-} X509__  -- X509_VERIFY_PARAM *SSL_CTX_get0_param(SSL_CTX *ctx); foreign import ccall unsafe "SSL_CTX_get0_param"@@ -47,6 +54,28 @@     CString                {- ^ name                 -} ->     CSize                  {- ^ namelen              -} ->     IO CInt                {- ^ 1 success, 0 failure -}++-- X509_PUBKEY *X509_get_X509_PUBKEY(X509 *x);+foreign import capi unsafe "openssl/x509.h X509_get_X509_PUBKEY"+  x509getX509Pubkey ::+    Ptr X509__ -> IO (Ptr X509_PUBKEY_)++-- int i2d_X509_PUBKEY(X509_PUBKEY *p, unsigned char **ppout);+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+  -- | Add hostname checking to the certificate verification step. -- Partial wildcards matching is disabled.