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

@@ -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
+      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
+      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

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
                                        }

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,
+import qualified Network.Socket                as N hiding (recv, recvFrom, send, sendTo)
-                                                     send, sendTo)
-import qualified Network.Socket.ByteString     as N
-
 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