How do I get the desired behavior in my TCP server?

> import Network.Socket
> import Control.Monad
> import Network
> import System.Environment (getArgs)
> import System.IO
> import Control.Concurrent (forkIO)

> main :: IO ()
> main = withSocketsDo $ do
>    putStrLn ("up top\n")
>    [portStr] <- getArgs
>    sock' <- socket AF_INET Stream defaultProtocol 
>    let port = fromIntegral (read portStr :: Int)
>        socketAddress = SockAddrInet port 0000 
>    bindSocket sock' socketAddress
>    listen sock' 1
>    putStrLn $ "Listening on " ++ (show port)
>    (sock, sockAddr) <- Network.Socket.accept sock'
>    handle <- socketToHandle sock ReadWriteMode
>    sockHandler sock handle
> -- hClose handle putStrLn ("close handle\n")

> sockHandler :: Socket -> Handle -> IO ()
> sockHandler sock' handle = forever $ do
>     hSetBuffering handle LineBuffering
>     forkIO $ commandProcessor handle

> commandProcessor :: Handle -> IO ()
> commandProcessor  handle = do
>     line <- hGetLine handle
>     let (cmd:arg) = words line
>     case cmd of
>         "echo" -> echoCommand handle arg 
>         "add" -> addCommand handle arg 
>         _ -> do hPutStrLn handle "Unknown command"
>  

> echoCommand :: Handle -> [String] -> IO ()
> echoCommand handle arg = do
>     hPutStrLn handle (unwords arg)

> addCommand :: Handle -> [String] -> IO ()
> addCommand handle [x,y] = do
>     hPutStrLn handle $ show $ read x + read y
> addCommand handle _ = do
>     hPutStrLn handle "usage: add Int Int"

I'm noticing some quirks in it's behavior, but the one I want to address for the moment is what happens when a client disconnects with the server. When that happens, the server throws the following exception endlessly, and will not respond to further client connections.

strawboss: : hGetLine: end of file

I've tried flushing the handle, and closing the handle. I think that closing the handle is the right thing to do, but I cannot figure out where te correct place to close the handle is. So my first question is: Is the solution to this problem a judicious hClose placement in the code? If not, where does the proble开发者_JAVA百科m lie?

---

There are several problems in this code. The main one is that you have your forever in the wrong place. What I assume you want is to endlessly accept connections, and deal with them in sockHandler, whereas your code currently only ever accepts a single connection, and then endlessly forks off worker threads to handle that single connection in parallel. This causes the mess you're experiencing.

sockHandler sock' handle = forever $ do
    ...
    forkIO $ commandProcessor handle

Instead, you'll want to move the forever to main:

forever $ do
    (sock, sockAddr) <- Network.Socket.accept sock'
    handle <- socketToHandle sock ReadWriteMode
    sockHandler sock handle

However, you will still get an exception when a client disconnects, because you're not checking if the connection has ended before calling hGetLine. We can fix this by adding using hIsEOF. You can then safely do a hClose on the handle once you know you're done with it.

Here's your code with these modifications in place. I also took the liberty of restructuring your code a little.

import Network.Socket
import Control.Monad
import Network
import System.Environment (getArgs)
import System.IO
import Control.Concurrent (forkIO)
import Control.Exception (bracket)

main :: IO ()
main = withSocketsDo $ do
   putStrLn ("up top\n")
   [port] <- getArgs
   bracket (prepareSocket (fromIntegral $ read port))
           sClose
           acceptConnections

prepareSocket :: PortNumber -> IO Socket
prepareSocket port = do
   sock' <- socket AF_INET Stream defaultProtocol 
   let socketAddress = SockAddrInet port 0000 
   bindSocket sock' socketAddress
   listen sock' 1
   putStrLn $ "Listening on " ++ (show port)
   return sock'

acceptConnections :: Socket -> IO ()
acceptConnections sock' = do
   forever $ do
       (sock, sockAddr) <- Network.Socket.accept sock'
       handle <- socketToHandle sock ReadWriteMode
       sockHandler sock handle

sockHandler :: Socket -> Handle -> IO ()
sockHandler sock' handle = do
    hSetBuffering handle LineBuffering
    -- Add the forkIO back if you want to allow concurrent connections.
    {- forkIO  $ -}
    commandProcessor handle
    return ()

commandProcessor :: Handle -> IO ()
commandProcessor handle = untilM (hIsEOF handle) handleCommand >> hClose handle
  where
    handleCommand = do
        line <- hGetLine handle
        let (cmd:arg) = words line
        case cmd of
            "echo" -> echoCommand handle arg 
            "add" -> addCommand handle arg 
            _ -> do hPutStrLn handle "Unknown command"

echoCommand :: Handle -> [String] -> IO ()
echoCommand handle arg = do
    hPutStrLn handle (unwords arg)

addCommand :: Handle -> [String] -> IO ()
addCommand handle [x,y] = do
    hPutStrLn handle $ show $ read x + read y
addCommand handle _ = do
    hPutStrLn handle "usage: add Int Int"

untilM cond action = do
   b <- cond
   if b
     then return ()
     else action >> untilM cond action