export createProcess with debug logging from Propellor.Property.Cmd

debian/changelog

@@ -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
+  * Export CommandParam, boolSystem, safeSystem, shellEscape, and
-    Propellor.Property.Cmd, so they are available for use in constricting
+  * createProcess from Propellor.Property.Cmd, so they are available
-    your own Properties when using propellor as a library.
+    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

src/Propellor/Property/Cmd.hs

@@ -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.
 --

src/Utility/Process.hs

@@ -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
+-- | Normally, when reading from a process, it does not need to be fed any
- - standard input. -}
+-- 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, 
+-- | Runs an action to write to a process on its stdin, 
- - returns its output, and also allows specifying the environment.
+-- 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
+-- | Waits for a ProcessHandle, and throws an IOError if the process
- - did not exit successfully. -}
+-- 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.
+-- | Waits for a ProcessHandle and returns True if it exited successfully.
- - Note that using this with createProcessChecked will throw away
+-- Note that using this with createProcessChecked will throw away
- - the Bool, and is only useful to ignore the exit code of a process,
+-- the Bool, and is only useful to ignore the exit code of a process,
- - while still waiting for it. -}
+-- 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
+-- | Runs createProcess, then an action on its handles, and then
- - forceSuccessProcess. -}
+-- forceSuccessProcess.
 createProcessSuccess :: CreateProcessRunner
 createProcessSuccess p a = createProcessChecked (forceSuccessProcess p) p a
 
-{- Runs createProcess, then an action on its handles, and then
+-- | Runs createProcess, then an action on its handles, and then
- - a checker action on its exit code, which must wait for the process. -}
+-- 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.
+-- | Leaves the process running, suitable for lazy streaming.
- - Note: Zombies will result, and must be waited on. -}
+-- 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
+-- | Runs a process, optionally feeding it some input, and
- - returns a transcript combining its stdout and stderr, and
+-- returns a transcript combining its stdout and stderr, and
- - whether it succeeded or failed. -}
+-- 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
+-- | Runs a CreateProcessRunner, on a CreateProcess structure, that
- - is adjusted to pipe only from/to a single StdHandle, and passes
+-- is adjusted to pipe only from/to a single StdHandle, and passes
- - the resulting Handle to an action. -}
+-- 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;
+-- | Forces the CreateProcessRunner to run quietly;
- - both stdout and stderr are discarded. -}
+-- 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
+-- | Stdout and stderr are discarded, while the process is fed stdin
- - from the handle. -}
+-- from the handle.
 feedWithQuietOutput
 	:: CreateProcessRunner
 	-> CreateProcess
@@ -321,11 +320,11 @@ devNull = "/dev/null"
 devNull = "NUL"
 #endif
 
-{- Extract a desired handle from createProcess's tuple.
+-- | Extract a desired handle from createProcess's tuple.
- - These partial functions are safe as long as createProcess is run
+-- These partial functions are safe as long as createProcess is run
- - with appropriate parameters to set up the desired handle.
+-- with appropriate parameters to set up the desired handle.
- - Get it wrong and the runtime crash will always happen, so should be
+-- Get it wrong and the runtime crash will always happen, so should be
- - easily noticed. -}
+-- 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
+-- | Starts an interactive process. Unlike runInteractiveProcess in
- - System.Process, stderr is inherited. -}
+-- 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