diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 3ea80c6df23..385f0a0a672 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/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 diff --git a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs index 6ac62a6e82d..a4b6fbec836 100644 --- a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs +++ b/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) diff --git a/cabal-testsuite/PackageTests/UserConfig/cabal.out b/cabal-testsuite/PackageTests/UserConfig/cabal.out index b5e1f5ef9f8..2c6e1a3cd14 100644 --- a/cabal-testsuite/PackageTests/UserConfig/cabal.out +++ b/cabal-testsuite/PackageTests/UserConfig/cabal.out @@ -12,3 +12,6 @@ Writing merged config to /cabal.dist/cabal-config. # cabal user-config Renaming /cabal.dist/cabal-config to /cabal.dist/cabal-config.backup. Writing merged config to /cabal.dist/cabal-config. +# cabal user-config +Renaming /cabal.dist/cabal-config to /cabal.dist/cabal-config.backup. +Writing merged config to /cabal.dist/cabal-config. diff --git a/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs b/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs index 85d67212d4c..300bcc59ea5 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 00000000000..cc78eecf884 --- /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 b10d28787b5..1b52f51f204 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 ^^^^^^^^^^^^