Use safer popen implementation from lambdabot/yi

This commit is contained in:
Don Stewart 2005-04-25 03:49:32 +00:00
parent 1930e846e4
commit 34f61c8367

View File

@ -63,17 +63,19 @@ import Data.Char
import Data.List import Data.List
import System.IO import System.IO
import System.Environment ( getEnv ) import System.Environment ( getEnv )
import System.Directory import System.Directory
-- --
-- The fork library -- The fork library
-- --
#if CABAL == 0 && __GLASGOW_HASKELL__ < 604 #if CABAL == 0 && __GLASGOW_HASKELL__ < 604
import POpen ( popen ) import POpen ( popen )
import System.Posix.Process ( getProcessStatus ) import System.Posix.Process ( getProcessStatus )
#else #else
import System.Process import System.Process
import Control.Concurrent ( forkIO )
import qualified Control.Exception ( evaluate )
#endif #endif
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
@ -175,15 +177,17 @@ exec :: String -> [String] -> IO ([String],[String])
#if CABAL == 1 || __GLASGOW_HASKELL__ >= 604 #if CABAL == 1 || __GLASGOW_HASKELL__ >= 604
-- --
-- Use the forkProcess library -- Use the forkProcess library, adapted from lambdabot's PosixCompat
-- Needs to be compiled with -threaded for waitForProcess not to block
-- --
exec prog args = do exec prog args = do
(_,outh,errh,proc_hdl) <- runInteractiveProcess prog args Nothing Nothing (_,outh,errh,proc_hdl) <- runInteractiveProcess prog args Nothing Nothing
b <- waitForProcess proc_hdl -- wait output <- hGetContents outh
out <- hGetContents outh errput <- hGetContents errh
err <- hGetContents errh forkIO (Control.Exception.evaluate (length output) >> return ())
case b of forkIO (Control.Exception.evaluate (length errput) >> return ())
_exit_status -> return ( lines $ out, lines $ err ) waitForProcess proc_hdl
return ( lines $ output, lines $ errput )
#else #else
-- --