1{- safely running shell commands 2 - 3 - Copyright 2010-2015 Joey Hess <id@joeyh.name> 4 - 5 - License: BSD-2-clause 6 -} 7 8{-# OPTIONS_GHC -fno-warn-tabs #-} 9 10module Utility.SafeCommand ( 11 CommandParam(..), 12 toCommand, 13 boolSystem, 14 boolSystem', 15 boolSystemEnv, 16 safeSystem, 17 safeSystem', 18 safeSystemEnv, 19 segmentXargsOrdered, 20 segmentXargsUnordered, 21) where 22 23import Utility.Process 24 25import System.Exit 26import System.FilePath 27import Data.Char 28import Data.List 29import Control.Applicative 30import Prelude 31 32-- | Parameters that can be passed to a shell command. 33data CommandParam 34 = Param String -- ^ A parameter 35 | File FilePath -- ^ The name of a file 36 deriving (Eq, Show, Ord) 37 38-- | Used to pass a list of CommandParams to a function that runs 39-- a command and expects Strings. -} 40toCommand :: [CommandParam] -> [String] 41toCommand = map toCommand' 42 43toCommand' :: CommandParam -> String 44toCommand' (Param s) = s 45-- Files that start with a non-alphanumeric that is not a path 46-- separator are modified to avoid the command interpreting them as 47-- options or other special constructs. 48toCommand' (File s@(h:_)) 49 | isAlphaNum h || h `elem` pathseps = s 50 | otherwise = "./" ++ s 51 where 52 -- '/' is explicitly included because it's an alternative 53 -- path separator on Windows. 54 pathseps = pathSeparator:"./" 55toCommand' (File s) = s 56 57-- | Run a system command, and returns True or False if it succeeded or failed. 58-- 59-- (Throws an exception if the command is not found.) 60-- 61-- This and other command running functions in this module log the commands 62-- run at debug level, using System.Log.Logger. 63boolSystem :: FilePath -> [CommandParam] -> IO Bool 64boolSystem command params = boolSystem' command params id 65 66boolSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool 67boolSystem' command params mkprocess = dispatch <$> safeSystem' command params mkprocess 68 where 69 dispatch ExitSuccess = True 70 dispatch _ = False 71 72boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool 73boolSystemEnv command params environ = boolSystem' command params $ 74 \p -> p { env = environ } 75 76-- | Runs a system command, returning the exit status. 77safeSystem :: FilePath -> [CommandParam] -> IO ExitCode 78safeSystem command params = safeSystem' command params id 79 80safeSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO ExitCode 81safeSystem' command params mkprocess = 82 withCreateProcess p $ \_ _ _ pid -> 83 waitForProcess pid 84 where 85 p = mkprocess $ proc command (toCommand params) 86 87safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode 88safeSystemEnv command params environ = safeSystem' command params $ 89 \p -> p { env = environ } 90 91-- | Segments a list of filenames into groups that are all below the maximum 92-- command-line length limit. 93segmentXargsOrdered :: [FilePath] -> [[FilePath]] 94segmentXargsOrdered = reverse . map reverse . segmentXargsUnordered 95 96-- | Not preserving order is a little faster, and streams better when 97-- there are a great many filenames. 98segmentXargsUnordered :: [FilePath] -> [[FilePath]] 99segmentXargsUnordered l = go l [] 0 [] 100 where 101 go [] c _ r = (c:r) 102 go (f:fs) c accumlen r 103 | newlen > maxlen && len < maxlen = go (f:fs) [] 0 (c:r) 104 | otherwise = go fs (f:c) newlen r 105 where 106 len = length f 107 newlen = accumlen + len 108 109 {- 10k of filenames per command, well under 100k limit 110 - of Linux (and OSX has a similar limit); 111 - allows room for other parameters etc. Also allows for 112 - eg, multibyte characters. -} 113 maxlen = 10240 114