5
\$\begingroup\$

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.

\$\endgroup\$

1 Answer 1

6
\$\begingroup\$

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.

\$\endgroup\$
1
  • \$\begingroup\$ 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. \$\endgroup\$ Feb 10, 2012 at 9:37

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.