hookup-0.1.0.0/0000755000000000000000000000000012775362436011360 5ustar0000000000000000hookup-0.1.0.0/ChangeLog.md0000644000000000000000000000015612775362436013533 0ustar0000000000000000# Revision history for hookup ## 0.1.0.0 -- YYYY-mm-dd * First version. Released on an unsuspecting world. hookup-0.1.0.0/hookup.cabal0000644000000000000000000000240112775362436013646 0ustar0000000000000000name: hookup version: 0.1.0.0 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) homepage: https://github.com/glguy/irc-core license: ISC license-file: LICENSE author: Eric Mertens maintainer: emertens@gmail.com copyright: 2016 Eric Mertens category: Network build-type: Simple extra-source-files: ChangeLog.md cabal-version: >=1.10 library exposed-modules: Hookup other-modules: Hookup.OpenSSL extra-libraries: ssl build-depends: base >=4.9 && <4.10, socks >=0.5 && <0.6, network >=2.6 && <2.7, bytestring >=0.10 && <0.11, HsOpenSSL >=0.11.2.3 && <0.12, HsOpenSSL-x509-system >=0.1 && <0.2, template-haskell >=2.11 && <2.12 hs-source-dirs: src default-language: Haskell2010 hookup-0.1.0.0/LICENSE0000644000000000000000000000133212775362436012364 0ustar0000000000000000Copyright (c) 2016 Eric Mertens Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. hookup-0.1.0.0/Setup.hs0000644000000000000000000000005612775362436013015 0ustar0000000000000000import Distribution.Simple main = defaultMain hookup-0.1.0.0/src/0000755000000000000000000000000012775362436012147 5ustar0000000000000000hookup-0.1.0.0/src/Hookup.hs0000644000000000000000000002204512775362436013753 0ustar0000000000000000{-| Module : Hookup Description : Network connections generalized over TLS and SOCKS Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module provides a uniform interface to network connections with optional support for TLS and SOCKS. -} module Hookup ( -- * Configuration ConnectionParams(..), SocksParams(..), TlsParams(..), -- * Connections Connection, connect, recvLine, send, close, -- * Errors ConnectionFailure(..), ) where import Control.Concurrent import Control.Exception import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Foldable import Network (PortID(..)) import Network.Socket (Socket, AddrInfo, PortNumber, HostName) import qualified Network.Socket as Socket import qualified Network.Socket.ByteString as SocketB import Network.Socks5 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 qualified OpenSSL.PEM as PEM import Hookup.OpenSSL (installVerification) -- | Parameters for 'connect'. data ConnectionParams = ConnectionParams { cpHost :: HostName -- ^ Destination host , cpPort :: PortNumber -- ^ Destination TCP port , cpSocks :: Maybe SocksParams -- ^ Optional SOCKS5 parameters , cpTls :: Maybe TlsParams -- ^ Optional TLS parameters } -- | SOCKS5 connection parameters data SocksParams = SocksParams { spHost :: HostName -- ^ SOCKS server host , spPort :: PortNumber -- ^ SOCKS server port } -- | TLS connection parameters data TlsParams = TlsParams { tpClientCertificate :: Maybe FilePath , tpClientPrivateKey :: Maybe FilePath , tpServerCertificate :: Maybe FilePath , tpCipherSuite :: String , tpInsecure :: Bool } -- | Type for errors that can be thrown by this package. data ConnectionFailure -- | Failure during 'getAddrInfo' resolving remote host = HostnameResolutionFailure IOError -- | Failure during 'connect' to remote host | ConnectionFailure [IOError] -- | Failure during 'recvLine' | LineTooLong -- | Incomplete line during 'recvLine' | LineTruncated deriving Show instance Exception ConnectionFailure ------------------------------------------------------------------------ -- Opening sockets ------------------------------------------------------------------------ -- | Open a socket using the given parameters either directly or -- via a SOCKS server. openSocket :: ConnectionParams -> IO Socket openSocket params = case cpSocks params of Nothing -> openSocket' (cpHost params) (cpPort params) Just sp -> openSocks sp (cpHost params) (cpPort params) openSocks :: SocksParams -> HostName -> PortNumber -> IO Socket openSocks sp h p = do socksConnectTo' (spHost sp) (PortNumber (spPort sp)) h (PortNumber p) openSocket' :: HostName -> PortNumber -> IO Socket openSocket' h p = do let hints = Socket.defaultHints { Socket.addrSocketType = Socket.Stream , Socket.addrFlags = [Socket.AI_ADDRCONFIG ,Socket.AI_NUMERICSERV] } res <- try (Socket.getAddrInfo (Just hints) (Just h) (Just (show p))) case res of Right ais -> attemptConnections [] ais Left ioe -> throwIO (HostnameResolutionFailure ioe) attemptConnections :: [IOError] -> [Socket.AddrInfo] -> IO Socket attemptConnections exs [] = throwIO (ConnectionFailure exs) attemptConnections exs (ai:ais) = do s <- socket' ai res <- try (Socket.connect s (Socket.addrAddress ai)) case res of Left ex -> do Socket.close s attemptConnections (ex:exs) ais Right{} -> return s -- | Open a 'Socket' using the parameters from an 'AddrInfo' socket' :: AddrInfo -> IO Socket socket' ai = Socket.socket (Socket.addrFamily ai) (Socket.addrSocketType ai) (Socket.addrProtocol ai) ------------------------------------------------------------------------ -- Generalization of Socket ------------------------------------------------------------------------ data NetworkHandle = SSL SSL | Socket Socket openNetworkHandle :: ConnectionParams -> IO NetworkHandle openNetworkHandle params = do s <- openSocket params case cpTls params of Nothing -> return (Socket s) Just tp -> SSL <$> startTls (cpHost params) tp s closeNetworkHandle :: NetworkHandle -> IO () closeNetworkHandle (SSL s) = SSL.shutdown s SSL.Unidirectional closeNetworkHandle (Socket s) = Socket.close s networkSend :: NetworkHandle -> ByteString -> IO () networkSend (Socket s) = SocketB.sendAll s networkSend (SSL s) = SSL.write s networkRecv :: NetworkHandle -> Int -> IO ByteString networkRecv (Socket s) = SocketB.recv s networkRecv (SSL s) = SSL.read s ------------------------------------------------------------------------ -- Sockets with a receive buffer ------------------------------------------------------------------------ -- | A connection to a network service along with its read buffer -- used for line-oriented protocols. The connection could be a plain -- network connection, SOCKS connected, or TLS. data Connection = Connection (MVar ByteString) NetworkHandle -- | Open network connection to TCP service specified by -- the given parameters. -- -- Throws 'IOError', 'SocksError', 'SSL.ProtocolError', 'ConnectionFailure' connect :: ConnectionParams -> IO Connection connect params = do h <- openNetworkHandle params b <- newMVar B.empty return (Connection b h) -- | Close network connection. close :: Connection -> IO () close (Connection _ h) = closeNetworkHandle h -- | Receive a line from the network connection. Both -- @"\r\n"@ and @"\n"@ are recognized. -- -- Throws: 'ConnectionAbruptlyTerminated', 'ConnectionFailure', 'IOError' recvLine :: Connection -> Int -> IO (Maybe ByteString) recvLine (Connection buf h) n = modifyMVar buf $ \bs -> go (B.length bs) bs [] where go bsn bs bss = case B.elemIndex 10 bs of Just i -> return (B.tail b, Just (cleanEnd (B.concat (reverse (a:bss))))) where (a,b) = B.splitAt i bs Nothing -> do when (bsn >= n) (throwIO LineTooLong) more <- networkRecv h n if B.null more then if B.null bs then return (B.empty, Nothing) else throwIO LineTruncated else go (bsn + B.length more) more (bs:bss) -- | Remove the trailing @'\r'@ if one is found. cleanEnd :: ByteString -> ByteString cleanEnd bs | B.null bs || B.last bs /= 13 = bs | otherwise = B.init bs -- | Send bytes on the network connection. Ensures that the whole message -- is sent. -- -- Throws: 'IOError', 'ProtocolError' send :: Connection -> ByteString -> IO () send (Connection _ h) = networkSend h ------------------------------------------------------------------------ -- | Initiate a TLS session on the given socket destined for -- the given hostname. When successful an active TLS connection -- is returned with certificate verification successful when -- requested. startTls :: HostName {- ^ server hostname -} -> TlsParams {- ^ parameters -} -> Socket {- ^ connected socket -} -> IO SSL {- ^ connected TLS -} startTls host tp s = SSL.withOpenSSL $ do ctx <- SSL.context -- configure context SSL.contextSetCiphers ctx (tpCipherSuite tp) installVerification ctx host SSL.contextSetVerificationMode ctx (verificationMode (tpInsecure tp)) SSL.contextAddOption ctx SSL.SSL_OP_ALL SSL.contextRemoveOption ctx SSL.SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS -- configure certificates setupCaCertificates ctx (tpServerCertificate tp) traverse_ (setupCertificate ctx) (tpClientCertificate tp) traverse_ (setupPrivateKey ctx) (tpClientPrivateKey tp) -- add socket to context ssl <- SSL.connection ctx s SSL.setTlsextHostName ssl host SSL.connect ssl return ssl setupCaCertificates :: SSLContext -> Maybe FilePath -> IO () setupCaCertificates ctx mbPath = case mbPath of Nothing -> contextLoadSystemCerts ctx Just path -> SSL.contextSetCAFile ctx path setupCertificate :: SSLContext -> FilePath -> IO () setupCertificate ctx path = SSL.contextSetCertificate ctx =<< PEM.readX509 -- EX =<< readFile path setupPrivateKey :: SSLContext -> FilePath -> IO () setupPrivateKey ctx path = do str <- readFile path -- EX key <- PEM.readPrivateKey str PEM.PwNone -- add password support SSL.contextSetPrivateKey ctx key verificationMode :: Bool {- ^ insecure -} -> SSL.VerificationMode verificationMode insecure | insecure = SSL.VerifyNone | otherwise = SSL.VerifyPeer { SSL.vpFailIfNoPeerCert = True , SSL.vpClientOnce = True , SSL.vpCallback = Nothing } hookup-0.1.0.0/src/Hookup/0000755000000000000000000000000012775362436013414 5ustar0000000000000000hookup-0.1.0.0/src/Hookup/OpenSSL.hsc0000644000000000000000000000427612775362436015407 0ustar0000000000000000{-| Module : Hookup.OpenSSL Description : Hack into the internals of OpenSSL to add missing functionality Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com -} #include "openssl/ssl.h" #include "openssl/x509_vfy.h" #include "openssl/x509v3.h" module Hookup.OpenSSL (installVerification) where import Control.Monad (unless) import Foreign.C (CString(..), CSize(..), CUInt(..), CInt(..), withCStringLen) import Foreign.Ptr (Ptr) import OpenSSL.Session (SSLContext, SSLContext_, withContext) ------------------------------------------------------------------------ -- Bindings to hostname verification interface ------------------------------------------------------------------------ data X509_VERIFY_PARAM_ -- X509_VERIFY_PARAM *SSL_CTX_get0_param(SSL_CTX *ctx); foreign import ccall unsafe "SSL_CTX_get0_param" sslGet0Param :: Ptr SSLContext_ {- ^ ctx -} -> IO (Ptr X509_VERIFY_PARAM_) -- void X509_VERIFY_PARAM_set_hostflags(X509_VERIFY_PARAM *param, unsigned int flags); foreign import ccall unsafe "X509_VERIFY_PARAM_set_hostflags" x509VerifyParamSetHostflags :: Ptr X509_VERIFY_PARAM_ {- ^ param -} -> CUInt {- ^ flags -} -> IO () -- int X509_VERIFY_PARAM_set1_host(X509_VERIFY_PARAM *param, const char *name, size_t namelen); foreign import ccall unsafe "X509_VERIFY_PARAM_set1_host" x509VerifyParamSet1Host :: Ptr X509_VERIFY_PARAM_ {- ^ param -} -> CString {- ^ name -} -> CSize {- ^ namelen -} -> IO CInt {- ^ 1 success, 0 failure -} -- | Add hostname checking to the certificate verification step. -- Partial wildcards matching is disabled. installVerification :: SSLContext -> String {- ^ hostname -} -> IO () installVerification ctx host = withContext ctx $ \ctxPtr -> withCStringLen host $ \(ptr,len) -> 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")