Question

以下是使用conduit，network-conduit和stm-conduit实现小型接收服务器的一些代码。它在套接字上接收数据，然后通过STM通道将其流式传输到主线程。

import Control.Concurrent (forkIO)
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TBMChan (newTBMChan, TBMChan())
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Class

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Conduit
import qualified Data.Conduit.Binary as DCB
import Data.Conduit.Extra.Resumable
import Data.Conduit.Network (sourceSocket)
import Data.Conduit.TMChan (sinkTBMChan, sourceTBMChan, mergeSources)

import System.Directory (removeFile)
import System.IO

type BSChan = TBMChan ByteString

listenSocket :: Socket -> Int -> IO BSChan
listenSocket soc bufSize = do
    chan <- atomically $ newTBMChan bufSize
    forkListener chan
    return chan
  where
    forkListener chan = void . forkIO $ listen soc 2 >> loop where 
      loop = do
        (conn, _) <- accept soc
        sourceSocket conn $$ sinkTBMChan chan
        close conn
        loop

main :: IO ()
main = do
  soc <- socket AF_UNIX Stream 0
  bind soc (SockAddrUnix "mysock")
  socChan <- listenSocket soc 8
  sourceTBMChan socChan $$ DCB.sinkHandle stdout
  removeFile "mysock"

（在实际应用程序中，来自套接字的数据流与其他一些数据流合并，这就是我不直接在侦听器中处理它的原因。）

问题在于，我预计这将在主线程被杀死之前保持打开状态，而不是在套接字上收到第一条消息后退出。我无法弄清楚为什么会这样做，除非是看到第一个数据流结束后接收器（在第2行到最后一行）退出。我可以说服它不要这样做吗？ Conduit中有一些关于使源可恢复的内容，但不是一个接收器。

Answer 1

来自sinkTBMChan的文件：

当水槽关闭时，通道也会关闭。

因此，当第一个套接字句柄关闭时，它会导致Source sourceSocket关闭，关闭连接的接收器，然后关闭传播到TBMChan的{{1}}停下水槽。

解决此问题的最简单方法可能是将sinkHandle更改为不会在关联之间关闭的自定义源，并将该源连接到loop。

TBMChan

Answer 2

从通道协调关闭编写器和读取器是一个非常重要的问题，但您可以重用pipes生态系统中的解决方案来解决此问题，即使用pipes-concurrency库。该库提供了几个pipes独立的实用程序，您可以将它们与conduit库一起用于读取器和编写器之间的通信，以便每一方自动正确地知道何时清理，并且您也可以手动清理任何一方也是。

您在pipes-concurrency库中使用的关键功能是spawn。它的类型是：

spawn :: Buffer a -> IO (Output a, Input a)

Buffer指定要使用的基础STM通道抽象。根据您的示例代码判断，听起来您需要Bounded缓冲区：

spawn (Bounded 8) :: IO (Output a, Input a)

a在这种情况下可以是任何内容，因此它可以是ByteString，例如：

spawn (Bounded 8) :: IO (Output ByteString, Input ByteString)

Input和Output的行为类似于邮箱。您可以通过send数据向Output添加邮件到邮箱，然后通过recv来自Input的数据将邮件从邮箱中删除（按FIFO顺序）：

-- Returns `False` if the mailbox is sealed
send :: Output a -> a -> STM Bool

-- Returns `Nothing` if the mailbox is sealed
recv :: Input a -> STM (Maybe a)

pipes-concurrency的简洁功能是，如果没有读者或没有写入邮箱的作者，它会设置垃圾收集器自动密封邮箱。这避免了常见的死锁源。

如果您使用pipes生态系统，通常会使用以下两个更高级别的实用程序来读取和写入邮箱。

-- Stream values into the mailbox until it is sealed
toOutput :: Output a -> Consumer a IO ()

-- Stream values from the mailbox until it is sealed
fromInput :: Input a -> Producer a IO ()

但是，因为核心机制是pipes - 独立的，所以你可以重写这些函数的等效conduit版本：

import Control.Monad.Trans.Class (lift)
import Data.Conduit
import Pipes.Concurrent

toOutput' :: Output a -> Sink a IO ()
toOutput' o = awaitForever (\a -> lift $ atomically $ send o a)

fromInput' :: Input a -> Source IO a
fromInput' i = do
    ma <- lift $ atomically $ recv i
    case ma of
        Nothing -> return ()
        Just a  -> do
            yield a
            fromInput' i

然后你的主要功能看起来像这样：

main :: IO ()
main = do
    soc <- socket AF_UNIX Stream 0
    bind soc (SockAddrUnix "mysock")
    (output, input) <- spawn (Bounded 8)
    forkIO $ readFromSocket soc $$ toOutput output
    fromInput input $$ DCB.sinkHandle stdout
  removeFile "mysock"

...其中readFromSocket是从您的Source读取的Socket。

然后，您也可以使用其他数据源自由地写入output，而不必担心必须协调它们或在您使用时正确处置input或output完成。

要详细了解pipes-concurrency，建议您阅读official tutorial。

Answer 3

所以，这里有一个答案，不涉及创建一个可恢复的接收器。 sourceSocket中的network-conduit允许单个连接，但我们可以在sourceSocket内实现重新连接行为（对代码道歉，我认为它需要清理，但至少它有效！）：

sourceSocket :: (MonadIO m) => Socket -> Producer m ByteString
sourceSocket sock =
    loop
  where
    loop = do
      (conn, _) <- lift . liftIO $ accept sock
      loop' conn
      lift . liftIO $ close conn
      loop
    loop' conn = do
      bs <- lift . liftIO $ recv conn 4096
      if B.null bs
        then return ()
        else yield bs >> loop' conn

这里的一个问题是它永远不会退出（直到程序死亡）。这在我的用例中不是问题，因为套接字应该继续监听程序的生命周期。

Answer 4

我认为@ shang的回答是正确的，我只是走得更远，并说writeTBMChan的行为看起来像是更好的罪魁祸首。我建议将其更改为不自动关闭TBMChan。这个想法的简单实现是：

sinkTBMChan chan = awaitForever $ liftIO . atomically . writeTBMChan chan

如果您在程序中使用它，它将按预期工作。

导管和插座：允许多个连接

4 个答案: