add debug logging of process exits

This is mostly to be able to see how long a command took to run. Also exit
code may be useful.

Unofrtunately, I can't put the command name in there, because it's not
available at this point, and it would be a much larger change to wrap the
ProcessHandle data type to add that. However, it's generally pretty obvious
which process exited from context.
This commit is contained in:
Joey Hess 2015-08-13 13:12:44 -04:00
parent 7584e47ba3
commit 4665fc9e84

View file

@ -31,6 +31,7 @@ module Utility.Process (
withQuietOutput, withQuietOutput,
feedWithQuietOutput, feedWithQuietOutput,
createProcess, createProcess,
waitForProcess,
startInteractiveProcess, startInteractiveProcess,
stdinHandle, stdinHandle,
stdoutHandle, stdoutHandle,
@ -42,7 +43,7 @@ module Utility.Process (
import qualified System.Process import qualified System.Process
import qualified System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess) import qualified System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
import System.Process hiding (createProcess, readProcess) import System.Process hiding (createProcess, readProcess, waitForProcess)
import System.Exit import System.Exit
import System.IO import System.IO
import System.Log.Logger import System.Log.Logger
@ -345,22 +346,6 @@ oeHandles _ = error "expected oeHandles"
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
processHandle (_, _, _, pid) = pid processHandle (_, _, _, pid) = pid
-- | Debugging trace for a CreateProcess.
debugProcess :: CreateProcess -> IO ()
debugProcess p = do
debugM "Utility.Process" $ unwords
[ action ++ ":"
, showCmd p
]
where
action
| piped (std_in p) && piped (std_out p) = "chat"
| piped (std_in p) = "feed"
| piped (std_out p) = "read"
| otherwise = "call"
piped Inherit = False
piped _ = True
-- | Shows the command that a CreateProcess will run. -- | Shows the command that a CreateProcess will run.
showCmd :: CreateProcess -> String showCmd :: CreateProcess -> String
showCmd = go . cmdspec showCmd = go . cmdspec
@ -385,9 +370,31 @@ startInteractiveProcess cmd args environ = do
(Just from, Just to, _, pid) <- createProcess p (Just from, Just to, _, pid) <- createProcess p
return (pid, to, from) return (pid, to, from)
-- | Wrapper around 'System.Process.createProcess' from System.Process, -- | Wrapper around 'System.Process.createProcess' that does debug logging.
-- that does debug logging.
createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess p = do createProcess p = do
debugProcess p debugProcess p
System.Process.createProcess p System.Process.createProcess p
-- | Debugging trace for a CreateProcess.
debugProcess :: CreateProcess -> IO ()
debugProcess p = do
debugM "Utility.Process" $ unwords
[ action ++ ":"
, showCmd p
]
where
action
| piped (std_in p) && piped (std_out p) = "chat"
| piped (std_in p) = "feed"
| piped (std_out p) = "read"
| otherwise = "call"
piped Inherit = False
piped _ = True
-- | Wrapper around 'System.Process.waitForProcess' that does debug logging.
waitForProcess :: ProcessHandle -> IO ExitCode
waitForProcess h = do
r <- System.Process.waitForProcess h
debugM "Utility.Process" ("process done " ++ show r)
return r