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

时间:2011-09-27 20:06:34

标签: windows haskell

> 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放置?如果没有,问题出在哪里?

1 个答案:

答案 0 :(得分:4)

此代码中存在几个问题。主要的一点是你的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