> 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"
我注意到它的行为有些怪异,但是我现在要解决的问题是客户端与服务器断开连接时发生的情况。 发生这种情况时,服务器会无休止地抛出以下exception,并且不会响应其他客户端连接。
strawboss :: hGetLine:文件结尾
我已经尝试冲洗手柄,并closures手柄。 我认为closures手柄是正确的做法,但我不知道在哪里正确的地方closures手柄。 所以我的第一个问题是:这个问题的解决scheme在代码中明智的hClose位置? 如果不是,问题在哪里?
这个代码有几个问题。 主要的是你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
来解决这个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 $ "listning 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