Simple TCP client - memory issues

Question

Does this snippet take too much memory? How can I let the connection opened with the function connectTo outside the forever loop?

import Control.Concurrent
import Network
import System.IO
import Control.Monad
import System.Environment
main = do 
 [host,port]<-getArgs
 let pn1 = fromIntegral ( read port::Int)
 forever $ do
 h <- connectTo host $ PortNumber pn1
 hSetBuffering h NoBuffering
 getLine >>= hPutStrLn h 
 forkIO $ hGetContents h >>= putStrL

If I put the line forever ... after the line hSetBuffering, the connection is lost after one input.

It seems to me that this code open too much connection.

Answer 1

hGetContents gets all remaining input, using lazy IO. The second call to hGetContents throws an error because the first call has already claimed the data, in a sense.

What I would do is have a separate thread tunnel data from the handle to standard output, and have the main thread tunnel data from standard input to the handle:

_ <- forkIO $ hGetContents h >>= putStr
getContents >>= hPutStr h

I would also use LineBuffering rather than NoBuffering, so it doesn't have to transmit a TCP packet for every character (*).

Thus, we have:

import Control.Concurrent
import Network
import System.Environment
import System.IO
main :: IO ()
main = do
 [host, port] <- getArgs
 h <- connectTo host $ PortNumber $ toEnum $ read port
 hSetBuffering stdout LineBuffering
 hSetBuffering h LineBuffering
 _ <- forkIO $ hGetContents h >>= putStr
 getContents >>= hPutStr h

A couple notes:

• I was able to avoid the type signature by using toEnum rather than fromIntegral.

• _ <- forkIO $ ... suppresses a warning when the program is compiled with -Wall.

We can do better, though. Currently, if the server disconnects, the user does not see that the server disconnected until hitting enter a couple times, which produces an ugly error message:

tcp-client: <socket: 3>: commitBuffer: resource vanished (Broken pipe)

Let's see if we can get the program to terminate when either the server or the client closes the connection. Bear in mind that:

• getContents and hGetContents terminate the list when EOF is reached. Thus:

  • hGetContents h >>= putStr terminates when the server closes the connection

  • getContents >>= hPutStr h terminates when the user presses Ctrl+D

• The program terminates when the main thread terminates, regardless if child threads still have work to do.

A good way to do this, I think, is to perform the receiving and sending in two separate threads, and have the main thread wait on an MVar:

done <- newEmptyMVar
_ <- forkIO $ (hGetContents h >>= putStr)
 `finally` tryPutMVar done ()
_ <- forkIO $ (getContents >>= hPutStr h)
 `finally` tryPutMVar done ()
-- Wait for at least one of the above threads to complete
takeMVar done

_{* Actually, sending individual characters at a time will probably trigger Nagle's algorithm. Still, sending characters one at a time creates a lot of unnecessary CPU overhead.}

• jinkou2 jinkou2: in order to better understand your comment i will try with a tcp simple server . I have found one here or in stackoverflow but can't find it again. Once i have some more code to share i will post it again.