diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,11 @@ +# 1.12.0.1 + +Andreas Abel, 2023-04-02 +* Make `show_command` more robust to special characters + and only quote when necessary. + (Chris Wendt, PR [#229](https://github.com/gregwebs/Shelly.hs/pull/229).) +* Tested with GHC 8.2 - 9.6 (cabal) and GHC 8.10 - 9.6 (stack). + # 1.12.0 Andreas Abel, 2023-02-27 diff --git a/shelly.cabal b/shelly.cabal --- a/shelly.cabal +++ b/shelly.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 Name: shelly -Version: 1.12.0 +Version: 1.12.0.1 Synopsis: shell-like (systems) programming in Haskell @@ -30,8 +30,9 @@ Build-type: Simple tested-with: + GHC == 9.6.1 GHC == 9.4.4 - GHC == 9.2.5 + GHC == 9.2.7 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 @@ -133,6 +134,7 @@ ReadFileSpec RmSpec RunSpec + ShowCommandSpec SshSpec TestInit WhichSpec diff --git a/src/Shelly.hs b/src/Shelly.hs --- a/src/Shelly.hs +++ b/src/Shelly.hs @@ -110,7 +110,7 @@ import Control.Monad.Reader (ask) import Data.ByteString ( ByteString ) -import Data.Char ( isAlphaNum, isDigit, isSpace ) +import Data.Char ( isAlphaNum, isDigit, isSpace, isPrint ) #if defined(mingw32_HOST_OS) import Data.Char ( toLower ) #endif @@ -126,6 +126,7 @@ import Data.Typeable import qualified Data.ByteString as BS +import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.IO as TIO import qualified Data.Text.Encoding as TE @@ -1025,11 +1026,23 @@ show_command :: FilePath -> [Text] -> Text show_command exe args = - T.intercalate " " $ map quote (toTextIgnore exe : args) - where - quote t | T.any (== '\'') t = t - quote t | T.any isSpace t = surround '\'' t - quote t | otherwise = t + let escape char | char `Set.member` specialsInQuotes = T.pack ['\\', char] + escape char = T.singleton char + quote arg = surround '"' $ T.concatMap escape arg + isSafe c = all ($ c) [isPrint, not . isSpace, (`Set.notMember` specials)] + showArg "" = surround '"' "" + showArg arg | T.all isSafe arg = arg + showArg arg = quote arg + in T.intercalate " " $ map showArg (toTextIgnore exe : args) + +-- | Characters that need to be escaped or quoted to retain their literal value. +specials :: Set.Set Char +specials = Set.fromList "\\'\"`$&|;(){}<>" + +-- | When inside quotes, characters that need to be escaped to retain their +-- literal value. +specialsInQuotes :: Set.Set Char +specialsInQuotes = Set.fromList "\\\"`$" -- quote one argument quoteOne :: Text -> Text diff --git a/test/src/FindSpec.hs b/test/src/FindSpec.hs --- a/test/src/FindSpec.hs +++ b/test/src/FindSpec.hs @@ -51,7 +51,7 @@ res <- shelly $ cd "test/src" >> ls "." sort res @?= map toWindowsStyleIfNecessary ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs", "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs", - "./PipeSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs", + "./PipeSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./ShowCommandSpec.hs", "./SshSpec.hs", "./TestInit.hs", "./TestMain.hs", "./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"] @@ -59,7 +59,7 @@ res <- shelly $ cd "test" >> ls "src" sort res @?= map toWindowsStyleIfNecessary ["src/CopySpec.hs", "src/EnvSpec.hs", "src/FailureSpec.hs", "src/FindSpec.hs", "src/Help.hs", "src/LiftedSpec.hs", "src/LogWithSpec.hs", "src/MoveSpec.hs", - "src/PipeSpec.hs", "src/ReadFileSpec.hs", "src/RmSpec.hs", "src/RunSpec.hs", "src/SshSpec.hs", + "src/PipeSpec.hs", "src/ReadFileSpec.hs", "src/RmSpec.hs", "src/RunSpec.hs", "src/ShowCommandSpec.hs", "src/SshSpec.hs", "src/TestInit.hs", "src/TestMain.hs", "src/WhichSpec.hs", "src/WriteSpec.hs", "src/sleep.hs"] @@ -67,7 +67,7 @@ res <- shelly $ cd "test/src" >> find "." sort res @?= map toWindowsStyleIfNecessary ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs", "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs", - "./PipeSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs", + "./PipeSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./ShowCommandSpec.hs", "./SshSpec.hs", "./TestInit.hs", "./TestMain.hs", "./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"] @@ -87,13 +87,13 @@ then sort res @?= ["test/src\\CopySpec.hs", "test/src\\EnvSpec.hs", "test/src\\FailureSpec.hs", "test/src\\FindSpec.hs", "test/src\\Help.hs", "test/src\\LiftedSpec.hs", "test/src\\LogWithSpec.hs", "test/src\\MoveSpec.hs", "test/src\\PipeSpec.hs", "test/src\\ReadFileSpec.hs", - "test/src\\RmSpec.hs", "test/src\\RunSpec.hs", "test/src\\SshSpec.hs", + "test/src\\RmSpec.hs", "test/src\\RunSpec.hs", "test/src\\ShowCommandSpec.hs", "test/src\\SshSpec.hs", "test/src\\TestInit.hs", "test/src\\TestMain.hs", "test/src\\WhichSpec.hs", "test/src\\WriteSpec.hs", "test/src\\sleep.hs"] else sort res @?= ["test/src/CopySpec.hs", "test/src/EnvSpec.hs", "test/src/FailureSpec.hs", "test/src/FindSpec.hs", "test/src/Help.hs", "test/src/LiftedSpec.hs", "test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/PipeSpec.hs", "test/src/ReadFileSpec.hs", - "test/src/RmSpec.hs", "test/src/RunSpec.hs", "test/src/SshSpec.hs", + "test/src/RmSpec.hs", "test/src/RunSpec.hs", "test/src/ShowCommandSpec.hs", "test/src/SshSpec.hs", "test/src/TestInit.hs", "test/src/TestMain.hs", "test/src/WhichSpec.hs", "test/src/WriteSpec.hs", "test/src/sleep.hs"] @@ -102,7 +102,7 @@ sort res @?= ["CopySpec.hs", "EnvSpec.hs", "FailureSpec.hs", "FindSpec.hs", "Help.hs", "LiftedSpec.hs", "LogWithSpec.hs", "MoveSpec.hs", "PipeSpec.hs", "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs", - "SshSpec.hs", "TestInit.hs", "TestMain.hs", + "ShowCommandSpec.hs", "SshSpec.hs", "TestInit.hs", "TestMain.hs", "WhichSpec.hs", "WriteSpec.hs", "sleep.hs"] unless isWindows $ before createSymlinkForTest $ do diff --git a/test/src/ShowCommandSpec.hs b/test/src/ShowCommandSpec.hs new file mode 100644 --- /dev/null +++ b/test/src/ShowCommandSpec.hs @@ -0,0 +1,37 @@ +module ShowCommandSpec (showCommandSpec) where + +import TestInit + +showCommandSpec :: Spec +showCommandSpec = do + describe "show_command" $ do + it "preserves the empty string" $ do + show_command "echo" [""] @?= "echo \"\"" + + it "does not quote arguments that do not contain special characters" $ do + show_command "echo" ["a1~!@#%^-_+=:,.?/"] @?= "echo a1~!@#%^-_+=:,.?/" + + it "quotes whitespace" $ do + show_command "echo" [" "] @?= "echo \" \"" + show_command "echo" ["\t"] @?= "echo \"\t\"" + show_command "echo" ["\r"] @?= "echo \"\r\"" + show_command "echo" ["\n"] @?= "echo \"\n\"" + + + it "quotes arguments that contain special characters" $ do + show_command "echo" ["'"] @?= "echo \"'\"" + show_command "echo" ["&"] @?= "echo \"&\"" + show_command "echo" ["|"] @?= "echo \"|\"" + show_command "echo" [";"] @?= "echo \";\"" + show_command "echo" ["("] @?= "echo \"(\"" + show_command "echo" [")"] @?= "echo \")\"" + show_command "echo" ["{"] @?= "echo \"{\"" + show_command "echo" ["}"] @?= "echo \"}\"" + show_command "echo" ["<"] @?= "echo \"<\"" + show_command "echo" [">"] @?= "echo \">\"" + + it "escapes the few special characters that must be escaped even in quotes" $ do + show_command "echo" ["\""] @?= "echo \"\\\"\"" + show_command "echo" ["\\"] @?= "echo \"\\\\\"" + show_command "echo" ["$"] @?= "echo \"\\$\"" + show_command "echo" ["`"] @?= "echo \"\\`\"" diff --git a/test/src/TestMain.hs b/test/src/TestMain.hs --- a/test/src/TestMain.hs +++ b/test/src/TestMain.hs @@ -12,6 +12,7 @@ import CopySpec import LiftedSpec import RunSpec +import ShowCommandSpec import SshSpec import PipeSpec @@ -30,5 +31,6 @@ copySpec liftedSpec runSpec + showCommandSpec sshSpec pipeSpec