Question

我试图在haskell中实现一个简单的网络应用程序。该应用程序应该启动两个服务器，彼此发送数据包。请参阅以下代码：

#!/usr/bin/env runghc

module Main where

import Network
import System.IO
import Control.Concurrent.Thread as Thread
import Control.Arrow

instance Read PortNumber where
  readsPrec p s = map (first fromInteger) $ readsPrec p s

pingpong :: PortNumber -> IO (IO ())
pingpong port = do
    s <- listenOn $ PortNumber port  -- start server
    print ("listening", "on", port)
    return $ run s                 
  where
    run s = do 
      (h,host,_) <- accept s            -- wait for packet to arrive
      port' <- fmap read $ hGetLine h   -- read dst port from packet
      hClose h
      print ("recved", "from", host, port')
      h <- connectTo host (PortNumber port')  -- send packet back
      print ("connected", "to", port')
      hPutStr h $ show port
      hClose h
      print ("sent", "to", port')

hosts = map pingpong [8080, 8081]

main :: IO ()
main = withSocketsDo $ do
    servers <- sequence hosts   -- start servers
    print "started servers"
    threads <- mapM Thread.forkIO servers  -- start listeners
    h <- connectTo "localhost" (PortNumber 8080)  -- send initial packet
    hPutStr h $ show 8081
    hClose h
    print "sent initial ping to 8081"

运行上面的代码，两台服务器按预期启动，发送一个数据包，但接收器就会死掉而没有任何错误消息。

("listening","on",8080)
("listening","on",8081)
"started servers"
"sent initial ping to 8081"
("recved","from","localhost",8081)

有谁能告诉我出了什么问题，或者我如何调试问题？我尝试使用catch/handle和stack-traces，但没有获得任何有价值的补充信息。

Haskell：调试多线程服务器

0 个答案: