Question

我有一个TChan作为线程的输入，其行为应该如下：

如果sombody在特定时间内写入TChan，则应检索内容。如果在指定时间内没有任何内容写入，则应取消阻止并继续Nothing。

我对此的尝试是使用System.Timeout中的超时功能，如下所示：

timeout 1000000 $ atomically $ readTChan pktChannel

这似乎有效，但现在我发现，我有时会丢失数据包（它们写入通道，但不会在另一侧读取。在日志中我得到了这个：

2014.063.11.53.43.588365 Pushing Recorded Packet: 2 1439
2014.063.11.53.43.592319 Run into timeout
2014.063.11.53.44.593396 Run into timeout
2014.063.11.53.44.593553 Pushing Recorded Packet: 3 1439
2014.063.11.53.44.597177 Sending Recorded Packet: 3 1439

其中“推送记录的数据包”是来自一个线程的写入，“发送记录的数据包”是来自发送方线程中的TChan的读取。缺少Sending Recorded Packet 2 1439的行，这表示从TChan成功读取。

似乎如果在错误的时间点收到超时，则通道会丢失数据包。我怀疑threadKill和STM中使用的timeout函数不能很好地协同工作。

这是对的吗？有人有另一种不会丢失数据包的解决方案吗？

Answer 1

使用STM函数registerDelay在达到超时时发出TVar信号。然后，您可以使用orElse函数或Alternative运算符<|>在下一个TChan值或超时之间进行选择。

import Control.Applicative
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
import System.Random

-- write random values after a random delay
packetWriter :: Int -> TChan Int -> IO ()
packetWriter maxDelay chan = do
  let xs = randomRs (10000 :: Int, maxDelay + 50000) (mkStdGen 24036583)
  forM_ xs $ \ x -> do
    threadDelay x
    atomically $ writeTChan chan x

-- block (retry) until the delay TVar is set to True
fini :: TVar Bool -> STM ()
fini = check <=< readTVar

-- Read the next value from a TChan or timeout
readTChanTimeout :: Int -> TChan a -> IO (Maybe a)
readTChanTimeout timeoutAfter pktChannel = do
  delay <- registerDelay timeoutAfter
  atomically $
        Just <$> readTChan pktChannel
    <|> pure Nothing <* fini delay

-- | Print packets until a timeout is reached
readLoop :: Show a => Int -> TChan a -> IO ()
readLoop timeoutAfter pktChannel = do
  res <- readTChanTimeout timeoutAfter pktChannel
  case res of
    Nothing -> putStrLn "timeout"
    Just val -> do
      putStrLn $ "packet: " ++ show val
      readLoop timeoutAfter pktChannel

main :: IO ()
main = do
  let timeoutAfter = 1000000

  -- spin up a packet writer simulation
  pktChannel <- newTChanIO
  tid <- forkIO $ packetWriter timeoutAfter pktChannel

  readLoop timeoutAfter pktChannel

  killThread tid

Answer 2

并发的拇指规则是：如果在IO操作中的某个点添加睡眠很重要，那么您的程序就不安全了。

要理解代码timeout 1000000 $ atomically $ readTChan pktChannel无效的原因，请考虑atomically的以下替代实现：

atomically' :: STM a -> IO a
atomically' action = do
  result <- atomically action
  threadDelay someTimeAmount
  return result

以上等于atomically，但是额外的无辜延迟。现在很容易看出，如果timeout在threadDelay期间杀死线程，则原子操作已完成（使用来自频道的消息），但timeout将返回Nothing }。

timeout n $ atomically ...的简单修复可能是以下

smartTimeout :: Int -> STM a -> IO (Maybe a)
smartTimeout n action = do
   v <- atomically $ newEmptyTMvar
   _ <- timeout n $ atomically $ do
          result <- action
          putTMvar v result
   atomically $ tryTakeTMvar v

以上使用额外的事务变量v来完成这个伎俩。操作的结果值存储在运行操作的同一原子块中的v 内。超时的返回值不受信任，因为它不会告诉我们是否运行了操作。之后，我们会检查TMVar v，当且仅当action运行时才会填满。

Answer 3

而不是TChan a，请使用TChan (Maybe a)。您的普通生产者（x）现在写Just x。分叉一个额外的“滴答”过程，将Nothing写入通道（每隔x秒）。然后有一个读者用于频道，如果连续两次Nothing则中止。这样，您可以避免异常，这可能会导致数据丢失（但我不确定）。

使用带有超时的TChan

3 个答案: