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

时间:2016-01-26 19:36:36

标签: haskell

问题说明了一切......我正在使用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

1 个答案:

答案 0 :(得分:5)

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

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

  

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

未指定的超时间隔 yikes。你在C中可以做的是set the socket to be nonblocking and then use select(3) to check up on the socket after some amount of time has passed。它也决定不便携,可能只能保证在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 - 秒计时器的线程和包含runTCPClient的线程之间建立竞争。如果计时器先关闭,我们会抛出异常;如果connect(3)首先出现,我们会继续运行。演示代码警告:您可能希望在runTCPClient线程获胜但端点仍不存在的情况下捕获异常(发出信号,尽管计时器尚未关闭,但操作系统仍然存在确定终点已经死亡)。两个线程通过通道进行通信。

非常讨厌!