convering Fds to Handles

Sebastien Carlier sebc@wise-language.org
Fri, 17 May 2002 10:27:56 +0200


Hi,

>> I have had problems with pipes and runProcess, now I am using
>> forkProcess/executeFile/getProcessStatus and it works properly.

> Non-lazy IO presumably?  Do you have an example you can show?

Sure:

---_%--- cut here ---_%---

module Main where

import IO
import Posix
import System

main =3D
     do (ri, wi) <- createPipe
        (ro, wo) <- createPipe
        rih <- fdToHandle ri
        woh <- fdToHandle wo
        runProcess "/bin/cat" [] Nothing Nothing (Just rih) (Just woh)=20=

Nothing
        wih <- fdToHandle wi
        hPutStrLn wih (replicate 10000 'a')
        roh <- fdToHandle ro
        cs <- hGetContents roh
        fdClose wi
        putStrLn (show $ length cs)
---_%--- cut here ---_%---

I am using GHC 5.03 from the HEAD (May 12 2002), on MacOS X.
Older versions of GHC on Linux exhibit the same behavior.

Output:
> localhost% ghc -o foo -package posix Main.hs
> localhost% ./foo
> /bin/cat: stdin: Resource temporarily unavailable
> 8192
> localhost%

It seems that the output is truncated to some buffer size, and I =
couldn't
get rid of the error message.

If you set up the file descriptors yourself (using dupTo, fdClose,
forkProcess, and executeFile as appropriate), it seems to works
better (no error message, and no limit on input/ouput size).

Is runProcess broken?  Or does the above example abuse its power?

--
S=E9bastien