From 34f61c8367acf94c5c93622d8ae9ca761a63ab00 Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@cse.unsw.edu.au>
Date: Mon, 25 Apr 2005 03:49:32 +0000
Subject: [PATCH] Use safer popen implementation from lambdabot/yi

---
 src/plugins/Plugins/Utils.hs | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

diff --git a/src/plugins/Plugins/Utils.hs b/src/plugins/Plugins/Utils.hs
index 5d6d276..446b101 100644
--- a/src/plugins/Plugins/Utils.hs
+++ b/src/plugins/Plugins/Utils.hs
@@ -63,17 +63,19 @@ import Data.Char
 import Data.List
 
 import System.IO
-import System.Environment       ( getEnv )
+import System.Environment           ( getEnv )
 import System.Directory
 
 --
 -- The fork library
 --
 #if CABAL == 0 && __GLASGOW_HASKELL__ < 604
-import POpen                    ( popen )
-import System.Posix.Process     ( getProcessStatus )
+import POpen                        ( popen )
+import System.Posix.Process         ( getProcessStatus )
 #else
 import System.Process
+import Control.Concurrent           ( forkIO )
+import qualified Control.Exception  ( evaluate )
 #endif
 
 -- ---------------------------------------------------------------------
@@ -175,15 +177,17 @@ exec :: String -> [String] -> IO ([String],[String])
 
 #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
-    (_,outh,errh,proc_hdl) <- runInteractiveProcess prog args Nothing Nothing   
-    b <- waitForProcess proc_hdl    -- wait
-    out <- hGetContents outh
-    err <- hGetContents errh
-    case b of
-        _exit_status -> return ( lines $ out, lines $ err )
+    (_,outh,errh,proc_hdl) <- runInteractiveProcess prog args Nothing Nothing
+    output <- hGetContents outh
+    errput <- hGetContents errh
+    forkIO (Control.Exception.evaluate (length output) >> return ())
+    forkIO (Control.Exception.evaluate (length errput) >> return ())
+    waitForProcess proc_hdl
+    return ( lines $ output, lines $ errput )
 
 #else 
 --