From 26035a834a4a16174d3bc2429f91a9010488b928 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=CE=A3rebe=20-=20Romain=20GERARD?= Date: Sun, 6 Nov 2022 22:15:26 +0100 Subject: [PATCH] Allow specify certificate for server Former-commit-id: acb355bc9b816c3f87c1db08e8a8792acf780c69 Former-commit-id: a5addaff33401413838d6d3b5e3f3f2e028d6c0c [formerly 8f162adacdff0d8369929d31d00e5d1a1b13836d] [formerly 57cdd78a0bb4a2c0ddc80fcf7067b25042765a33 [formerly bb22f8601c8878cf6db4d446e25bd52a0a9cdbe8 [formerly bb22f8601c8878cf6db4d446e25bd52a0a9cdbe8 [formerly bb22f8601c8878cf6db4d446e25bd52a0a9cdbe8 [formerly cdc4bb912f844cf4d0f5f2820f8a1ff9154d1675]]]]] Former-commit-id: cba91d0daf45ee323069dca4a64eea1dd997d673 [formerly 6d5407d23091f292996d5e582b2f1a31b1b95593] Former-commit-id: 634a6c97eaac7b581d04625bb320b88d8d1a86f0 Former-commit-id: 20ca95eb92c0e12cd44bc42bee295344753e65bf Former-commit-id: 5acdd9113addf04d9a9a44db14fbc4b075ec3d52 Former-commit-id: 477fad0a3ef6add5882a279f60fe9c77ea7e0400 [formerly 88bf0b8e9300bdd5a14005cbf097df07989ce872] Former-commit-id: 9f5ef6cb1d63fc987e9fc0bd7bae480721e8b3ab --- app/Main.hs | 22 ++++++++++++++++------ src/Tunnel.hs | 11 ++++++----- 2 files changed, 22 insertions(+), 11 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 790ef48..338c0db 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -17,6 +17,7 @@ import System.Environment (getArgs, withArgs) import qualified Logger import Tunnel import Types +import Credentials import Control.Concurrent.Async as Async data WsTunnel = WsTunnel @@ -28,8 +29,6 @@ data WsTunnel = WsTunnel , udpTimeout :: Int , proxy :: String , soMark :: Int - , serverMode :: Bool - , restrictTo :: String , verbose :: Bool , quiet :: Bool , pathPrefix :: String @@ -38,6 +37,10 @@ data WsTunnel = WsTunnel , websocketPingFrequencySec :: Int , wsTunnelCredentials :: String , customHeaders :: [String] + , serverMode :: Bool + , restrictTo :: String + , tlsCertificate :: FilePath + , tlsKey :: FilePath } deriving (Show, Data, Typeable) data WsServerInfo = WsServerInfo @@ -88,15 +91,19 @@ cmdLine = WsTunnel , serverMode = def &= explicit &= name "server" &= help "Start a server that will forward traffic for you" &= groupname "Server options" - , restrictTo = def &= explicit &= name "r" &= name "restrictTo" + , restrictTo = def &= explicit &= name "r" &= name "restrictTo" &= groupname "Server options" &= help "Accept traffic to be forwarded only to this service" &= typ "HOST:PORT" + , tlsCertificate = def &= explicit &= name "tlsCertificate" &= groupname "Server options" + &= help "[optional] provide a custom tls certificate (.crt) that the server will use instead of the embeded one" &= typFile + , tlsKey = def &= explicit &= name "tlsKey" &= groupname "Server options" + &= help "[optional] provide a custom tls key (.key) that the server will use instead of the embeded one" &= typFile , verbose = def &= groupname "Common options" &= help "Print debug information" - , quiet = def &= help "Print only errors" + , quiet = def &= help "Print only errors" &= groupname "Common options" } &= summary ( "Use the websockets protocol to tunnel {TCP,UDP} traffic\n" ++ "wsTunnelClient <---> wsTunnelServer <---> RemoteHost\n" ++ "Use secure connection (wss://) to bypass proxies" ) - &= helpArg [explicit, name "help", name "h"] + &= helpArg [explicit, name "help", name "h", groupname "Common options"] toPort :: String -> Int @@ -212,7 +219,10 @@ runApp cfg serverInfo -- server mode | serverMode cfg = do putStrLn $ "Starting server with opts " <> tshow serverInfo - runServer (Main.useTls serverInfo) (Main.host serverInfo, fromIntegral $ Main.port serverInfo) (parseRestrictTo $ restrictTo cfg) + 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) -- -L localToRemote tunnels | not . null $ localToRemote cfg = do diff --git a/src/Tunnel.hs b/src/Tunnel.hs index 26ee1e5..6af014e 100644 --- a/src/Tunnel.hs +++ b/src/Tunnel.hs @@ -188,11 +188,11 @@ runClient cfg@TunnelSettings{..} = do -- -- Server -- -runTlsTunnelingServer :: (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO () -runTlsTunnelingServer endPoint@(bindTo, portNumber) isAllowed = do +runTlsTunnelingServer :: (ByteString, ByteString) -> (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO () +runTlsTunnelingServer (tlsCert, tlsKey) endPoint@(bindTo, portNumber) isAllowed = do info $ "WAIT for TLS connection on " <> toStr endPoint - N.runTCPServerTLS (N.tlsConfigBS (fromString bindTo) (fromIntegral portNumber) Credentials.certificate Credentials.key) $ \sClient -> + N.runTCPServerTLS (N.tlsConfigBS (fromString bindTo) (fromIntegral portNumber) tlsCert tlsKey) $ \sClient -> runApp sClient WS.defaultConnectionOptions (serverEventLoop (N.appSockAddr sClient) isAllowed) info "SHUTDOWN server" @@ -244,8 +244,9 @@ serverEventLoop sClient isAllowed pendingConn = do SOCKS5 -> mempty -runServer :: Bool -> (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO () -runServer useTLS = if useTLS then runTlsTunnelingServer else runTunnelingServer +runServer :: Maybe (ByteString, ByteString) -> (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO () +runServer Nothing = runTunnelingServer +runServer (Just (tlsCert, tlsKey)) = runTlsTunnelingServer (tlsCert, tlsKey)