Haskell 守护进程无法从 Redis 中提取 `getAddrInfo`/`Too many open files` 错误

Question

我有一个相对简单的 Haskell 守护进程，它从 Redis 中blpops 东西，并在一个线程中将它们写入 channel ，然后从 channel 中读取它们，并在另一个线程中将它们打印到标准输出。

运行它时，它开始时一切正常，一段时间后，我在 stderr 上得到以下信息:

hogstash: getAddrInfo: does not exist (nodename nor servname provided, or not known)

并在我的 system.log (OSX) 中查看以下内容:

hogstash[11281]: dnssd_clientstub deliver_request: socketpair failed 24 (Too many open files)

我从中推断出我正在以某种方式进行一些无界线程 DNS 查找，但我不明白如何进行，而且我对 Haskell 的熟悉程度不够，无法真正了解如何调试它。

主要程序如下:

import Hogstash.Inputs.Redis
import Hogstash.Event
import Hogstash.Outputs.Stdout

import Control.Concurrent
import Control.Concurrent.BoundedChan
import Control.Monad

main = forever $ do
           channel <- newBoundedChan 10
           forkIO $ do
               connection <- tmpHaxx
               forever $ getEvent connection "logstash:beaver" channel
           forkIO $ forever $ stdout channel

stdout 就是:

module Hogstash.Outputs.Stdout where

import Control.Concurrent.BoundedChan as BC
import Hogstash.Event

stdout :: BoundedChan Event -> IO ()
stdout channel = do 
                     event <- readChan channel
                     putStrLn $ show event

和getEvent是:

module Hogstash.Inputs.Redis where

import Database.Redis

import Hogstash.Event

import Control.Concurrent
import Control.Concurrent.BoundedChan as BC
import qualified Data.ByteString.Char8 as BSC


eventFromByteString :: BSC.ByteString -> Event
eventFromByteString _ = Event

listListen key = blpop [key] 0

tmpHaxx = connect defaultConnectInfo -- FIXME Remove this

getEvent :: Connection -> String -> BoundedChan Event -> IO ()

getEvent a b = getEvent' a (BSC.pack b)

getEvent' ci key channel = do
                                fnar <- pullEvent ci key
                                case fnar of
                                    Just e -> BC.writeChan channel e
                                    Nothing -> return ()

pullEvent :: Connection -> BSC.ByteString -> IO (Maybe Event)
pullEvent connection key = do
                                    event_data <- runRedis connection $ listListen key
                                    return (case event_data of
                                        Left a -> Nothing
                                        Right a -> extractEvent a)

extractEvent :: Maybe (a, BSC.ByteString) -> Maybe Event
extractEvent = fmap (eventFromByteString . snd)

谢谢

Answer 1

非常感谢 #haskell 在 Freenode 上的 Kaini:

main 愚蠢地使用 forever 无限期阻塞主线程。这当然意味着永远产生 Redis 和 stdout 线程，从而达到文件打开限制。

重写 main 为

main = do
           channel <- newBoundedChan 10
           forkIO $ do
               connection <- tmpHaxx
               forever $ getEvent connection "logstash:beaver" channel
           forkIO $ forever $ stdout channel
           forever $ threadDelay 1000 -- Block forever

效果明显更好!