module Main where

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

data Setting = Setting { locPort :: PortNumber , remHost :: String, remPort :: String }

setting :: Setting
setting = Setting 9900 "ftp.free.fr" "80"

main :: IO ()
main = installHandler sigPIPE Ignore Nothing >> do
  withSocketsDo $ do
    listener <- listenOn $ PortNumber (locPort setting)
    forever $ accept listener >>= \(client,_) ->
      ignore $ forkIO $ do
        server <- getServerSocket
        client <~~> server
  where
    getServerSocket = do
      (servAddr:_) <- getAddrInfo Nothing (Just $ remHost setting) (Just $ remPort setting)
      server <- socket (addrFamily servAddr) Stream defaultProtocol
      connect server (addrAddress servAddr) >> return server
    p1 <~~> p2      = ignore $ forkIO (p1 `proxyTo` p2) >> forkIO (p2 `proxyTo` p1)
    proxyTo from to = flip catch (const $ sClose from >> sClose to) $ mapData from to
    mapData from to = do
      content <- recv from 4096
      unless (S.null content) $ sendAll to content >> mapData from to
    ignore x        = x >> return ()