Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How do I change runTCPClient timeout duration?

Tags:

haskell

The question says it all.... I am using Data.Conduit.Network, and sometimes the server isn't up. The default timeout takes minutes, my program needs to know in a few seconds.

{-# 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"

I've looked up and down in the docs and source, and the answer just isn't clear to me. I think it may be impossible....


Additional info in response to @haoformayor 's answer....

I have ended up using a similar approach that @haoformayor suggested, but needed to make some changes to get it working. Here is my current working code.

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
like image 627
jamshidh Avatar asked Jan 26 '16 19:01

jamshidh


1 Answers

This is tricky to do, even in the C world, with no good API.

So, assuming you're on POSIX, that Haskell code will eventually call connect(3). As the docs say:

If the connection cannot be established immediately and O_NONBLOCK is not set for the file descriptor for the socket, connect() shall block for up to an unspecified timeout interval until the connection is established. If the timeout interval expires before the connection is established, connect() shall fail and the connection attempt shall be aborted.   ~man page

unspecified timeout interval yikes. What you can do in C is set the socket to be nonblocking and then use select(3) to check up on the socket after some amount of time has passed. It's decidely un-portable too, probably only guaranteed to work on Linux.

Googling around, it doesn't seem that anybody's ever really packaged up this kind of code into a C library much less a Haskell library. This leaves us with a blunt attack:

{-# 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!"))

This code sets up a race between a thread containing an n-second timer and a thread containing the runTCPClient. If the timer goes off first, we throw an exception; if the connect(3) goes off first, we run the continuation. Demo code warning: you'll likely want to catch the exception in the case where the runTCPClient thread wins but the endpoint still doesn't exist (signalling that, though the timer hasn't gone off, the OS has still determined that the endpoint has died). The two threads communicate via a channel.

Pretty nasty!

like image 170
hao Avatar answered Oct 05 '22 23:10

hao