我有一个简单的聊天服务器程序在Haskell。我希望用户能够连接到聊天服务器,并能够键入“退出()”离开。我目前正在运行这一切在ghci。代码如下:
(Edit:在带有GHCi的Windows 10上运行,版本9.4.5)
import Network.Socket
import Control.Monad
import Control.Concurrent
import System.IO
import Control.Monad.Fix
connectToChatRoom :: IO ()
connectToChatRoom = do
addrinfos <- getAddrInfo
Nothing
(Just "localhost")
(Just "9999")
let serveraddr = head addrinfos
serverSock <- socket (addrFamily serveraddr) Stream defaultProtocol
connect serverSock (addrAddress serveraddr)
hdl <- socketToHandle serverSock ReadWriteMode -- make a handle
hSetBuffering hdl NoBuffering
listenThread <- forkIO (clientListener hdl) -- open a new thread that listens
clientSender hdl -- this thread now sends messages
putStrLn "####### Left Chat #######"
killThread listenThread
close serverSock
clientSender :: Handle -> IO ()
clientSender hdl = fix $ \loop -> do
msg <- getLine -- read message from user
when (msg /= "quit()") $ hPutStrLn hdl msg >> loop -- if not "quit()" send msg and continue looping
clientListener :: Handle -> IO ()
clientListener hdl = fix $ \loop -> do
msg <- hGetLine hdl -- listen for msg from server
putStrLn msg -- print to stdout
loop
字符串
在ghci中:
ghci> connectToChatRoom
Here is a message to send
From User 4: Here is a message sent from another term.
Now I want to leave
quit()
####### Left Chat #######
型
一切看起来都很好,但该程序并没有终止,它只是在等待。在发送“quit()”之后,我希望clientSender
离开fix
,我可以确认它确实离开了,因为留下的聊天消息已经发布,但是我一直挂着,直到另一个用户发送聊天。killThread listenThread
似乎没有终止clientListener
函数。为什么会发生这种情况,我该如何解决?
对代码运行方式的任何其他评论也是值得赞赏的。
下面是服务器的代码,如果它很重要:
type Msg = (ID, String)
type ID = Int
chatRoomServer :: IO ()
chatRoomServer = do
addrinfos <- getAddrInfo
(Just (defaultHints {addrFlags = [AI_PASSIVE]}))
Nothing
(Just "9999")
let serveraddr = head addrinfos
sock <- socket (addrFamily serveraddr) Stream defaultProtocol -- make socket
bind sock (addrAddress serveraddr) -- bind socket to port
listen sock 1 -- set up socket listener
chan <- newChan
_ <- forkIO $ fix $ \loop -> do -- in a tutorial, something about reading the initial channel
(_, _) <- readChan chan
loop
listenForConnections sock chan -- loops waiting to accept connections
listenForConnections :: Socket -> Chan Msg -> IO ()
listenForConnections sock chan = fix loop_ 1
where loop_ loop idNum = do
(clientSock, _) <- accept sock
_ <- forkIO $ manageConnection clientSock idNum chan
loop (idNum + 1)
manageConnection :: Socket -> ID -> Chan Msg -> IO ()
manageConnection sock idNum chan = do
let broadcast msg = writeChan chan msg -- send message to all users
hdl <- socketToHandle sock ReadWriteMode
hSetBuffering hdl NoBuffering
commline <- dupChan chan
_ <- forkIO $ fix $ \loop -> do -- listen for msg to user
(idNum', msg) <- readChan commline
when (idNum' /= idNum) $ hPutStrLn hdl ("From User " ++ show idNum' ++ ": " ++ msg)
loop
fix $ \loop -> do -- listen for msg from user
msg <- hGetLine hdl
broadcast (idNum, msg)
loop
型
2条答案
按热度按时间oxcyiej71#
这个问题似乎是在Windows下运行GHCi下的客户端所特有的。我发现我能够复制您在Windows 10上运行的GHCi版本9.2.5下运行客户端的问题,但是如果我编译客户端并将其作为可执行文件运行,它会正常退出,并且在Linux下运行,无论是编译还是在GHCi下运行,它都能正常工作。
killThread
函数使用throwTo
在目标线程中引发ThreadKilled
异常,正如该函数的文档所解释的那样,异常不能保证立即交付,killThread
在设计上会阻塞,直到异常交付。这似乎就是你在这里看到的。由于某些原因,主线程在等待
hGetLine
时无法将异常传递到目标线程,并且需要处理额外的chat行,以便hGetLine
可以在目标线程中返回,从而允许在主线程中传递异常并返回killThread
。我不能解释为什么异常不能在
hGetLine
上等待时被传递到线程,但只有在GHCi下,只有在Windows下,除了注意GHC Windows运行时历史上有很多这样的问题,优先级是让编译代码正确工作,而不是让GHCi下的事情正确工作。所以,我的建议是忽略这个问题。请注意,在“真实的的”客户端程序中,当用户退出程序时,没有理由杀死任何线程。只要结束主线程--所有其他子线程将立即自动终止。
jjhzyzn02#
来自
socketToHandle
上的文档:...在调用socketToHandle后,应避免在Socket上执行任何其他操作。要在socketToHandle之后关闭Socket,请在Handle上调用hClose。
所以你应该在socket句柄上调用
hClose
。但这对你的悬挂没什么帮助。我同意@K。答:Buhr,看起来像
killThread
挂起,因为无法向线程传递异常。来自throwTo
的文档(killThread
调用throwTo
):如果目标线程当前正在进行外部调用,则在调用完成之前不会引发异常(因此throwTo不会返回)。
所以,也许,在套接字句柄上实现
hGetLine
,特别是在Windows下进行外部调用,这就是为什么会挂起。我认为正确的解决方案是不显式地杀死线程,而只是在套接字句柄上调用
hClose
,这将导致在hGetLine
上抛出IOError
,线程将被终止。还有一个问题。单独“打开”手柄以“关闭”手柄是危险的。如果在打开/关闭句柄之间会发生一些异常,则句柄可能会在打开状态下停留很长时间。解决这个问题的一种方法是使用
bracket
函数。字符串