{- 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandParam -> CommandParam -> Bool
$c/= :: CommandParam -> CommandParam -> Bool
== :: CommandParam -> CommandParam -> Bool
$c== :: CommandParam -> CommandParam -> Bool
Eq, Int -> CommandParam -> ShowS
[CommandParam] -> ShowS
CommandParam -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandParam] -> ShowS
$cshowList :: [CommandParam] -> ShowS
show :: CommandParam -> String
$cshow :: CommandParam -> String
showsPrec :: Int -> CommandParam -> ShowS
$cshowsPrec :: Int -> CommandParam -> ShowS
Show, Eq 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
min :: CommandParam -> CommandParam -> CommandParam
$cmin :: CommandParam -> CommandParam -> CommandParam
max :: CommandParam -> CommandParam -> CommandParam
$cmax :: CommandParam -> CommandParam -> CommandParam
>= :: CommandParam -> CommandParam -> Bool
$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
compare :: CommandParam -> CommandParam -> Ordering
$ccompare :: CommandParam -> CommandParam -> Ordering
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 = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
pathseps = String
s
	| Bool
otherwise = String
"./" forall a. [a] -> [a] -> [a]
++ String
s
  where
	-- '/' is explicitly included because it's an alternative
	-- path separator on Windows.
	pathseps :: String
pathseps = Char
pathSeparatorforall 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 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 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 forall a b. (a -> b) -> a -> b
$
	\CreateProcess
p -> CreateProcess
p { env :: Maybe [(String, String)]
env = Maybe [(String, String)]
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 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
	(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
pid) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
p
	ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid
  where
	p :: CreateProcess
p = CreateProcess -> CreateProcess
mkprocess 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 forall a b. (a -> b) -> a -> b
$ 
	\CreateProcess
p -> CreateProcess
p { env :: Maybe [(String, String)]
env = Maybe [(String, String)]
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 " 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
"'" forall a. [a] -> [a] -> [a]
++ String
escaped forall a. [a] -> [a] -> [a]
++ String
"'"
  where
	-- replace ' with '"'"'
	escaped :: String
escaped = forall a. [a] -> [[a]] -> [a]
intercalate String
"'\"'\"'" forall a b. (a -> b) -> a -> b
$ 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 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 forall a. Eq a => a -> a -> Bool
== Char
' ' = (String
w, String
cs)
		| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\'' = Char -> String -> String -> (String, String)
inquote Char
c String
w String
cs
		| Char
c 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
wforall 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 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
wforall 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] forall a. Eq a => a -> a -> Bool
== (String -> [String]
shellUnEscape 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 forall a. Eq a => a -> a -> Bool
== (String -> [String]
shellUnEscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse 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 = 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]
cforall a. a -> [a] -> [a]
:[[t a]]
r)
	go (t a
f:[t a]
fs) [t a]
c Int
accumlen [[t a]]
r
		| Int
newlen forall a. Ord a => a -> a -> Bool
> Int
maxlen Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
< Int
maxlen = [t a] -> [t a] -> Int -> [[t a]] -> [[t a]]
go (t a
fforall a. a -> [a] -> [a]
:[t a]
fs) [] Int
0 ([t a]
cforall a. a -> [a] -> [a]
:[[t a]]
r)
		| Bool
otherwise = [t a] -> [t a] -> Int -> [[t a]] -> [[t a]]
go [t a]
fs (t a
fforall a. a -> [a] -> [a]
:[t a]
c) Int
newlen [[t a]]
r
	  where
		len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
f
		newlen :: Int
newlen = Int
accumlen 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