Getting the file descriptor of a handle, without closing it

10 Mar 2012

      Hello!

A few months ago, I started a discussion about how to extract the file 
descriptor of a handle, without the side effect of closing the handle. Bas van 
Dijk kindly provided the following function:

unsafeWithHandleFd :: Handle -> (Fd -> IO a) -> IO a

(The action in the second argument is applied to the file descriptor of the 
handle in the first argument.)

Now I'm trying to use it, but it appears to have a bug. This program shows it:

snip----------------------------------------------------------------------

import IO
import GHC.IO.Handle.Types                        -- haType, haDevice
import GHC.IO.Handle.Internals                    -- withHandle', do_operation
import System.Posix.Types                         -- Fd
import System.IO.Error                            -- ioeSetErrorString
import Data.Typeable                              -- cast
import GHC.IO.Exception                           -- IllegalOperation
import GHC.IO.FD hiding (stdin, stdout, stderr)   -- fdFD
import Foreign.C                                  -- CInt
import Control.Concurrent.MVar (MVar)

main = do
   -- Works okay
   unsafeWithHandleFd stdin $ \fd ->
      putStrLn ("stdin: fd = " ++ show fd)

   -- Blocks
   unsafeWithHandleFd stdout $ \fd ->
      putStrLn ("stdout: fd = " ++ show fd)

-- By Bas van Dijk

unsafeWithHandleFd :: Handle -> (Fd -> IO a) -> IO a
unsafeWithHandleFd h@(FileHandle _ m)     f = unsafeWithHandleFd' h m f
unsafeWithHandleFd h@(DuplexHandle _ _ w) f = unsafeWithHandleFd' h w f

unsafeWithHandleFd' :: Handle -> MVar Handle__ -> (Fd -> IO a) -> IO a
unsafeWithHandleFd' h m f =
  withHandle' "unsafeWithHandleFd" h m $ \h_@Handle__{haDevice} ->
    case cast haDevice of
      Nothing -> ioError (System.IO.Error.ioeSetErrorString 
                          (System.IO.Error.mkIOError IllegalOperation 
                           "unsafeWithHandleFd" (Just h) Nothing)
                         "handle is not a file descriptor")
      Just fd -> do
        x <- f (Fd (GHC.IO.FD.fdFD fd))
        return (h_, x)

snip----------------------------------------------------------------------

The first call of unsafeWithHandleFd, works as expected. The second one blocks.

I need unsafeWithHandleFd, or something similar, in order to port my 
HsShellScript library (http://volker-wysk.de/hsshellscript/index.html) to the 
current version of GHC. 

If someone who understands the internals of the GHC IO libraries, had a hint, 
or even a fix, I'd be very grateful.

Sincerely,
Volker Wysk