I've isolated the hang further to hPipeFrom's use of System.Log.Logger.
Commenting out calls to logging functions makes it reliably run ok. See
the "LINE OF DEATH" in the attached updated test case.
... And it turns out that System.Log.Logger uses a MVar to hold the
logger information. So I think this points to a MissingH bug, although I
don't yet understand it.
--
see shy jo
import System.Cmd
import System.IO
import System.Posix.Process
import Control.Monad
import System.Exit
import System.Cmd
import System.Log.Logger
import System.Posix.IO
import System.Posix.Process
import System.Posix.Signals
import System.Posix.Types
import System.IO
import System.IO.Error
import Control.Concurrent(forkIO)
import Control.Exception(finally)
main :: IO ()
main = forever $
pipeRead ["hello", "world"]
pipeRead :: [String] -> IO ()
pipeRead params = do
print $ "pipeRead in " ++ show (params)
(p, h) <- hPipeFrom "echo" params
print "pipeRead getcontents"
c <- hGetContents h
print $ "got: " ++ c
_ <- getProcessStatus True False $ processID p
print "pipeRead out"
data PipeHandle =
PipeHandle { processID :: ProcessID,
phCommand :: FilePath,
phArgs :: [String],
phCreator :: String -- ^ Function that created it
}
deriving (Eq, Show)
logRunning :: String -> FilePath -> [String] -> IO ()
logRunning func fp args = debugM (logbase ++ "." ++ func) (showCmd fp args)
logbase :: String
logbase = "System.Cmd.Utils"
showCmd :: FilePath -> [String] -> String
showCmd fp args = fp ++ " " ++ show args
warnFail :: [Char] -> FilePath -> [String] -> [Char] -> IO t
warnFail funcname fp args msg =
let m = showCmd fp args ++ ": " ++ msg
in do warningM (logbase ++ "." ++ funcname) m
fail m
hPipeFrom :: FilePath -> [String] -> IO (PipeHandle, Handle)
hPipeFrom fp args =
do pipepair <- createPipe
logRunning "pipeFrom" fp args --- LINE OF DEATH
let childstuff = do dupTo (snd pipepair) stdOutput
closeFd (fst pipepair)
executeFile fp True args Nothing
p <- try (forkProcess childstuff)
-- parent
pid <- case p of
Right x -> return x
Left e -> warnFail "pipeFrom" fp args $
"Error in fork: " ++ show e
closeFd (snd pipepair)
h <- fdToHandle (fst pipepair)
return (PipeHandle pid fp args "pipeFrom", h)
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
