How to write a minimal-overhead proxy to localhost:3389 in Haskell?

Question

Update: question now contains the final edited answer!

I now use the following (final answer):

module Main where

import Control.Concurrent        (forkIO)
import Control.Monad             (when,forever,void)
import Network                   (PortID(PortNumber),listenOn)
import Network.Socket hiding     (listen,recv,send)
import Network.Socket.ByteString (recv,sendAll)
import qualified Data.ByteString as B
import System

type Host = String
type Port = PortNumber

main :: IO ()
main = do
  [lp,h,p] <- getArgs  
  start (port lp) h (port p)
  where
    port = fromInteger . read

start :: Port -> Host -> Port -> IO ()
start lp rh rp = withSocketsDo $ do
  proxy <- listenOn $ PortNumber lp
  forever $ do
    (client,_) <- accept proxy
    void . forkIO $ (client >-<) =<< rh .@. rp

(.@.) :: Host -> Port -> IO Socket
host .@. port = do
  addr:_ <- getAddrInfo Nothing (Just host) (Just $ show port)
  server <- socket (addrFamily  addr) Stream defaultProtocol
  connect server   (addrAddress addr)
  return  server

(>-<) :: Socket -> Socket -> IO ()
x >-< y = do x >- y; y >- x

(>-) :: Socket -> Socket -> IO ()
s >- r = void . forkIO . handle $ forever stream
  where
    stream = recv s (64 * 1024) >>= ifNot0 >>= sendAll r
    ifNot0  = \c -> do when (B.null c) $ handle (error "0"); return c
    handle = flip catch $ \e -> print e >> sClose s >> sClose r

which can be run like this:

proxy 2000 localhost 3389

Using mRemote, if I connect to localhost:2000, I do see the login screen of the local machine! :)

*If I find a way to improve (>-) even further, I will update this answer!

what specific problem are you trying to solve with his code? — Mike Pennington, Feb 27 '12 at 01:38
@MikePennington , I just described the problem I am trying to solve at the end of the question. — Cetin Sert, Feb 27 '12 at 01:45
@NiklasB. faster & also using as little memory as possible, without creating `content` inside `(>-)` — Cetin Sert, Feb 27 '12 at 02:59
I have no good suggestions about how to speed things up but have two notes on style. `ignore` function is already available in `Control.Monad` under the name `void`. Also `//` name is not too descriptive and I'd better use plain `sClose from >> sClose to`. — Paul Graphov, Feb 28 '12 at 16:03
@PaulGraphov Oh many thanks for `void`. You are right about `//` as well. — Cetin Sert, Mar 02 '12 at 10:14

h0tw1r3 · Answer 1 · 2012-02-27T03:30:26.423

Found this gist a few months ago when I was getting started with Haskell.

It's really simple and easy to understand.

EDIT: Based on the gist above, here is a tested RDP proxy. Difference is replacing send with sendAll to make sure all data is delivered. Found this problem when testing through the linux rdp server (large payload disconnects).

module Main where

import Control.Concurrent      (forkIO)
import Control.Monad           (forever,unless)
import Network                 (PortID(PortNumber),listenOn)
import qualified Data.ByteString as S
import Network.Socket hiding (listen,recv,send)
import Network.Socket.ByteString (recv,sendAll)
import System.Posix            (Handler(Ignore),installHandler,sigPIPE)


localPort :: PortNumber
localPort = 3390

remoteHost :: String
remoteHost = "localhost"

remotePort :: Integer
remotePort = 3389

main :: IO ()
main = do
  ignore $ installHandler sigPIPE Ignore Nothing
  start

start :: IO ()
start = withSocketsDo $ do
  listener <- listenOn $ PortNumber localPort
  forever $ do
    (client,_) <- accept listener
    ignore $ forkIO $ do
      server <- connectToServer
      client `proxyTo` server
      server `proxyTo` client
    return ()
  where
    connectToServer = do
      addrinfos <- getAddrInfo Nothing (Just remoteHost) (Just $ show remotePort)
      let serveraddr = head addrinfos
      server <- socket (addrFamily serveraddr) Stream defaultProtocol
      connect server (addrAddress serveraddr)
      return server
    proxyTo from to = do
      ignore $ forkIO $ flip catch (close from to) $ forever $ do
        content <- recv from 1024
        unless (S.null content) $ sendAll to content
      return ()
    close a b _ = do
      sClose a
      sClose b

-- | Run an action and ignore the result.
ignore :: Monad m => m a -> m ()
ignore m = m >> return ()

Thanks for the link. I actually used the same one in the question ..., my question is about proxyTo's efficency but I guess I will get no answer anytime soon or perhaps it is hard to improve upon it. — Cetin Sert, Feb 27 '12 at 03:21
Fixed the code from github. It had the same problem as your code, munging up the data stream. — h0tw1r3, Feb 27 '12 at 20:20

Paul R · Accepted Answer · 2012-03-02T13:09:48.470

3

It seems that you came to this tcp proxy gist when looking for information. At this time, is is broken and a bit messy. In such case, please don't hesitate to ping the author (in this case, me) so that he can fix the gist for future references :)

I'll fix it ASAP and link to this SO question. The fixed version will include sendAll as well as all nice suggestions coming from this SO question, so please share your best thoughts. As a side note, this branch of throttle already had the sendAll fix, in case of interest.

EDIT : the gist is fixed now

edited Mar 02 '12 at 13:09

answered Mar 02 '12 at 08:34

Paul R

747
4
13

I have still to catch up with the fast-paced environment of github so concepts like gists and pings are a bit beyond my current horizon :) . I am glad the gist is going to be now fixed. – Cetin Sert Mar 02 '12 at 09:55
1

The easiest way is probably to drop a comment in the Gist itself, but unfortunately you must log-in for that. Like many people, I tend to use Gist for pasting code for sharing quick and dirty concepts with mates. As a result, my gists (and a lot of others') are almost always poorly designed and broken. That's why if a search engine happens to index one of them, and some people find it interesting, it is very important to let the author know that his ugly hack needs a bit of care :) – Paul R Mar 02 '12 at 10:14
48 lines of code and we have a working reliable, low-mem, high-perf lovely proxy. And the code is so crystal clear that it is truly an executable stream of consciousness that carries no noise but pure intent in the loveliest functional programming language I have ever come across. I am really glad and thankful I stumbled upon your gist. :) – Cetin Sert Mar 02 '12 at 10:35
even shorter and more to the point than before :) `<~~>`! I am delighted to be partly responsible for broader acceptance of fancy symbols in Haskell. – Cetin Sert Mar 02 '12 at 14:28

How to write a minimal-overhead proxy to localhost:3389 in Haskell?

2 Answers2

Linked