hex/wstunnel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow specify certificate for server

Browse source 
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
This commit is contained in:
Σrebe - Romain GERARD 2022-11-06 22:15:26 +01:00
parent 001619f7b1
commit 26035a834a
2 changed files with 22 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
app/Main.hs
View file

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

11
src/Tunnel.hs
View file

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