diff options
| author | Daniel Brooks <db48x@db48x.net> | 2015-08-02 00:59:28 -0400 |
|---|---|---|
| committer | Daniel Brooks <db48x@db48x.net> | 2015-08-02 00:59:28 -0400 |
| commit | eb15f06896aeb208d19f6f322905c7782125356e (patch) | |
| tree | 6f28ac50e476e83b212e2827a10d4b6dee0730c9 /src/Utility/SafeCommand.hs | |
| parent | 65b511e2d4f4ec9864167e414e76b967eda32dba (diff) | |
| parent | b7a9655a695103b3ca2e4e6edfe305f9b44d9250 (diff) | |
Merge branch 'joeyconfig' of git://git.kitenet.net/propellor into joeyconfig
Conflicts:
src/Propellor/Property/SiteSpecific/IABak.hs
Diffstat (limited to 'src/Utility/SafeCommand.hs')
| -rw-r--r-- | src/Utility/SafeCommand.hs | 64 |
1 files changed, 32 insertions, 32 deletions
diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs index 9eaa5308..9102b726 100644 --- a/src/Utility/SafeCommand.hs +++ b/src/Utility/SafeCommand.hs @@ -5,44 +5,45 @@ - License: BSD-2-clause -} +{-# OPTIONS_GHC -fno-warn-tabs #-} + module Utility.SafeCommand where import System.Exit import Utility.Process import Data.String.Utils -import Control.Applicative import System.FilePath import Data.Char +import Control.Applicative +import Prelude -{- 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 CommandParam = Params String | Param String | File FilePath +-- | Parameters that can be passed to a shell command. +data CommandParam + = Param String -- ^ A parameter + | File FilePath -- ^ The name of a file deriving (Eq, Show, Ord) -{- Used to pass a list of CommandParams to a function that runs - - a command and expects Strings. -} +-- | Used to pass a list of CommandParams to a function that runs +-- a command and expects Strings. -} toCommand :: [CommandParam] -> [String] -toCommand = concatMap unwrap +toCommand = map unwrap where - unwrap (Param s) = [s] - unwrap (Params s) = filter (not . null) (split " " s) + unwrap (Param s) = s -- Files that start with a non-alphanumeric that is not a path -- separator are modified to avoid the command interpreting them as -- options or other special constructs. unwrap (File s@(h:_)) - | isAlphaNum h || h `elem` pathseps = [s] - | otherwise = ["./" ++ s] - unwrap (File s) = [s] + | isAlphaNum h || h `elem` pathseps = s + | otherwise = "./" ++ s + unwrap (File s) = s -- '/' is explicitly included because it's an alternative -- path separator on Windows. pathseps = pathSeparator:"./" -{- Run a system command, and returns True or False - - if it succeeded or failed. - -} +-- | Run a system command, and returns True or False if it succeeded or failed. +-- +-- This and other command running functions in this module log the commands +-- run at debug level, using System.Log.Logger. boolSystem :: FilePath -> [CommandParam] -> IO Bool boolSystem command params = boolSystem' command params id @@ -56,7 +57,7 @@ boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bo boolSystemEnv command params environ = boolSystem' command params $ \p -> p { env = environ } -{- Runs a system command, returning the exit status. -} +-- | Runs a system command, returning the exit status. safeSystem :: FilePath -> [CommandParam] -> IO ExitCode safeSystem command params = safeSystem' command params id @@ -71,23 +72,22 @@ safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Ex safeSystemEnv command params environ = safeSystem' command params $ \p -> p { env = environ } -{- Wraps a shell command line inside sh -c, allowing it to be run in a - - login shell that may not support POSIX shell, eg csh. -} +-- | Wraps a shell command line inside sh -c, allowing it to be run in a +-- login shell that may not support POSIX shell, eg csh. shellWrap :: String -> String shellWrap cmdline = "sh -c " ++ shellEscape cmdline -{- Escapes a filename or other parameter to be safely able to be exposed to - - the shell. - - - - This method works for POSIX shells, as well as other shells like csh. - -} +-- | Escapes a filename or other parameter to be safely able to be exposed to +-- the shell. +-- +-- This method works for POSIX shells, as well as other shells like csh. shellEscape :: String -> String shellEscape f = "'" ++ escaped ++ "'" where -- replace ' with '"'"' escaped = join "'\"'\"'" $ split "'" f -{- Unescapes a set of shellEscaped words or filenames. -} +-- | Unescapes a set of shellEscaped words or filenames. shellUnEscape :: String -> [String] shellUnEscape [] = [] shellUnEscape s = word : shellUnEscape rest @@ -104,19 +104,19 @@ shellUnEscape s = word : shellUnEscape rest | c == q = findword w cs | otherwise = inquote q (w++[c]) cs -{- For quickcheck. -} +-- | 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 -{- Segments a list of filenames into groups that are all below the maximum - - command-line length limit. -} +-- | Segments a list of filenames into groups that are all below the maximum +-- command-line length limit. segmentXargsOrdered :: [FilePath] -> [[FilePath]] segmentXargsOrdered = reverse . map reverse . segmentXargsUnordered -{- Not preserving data is a little faster, and streams better when - - there are a great many filesnames. -} +-- | Not preserving order is a little faster, and streams better when +-- there are a great many filenames. segmentXargsUnordered :: [FilePath] -> [[FilePath]] segmentXargsUnordered l = go l [] 0 [] where |
