Merge pull request #9125 from haskell/mergify/bp/3.10/pr-9002

Fix parsing of password-command option (#6268) (backport #9002)

cabal-install/src/Distribution/Client/Setup.hs

@@ -72,7 +72,11 @@ 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
-         ( UserConstraint, readUserConstraint )
+  ( UserConstraint
+  , readUserConstraint
+  )
+import Distribution.Deprecated.ParseUtils (parseSpaceList, parseTokenQ)
+import Distribution.Deprecated.ReadP (readP_to_E)
 import Distribution.Utils.NubList
          ( NubList, toNubList, fromNubList)
 
@@ -2004,51 +2008,77 @@ defaultUploadFlags = UploadFlags {
   }
 
 uploadCommand :: CommandUI UploadFlags
-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' "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))
+            )
+        ]
+    }
 
 instance Monoid UploadFlags where
   mempty = gmempty

cabal-install/src/Distribution/Deprecated/ParseUtils.hs

@@ -21,25 +21,43 @@
 
 {-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE Rank2Types #-}
-module Distribution.Deprecated.ParseUtils (
-        LineNo, PError(..), PWarning(..), locatedErrorMsg, syntaxError, warning,
-        runP, runE, ParseResult(..), parseFail, showPWarning,
-        Field(..), lineNo,
-        FieldDescr(..), readFields,
-        parseHaskellString, parseTokenQ,
-        parseOptCommaList,
-        showFilePath, showToken, showFreeText,
-        field, simpleField, listField, listFieldWithSep, spaceListField,
-        newLineListField,
-        liftField,
-        readPToMaybe,
-
-        fieldParsec, simpleFieldParsec,
-        listFieldParsec,
-        commaListFieldParsec,
-        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
   ) where
 
 import Distribution.Client.Compat.Prelude hiding (get)

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.

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\""

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).
+
+}

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
 ^^^^^^^^^^^^