如何更改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（）將失敗並且連接嘗試將中止。 〜 手冊頁

未指定超時間隔 。 在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秒計時器的線程和包含runTCPClient的線程之間建立了競爭。 如果計時器先關閉，則拋出異常； 如果connect(3)首先關閉，我們將繼續執行。 演示代碼警告：如果runTCPClient線程獲勝但端點仍然不存在，您可能想捕獲異常（這表明，盡管計時器尚未關閉，但操作系統仍確定該端點已經死了）。 這兩個線程通過通道進行通信。

真討厭！