From e08b46559d0c513dd17b61d9b8b0657fc8ccd890 Mon Sep 17 00:00:00 2001
From: Fraser Tweedale <ftweedal@redhat.com>
Date: Mon, 5 Jun 2023 22:19:06 +1000
Subject: [PATCH] Fix parsing of password-command option (#6268)

The password-command option does not parse its value correctly.
Quotes are ignored, making many kinds of commands impossible to
express (e.g.  `sh -c "foo | bar"`).  Also, `cabal user-config`
treats the argument list as a *list of option values*, rather than a
*value that is a list*.  As a consequence, `cabal user-config
update` corrupts the value in the config file.

Fix these issues by parsing the command as a space separated list of
tokens, and changing the getter to `unwords` the value and return a
*singleton* list.  Also update the argument placeholder from
`PASSWORD` to `COMMAND`.

Fixes: https://github.com/haskell/cabal/issues/6268
(cherry picked from commit 95f48ad71eba4891ccfd6affe72cbf1a6dd3b970)

# Conflicts:
#	cabal-install/src/Distribution/Client/Setup.hs
#	cabal-install/src/Distribution/Deprecated/ParseUtils.hs
---
 .../src/Distribution/Client/Setup.hs          | 82 +++++++++++++++++++
 .../src/Distribution/Deprecated/ParseUtils.hs | 40 +++++++++
 .../PackageTests/UserConfig/cabal.out         |  3 +
 .../PackageTests/UserConfig/cabal.test.hs     |  6 ++
 changelog.d/issue-6268                        | 19 +++++
 doc/cabal-commands.rst                        | 14 +++-
 6 files changed, 163 insertions(+), 1 deletion(-)
 create mode 100644 changelog.d/issue-6268

diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
index 3ea80c6df2..af597684eb 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -72,7 +72,15 @@ import Distribution.Client.IndexUtils.IndexState
 import qualified Distribution.Client.Init.Types as IT
 import qualified Distribution.Client.Init.Defaults as IT
 import Distribution.Client.Targets
+<<<<<<< HEAD
          ( UserConstraint, readUserConstraint )
+=======
+  ( UserConstraint
+  , readUserConstraint
+  )
+import Distribution.Deprecated.ParseUtils (parseSpaceList, parseTokenQ)
+import Distribution.Deprecated.ReadP (readP_to_E)
+>>>>>>> 95f48ad71 (Fix parsing of password-command option (#6268))
 import Distribution.Utils.NubList
          ( NubList, toNubList, fromNubList)
 
@@ -2004,6 +2012,7 @@ defaultUploadFlags = UploadFlags {
   }
 
 uploadCommand :: CommandUI UploadFlags
+<<<<<<< HEAD
 uploadCommand = CommandUI {
     commandName         = "upload",
     commandSynopsis     = "Uploads source packages or documentation to Hackage.",
@@ -2049,6 +2058,79 @@ uploadCommand = CommandUI {
         (reqArg' "PASSWORD" (Flag . words) (fromMaybe [] . flagToMaybe))
       ]
   }
+=======
+uploadCommand =
+  CommandUI
+    { commandName = "upload"
+    , commandSynopsis = "Uploads source packages or documentation to Hackage."
+    , commandDescription = Nothing
+    , commandNotes = Just $ \_ ->
+        "You can store your Hackage login in the ~/.config/cabal/config file\n"
+          ++ relevantConfigValuesText ["username", "password", "password-command"]
+    , commandUsage = \pname ->
+        "Usage: " ++ pname ++ " upload [FLAGS] TARFILES\n"
+    , commandDefaultFlags = defaultUploadFlags
+    , commandOptions = \_ ->
+        [ optionVerbosity
+            uploadVerbosity
+            (\v flags -> flags{uploadVerbosity = v})
+        , option
+            []
+            ["publish"]
+            "Publish the package instead of uploading it as a candidate."
+            uploadCandidate
+            (\v flags -> flags{uploadCandidate = v})
+            (noArg (Flag IsPublished))
+        , option
+            ['d']
+            ["documentation"]
+            ( "Upload documentation instead of a source package. "
+                ++ "By default, this uploads documentation for a package candidate. "
+                ++ "To upload documentation for "
+                ++ "a published package, combine with --publish."
+            )
+            uploadDoc
+            (\v flags -> flags{uploadDoc = v})
+            trueArg
+        , option
+            ['u']
+            ["username"]
+            "Hackage username."
+            uploadUsername
+            (\v flags -> flags{uploadUsername = v})
+            ( reqArg'
+                "USERNAME"
+                (toFlag . Username)
+                (flagToList . fmap unUsername)
+            )
+        , option
+            ['p']
+            ["password"]
+            "Hackage password."
+            uploadPassword
+            (\v flags -> flags{uploadPassword = v})
+            ( reqArg'
+                "PASSWORD"
+                (toFlag . Password)
+                (flagToList . fmap unPassword)
+            )
+        , option
+            ['P']
+            ["password-command"]
+            "Command to get Hackage password."
+            uploadPasswordCmd
+            (\v flags -> flags{uploadPasswordCmd = v})
+            ( reqArg
+                "COMMAND"
+                ( readP_to_E
+                    ("Cannot parse command: " ++)
+                    (Flag <$> parseSpaceList parseTokenQ)
+                )
+                (flagElim [] (pure . unwords . fmap show))
+            )
+        ]
+    }
+>>>>>>> 95f48ad71 (Fix parsing of password-command option (#6268))
 
 instance Monoid UploadFlags where
   mempty = gmempty
diff --git a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs
index 6ac62a6e82..26bffbd8ca 100644
--- a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs
+++ b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs
@@ -16,6 +16,7 @@
 -- couple others. It has the parsing framework code and also little parsers for
 -- many of the formats we get in various @.cabal@ file fields, like module
 -- names, comma separated lists etc.
+<<<<<<< HEAD
 
 -- This module is meant to be local-only to Distribution...
 
@@ -40,6 +41,45 @@ module Distribution.Deprecated.ParseUtils (
         commaNewLineListFieldParsec,
 
         UnrecFieldParser,
+=======
+module Distribution.Deprecated.ParseUtils
+  ( LineNo
+  , PError (..)
+  , PWarning (..)
+  , locatedErrorMsg
+  , syntaxError
+  , warning
+  , runP
+  , runE
+  , ParseResult (..)
+  , parseFail
+  , showPWarning
+  , Field (..)
+  , lineNo
+  , FieldDescr (..)
+  , readFields
+  , parseHaskellString
+  , parseTokenQ
+  , parseSpaceList
+  , parseOptCommaList
+  , showFilePath
+  , showToken
+  , showFreeText
+  , field
+  , simpleField
+  , listField
+  , listFieldWithSep
+  , spaceListField
+  , newLineListField
+  , liftField
+  , readPToMaybe
+  , fieldParsec
+  , simpleFieldParsec
+  , listFieldParsec
+  , commaListFieldParsec
+  , commaNewLineListFieldParsec
+  , UnrecFieldParser
+>>>>>>> 95f48ad71 (Fix parsing of password-command option (#6268))
   ) where
 
 import Distribution.Client.Compat.Prelude hiding (get)
diff --git a/cabal-testsuite/PackageTests/UserConfig/cabal.out b/cabal-testsuite/PackageTests/UserConfig/cabal.out
index b5e1f5ef9f..2c6e1a3cd1 100644
--- a/cabal-testsuite/PackageTests/UserConfig/cabal.out
+++ b/cabal-testsuite/PackageTests/UserConfig/cabal.out
@@ -12,3 +12,6 @@ Writing merged config to <ROOT>/cabal.dist/cabal-config.
 # cabal user-config
 Renaming <ROOT>/cabal.dist/cabal-config to <ROOT>/cabal.dist/cabal-config.backup.
 Writing merged config to <ROOT>/cabal.dist/cabal-config.
+# cabal user-config
+Renaming <ROOT>/cabal.dist/cabal-config to <ROOT>/cabal.dist/cabal-config.backup.
+Writing merged config to <ROOT>/cabal.dist/cabal-config.
diff --git a/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs b/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs
index 85d67212d4..300bcc59ea 100644
--- a/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs
+++ b/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs
@@ -15,3 +15,9 @@ main = cabalTest $ do
     assertFileDoesContain conf "foo,bar"
     cabalG ["--config-file", conf] "user-config" ["update", "-f", "-a", "extra-prog-path: foo, bar"]
     assertFileDoesContain conf "foo,bar"
+
+    -- regression test for #6268 (password-command parsing)
+    cabalG ["--config-file", conf]
+        "user-config" ["update", "-f", "-a", "password-command: sh -c \"echo secret\""]
+    -- non-quoted tokens do get quoted when writing, but this is expected
+    assertFileDoesContain conf "password-command: \"sh\" \"-c\" \"echo secret\""
diff --git a/changelog.d/issue-6268 b/changelog.d/issue-6268
new file mode 100644
index 0000000000..cc78eecf88
--- /dev/null
+++ b/changelog.d/issue-6268
@@ -0,0 +1,19 @@
+synopsis: Fix parsing of password-command option
+packages: cabal-install
+prs: #9002
+issuesa: #6268
+
+description: {
+
+The password-command option did not parse its value correctly.
+Quotes were ignored, making many kinds of commands impossible to
+express (e.g.  `sh -c "foo | bar"`).  Also, `cabal user-config`
+treated the argument list as a *list of option values*, rather than a
+*value that is a list*.  As a consequence, `cabal user-config
+update` corrupted the value in the config file.
+
+Fixed these issues by parsing the command as a space separated list
+of tokens (which may be enclosed in double quotes), and treating the
+parsed list-of-token as one value (not multiple).
+
+}
diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst
index b10d28787b..1b52f51f20 100644
--- a/doc/cabal-commands.rst
+++ b/doc/cabal-commands.rst
@@ -1066,7 +1066,19 @@ to Hackage.
 
 .. option:: -P, --password-command
 
-    Command to get your Hackage password.
+    Command to get your Hackage password.  Arguments with whitespace
+    must be quoted (double-quotes only).  For example:
+
+    ::
+
+        --password-command 'sh -c "grep hackage ~/secrets | cut -d : -f 2"'
+
+    Or in the config file:
+
+    ::
+
+        password-command: sh -c "grep hackage ~/secrets | cut -d : -f 2"
+
 
 cabal report
 ^^^^^^^^^^^^
-- 
GitLab