Как мне получить желаемое поведение на моем 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: конец файла

Я пытался промыть ручку и закрыть ручку. Я думаю, что закрытие ручки - это то, что нужно, но я не могу понять, где находится правильное место для закрытия ручки. Итак, мой первый вопрос: является ли решение этой проблемы разумным размещением 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