From f167bde3e5634ae132f686cb943f5f765375f063 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=CE=A3rebe=20-=20Romain=20GERARD?= Date: Thu, 15 Dec 2022 21:22:12 +0100 Subject: [PATCH] Allow client to verify tls certificate Former-commit-id: 07cac1ac8e036db01c2720f0375e27b1cd0ee348 Former-commit-id: 3313f353f6258cab1bab53dcee45af60c3599cef [formerly 924008fed88d0dddb5f055b0dbbff45716b5b0ae] [formerly 4f50a2e36ebcd84816b16a3665da3de5670b6208 [formerly 9eb26df3a16aeef5b0484746a3c08f2db206a3b1 [formerly e0b115016d188d04fc3f99dfbba99b7436c76f46] [formerly 9eb26df3a16aeef5b0484746a3c08f2db206a3b1 [formerly e0b115016d188d04fc3f99dfbba99b7436c76f46] [formerly e0b115016d188d04fc3f99dfbba99b7436c76f46 [formerly 32bc3ac2a2dd3258b519f8f78dee4de9b5025dea]]]]] Former-commit-id: bd34fc8322034b6d14f179df9e930dfc71bcc5ea [formerly e118e42a69a6504c4153178b77dcafa57e6c9bd0] Former-commit-id: 83691e7ee47e683e806e0b4618d276128a51a5c8 Former-commit-id: 3632eac7a04d88058295368eea92a6a817a68e40 Former-commit-id: 02aa1f25917ac7199ca78d9a7ff9589b0d2e060c Former-commit-id: 180b1ea3defe38efb579179562cd314e88ed357e [formerly f3ebd259e67a54914ca45d15a8cfb04bdfadbec3] Former-commit-id: 932c6cbcf42afb782c5139e04c51df18f4da6b69 --- app/Main.hs | 16 +++++++++++----- src/Tunnel.hs | 2 +- src/Types.hs | 6 ++---- 3 files changed, 14 insertions(+), 10 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 338c0db..2327b9e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -10,7 +10,6 @@ import Data.CaseInsensitive ( CI ) import qualified Data.CaseInsensitive as CI import qualified Data.ByteString.Char8 as BC import Data.List (head, (!!)) -import Data.Maybe (fromMaybe) import System.Console.CmdArgs import System.Environment (getArgs, withArgs) @@ -34,6 +33,7 @@ data WsTunnel = WsTunnel , pathPrefix :: String , hostHeader :: String , tlsSNI :: String + , tlsVerifyCertificate :: Bool , websocketPingFrequencySec :: Int , wsTunnelCredentials :: String , customHeaders :: [String] @@ -83,6 +83,8 @@ cmdLine = WsTunnel &= help "If set, add the custom string as host http header" &= typ "String" &= groupname "Client options" , tlsSNI = def &= explicit &= name "tlsSNI" &= groupname "Client options" &= help "If set, use custom string in the SNI during TLS handshake" &= typ "String" &= groupname "Client options" + , tlsVerifyCertificate = def &= explicit &= name "tlsVerifyCertificate" &= groupname "Client options" + &= help "Verify tls server certificate. Default to false" , soMark = def &= explicit &= name "soMark" &= help "(linux only) Mark network packet with SO_MARK sockoption with the specified value. You need to use {root, sudo, capabilities} to run wstunnel when using this option" &= typ "int" , websocketPingFrequencySec = def &= explicit &= name "websocketPingFrequencySec" @@ -166,7 +168,7 @@ parseRestrictTo str = let !(!h, !p) = fromMaybe (error "Invalid Parameter restar let (host, port) = BC.spanEnd (/= ':') (BC.pack str) guard (host /= mempty) portNumber <- readMay . BC.unpack $ port :: Maybe Int - return $! (BC.filter (\c -> c /= '[' && c /= ']') (BC.init host), portNumber) + return (BC.filter (\c -> c /= '[' && c /= ']') (BC.init host), portNumber) parseProxyInfo :: String -> Maybe ProxySettings parseProxyInfo str = do @@ -219,8 +221,8 @@ runApp cfg serverInfo -- server mode | serverMode cfg = do putStrLn $ "Starting server with opts " <> tshow serverInfo - key <- if (Main.tlsKey cfg) /= mempty then readFile (Main.tlsKey cfg) else return Credentials.key - certificate <- if (Main.tlsCertificate cfg) /= mempty then readFile (Main.tlsCertificate cfg) else return Credentials.certificate + key <- if Main.tlsKey cfg /= mempty then readFile (Main.tlsKey cfg) else return Credentials.key + certificate <- if Main.tlsCertificate cfg /= mempty then readFile (Main.tlsCertificate cfg) else return Credentials.certificate let tls = if Main.useTls serverInfo then Just (certificate, key) else Nothing runServer tls (Main.host serverInfo, fromIntegral $ Main.port serverInfo) (parseRestrictTo $ restrictTo cfg) @@ -235,7 +237,7 @@ runApp cfg serverInfo -- -D dynamicToRemote tunnels | not . null $ dynamicToRemote cfg = do - let tunnelSetting = toDynamicTunnelSetting cfg serverInfo . parseTunnelInfo $ (dynamicToRemote cfg) ++ ":127.0.0.1:1212" + let tunnelSetting = toDynamicTunnelSetting cfg serverInfo . parseTunnelInfo $ dynamicToRemote cfg ++ ":127.0.0.1:1212" runClient tunnelSetting | otherwise = do @@ -258,6 +260,7 @@ runApp cfg serverInfo , upgradeCredentials = BC.pack $ wsTunnelCredentials cfg , udpTimeout = Main.udpTimeout cfg , tlsSNI = BC.pack $ Main.tlsSNI cfg + , tlsVerifyCertificate = Main.tlsVerifyCertificate cfg , hostHeader = BC.pack $ Main.hostHeader cfg , websocketPingFrequencySec = Main.websocketPingFrequencySec cfg , customHeaders = parseCustomHeader <$> Main.customHeaders cfg @@ -279,6 +282,7 @@ runApp cfg serverInfo , upgradeCredentials = BC.pack $ wsTunnelCredentials cfg , udpTimeout = Main.udpTimeout cfg , tlsSNI = BC.pack $ Main.tlsSNI cfg + , tlsVerifyCertificate = Main.tlsVerifyCertificate cfg , hostHeader = BC.pack $ Main.hostHeader cfg , websocketPingFrequencySec = Main.websocketPingFrequencySec cfg , customHeaders = parseCustomHeader <$> Main.customHeaders cfg @@ -300,6 +304,7 @@ runApp cfg serverInfo , upgradeCredentials = BC.pack $ wsTunnelCredentials cfg , udpTimeout = Main.udpTimeout cfg , tlsSNI = BC.pack $ Main.tlsSNI cfg + , tlsVerifyCertificate = Main.tlsVerifyCertificate cfg , hostHeader = BC.pack $ Main.hostHeader cfg , websocketPingFrequencySec = Main.websocketPingFrequencySec cfg , customHeaders = parseCustomHeader <$> Main.customHeaders cfg @@ -321,6 +326,7 @@ runApp cfg serverInfo , upgradeCredentials = BC.pack $ wsTunnelCredentials cfg , udpTimeout = Main.udpTimeout cfg , tlsSNI = BC.pack $ Main.tlsSNI cfg + , tlsVerifyCertificate = Main.tlsVerifyCertificate cfg , hostHeader = BC.pack $ Main.hostHeader cfg , websocketPingFrequencySec = Main.websocketPingFrequencySec cfg , customHeaders = parseCustomHeader <$> Main.customHeaders cfg diff --git a/src/Tunnel.hs b/src/Tunnel.hs index 6af014e..4e3f455 100644 --- a/src/Tunnel.hs +++ b/src/Tunnel.hs @@ -97,7 +97,7 @@ tlsClientP TunnelSettings{..} app conn = onError $ do where onError = flip catch (\(e :: SomeException) -> return . throwError . TlsError $ show e) - tlsSettings = NC.TLSSettingsSimple { NC.settingDisableCertificateValidation = True + tlsSettings = NC.TLSSettingsSimple { NC.settingDisableCertificateValidation = not tlsVerifyCertificate , NC.settingDisableSession = False , NC.settingUseServerName = False } diff --git a/src/Types.hs b/src/Types.hs index a7f73d0..832a3fd 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -15,10 +15,7 @@ import Data.CaseInsensitive ( CI ) import qualified Data.Streaming.Network as N import qualified Network.Connection as NC import Network.Socket (HostName, PortNumber) -import qualified Network.Socket as N hiding (recv, recvFrom, - send, sendTo) -import qualified Network.Socket.ByteString as N - +import qualified Network.Socket as N hiding (recv, recvFrom, send, sendTo) import qualified Network.WebSockets.Connection as WS import System.IO.Unsafe (unsafeDupablePerformIO) @@ -78,6 +75,7 @@ data TunnelSettings = TunnelSettings , upgradeCredentials :: ByteString , tlsSNI :: ByteString + , tlsVerifyCertificate :: Bool , hostHeader :: ByteString , udpTimeout :: Int , websocketPingFrequencySec :: Int