mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add debug logging of process exits

Browse source 
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
1 changed files with 26 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
Utility/Process.hs
View file

@ -31,6 +31,7 @@ module Utility.Process (
withQuietOutput,
feedWithQuietOutput,
createProcess,
waitForProcess,
startInteractiveProcess,
stdinHandle,
stdoutHandle,
@ -42,7 +43,7 @@ module Utility.Process (
import qualified System.Process
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.IO
import System.Log.Logger
@ -345,22 +346,6 @@ oeHandles _ = error "expected oeHandles"
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
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.
showCmd :: CreateProcess -> String
showCmd = go . cmdspec
@ -385,9 +370,31 @@ startInteractiveProcess cmd args environ = do
(Just from, Just to, _, pid) <- createProcess p
return (pid, to, from)
-- | Wrapper around 'System.Process.createProcess' from System.Process,
-- that does debug logging.
-- | Wrapper around 'System.Process.createProcess' that does debug logging.
createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess p = do
debugProcess 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