    {- safely running shell commands
     -
     - Copyright 2010-2015 Joey Hess <id@joeyh.name>
     -
     - License: BSD-2-clause
     -}

    {-# OPTIONS_GHC -fno-warn-tabs #-}

    module Utility.SafeCommand where

    import System.Exit
    import Utility.Process
    import Utility.Split
    import System.FilePath
    import Data.Char
    import Data.List
    import Control.Applicative
    import Prelude

    -- | Parameters that can be passed to a shell command.
    data CommandParam
    	= Param String -- ^ A parameter
    	| File FilePath -- ^ The name of a file
    	deriving (CommandParam -> CommandParam -> Bool
    (CommandParam -> CommandParam -> Bool)
    -> (CommandParam -> CommandParam -> Bool) -> Eq CommandParam
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CommandParam -> CommandParam -> Bool
    == :: CommandParam -> CommandParam -> Bool
    $c/= :: CommandParam -> CommandParam -> Bool
    /= :: CommandParam -> CommandParam -> Bool
    Eq, Int -> CommandParam -> ShowS
    [CommandParam] -> ShowS
    CommandParam -> String
    (Int -> CommandParam -> ShowS)
    -> (CommandParam -> String)
    -> ([CommandParam] -> ShowS)
    -> Show CommandParam
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CommandParam -> ShowS
    showsPrec :: Int -> CommandParam -> ShowS
    $cshow :: CommandParam -> String
    show :: CommandParam -> String
    $cshowList :: [CommandParam] -> ShowS
    showList :: [CommandParam] -> ShowS
    Show, Eq CommandParam
    Eq CommandParam =>
    (CommandParam -> CommandParam -> Ordering)
    -> (CommandParam -> CommandParam -> Bool)
    -> (CommandParam -> CommandParam -> Bool)
    -> (CommandParam -> CommandParam -> Bool)
    -> (CommandParam -> CommandParam -> Bool)
    -> (CommandParam -> CommandParam -> CommandParam)
    -> (CommandParam -> CommandParam -> CommandParam)
    -> Ord CommandParam
    CommandParam -> CommandParam -> Bool
    CommandParam -> CommandParam -> Ordering
    CommandParam -> CommandParam -> CommandParam
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: CommandParam -> CommandParam -> Ordering
    compare :: CommandParam -> CommandParam -> Ordering
    $c< :: CommandParam -> CommandParam -> Bool
    < :: CommandParam -> CommandParam -> Bool
    $c<= :: CommandParam -> CommandParam -> Bool
    <= :: CommandParam -> CommandParam -> Bool
    $c> :: CommandParam -> CommandParam -> Bool
    > :: CommandParam -> CommandParam -> Bool
    $c>= :: CommandParam -> CommandParam -> Bool
    >= :: CommandParam -> CommandParam -> Bool
    $cmax :: CommandParam -> CommandParam -> CommandParam
    max :: CommandParam -> CommandParam -> CommandParam
    $cmin :: CommandParam -> CommandParam -> CommandParam
    min :: CommandParam -> CommandParam -> CommandParam
    Ord)

    -- | Used to pass a list of CommandParams to a function that runs
    -- a command and expects Strings. -}
    toCommand :: [CommandParam] -> [String]
    toCommand :: [CommandParam] -> [String]
    toCommand = (CommandParam -> String) -> [CommandParam] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map CommandParam -> String
    toCommand'

    toCommand' :: CommandParam -> String
    toCommand' :: CommandParam -> String
    toCommand' (Param String
    s) = String
    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.
    toCommand' (File s :: String
    s@(Char
    h:String
    _))
    	| Char -> Bool
    isAlphaNum Char
    h Bool -> Bool -> Bool
    || Char
    h Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    pathseps = String
    s
    	| Bool
    otherwise = String
    "./" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s
      where
    	-- '/' is explicitly included because it's an alternative
    	-- path separator on Windows.
    	pathseps :: String
    pathseps = Char
    pathSeparatorChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    "./"
    toCommand' (File String
    s) = String
    s

    -- | 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 :: String -> [CommandParam] -> IO Bool
    boolSystem String
    command [CommandParam]
    params = String
    -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
    boolSystem' String
    command [CommandParam]
    params CreateProcess -> CreateProcess
    forall a. a -> a
    id

    boolSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
    boolSystem' :: String
    -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
    boolSystem' String
    command [CommandParam]
    params CreateProcess -> CreateProcess
    mkprocess = ExitCode -> Bool
    dispatch (ExitCode -> Bool) -> IO ExitCode -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String
    -> [CommandParam]
    -> (CreateProcess -> CreateProcess)
    -> IO ExitCode
    safeSystem' String
    command [CommandParam]
    params CreateProcess -> CreateProcess
    mkprocess
      where
    	dispatch :: ExitCode -> Bool
    dispatch ExitCode
    ExitSuccess = Bool
    True
    	dispatch ExitCode
    _ = Bool
    False

    boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
    boolSystemEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
    boolSystemEnv String
    command [CommandParam]
    params Maybe [(String, String)]
    environ = String
    -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
    boolSystem' String
    command [CommandParam]
    params ((CreateProcess -> CreateProcess) -> IO Bool)
    -> (CreateProcess -> CreateProcess) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $
    	\CreateProcess
    p -> CreateProcess
    p { env = environ }

    -- | Runs a system command, returning the exit status.
    safeSystem :: FilePath -> [CommandParam] -> IO ExitCode
    safeSystem :: String -> [CommandParam] -> IO ExitCode
    safeSystem String
    command [CommandParam]
    params = String
    -> [CommandParam]
    -> (CreateProcess -> CreateProcess)
    -> IO ExitCode
    safeSystem' String
    command [CommandParam]
    params CreateProcess -> CreateProcess
    forall a. a -> a
    id

    safeSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO ExitCode
    safeSystem' :: String
    -> [CommandParam]
    -> (CreateProcess -> CreateProcess)
    -> IO ExitCode
    safeSystem' String
    command [CommandParam]
    params CreateProcess -> CreateProcess
    mkprocess = do
    	(_, _, _, pid) <- CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcess CreateProcess
    p
    	waitForProcess pid
      where
    	p :: CreateProcess
    p = CreateProcess -> CreateProcess
    mkprocess (CreateProcess -> CreateProcess) -> CreateProcess -> CreateProcess
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> CreateProcess
    proc String
    command ([CommandParam] -> [String]
    toCommand [CommandParam]
    params)

    safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode
    safeSystemEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode
    safeSystemEnv String
    command [CommandParam]
    params Maybe [(String, String)]
    environ = String
    -> [CommandParam]
    -> (CreateProcess -> CreateProcess)
    -> IO ExitCode
    safeSystem' String
    command [CommandParam]
    params ((CreateProcess -> CreateProcess) -> IO ExitCode)
    -> (CreateProcess -> CreateProcess) -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $
    	\CreateProcess
    p -> CreateProcess
    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.
    shellWrap :: String -> String
    shellWrap :: ShowS
    shellWrap String
    cmdline = String
    "sh -c " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    shellEscape String
    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.
    shellEscape :: String -> String
    shellEscape :: ShowS
    shellEscape String
    f = String
    "'" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    escaped String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"
      where
    	-- replace ' with '"'"'
    	escaped :: String
    escaped = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "'\"'\"'" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ Char -> String -> [String]
    forall c. Eq c => c -> [c] -> [[c]]
    splitc Char
    '\'' String
    f

    -- | Unescapes a set of shellEscaped words or filenames.
    shellUnEscape :: String -> [String]
    shellUnEscape :: String -> [String]
    shellUnEscape [] = []
    shellUnEscape String
    s = String
    word String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    shellUnEscape String
    rest
      where
    	(String
    word, String
    rest) = String -> String -> (String, String)
    findword String
    "" String
    s
    	findword :: String -> String -> (String, String)
    findword String
    w [] = (String
    w, String
    "")
    	findword String
    w (Char
    c:String
    cs)
    		| Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' = (String
    w, String
    cs)
    		| Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\'' = Char -> String -> String -> (String, String)
    inquote Char
    c String
    w String
    cs
    		| Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '"' = Char -> String -> String -> (String, String)
    inquote Char
    c String
    w String
    cs
    		| Bool
    otherwise = String -> String -> (String, String)
    findword (String
    wString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[Char
    c]) String
    cs
    	inquote :: Char -> String -> String -> (String, String)
    inquote Char
    _ String
    w [] = (String
    w, String
    "")
    	inquote Char
    q String
    w (Char
    c:String
    cs)
    		| Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    q = String -> String -> (String, String)
    findword String
    w String
    cs
    		| Bool
    otherwise = Char -> String -> String -> (String, String)
    inquote Char
    q (String
    wString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[Char
    c]) String
    cs

    -- | For quickcheck.
    prop_isomorphic_shellEscape :: String -> Bool
    prop_isomorphic_shellEscape :: String -> Bool
    prop_isomorphic_shellEscape String
    s = [String
    s] [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    == (String -> [String]
    shellUnEscape (String -> [String]) -> ShowS -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    shellEscape) String
    s
    prop_isomorphic_shellEscape_multiword :: [String] -> Bool
    prop_isomorphic_shellEscape_multiword :: [String] -> Bool
    prop_isomorphic_shellEscape_multiword [String]
    s = [String]
    s [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    == (String -> [String]
    shellUnEscape (String -> [String])
    -> ([String] -> String) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unwords ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ShowS
    shellEscape) [String]
    s

    -- | Segments a list of filenames into groups that are all below the maximum
    --  command-line length limit.
    segmentXargsOrdered :: [FilePath] -> [[FilePath]]
    segmentXargsOrdered :: [String] -> [[String]]
    segmentXargsOrdered = [[String]] -> [[String]]
    forall a. [a] -> [a]
    reverse ([[String]] -> [[String]])
    -> ([String] -> [[String]]) -> [String] -> [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String] -> [String]) -> [[String]] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map [String] -> [String]
    forall a. [a] -> [a]
    reverse ([[String]] -> [[String]])
    -> ([String] -> [[String]]) -> [String] -> [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [[String]]
    segmentXargsUnordered

    -- | Not preserving order is a little faster, and streams better when
    -- there are a great many filenames.
    segmentXargsUnordered :: [FilePath] -> [[FilePath]]
    segmentXargsUnordered :: [String] -> [[String]]
    segmentXargsUnordered [String]
    l = [String] -> [String] -> Int -> [[String]] -> [[String]]
    forall {t :: * -> *} {a}.
    Foldable t =>
    [t a] -> [t a] -> Int -> [[t a]] -> [[t a]]
    go [String]
    l [] Int
    0 []
      where
    	go :: [t a] -> [t a] -> Int -> [[t a]] -> [[t a]]
    go [] [t a]
    c Int
    _ [[t a]]
    r = ([t a]
    c[t a] -> [[t a]] -> [[t a]]
    forall a. a -> [a] -> [a]
    :[[t a]]
    r)
    	go (t a
    f:[t a]
    fs) [t a]
    c Int
    accumlen [[t a]]
    r
    		| Int
    newlen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxlen Bool -> Bool -> Bool
    && Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    maxlen = [t a] -> [t a] -> Int -> [[t a]] -> [[t a]]
    go (t a
    ft a -> [t a] -> [t a]
    forall a. a -> [a] -> [a]
    :[t a]
    fs) [] Int
    0 ([t a]
    c[t a] -> [[t a]] -> [[t a]]
    forall a. a -> [a] -> [a]
    :[[t a]]
    r)
    		| Bool
    otherwise = [t a] -> [t a] -> Int -> [[t a]] -> [[t a]]
    go [t a]
    fs (t a
    ft a -> [t a] -> [t a]
    forall a. a -> [a] -> [a]
    :[t a]
    c) Int
    newlen [[t a]]
    r
    	  where
    		len :: Int
    len = t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    f
    		newlen :: Int
    newlen = Int
    accumlen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len

    	{- 10k of filenames per command, well under 100k limit
    	 - of Linux (and OSX has a similar limit);
    	 - allows room for other parameters etc. Also allows for
    	 - eg, multibyte characters. -}
    	maxlen :: Int
    maxlen = Int
    10240