cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

export createProcess with debug logging from Propellor.Property.Cmd

This commit is contained in:
Joey Hess 2015-05-30 11:05:34 -04:00
parent 3548033280
commit aa7dcad9ba
3 changed files with 47 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
debian/changelog vendored
View File

@ -4,9 +4,10 @@ propellor (2.5.0) UNRELEASED; urgency=medium
more generic cmdProperty' (API change)
* Add docker image related properties.
Thanks, Antoine Eiche.
* Export CommandParam, boolSystem, safeSystem and shellEscape from
Propellor.Property.Cmd, so they are available for use in constricting
your own Properties when using propellor as a library.
* Export CommandParam, boolSystem, safeSystem, shellEscape, and
* createProcess from Propellor.Property.Cmd, so they are available
for use in constricting your own Properties when using propellor
as a library.
* Improve enter-machine scripts for nspawn containers to unset most
environment variables.
* Fix Postfix.satellite bug; the default relayhost was set to the

5
src/Propellor/Property/Cmd.hs
View File

@ -14,18 +14,19 @@ module Propellor.Property.Cmd (
boolSystemEnv,
safeSystem,
safeSystemEnv,
shellEscape
shellEscape,
createProcess,
) where
import Control.Applicative
import Data.List
import "mtl" Control.Monad.Reader
import System.Process (CreateProcess)
import Propellor.Types
import Propellor.Property
import Utility.SafeCommand
import Utility.Env
import Utility.Process (createProcess, CreateProcess)
-- | A property that can be satisfied by running a command.
--

80
src/Utility/Process.hs
View File

