add ShellParam type, for type-checked shell params

1 files changed, 79 insertions, 66 deletions

diff --git a/Utility.hs b/Utility.hs
index 6a90e3cd5..b5c0dd617 100644
--- a/Utility.hs
+++ b/Utility.hs
@@ -6,6 +6,8 @@
  -}
 
 module Utility (
+	ShellParam(..),
+	toShell,
 	hGetContentsStrict,
 	readFileStrict,
 	parentDir,
@@ -15,7 +17,6 @@ module Utility (
 	boolSystem,
 	shellEscape,
 	shellUnEscape,
-	utilityEscape,
 	unsetFileMode,
 	readMaybe,
 	safeWriteFile,
@@ -41,6 +42,83 @@ import Foreign (complement)
 import Data.List
 import Control.Monad (liftM2)
 
+{- A type for parameters passed to a shell command. A command can
+ - be passed either some Params (multiple parameters can be included,
+ - whitespace-separated, or a single Param (for when parameters contain
+ - whitespace), or a File.
+ -}
+data ShellParam = Params String | Param String | File FilePath
+	deriving (Eq, Show, Ord)
+
+{- When converting ShellParam to a String in preparation for passing to
+ - a shell command, Files that start with a dash are modified to avoid
+ - the shell command interpreting them as options. -}
+toShell :: [ShellParam] -> [String]
+toShell l = concat $ map unwrap l
+	where
+		unwrap (Param s) = [s]
+		unwrap (Params s) = filter (not . null) (split " " s)
+		unwrap (File ('-':s)) = ["./-" ++ s]
+		unwrap (File (s)) = [s]
+
+{- Run a system command, and returns True or False
+ - if it succeeded or failed.
+ -
+ - SIGINT(ctrl-c) is allowed to propigate and will terminate the program.
+ -}
+boolSystem :: FilePath -> [ShellParam] -> IO Bool
+boolSystem command params = do
+	-- Going low-level because all the high-level system functions
+	-- block SIGINT etc. We need to block SIGCHLD, but allow
+	-- SIGINT to do its default program termination.
+	let sigset = addSignal sigCHLD emptySignalSet
+	oldint <- installHandler sigINT Default Nothing
+	oldset <- getSignalMask
+	blockSignals sigset
+	childpid <- forkProcess $ childaction oldint oldset
+	mps <- getProcessStatus True False childpid
+	restoresignals oldint oldset
+	case mps of
+		Just (Exited ExitSuccess) -> return True
+		_ -> return False
+	where
+		restoresignals oldint oldset = do
+			_ <- installHandler sigINT oldint Nothing
+			setSignalMask oldset
+		childaction oldint oldset = do
+			restoresignals oldint oldset
+			executeFile command True (toShell params) Nothing
+
+{- Escapes a filename to be safely able to be exposed to the shell. -}
+shellEscape :: FilePath -> String
+shellEscape f = "'" ++ escaped ++ "'"
+	where
+		-- replace ' with '"'"'
+		escaped = join "'\"'\"'" $ split "'" f
+
+{- Unescapes a set of shellEscaped words or filenames. -}
+shellUnEscape :: String -> [String]
+shellUnEscape [] = []
+shellUnEscape s = word:(shellUnEscape rest)
+	where
+		(word, rest) = findword "" s
+		findword w [] = (w, "")
+		findword w (c:cs)
+			| c == ' ' = (w, cs)
+			| c == '\'' = inquote c w cs
+			| c == '"' = inquote c w cs
+			| otherwise = findword (w++[c]) cs
+		inquote _ w [] = (w, "")
+		inquote q w (c:cs)
+			| c == q = findword w cs
+			| otherwise = inquote q (w++[c]) cs
+
+{- For quickcheck. -}
+prop_idempotent_shellEscape :: String -> Bool
+prop_idempotent_shellEscape s = [s] == (shellUnEscape $ shellEscape s)
+prop_idempotent_shellEscape_multiword :: [String] -> Bool
+prop_idempotent_shellEscape_multiword s = s == (shellUnEscape $ unwords $ map shellEscape s)
+
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
 hGetContentsStrict :: Handle -> IO String
@@ -128,71 +206,6 @@ prop_relPathDirToDir_basics from to
 	where
 		r = relPathDirToDir from to 
 
-{- Run a system command, and returns True or False
- - if it succeeded or failed.
- -
- - SIGINT(ctrl-c) is allowed to propigate and will terminate the program.
- -}
-boolSystem :: FilePath -> [String] -> IO Bool
-boolSystem command params = do
-	-- Going low-level because all the high-level system functions
-	-- block SIGINT etc. We need to block SIGCHLD, but allow
-	-- SIGINT to do its default program termination.
-	let sigset = addSignal sigCHLD emptySignalSet
-	oldint <- installHandler sigINT Default Nothing
-	oldset <- getSignalMask
-	blockSignals sigset
-	childpid <- forkProcess $ childaction oldint oldset
-	mps <- getProcessStatus True False childpid
-	restoresignals oldint oldset
-	case mps of
-		Just (Exited ExitSuccess) -> return True
-		_ -> return False
-	where
-		restoresignals oldint oldset = do
-			_ <- installHandler sigINT oldint Nothing
-			setSignalMask oldset
-		childaction oldint oldset = do
-			restoresignals oldint oldset
-			executeFile command True params Nothing
-
-{- Escapes a filename to be safely able to be exposed to the shell. -}
-shellEscape :: FilePath -> String
-shellEscape f = "'" ++ escaped ++ "'"
-	where
-		-- replace ' with '"'"'
-		escaped = join "'\"'\"'" $ split "'" f
-
-{- Unescapes a set of shellEscaped words or filenames. -}
-shellUnEscape :: String -> [String]
-shellUnEscape [] = []
-shellUnEscape s = word:(shellUnEscape rest)
-	where
-		(word, rest) = findword "" s
-		findword w [] = (w, "")
-		findword w (c:cs)
-			| c == ' ' = (w, cs)
-			| c == '\'' = inquote c w cs
-			| c == '"' = inquote c w cs
-			| otherwise = findword (w++[c]) cs
-		inquote _ w [] = (w, "")
-		inquote q w (c:cs)
-			| c == q = findword w cs
-			| otherwise = inquote q (w++[c]) cs
-
-{- Ensures that a filename is safe to pass to a utility program. In particular
- - since utilities tend to interpret things starting with a dash as
- - an option, relative filenames starting with a dash are escaped. -}
-utilityEscape :: FilePath -> FilePath
-utilityEscape ('-':s) = "./-" ++ s
-utilityEscape s = s
-
-{- For quickcheck. -}
-prop_idempotent_shellEscape :: String -> Bool
-prop_idempotent_shellEscape s = [s] == (shellUnEscape $ shellEscape s)
-prop_idempotent_shellEscape_multiword :: [String] -> Bool
-prop_idempotent_shellEscape_multiword s = s == (shellUnEscape $ unwords $ map shellEscape s)
-
 {- Removes a FileMode from a file.
  - For example, call with otherWriteMode to chmod o-w -}
 unsetFileMode :: FilePath -> FileMode -> IO ()