[Haskell-cafe] Preventing leaked open file descriptors when catching exceptions

Ryan Newton rrnewton at gmail.com
Tue Feb 21 17:13:34 CET 2012


Hi all,

I'm trying to run a loop that repeatedly attempts to open a file until it
succeeds.  The file is a named pipe in nonblocking mode, so the writer can
only connect after the reader has connected.  (Perhaps there is some way to
determine this by stat'ing the pipe, but I don't know it yet.)

Thus I do something like the following:

 tryUntilNoIOErr $ do
    performGC
    -- The reader must connect first, the writer here spins with backoff.
    PIO.openFd filename PIO.WriteOnly Nothing fileFlags

I'm running GC between iterations to try to make sure I get rid of open
files.  Also, in the "tryUntilNoIOErr" code below I have some debugging
messages which indicate that ioeGetHandle reports no handles associated
with the exceptions I'm getting back.  (If there were handles provided I
could close them explicitly.)

In spite of these attempted precautions I'm seeing "too many open files"
exceptions in simple benchmarks that should only have a maximum of ONE file
open.

Any hints / pointers?

Thanks,
  -Ryan


mkBackoff :: IO (IO ())
mkBackoff =
  do tref <- newIORef 1
     return$ do t <- readIORef tref
        writeIORef tref (min maxwait (2 * t))
        threadDelay t
 where
   maxwait = 50 * 1000

tryUntilNoIOErr :: IO a -> IO a
tryUntilNoIOErr action = mkBackoff >>= loop
 where
  loop bkoff =
    handle (\ (e :: IOException) ->
         do bkoff
                BSS.hPutStr stderr$ BSS.pack$ "    got IO err: " ++ show e
            case ioeGetHandle e of
              Nothing -> BSS.hPutStrLn stderr$ BSS.pack$ "  no hndl io err."
              Just x  -> BSS.hPutStrLn stderr$ BSS.pack$ "  HNDL on io
err!" ++ show x
            loop bkoff) $
       action
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120221/206974bf/attachment.htm>


More information about the Haskell-Cafe mailing list