如何更改runTCPClient超时持续时间？

Question

问题说明了一切....我正在使用Data.Conduit.Network,有时服务器没有启动.默认超时需要几分钟,我的程序需要在几秒钟内知道.

{-# LANGUAGE OverloadedStrings #-}

import Data.Conduit.Network

main = do --use any IP address that isn't up....  I use 1.2.3.4 for testing
  runTCPClient (clientSettings 80 "1.2.3.4") $ \server -> do
    putStrLn "connected"

我在文档和来源中上下打量,答案对我来说并不清楚.我想这可能是不可能的......

---

回复@haoformayor答案的其他信息....

我最终使用了@haoformayor建议的类似方法,但需要进行一些更改才能使其正常工作.这是我目前的工作代码.

runTCPClientWithConnectTimeout::ClientSettings->Double->(AppData->IO ())->IO ()
runTCPClientWithConnectTimeout settings secs cont = do
  race <- newChan
  resultMVar <- newEmptyMVar

  timerThreadID <- forkIO $ do
    threadDelaySeconds secs
    writeChan race False

  clientThreadID <- forkIO $ do
    result <-
      try $
      runTCPClient settings $ \appData -> do
        writeChan race True
        cont appData
    writeChan race True --second call needed because first call won't be hit in the case of an error caught by try
    putMVar resultMVar result

  timedOut <- readChan race

  if timedOut
    then do
      killThread timerThreadID --don't want a buildup of timer threads....
      result' <- readMVar resultMVar
      case result' of
       Left e -> throw (e::SomeException)
       Right x -> return x
    else do
      error "runTCPClientWithConnectTimeout: could not connect in time"
      killThread clientThreadID

Answer 1

即使在C世界中,这也很棘手,没有好的API.

因此,假设您使用的是POSIX,那么Haskell代码最终会调用connect(3).正如文档所说:

如果无法立即建立连接并且没有为套接字的文件描述符设置O_NONBLOCK,则connect()将阻止最多一个未指定的超时间隔,直到建立连接.如果超时间隔在建立连接之前到期,则connect()将失败并且连接尝试将被中止.〜手册页

未指定的超时间隔 yikes.您可以在C中执行的操作是将套接字设置为非阻塞,然后select(3)在经过一段时间后用于检查套接字.它也决定不便携,可能只能保证在Linux上运行.

谷歌搜索,似乎没有人真正将这种代码打包到C库中,而不是Haskell库.这给我们留下了直接的攻击:

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Concurrent
import Data.Conduit.Network

-- | A more sensible unit of measurement for thread delays
threadDelaySeconds :: Double -> IO ()
threadDelaySeconds secs =
  threadDelay (ceiling $ secs * 1e6)

runTCPClientBounded :: ClientSettings -> Double -> (AppData -> IO ()) -> IO ()
runTCPClientBounded settings secs cont = do
  race <- newChan
  _ <- forkIO (timer race)
  _ <- forkIO (runTCPClient settings (handleServer race))
  winner <- readChan race
  case winner of
    Nothing ->
      error "runTCPClientBounded: could not connect in time"
    Just appdata ->
      cont appdata
  where
    timer :: Chan (Maybe AppData) -> IO ()
    timer chan = do
      putStrLn ("runTCPClientBounded: waiting $n seconds: " ++ show secs)
      threadDelaySeconds secs
      writeChan chan Nothing

    handleServer :: Chan (Maybe AppData) -> AppData -> IO ()
    handleServer chan appdata =
      writeChan chan (Just appdata)

main :: IO ()
main =
  runTCPClientBounded (clientSettings 80 "1.2.3.4") 1 (const (putStrLn "connected to 1.2.3.4!"))
  -- runTCPClientBounded (clientSettings 80 "example.com") 1 (const (putStrLn "connected to example.com!"))

此代码在包含n-second计时器的线程和包含该计时器的线程之间建立竞争runTCPClient.如果计时器先关闭,我们会抛出异常; 如果connect(3)先退出,我们继续运行.演示代码警告:您可能希望在runTCPClient线程获胜但端点仍然不存在的情况下捕获异常(发信号通知虽然计时器尚未关闭,但操作系统仍确定端点已死亡).两个线程通过通道进行通信.

太讨厌了!