@ -1,7 +1,7 @@
{- System.Process enhancements, including additional ways of running
- processes, and logging.
-
- Copyright 2012 Joey Hess <id@joeyh.name>
- Copyright 2012-2015 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@ -65,8 +65,8 @@ type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Hand
data StdHandle = StdinHandle | StdoutHandle | StderrHandle
deriving (Eq)
{- Normally, when reading from a process, it does not need to be fed any
- standard input. -}
-- | Normally, when reading from a process, it does not need to be fed any
-- standard input.
readProcess :: FilePath -> [String] -> IO String
readProcess cmd args = readProcessEnv cmd args Nothing
@ -84,9 +84,8 @@ readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do
hClose h
return output
{- Runs an action to write to a process on its stdin,
- returns its output, and also allows specifying the environment.
-}
-- | Runs an action to write to a process on its stdin,
-- returns its output, and also allows specifying the environment.
writeReadProcessEnv
:: FilePath
-> [String]
@ -126,8 +125,8 @@ writeReadProcessEnv cmd args environ writestdin adjusthandle = do
, env = environ
}
{- Waits for a ProcessHandle, and throws an IOError if the process
- did not exit successfully. -}
-- | Waits for a ProcessHandle, and throws an IOError if the process
-- did not exit successfully.
forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()
forceSuccessProcess p pid = do
code <- waitForProcess pid
@ -135,10 +134,10 @@ forceSuccessProcess p pid = do
ExitSuccess -> return ()
ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n
{- Waits for a ProcessHandle and returns True if it exited successfully.
- Note that using this with createProcessChecked will throw away
- the Bool, and is only useful to ignore the exit code of a process,
- while still waiting for it. -}
-- | Waits for a ProcessHandle and returns True if it exited successfully.
-- Note that using this with createProcessChecked will throw away
-- the Bool, and is only useful to ignore the exit code of a process,
-- while still waiting for it. -}
checkSuccessProcess :: ProcessHandle -> IO Bool
checkSuccessProcess pid = do
code <- waitForProcess pid
@ -149,13 +148,13 @@ ignoreFailureProcess pid = do
void $ waitForProcess pid
return True
{- Runs createProcess, then an action on its handles, and then
- forceSuccessProcess. -}
-- | Runs createProcess, then an action on its handles, and then
-- forceSuccessProcess.
createProcessSuccess :: CreateProcessRunner
createProcessSuccess p a = createProcessChecked (forceSuccessProcess p) p a
{- Runs createProcess, then an action on its handles, and then
- a checker action on its exit code, which must wait for the process. -}
-- | Runs createProcess, then an action on its handles, and then
-- a checker action on its exit code, which must wait for the process.
createProcessChecked :: (ProcessHandle -> IO b) -> CreateProcessRunner
createProcessChecked checker p a = do
t@(_, _, _, pid) <- createProcess p
@ -163,14 +162,14 @@ createProcessChecked checker p a = do
_ <- checker pid
either E.throw return r
{- Leaves the process running, suitable for lazy streaming.
- Note: Zombies will result, and must be waited on. -}
-- | Leaves the process running, suitable for lazy streaming.
-- Note: Zombies will result, and must be waited on.
createBackgroundProcess :: CreateProcessRunner
createBackgroundProcess p a = a =<< createProcess p
{- Runs a process, optionally feeding it some input, and
- returns a transcript combining its stdout and stderr, and
- whether it succeeded or failed. -}
-- | Runs a process, optionally feeding it some input, and
-- returns a transcript combining its stdout and stderr, and
-- whether it succeeded or failed.
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
processTranscript cmd opts input = processTranscript' cmd opts Nothing input
@ -234,9 +233,9 @@ processTranscript' cmd opts environ input = do
hClose inh
writeinput Nothing _ = return ()
{- Runs a CreateProcessRunner, on a CreateProcess structure, that
- is adjusted to pipe only from/to a single StdHandle, and passes
- the resulting Handle to an action. -}
-- | Runs a CreateProcessRunner, on a CreateProcess structure, that
-- is adjusted to pipe only from/to a single StdHandle, and passes
-- the resulting Handle to an action.
withHandle
:: StdHandle
-> CreateProcessRunner
@ -258,7 +257,7 @@ withHandle h creator p a = creator p' $ a . select
| h == StderrHandle =
(stderrHandle, base { std_err = CreatePipe })
{- Like withHandle, but passes (stdin, stdout) handles to the action. -}
-- | Like withHandle, but passes (stdin, stdout) handles to the action.
withIOHandles
:: CreateProcessRunner
-> CreateProcess
@ -272,7 +271,7 @@ withIOHandles creator p a = creator p' $ a . ioHandles
, std_err = Inherit
}
{- Like withHandle, but passes (stdout, stderr) handles to the action. -}
-- | Like withHandle, but passes (stdout, stderr) handles to the action.
withOEHandles
:: CreateProcessRunner
-> CreateProcess
@ -286,8 +285,8 @@ withOEHandles creator p a = creator p' $ a . oeHandles
, std_err = CreatePipe
}
{- Forces the CreateProcessRunner to run quietly;
- both stdout and stderr are discarded. -}
-- | Forces the CreateProcessRunner to run quietly;
-- both stdout and stderr are discarded.
withQuietOutput
:: CreateProcessRunner
-> CreateProcess
@ -299,8 +298,8 @@ withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do
}
creator p' $ const $ return ()
{- Stdout and stderr are discarded, while the process is fed stdin
- from the handle. -}
-- | Stdout and stderr are discarded, while the process is fed stdin
-- from the handle.
feedWithQuietOutput
:: CreateProcessRunner
-> CreateProcess
@ -321,11 +320,11 @@ devNull = "/dev/null"
devNull = "NUL"
#endif
{- Extract a desired handle from createProcess's tuple.
- These partial functions are safe as long as createProcess is run
- with appropriate parameters to set up the desired handle.
- Get it wrong and the runtime crash will always happen, so should be
- easily noticed. -}
-- | Extract a desired handle from createProcess's tuple.
-- These partial functions are safe as long as createProcess is run
-- with appropriate parameters to set up the desired handle.
-- Get it wrong and the runtime crash will always happen, so should be
-- easily noticed.
type HandleExtractor = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Handle
stdinHandle :: HandleExtractor
stdinHandle (Just h, _, _, _) = h
@ -346,7 +345,7 @@ oeHandles _ = error "expected oeHandles"
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
processHandle (_, _, _, pid) = pid
{- Debugging trace for a CreateProcess. -}
-- | Debugging trace for a CreateProcess.
debugProcess :: CreateProcess -> IO ()
debugProcess p = do
debugM "Utility.Process" $ unwords
@ -362,15 +361,15 @@ debugProcess p = do
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 = go . cmdspec
where
go (ShellCommand s) = s
go (RawCommand c ps) = c ++ " " ++ show ps
{- Starts an interactive process. Unlike runInteractiveProcess in
- System.Process, stderr is inherited. -}
-- | Starts an interactive process. Unlike runInteractiveProcess in
-- System.Process, stderr is inherited.
startInteractiveProcess
:: FilePath
-> [String]
@ -386,7 +385,8 @@ startInteractiveProcess cmd args environ = do
(Just from, Just to, _, pid) <- createProcess p
return (pid, to, from)
{- Wrapper around System.Process function that does debug logging. -}
-- | Wrapper around 'System.Process.createProcess' from System.Process,
-- that does debug logging.
createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess p = do
debugProcess p