packages feed

shellwords (empty) → 0.1.0.0

raw patch · 8 files changed

+341/−0 lines, 8 filesdep +basedep +hspecdep +megaparsecsetup-changed

Dependencies added: base, hspec, megaparsec, shellwords, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,7 @@+## [*Unreleased*](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.0.0...master)++None++## [v0.1.0.0](https://github.com/pbrisbin/hs-shellwords/tree/v0.1.0.0)++First released version.
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2018 Patrick Brisbin <pbrisbin@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ README.md view
@@ -0,0 +1,56 @@+# ShellWords++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:++```haskell+callProcess "sh" ["-c", "some --user --input"]+```++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:++```haskell+callProcess "some" ["--user", "--input"]+```++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.++So here we are.++## Example++```haskell+Right (cmd:args) <- parse "some -complex --command=\"Line And\" 'More'"++callProcess cmd args+--+-- Is equivalent to:+--+-- > callProcess "some" ["-complex", "--command=Line And", "More"]+--+```++## Lineage++This package is inspired by and named after++- [`python-shellwords`][python-shellwords], which was itself inspired by+- [`go-shellwords`][go-shellwords], which was itself inspired by+- [`Parser::CommandLine`][parser-commandline]++[python-shellwords]: https://github.com/mozillazg/python-shellwords+[go-shellwords]: https://github.com/mattn/go-shellwords+[parser-commandline]: https://github.com/Songmu/p5-Parse-CommandLine++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ shellwords.cabal view
@@ -0,0 +1,58 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 11e7209deb6877bc69c75f56eba1279ab472ce405ad7cf1d1f576f059cb05126++name:           shellwords+version:        0.1.0.0+synopsis:       Parse strings into words, like a shell would+description:    See https://github.com/pbrisbin/hs-shellwords#readme+category:       Text+homepage:       https://github.com/pbrisbin/hs-shellwords#readme+bug-reports:    https://github.com/pbrisbin/hs-shellwords/issues+author:         Patrick Brisbin+maintainer:     pbrisbin@gmail.com+copyright:      2018 Patrick Brisbin+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.md+    README.md++source-repository head+  type: git+  location: https://github.com/pbrisbin/hs-shellwords++library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , megaparsec+    , text+  exposed-modules:+      ShellWords+  other-modules:+      Paths_shellwords+  default-language: Haskell2010++test-suite hspec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , hspec+    , shellwords+    , text+  other-modules:+      ShellWordsSpec+      Paths_shellwords+  default-language: Haskell2010
+ src/ShellWords.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module ShellWords+    ( parse+    ) where++--import Control.Monad (void)+import Data.Bifunctor (first)+import Data.Char+import Data.Semigroup ((<>))+import Data.Text (Text)+import Data.Text as T+import Data.Void (Void)+import Text.Megaparsec hiding (parse)+import qualified Text.Megaparsec as Megaparsec+import Text.Megaparsec.Char++type Parser = Parsec Void Text++parse :: Text -> Either String [Text]+parse = first parseErrorPretty . Megaparsec.parse parser "<input>"++parser :: Parser [Text]+parser = shellword `sepBy` space1++shellword :: Parser Text+shellword = choice+    [ quoted+    , try quotedFlag -- N.B. may fail after consuming "--"+    , flagArgument+    , value+    ]++-- | A balanced, single- or double-quoted string+quoted :: Parser Text+quoted = do+    q <- oneOf ['\'', '\"']+    T.pack <$> manyTill (try (escaped q) <|> anyToken) (char q)++-- | This wierd case: @--\"foo bar\"@+quotedFlag :: Parser Text+quotedFlag = (<>)+    <$> flagPrefix+    <*> quoted++-- | A flag and (possibly quoted) argument, @--foo=\"bar\"@+flagArgument :: Parser Text+flagArgument = concat4+    <$> flagPrefix+    <*> (T.pack <$> manyTill anyToken (char '='))+    <*> pure "="+    <*> (quoted <|> value)+  where+    concat4 a b c d = a <> b <> c <> d++flagPrefix :: Parser Text+flagPrefix = string "--" <|> string "-"++-- | A bare value, here till an (unescaped) space+value :: Parser Text+value = T.pack <$> many (try (escaped ' ') <|> nonSpace)++escaped :: Char -> Parser Char+escaped c = c <$ string ("\\" <> T.singleton c)++anyToken :: Parser Char+anyToken = satisfy $ const True++nonSpace :: Parser Char+nonSpace = satisfy $ not . isSpace
+ test/ShellWordsSpec.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+--+-- Case-for-case port from Python:+--+-- <https://github.com/mozillazg/python-shellwords/blob/master/tests/test_shellwords.py>+--+module ShellWordsSpec+    ( spec+    ) where++import Data.Foldable (for_)+import Data.Semigroup ((<>))+import Data.Text (Text)+import qualified Data.Text as T+import ShellWords+import Test.Hspec++testCases :: [(Text, [Text])]+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'"])++    --+    -- 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'"])+    --+    , ("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"])+    ]++errorCases :: [Text]+errorCases =+    [ "foo '"+    , "foo \""++    --+    -- Doesn't need to error since we don't have parse_backtick either.+    --+    -- , "foo `"+    ]++spec :: Spec+spec = describe "parse" $ do+    for_ testCases $ \(input, expected) -> do+        it (T.unpack $ "parses |" <> input <> "| correctly") $ do+            parse input `shouldBe` Right expected++    for_ errorCases $ \input -> do+        it (T.unpack $ "errors on |" <> input <> "|") $ do+            parse input `shouldSatisfy` isLeft++isLeft :: Either a b -> Bool+isLeft (Left _) = True+isLeft _ = False++{- Features I'm not sure I'll be porting, certainly not yet.++def test_backtick():+    goversion, err = shell_run("go version")+    assert not err++    s = ShellWords(parse_backtick=True)+    args = s.parse("echo `go version`")++    expected = ["echo", goversion.strip('\n')]+    assert args == expected+++def test_backtick_error():+    s = ShellWords(parse_backtick=True)+    try:+        s.parse("echo `go Version`")+    except:+        pass+    else:+        raise Exception("Should be an error")++def test_env():+    os.environ["FOO"] = "bar"++    s = ShellWords(parse_env=True)+    args = s.parse("echo $FOO")++    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"+    os.environ["FOO_BAR"] = "baz"++    s = ShellWords(parse_env=True)+    args = s.parse("echo $$FOO$")+    expected = ["echo", "$bar$"]+    assert args == expected++    args = s.parse("echo $${FOO_BAR}$")+    expected = ["echo", "$baz$"]+    assert args == expected+-}
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}