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