hookup 0.6 → 0.7

raw patch · 5 files changed

+99/−29 lines, 5 filesdep ~attoparsecdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec, base, bytestring

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• hookup.cabal +4/−4
• src/Hookup.hs +38/−15
• src/Hookup/OpenSSL.hsc +38/−7
• src/Hookup/Socks5.hs +15/−3

@@ -1,5 +1,9 @@ # Revision history for hookup +## 0.7++* Add ability to specify TLS 1.3 cipher suites+ ## 0.6  * Include SockAddr in connection exceptions

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                hookup-version:             0.6+version:             0.7 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)@@ -37,11 +37,11 @@     cbits/pem_password_cb.c    build-depends:-    base                  >=4.11 && <4.16,+    base                  >=4.11 && <4.17,     async                 ^>=2.2,     stm                   ^>=2.5,     network               >=3.0  && <3.2,-    bytestring            >=0.10 && <0.11,-    attoparsec            >=0.13 && <0.14,+    bytestring            >=0.10 && <0.12,+    attoparsec            ^>=0.14,     HsOpenSSL             >=0.11.2.3 && <0.12,     HsOpenSSL-x509-system >=0.1  && <0.2,

@@ -43,6 +43,7 @@   ConnectionParams(..),   SocksParams(..),   TlsParams(..),+  TlsVerify(..),   PEM.PemPasswordSupply(..),   defaultTlsParams, @@ -128,9 +129,16 @@   , tpClientPrivateKeyPassword :: Maybe ByteString -- ^ Private key decryption password   , tpServerCertificate  :: Maybe FilePath -- ^ Path to CA certificate bundle   , tpCipherSuite        :: String -- ^ OpenSSL cipher suite name (e.g. @\"HIGH\"@)-  , tpInsecure           :: Bool -- ^ Disables certificate checking when 'True'+  , tpCipherSuiteTls13   :: Maybe String -- ^ OpenSSL cipher suites for TLS 1.3+  , tpVerify             :: TlsVerify -- ^ Hostname to use when checking certificate validity   } +data TlsVerify+  = VerifyDefault -- ^ Use the connection hostname to verify+  | VerifyNone -- ^ No verification+  | VerifyHostname String -- ^ Use the given hostname to verify+  deriving Show+ -- | Type for errors that can be thrown by this package. data ConnectionFailure   -- | Failure during 'getAddrInfo' resolving remote host@@ -195,7 +203,8 @@   , tpClientPrivateKeyPassword = Nothing   , tpServerCertificate  = Nothing -- use system provided CAs   , tpCipherSuite        = "HIGH"-  , tpInsecure           = False+  , tpCipherSuiteTls13   = Nothing+  , tpVerify             = VerifyDefault   }  ------------------------------------------------------------------------@@ -549,8 +558,15 @@       -- configure context      SSL.contextSetCiphers          ctx (tpCipherSuite tp)-     installVerification            ctx hostname-     SSL.contextSetVerificationMode ctx (verificationMode (tpInsecure tp))+     traverse_ (contextSetTls13Ciphers ctx) (tpCipherSuiteTls13 tp)+     case tpVerify tp of+       VerifyDefault ->+         do installVerification ctx hostname+            SSL.contextSetVerificationMode ctx verifyPeer+       VerifyHostname h ->+         do installVerification ctx h+            SSL.contextSetVerificationMode ctx verifyPeer+       VerifyNone    -> pure ()      SSL.contextAddOption           ctx SSL.SSL_OP_ALL      SSL.contextRemoveOption        ctx SSL.SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS @@ -568,13 +584,23 @@      -- leaking the file descriptor in the cases of exceptions above.      ssl <- SSL.connection ctx =<< mkSocket -     -- configure hostname used for certificate validation-     SSL.setTlsextHostName ssl hostname+     -- configure hostname used for SNI+     isip <- isIpAddress hostname+     unless isip (SSL.setTlsextHostName ssl hostname)       SSL.connect ssl       return (clientCert, ssl) +isIpAddress :: HostName -> IO Bool+isIpAddress host =+ do res <- try (Socket.getAddrInfo+                  (Just Socket.defaultHints{Socket.addrFlags=[Socket.AI_NUMERICHOST]})+                  (Just host) Nothing)+    case res :: Either IOError [AddrInfo] of+      Right{} -> pure True+      Left {} -> pure False+ setupCaCertificates :: SSLContext -> Maybe FilePath -> IO () setupCaCertificates ctx mbPath =   case mbPath of@@ -588,15 +614,12 @@      SSL.contextSetCertificate ctx x509      pure x509 --verificationMode :: Bool {- ^ insecure -} -> SSL.VerificationMode-verificationMode insecure-  | insecure  = SSL.VerifyNone-  | otherwise = SSL.VerifyPeer-                  { SSL.vpFailIfNoPeerCert = True-                  , SSL.vpClientOnce       = True-                  , SSL.vpCallback         = Nothing-                  }+verifyPeer :: SSL.VerificationMode+verifyPeer = SSL.VerifyPeer+  { SSL.vpFailIfNoPeerCert = True+  , SSL.vpClientOnce       = True+  , SSL.vpCallback         = Nothing+  }  -- | Get peer certificate if one exists. getPeerCertificate :: Connection -> IO (Maybe X509.X509)

@@ -15,11 +15,11 @@ #error "OpenSSL 1.0.2 or later is required. This version was released in Jan 2015 and adds hostname verification" #endif -module Hookup.OpenSSL (withDefaultPassword, installVerification, getPubKeyDer) where+module Hookup.OpenSSL (withDefaultPassword, installVerification, getPubKeyDer, contextSetTls13Ciphers) where  import           Control.Exception (bracket, bracket_)-import           Control.Monad (unless)-import           Foreign.C (CStringLen, CString(..), CSize(..), CUInt(..), CInt(..), withCStringLen, CChar(..))+import           Control.Monad (when)+import           Foreign.C (CStringLen, CString(..), CSize(..), CUInt(..), CInt(..), withCString, withCStringLen, CChar(..)) import           Foreign.Ptr (FunPtr, Ptr, castPtr, nullPtr, nullFunPtr) import           Foreign.StablePtr (StablePtr, deRefStablePtr, castPtrToStablePtr) import           Foreign.Marshal (with)@@ -98,6 +98,13 @@     CSize                  {- ^ namelen              -} ->     IO CInt                {- ^ 1 success, 0 failure -} +-- int X509_VERIFY_PARAM_set1_ip_asc(X509_VERIFY_PARAM *param, const char *ipasc);+foreign import ccall unsafe "X509_VERIFY_PARAM_set1_ip_asc"+  x509VerifyParamSet1IpAsc ::+    Ptr X509_VERIFY_PARAM_ {- ^ param                -} ->+    CString                {- ^ IP address as string -} ->+    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 ::@@ -124,10 +131,34 @@ -- Partial wildcards matching is disabled. installVerification :: SSLContext -> String {- ^ hostname -} -> IO () installVerification ctx host =-  withContext ctx     $ \ctxPtr ->-  withCStringLen host $ \(ptr,len) ->+  withContext ctx $ \ctxPtr ->     do param <- sslGet0Param ctxPtr        x509VerifyParamSetHostflags param          (#const X509_CHECK_FLAG_NO_PARTIAL_WILDCARDS)-       success <- x509VerifyParamSet1Host param ptr (fromIntegral len)-       unless (success == 1) (fail "Unable to set verification host")++       ip_success <-+         withCString host $ \ptr ->+           x509VerifyParamSet1IpAsc param ptr++       when (ip_success == 0) $+         do success <-+              withCStringLen host $ \(ptr,len) ->+                x509VerifyParamSet1Host param ptr (fromIntegral len)++            when (success == 0)+              (fail "Unable to set verification host")++foreign import ccall unsafe "SSL_CTX_set_ciphersuites"+   sslCtxSetCiphersuites :: Ptr SSLContext_ -> CString -> IO CInt++-- | Set the ciphers to be used by the given context for TLS 1.3+--   https://www.openssl.org/docs/man1.1.1/man3/SSL_CTX_set_cipher_list.html+--+--   Unrecognised ciphers are ignored. If no ciphers from the list are+--   recognised, an exception is raised.+contextSetTls13Ciphers :: SSLContext -> String -> IO ()+contextSetTls13Ciphers context list =+  withContext context $ \ctx ->+  withCString list    $ \cpath ->+  do success <- sslCtxSetCiphersuites ctx cpath+     when (success == 0) (fail "Unable to set ciphersuites")

@@ -1,5 +1,4 @@ {-# Language PatternSynonyms #-}-{-# OPTIONS_GHC -Wall -Wno-missing-pattern-synonym-signatures #-} {-| Module      : Hookup.Socks5 Description : SOCKS5 network protocol implementation@@ -80,6 +79,9 @@  -- | SOCKS authentication methods newtype AuthMethod                      = AuthMethod Word8 deriving (Eq, Show)++pattern AuthNoAuthenticationRequired, AuthGssApi, AuthUsernamePassword, AuthNoAcceptableMethods :: AuthMethod+ pattern AuthNoAuthenticationRequired    = AuthMethod 0x00 pattern AuthGssApi                      = AuthMethod 0x01 pattern AuthUsernamePassword            = AuthMethod 0x02@@ -87,18 +89,28 @@  -- | SOCKS client commands newtype Command                         = Command Word8 deriving (Eq, Show)++pattern Connect, Bind, UdpAssociate :: Command+ pattern Connect                         = Command 1 pattern Bind                            = Command 2 pattern UdpAssociate                    = Command 3  -- | Tags used in the protocol messages for encoded 'Host' values newtype HostTag                         = HostTag Word8 deriving (Eq, Show)++pattern IPv4Tag, DomainNameTag, IPv6Tag :: HostTag+ pattern IPv4Tag                         = HostTag 1 pattern DomainNameTag                   = HostTag 3 pattern IPv6Tag                         = HostTag 4  -- | SOCKS command reply codes newtype CommandReply                    = CommandReply Word8 deriving (Eq, Show)++pattern Succeeded, GeneralFailure, NotAllowed, NetUnreachable, HostUnreachable,+  ConnectionRefused, TTLExpired, CmdNotSupported, AddrNotSupported :: CommandReply+ pattern Succeeded                       = CommandReply 0 pattern GeneralFailure                  = CommandReply 1 pattern NotAllowed                      = CommandReply 2@@ -122,13 +134,13 @@   -- | Initial SOCKS sent by client with proposed list of authentication methods.-data ClientHello = ClientHello+newtype ClientHello = ClientHello   { cHelloMethods :: [AuthMethod] -- ^ proposed methods (maximum length 255)   }   deriving Show  -- | Initial SOCKS sent by server with chosen authentication method.-data ServerHello = ServerHello+newtype ServerHello = ServerHello   { sHelloMethod  :: AuthMethod   }   deriving Show