diff --git a/Assistant.hs b/Assistant.hs index 2218a358d1..37c231ff43 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -100,18 +100,20 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = let flag = "GIT_ANNEX_OUTPUT_REDIR" createAnnexDirectory (parentDir logfile) ifM (liftIO $ isNothing <$> getEnv flag) - ( liftIO $ withFile devNull WriteMode $ \nullh -> do + ( liftIO $ withNullHandle $ \nullh -> do loghandle <- openLog logfile e <- getEnvironment cmd <- programPath ps <- getArgs - (_, _, _, pid) <- createProcess (proc cmd ps) + let p = (proc cmd ps) { env = Just (addEntry flag "1" e) , std_in = UseHandle nullh , std_out = UseHandle loghandle , std_err = UseHandle loghandle } - exitWith =<< waitForProcess pid + exitcode <- withCreateProcess p $ \_ _ _ pid -> + waitForProcess pid + exitWith exitcode , start (Utility.Daemon.foreground (Just pidfile)) $ case startbrowser of Nothing -> Nothing diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index 0cd5e1389e..e0b877bacc 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -137,8 +137,8 @@ openFileBrowser = do ifM (liftIO $ inPath cmd) ( do let run = void $ liftIO $ forkIO $ do - (Nothing, Nothing, Nothing, pid) <- createProcess p - void $ waitForProcess pid + withCreateProcess p $ \_ _ _ pid -> void $ + waitForProcess pid run #ifdef mingw32_HOST_OS {- On windows, if the file browser is not diff --git a/Utility/Process.hs b/Utility/Process.hs index e7142b9ecb..83229a8051 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -50,6 +50,7 @@ import Utility.Exception import System.Exit import System.IO import System.Log.Logger +import Control.Monad.IO.Class import Control.Concurrent import qualified Control.Exception as E import Control.Monad @@ -207,8 +208,10 @@ withOEHandles creator p a = creator p' $ a . oeHandles , std_err = CreatePipe } -withNullHandle :: (Handle -> IO a) -> IO a -withNullHandle = withFile devNull WriteMode +withNullHandle :: (MonadIO m, MonadMask m) => (Handle -> m a) -> m a +withNullHandle = bracket + (liftIO $ openFile devNull WriteMode) + (liftIO . hClose) -- | Forces the CreateProcessRunner to run quietly; -- both stdout and stderr are discarded. @@ -230,7 +233,7 @@ feedWithQuietOutput -> CreateProcess -> (Handle -> IO a) -> IO a -feedWithQuietOutput creator p a = withFile devNull WriteMode $ \nullh -> do +feedWithQuietOutput creator p a = withNullHandle $ \nullh -> do let p' = p { std_in = CreatePipe , std_out = UseHandle nullh