packages feed

shellwords 0.1.3.1 → 0.1.3.2

raw patch · 6 files changed

+206/−184 lines, 6 filesdep ~basedep ~hspecdep ~megaparsec

Dependency ranges changed: base, hspec, megaparsec, text

Files

CHANGELOG.md view
@@ -1,6 +1,8 @@-## [*Unreleased*](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.3.1...main)+## [*Unreleased*](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.3.2...main) -None+## [v0.1.3.2](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.3.1...v0.1.3.2)++- Fix bugs around `=` handling, adjacent strings, and escaped-backslash  ## [v0.1.3.1](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.3.0...v0.1.3.1) 
README.md view
@@ -1,43 +1,92 @@ # ShellWords +[![Hackage](https://img.shields.io/hackage/v/shellwords.svg?style=flat)](https://hackage.haskell.org/package/shellwords)+[![Stackage Nightly](http://stackage.org/package/shellwords/badge/nightly)](http://stackage.org/nightly/package/shellwords)+[![Stackage LTS](http://stackage.org/package/shellwords/badge/lts)](http://stackage.org/lts/package/shellwords)+[![CI](https://github.com/pbrisbin/hs-shellwords/actions/workflows/ci.yml/badge.svg)](https://github.com/pbrisbin/hs-shellwords/actions/workflows/ci.yml)+ Parse a string into words, like a shell would.  ## Motivation -If you need to execute commands given to you as user-input, you should know not-to give that text as-is to a shell:+If you want to execute a specific command with input given to you from an+untrusted source, you should not give that text as-is to a shell: -```haskell-callProcess "sh" ["-c", "some --user --input"]+```hs+let userInput = "push origin main"++callCommand $ "git " <> userInput+-- Forward output of the push command... ``` -Such code is a severe security vulnerability. Furthermore, any attempts to-sanitize the string are unlikely to be 100% affective and should be avoided. The-only safe way to do this is to not use a shell intermediary, and always `exec` a-process directly:+You may be tempted to do this because you want to correctly handle quoting and+other notoriously-difficult word-splitting problems. But doing so is a severe+security vulnerability: -```haskell-callProcess "some" ["--user", "--input"]+```hs+let userInput = "push origin main; cat /etc/passwd"++callCommand $ "git " <> userInput+-- Forward output of the push command...+-- And then dump /etc/passwd. Oops. ``` -The new problem (and not a security-related one) is how to correctly parse a-string like `"some --user --input"` into the command and its arguments. The-rules are complex enough that you probably want to get a library to do it.+Furthermore, any attempts to sanitize the string are unlikely to be 100%+affective and should be avoided. The only safe way to do this is to not use a+shell intermediary, and always `exec` a process directly: +```hs+let userInput = "push origin main"++callProcess "git" $ words userInput+-- Forward output of the push command...+```++Now, there's no vulnerability:++```hs+let userInput = "push origin main; cat /etc/passwd"++callProcess "git" $ words userInput+-- Invalid usage. :)+```++The new problem (but not a security-related one!) is how to correctly parse a+string like `"push origin main"` into command arguments. The rules are complex+enough that you probably want to get a library to do it.+ So here we are.  ## Example -```haskell-Right (cmd:args) <- parse "some -complex --command=\"Line And\" 'More'"+```hs+Right args <- parse "some -complex --command=\"Line And\" 'More'"  callProcess cmd args -- -- Is equivalent to: ----- > callProcess "some" ["-complex", "--command=Line And", "More"]+-- > callProcess cmd ["some", "-complex", "--command=Line And", "More"] -- ```++## Unsafe Usage++The following is a perfectly reasonable thing one might do with this library:++```hs+Right (cmd:args) <- parse userInput++callProcess cmd args+```++However, if:++1. `userInput` is un-trusted, and+1. You do no further validation of what `cmd` can be,++Then this re-introduces the original security vulnerability and, at that point,+you might as well just pass `userInput` to a shell.  ## Lineage 
shellwords.cabal view
@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            shellwords-version:         0.1.3.1+version:         0.1.3.2 license:         MIT license-file:    LICENSE copyright:       2018 Patrick Brisbin@@ -30,14 +30,15 @@     default-language:   Haskell2010     default-extensions: NoImplicitPrelude     ghc-options:-        -Weverything -Wno-missing-exported-signatures+        -Weverything -Wno-all-missed-specialisations+        -Wno-missed-specialisations -Wno-missing-exported-signatures         -Wno-missing-import-lists -Wno-missing-local-signatures-        -Wno-monomorphism-restriction -Wno-unsafe -Wno-safe+        -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe      build-depends:-        base >=4.11.1.0 && <5,-        megaparsec >=6.5.0,-        text >=1.2.3.1+        base >=4.18.2.1 && <5,+        megaparsec >=9.5.0,+        text >=2.0.2      if impl(ghc >=9.2)         ghc-options: -Wno-missing-kind-signatures@@ -57,16 +58,17 @@     default-language:   Haskell2010     default-extensions: NoImplicitPrelude     ghc-options:-        -Weverything -Wno-missing-exported-signatures+        -Weverything -Wno-all-missed-specialisations+        -Wno-missed-specialisations -Wno-missing-exported-signatures         -Wno-missing-import-lists -Wno-missing-local-signatures-        -Wno-monomorphism-restriction -Wno-unsafe -Wno-safe -threaded+        -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -threaded         -rtsopts -with-rtsopts=-N      build-depends:-        base >=4.11.1.0 && <5,-        hspec >=2.5.5,-        megaparsec >=6.5.0,-        shellwords -any+        base >=4.18.2.1 && <5,+        hspec >=2.11.9,+        megaparsec >=9.5.0,+        shellwords      if impl(ghc >=9.2)         ghc-options: -Wno-missing-kind-signatures
src/ShellWords.hs view
@@ -1,21 +1,19 @@ {-# LANGUAGE OverloadedStrings #-}  module ShellWords-    ( parse-    , parseText+  ( parse+  , parseText      -- * Low-level parser-    , Parser-    , runParser-    , parser-    ) where+  , Parser+  , runParser+  , parser+  ) where  import Prelude  import Data.Bifunctor (first) import Data.Char-import Data.List (dropWhileEnd)-import Data.Maybe (fromMaybe) import Data.Text (Text, pack, unpack) import Data.Void (Void) import qualified Text.Megaparsec as Megaparsec@@ -28,50 +26,34 @@ parse = runParser parser  runParser :: Parser a -> String -> Either String a-runParser p = first errorBundlePretty . Megaparsec.parse p "<input>"+runParser p = first errorBundlePretty . Megaparsec.parse (p <* eof) "<input>"  -- | Parse and return @'Text'@ values parseText :: Text -> Either String [Text] parseText = fmap (map pack) . parse . unpack  parser :: Parser [String]-parser = fmap (dropWhileEnd null) $ space *> shellword `sepEndBy1` space1+parser = space *> shellword `sepEndBy1` space1 <* space  shellword :: Parser String-shellword =-    choice-            [ quoted <?> "quoted string"-            , shelloption <?> "shell option"-            , value <?> "bare value"-            ]-        <?> "shell word"+shellword = fmap concat $ some $ bare <|> quoted +-- | A plain value, here till an (unescaped) space or quote+bare :: Parser String+bare = some go+ where+  go =+    escaped '\\'+      <|> escapedSpace+      <|> escapedAnyOf (reserved <> quotes)+      <|> satisfy ((&&) <$> not . isSpace <*> (`notElem` (reserved <> quotes)))+      <?> "non white space / non reserved character / non quote"+ -- | A balanced, single- or double-quoted string quoted :: Parser String quoted = do-    q <- oneOf ['\'', '\"']-    manyTill (escaped q <|> anyToken) $ char q---- | A flag, with or without an argument-shelloption :: Parser String-shelloption = (<>) <$> flag <*> (fromMaybe "" <$> optional argument)---- brittany-disable-next-binding---- | A flag like @--foo@, or (apparently) @--\"baz bat\"@-flag :: Parser String-flag =-    (<>)-        <$> (string "--" <|> string "-")-        <*> (quoted <|> value)---- | The argument to a flag like @=foo@, or @=\"baz bat\"@-argument :: Parser String-argument = (:) <$> char '=' <*> (quoted <|> value)---- | A plain value, here till an (unescaped) space-value :: Parser String-value = many nonSpaceNonReserved+  q <- oneOf quotes+  manyTill (escaped '\\' <|> escaped q <|> anyToken) $ char q  escaped :: Char -> Parser Char escaped c = c <$ (escapedSatisfy (== c) <?> "escaped" <> show c)@@ -88,15 +70,8 @@ anyToken :: Parser Char anyToken = satisfy $ const True -nonSpaceNonReserved :: Parser Char-nonSpaceNonReserved =-    escapedSpace-        <|> escapedAnyOf reserved-        <|> satisfy (\c -> not $ isSpace c || isReserved c)-        <?> "non white space / non reserved character"--isReserved :: Char -> Bool-isReserved = (`elem` reserved)- reserved :: [Char]-reserved = "();="+reserved = "();"++quotes :: [Char]+quotes = "\'\""
src/Text/Megaparsec/Compat.hs view
@@ -1,16 +1,19 @@ {-# LANGUAGE CPP #-}  module Text.Megaparsec.Compat-    ( module X-#if !MIN_VERSION_megaparsec(7,0,0)-    , errorBundlePretty-#endif-    ) where--import Text.Megaparsec as X+  ( module X+  , errorBundlePretty+  ) where -#if !MIN_VERSION_megaparsec(7,0,0)+#if MIN_VERSION_megaparsec(7,0,0)+-- Import errorBundlePretty not as part of X, so it can be exported separately+-- as is necessary in the < 7.0.0 case+import Text.Megaparsec as X hiding (errorBundlePretty)+import Text.Megaparsec (errorBundlePretty)+#else import Prelude++import Text.Megaparsec as X  errorBundlePretty :: Show a => a -> String errorBundlePretty = show
test/ShellWordsSpec.hs view
@@ -6,14 +6,13 @@ -- Case-for-case port from Python: -- -- <https://github.com/mozillazg/python-shellwords/blob/master/tests/test_shellwords.py>--- module ShellWordsSpec-    ( spec-    ) where+  ( spec+  ) where -import Prelude+import Prelude hiding (truncate) -import Data.Foldable (for_)+import Data.Foldable (for_, traverse_) import ShellWords import Test.Hspec import Text.Megaparsec.Char (string)@@ -21,113 +20,108 @@  testCases :: [(String, [String])] testCases =-    [ ("var --bar=baz", ["var", "--bar=baz"])-    , ("var --bar=\"baz\"", ["var", "--bar=baz"])-    , ("var \"--bar=baz\"", ["var", "--bar=baz"])-    , ("var \"--bar='baz'\"", ["var", "--bar='baz'"])-    , ("var --bar=`baz`", ["var", "--bar=`baz`"])-    , ("var \"--bar=\\\"baz'\"", ["var", "--bar=\"baz'"])-    , ("var \"--bar=\\'baz\\'\"", ["var", "--bar=\\'baz\\'"])-    , ("var \"--bar baz\"", ["var", "--bar baz"])-    , ("var --\"bar baz\"", ["var", "--bar baz"])-    , ("var --\"bar baz\"", ["var", "--bar baz"])--    -- Additional test cases for whitespace-    , ("var --bar=baz ", ["var", "--bar=baz"])-    , (" var --bar=baz ", ["var", "--bar=baz"])-    , (" var   --bar=baz ", ["var", "--bar=baz"])--    -- Additional test cases for escaped spaces-    , ("var --bar\\ baz", ["var", "--bar baz"])-    , ("var --bar=baz\\ bat", ["var", "--bar=baz bat"])-    , ("var --bar baz\\ bat", ["var", "--bar", "baz bat"])--    -- N.B. sh preserves escapes in quoted values, python-shellwords does not.-    -- we behave like sh in this regard. See omitted cases below too.-    , ("var --bar 'baz\\ bat'", ["var", "--bar", "baz\\ bat"])-    , ("var  --bar \"baz\\ bat\"", ["var", "--bar", "baz\\ bat"])-    ]--    -- Omitted cases:-    ---    -- I think the Python test case is wrong here:-    ---    -- > sh-4.4$ shellwords() { printf ">%s<\n" "$@"; }-    -- > sh-4.4$ shellwords var "--bar=\'baz\'"-    -- > >var<-    -- > >--bar=\'baz\'<-    ---    -- , ("var \"--bar=\\'baz\\'\"", ["var", "--bar='baz'"])-    ---    ---    -- I can't get this one to work:-    ---    -- , ("var --bar='\\'", ["var", "--bar=\\"])+  [ ("var --bar=baz", ["var", "--bar=baz"])+  , ("var --bar=\"baz\"", ["var", "--bar=baz"])+  , ("var \"--bar=baz\"", ["var", "--bar=baz"])+  , ("var \"--bar='baz'\"", ["var", "--bar='baz'"])+  , ("var --bar=`baz`", ["var", "--bar=`baz`"])+  , ("var \"--bar=\\\"baz'\"", ["var", "--bar=\"baz'"])+  , ("var \"--bar=\\'baz\\'\"", ["var", "--bar=\\'baz\\'"])+  , ("var \"--bar baz\"", ["var", "--bar baz"])+  , ("var --\"bar baz\"", ["var", "--bar baz"])+  , ("var --\"bar baz\"", ["var", "--bar baz"])+  , -- Additional test cases for whitespace+    ("var --bar=baz ", ["var", "--bar=baz"])+  , (" var --bar=baz ", ["var", "--bar=baz"])+  , (" var   --bar=baz ", ["var", "--bar=baz"])+  , -- Additional test cases for escaped spaces+    ("var --bar\\ baz", ["var", "--bar baz"])+  , ("var --bar=baz\\ bat", ["var", "--bar=baz bat"])+  , ("var --bar baz\\ bat", ["var", "--bar", "baz bat"])+  , -- N.B. sh preserves escapes in quoted values, python-shellwords does not.+    -- we behave like sh in this regard.+    ("var --bar 'baz\\ bat'", ["var", "--bar", "baz\\ bat"])+  , ("var  --bar \"baz\\ bat\"", ["var", "--bar", "baz\\ bat"])+  , ("var \"--bar=\\\\'baz\\\\'\"", ["var", "--bar=\\'baz\\'"])+  , ("var --bar='\\\\'", ["var", "--bar=\\"])+  ]  errorCases :: [String] errorCases =-    [ "foo '"-    , "foo \""+  [ "foo '"+  , "foo \""+  --+  -- Doesn't need to error since we don't have parse_backtick either.+  --+  -- , "foo `"+  ] -    ---    -- Doesn't need to error since we don't have parse_backtick either.-    ---    -- , "foo `"-    ]+runTestCase :: HasCallStack => String -> [String] -> Spec+runTestCase input expected =+  it ("parses |" <> truncate 50 input <> "| correctly") $ do+    runParser parser input `shouldBeParsed` expected+ where+  truncate n x+    | length x > n = take n x <> "..."+    | otherwise = x  spec :: Spec spec = describe "parser" $ do-    for_ testCases $ \(input, expected) -> do-        it ("parses |" <> input <> "| correctly") $ do-            runParser parser input `shouldBeParsed` expected+  traverse_ (uncurry runTestCase) testCases -    for_ errorCases $ \input -> do-        it ("errors on |" <> input <> "|") $ do-            expectParseError $ runParser parser input+  for_ errorCases $ \input -> do+    it ("errors on |" <> input <> "|") $ do+      expectParseError $ runParser parser input -    it "fixes #3" $ do-        let input-                = "-LC:/Users/Vitor\\ Coimbra/AppData/Local/Programs/stack/x86_64-windows/msys2-20150512/mingw64/lib -ltag\n"-            expected =-                [ "-LC:/Users/Vitor Coimbra/AppData/Local/Programs/stack/x86_64-windows/msys2-20150512/mingw64/lib"-                , "-ltag"-                ]+  context "Issue #3" $ do+    runTestCase+      "-LC:/Users/Vitor\\ Coimbra/AppData/Local/Programs/stack/x86_64-windows/msys2-20150512/mingw64/lib -ltag\n"+      [ "-LC:/Users/Vitor Coimbra/AppData/Local/Programs/stack/x86_64-windows/msys2-20150512/mingw64/lib"+      , "-ltag"+      ] -        runParser parser input `shouldBeParsed` expected+  context "Issue #7" $ do+    runTestCase "foo=123 bar" ["foo=123", "bar"]+    runTestCase "foo bar=123 cow" ["foo", "bar=123", "cow"]+    runTestCase "foo bar'();='bar cow" ["foo", "bar();=bar", "cow"]+    runTestCase "foo 'ba'\"r\" cow" ["foo", "bar", "cow"] -    context "delimited" $ do-        let-            parseDelimited input =-                runParser (between (string "FOO=$(") (string ")") parser)-                    $ "FOO=$("-                    <> input-                    <> ")"+  context "As part of a larger Parser" $ do+    let parseDelimited input =+          runParser (between (string "FOO=$(") (string ")") parser) $+            "FOO=$("+              <> input+              <> ")" -        it "parses within delimiters" $ do-            parseDelimited "echo \"hi\"" `shouldBeParsed` ["echo", "hi"]+    it "parses within delimiters" $ do+      parseDelimited "echo \"hi\"" `shouldBeParsed` ["echo", "hi"] -        it "handles quoted delimiter" $ do-            parseDelimited "echo \"hi (quietly)\")"-                `shouldBeParsed` ["echo", "hi (quietly)"]+    it "handles quoted delimiter" $ do+      parseDelimited "echo \"hi (quietly)\""+        `shouldBeParsed` ["echo", "hi (quietly)"] -        it "works with white space" $ do-            parseDelimited "  echo \n\"hi\" " `shouldBeParsed` ["echo", "hi"]+    it "works with white space" $ do+      parseDelimited "  echo \n\"hi\" " `shouldBeParsed` ["echo", "hi"] -        it "works with newlines" $ do-            parseDelimited "echo \n\"hi\"" `shouldBeParsed` ["echo", "hi"]+    it "works with newlines" $ do+      parseDelimited "echo \n\"hi\"" `shouldBeParsed` ["echo", "hi"] -        it "works with final newline" $ do-            parseDelimited "echo \n\"hi\"\n" `shouldBeParsed` ["echo", "hi"]+    it "works with final newline" $ do+      parseDelimited "echo \n\"hi\"\n" `shouldBeParsed` ["echo", "hi"] -expectParseError :: Show a => Either String a -> Expectation+expectParseError :: (Show a, HasCallStack) => Either String a -> Expectation expectParseError = \case-    Left{} -> pure ()-    Right a' -> expectationFailure $ "Expected parse error, got:" <> show a'+  Left {} -> pure ()+  Right a' -> expectationFailure $ "Expected parse error, got:" <> show a' -shouldBeParsed :: (Show a, Eq a) => Either String a -> a -> Expectation+shouldBeParsed+  :: (Show a, Eq a, HasCallStack)+  => Either String a+  -> a+  -> Expectation a `shouldBeParsed` b = case a of-    Left e -> expectationFailure e-    Right a' -> a' `shouldBe` b+  Left e -> expectationFailure e+  Right a' -> a' `shouldBe` b  {- Features I'm not sure I'll be porting, certainly not yet. @@ -141,7 +135,6 @@     expected = ["echo", goversion.strip('\n')]     assert args == expected - def test_backtick_error():     s = ShellWords(parse_backtick=True)     try:@@ -160,14 +153,12 @@     expected = ["echo", "bar"]     assert args == expected - def test_no_env():     s = ShellWords(parse_env=True)     args = s.parse("echo $BAR")      expected = ["echo", ""]     assert args == expected-  def test_dup_env():     os.environ["FOO"] = "bar"