Merge of #9125

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