diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 0.4.4 + +* add `rawTcpProxyTo` which can handle proxying connections without http headers + [#21](https://github.com/fpco/http-reverse-proxy/issues/21) + ## 0.4.3.3 * `fixReqHeaders` may create weird `x-real-ip` header [#19](https://github.com/fpco/http-reverse-proxy/issues/19) diff --git a/Network/HTTP/ReverseProxy.hs b/Network/HTTP/ReverseProxy.hs --- a/Network/HTTP/ReverseProxy.hs +++ b/Network/HTTP/ReverseProxy.hs @@ -10,6 +10,7 @@ ProxyDest (..) -- * Raw , rawProxyTo + , rawTcpProxyTo -- * WAI + http-conduit , waiProxyTo , defaultOnExc @@ -121,15 +122,35 @@ where fromClient = DCN.appSource appdata toClient = DCN.appSink appdata - withServer rsrc appdataServer = do - x <- newEmptyMVar - tid1 <- fork $ (rsrc $$+- toServer) `finally` putMVar x True - tid2 <- fork $ (fromServer $$ toClient) `finally` putMVar x False - y <- takeMVar x - killThread $ if y then tid2 else tid1 + withServer rsrc appdataServer = void $ concurrently + (rsrc $$+- toServer) + (fromServer $$ toClient) where fromServer = DCN.appSource appdataServer toServer = DCN.appSink appdataServer + +-- | Set up a reverse tcp proxy server, which will have a minimal overhead. +-- +-- This function uses raw sockets, parsing as little of the request as +-- possible. The workflow is: +-- +-- 1. Open up a connection to the given host\/port. +-- +-- 2. Pass all bytes across the wire unchanged. +-- +-- If you need more control, such as modifying the request or response, use 'waiProxyTo'. +-- +-- Since 0.4.4 +rawTcpProxyTo :: (MonadBaseControl IO m, MonadIO m) + => ProxyDest + -> AppData + -> m () +rawTcpProxyTo (ProxyDest host port) appdata = liftIO $ + DCN.runTCPClient (DCN.clientSettings port host) withServer + where + withServer appdataServer = void $ concurrently + (DCN.appSource appdata $$ DCN.appSink appdataServer) + (DCN.appSource appdataServer $$ DCN.appSink appdata ) -- | Sends a simple 502 bad gateway error message with the contents of the -- exception. diff --git a/http-reverse-proxy.cabal b/http-reverse-proxy.cabal --- a/http-reverse-proxy.cabal +++ b/http-reverse-proxy.cabal @@ -1,5 +1,5 @@ name: http-reverse-proxy -version: 0.4.3.3 +version: 0.4.4 synopsis: Reverse proxy HTTP requests, either over raw sockets or with WAI description: Provides a simple means of reverse-proxying HTTP requests. The raw approach uses the same technique as leveraged by keter, whereas the WAI approach performs full request/response parsing via WAI and http-conduit. homepage: https://github.com/fpco/http-reverse-proxy diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -28,7 +28,7 @@ import qualified Network.HTTP.Conduit as HC import Network.HTTP.ReverseProxy (ProxyDest (..), WaiProxyResponse (..), - defaultOnExc, rawProxyTo, + defaultOnExc, rawProxyTo, rawTcpProxyTo, WaiProxySettings (..), SetIpHeader (..), def, @@ -89,16 +89,18 @@ withMan = HC.withManager . (liftIO .) main :: IO () -main = hspec $ do +main = hspec $ describe "http-reverse-proxy" $ do it "works" $ let content = "mainApp" in withMan $ \manager -> withWApp (\_ f -> f $ responseLBS status200 [] content) $ \port1 -> withWApp (waiProxyTo (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> - withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do - lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port3 + withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> + withCApp (rawTcpProxyTo (ProxyDest "127.0.0.1" port3)) $ \port4 -> do + lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port4 lbs `shouldBe` content + it "modified path" $ let content = "/somepath" app req f = f $ responseLBS status200 [] $ L8.fromChunks [rawPathInfo req] @@ -108,8 +110,9 @@ in withMan $ \manager -> withWApp app $ \port1 -> withWApp (waiProxyTo (modReq $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> - withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do - lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port3 + withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> + withCApp (rawTcpProxyTo (ProxyDest "127.0.0.1" port3)) $ \port4 -> do + lbs <- HC.simpleHttp $ "http://127.0.0.1:" ++ show port4 S8.concat (L8.toChunks lbs) `shouldBe` content it "deals with streaming data" $ let app _ f = f $ responseStream status200 [] $ \sendChunk flush -> forever $ do @@ -172,8 +175,9 @@ in withMan $ \manager -> withWApp (\r f -> f $ responseLBS status200 [] $ getRealIp r ) $ \port1 -> withWApp (waiProxyTo' (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> - withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do - lbs <- httpWithForwardedFor $ "http://127.0.0.1:" ++ show port3 + withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> + withCApp (rawTcpProxyTo (ProxyDest "127.0.0.1" port3)) $ \port4 -> do + lbs <- httpWithForwardedFor $ "http://127.0.0.1:" ++ show port4 lbs `shouldBe` "127.0.1.1" it "get real ip 2" $ let getRealIp req = L8.fromStrict $ fromMaybe "" $ lookup "x-real-ip" (requestHeaders req) @@ -186,8 +190,9 @@ in withMan $ \manager -> withWApp (\r f -> f $ responseLBS status200 [] $ getRealIp r ) $ \port1 -> withWApp (waiProxyTo' (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> - withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do - lbs <- httpWithForwardedFor $ "http://127.0.0.1:" ++ show port3 + withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> + withCApp (rawTcpProxyTo (ProxyDest "127.0.0.1" port3)) $ \port4 -> do + lbs <- httpWithForwardedFor $ "http://127.0.0.1:" ++ show port4 lbs `shouldBe` "127.0.1.1" it "get real ip 3" $ let getRealIp req = L8.fromStrict $ fromMaybe "" $ lookup "x-real-ip" (requestHeaders req) @@ -201,7 +206,8 @@ withWApp (\r f -> f $ responseLBS status200 [] $ getRealIp r ) $ \port1 -> withWApp (waiProxyTo' (const $ return $ WPRProxyDest $ ProxyDest "127.0.0.1" port1) defaultOnExc manager) $ \port2 -> withCApp (rawProxyTo (const $ return $ Right $ ProxyDest "127.0.0.1" port2)) $ \port3 -> do - lbs <- httpWithForwardedFor $ "http://127.0.0.1:" ++ show port3 + withCApp (rawTcpProxyTo (ProxyDest "127.0.0.1" port3)) $ \port4 -> do + lbs <- httpWithForwardedFor $ "http://127.0.0.1:" ++ show port4 lbs `shouldBe` "127.0.0.1" {- FIXME describe "waiToRaw" $ do