如何在 TCP 服务器中获得所需的行为？

Question

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"

我注意到它的行为有一些怪癖，但我现在想解决的是当客户端与服务器断开连接时会发生什么。发生这种情况时，服务器会无休止地抛出以下异常，并且不会响应进一步的客户端连接。

strawboss: : hGetLine: end of file

我尝试过冲洗手柄，然后关闭手柄。我认为关闭手柄是正确的做法，但我无法弄清楚关闭手柄的正确位置在哪里。所以我的第一个问题是：这个问题的解决方案是在代码中明智地放置 hClose 吗？如果不是的话，问题出在哪里？

Answer 1

这段代码有几个问题。主要的一个是你的

forever

放错了地方。我假设您想要的是无休止地接受连接，并在

sockHandler

中处理它们，而您的代码当前只接受单个连接，然后无休止地分叉工作线程以并行处理该单个连接。这会导致您遇到的混乱。

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

相反，您需要将

forever

移至

main

：

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

但是，当客户端断开连接时，您仍然会遇到异常，因为您在调用

hGetLine

之前没有检查连接是否已结束。我们可以通过使用

hIsEOF

添加来解决此问题。一旦你知道你已经完成了，你就可以安全地在手柄上做一个

hClose

。

这是经过这些修改的代码。我还冒昧地重组了你的代码。

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