diff options
author | Ludovic Courtès <ludo@gnu.org> | 2023-02-24 11:15:45 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2023-02-27 23:40:43 +0100 |
commit | 43c36c5c9f7a31649eb059fd16ed82bde20da3fc (patch) | |
tree | 305f5793c75a118ef9a76d8229110ee104859f35 /guix | |
parent | 92a0e60a963a54230e400c5c2ae585205489bf35 (diff) |
ui: 'display-hint' quotes extra arguments for Texinfo.
Fixes <https://issues.guix.gnu.org/61201>.
Previously, common practice was to splice arbitrary strings (user names,
file names, etc.) into Texinfo snippets passed to 'display-hint'. This
is unsafe in the general case because at signs and braces need to be
escaped to produced valid Texinfo. This commit addresses that.
* guix/ui.scm (texinfo-quote): New procedure.
(display-hint): When ARGUMENTS is non-empty, pass it to 'texinfo-quote'
and call 'format'.
(report-unbound-variable-error, check-module-matches-file)
(display-collision-resolution-hint, run-guix-command): Remove explicit
'format' call; pass 'format' arguments as extra arguments to 'display-hint'.
* gnu/services/monitoring.scm (zabbix-front-end-config): Likewise.
* guix/scripts.scm (warn-about-disk-space): Likewise.
* guix/scripts/build.scm (%standard-cross-build-options)
(%standard-native-build-options): Likewise.
* guix/scripts/describe.scm (display-checkout-info): Likewise.
* guix/scripts/environment.scm (suggest-command-name): Likewise.
* guix/scripts/home.scm (process-command): Likewise.
* guix/scripts/home/edit.scm (service-type-not-found): Likewise.
* guix/scripts/import.scm (guix-import): Likewise.
* guix/scripts/package.scm (display-search-path-hint): Likewise.
* guix/scripts/pull.scm (build-and-install): Likewise.
* guix/scripts/shell.scm (auto-detect-manifest): Likewise.
* guix/scripts/system.scm (check-file-system-availability): Likewise.
(guix-system): Likewise.
* guix/scripts/system/edit.scm (service-type-not-found): Likewise.
* guix/status.scm (print-build-event): Likewise.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/scripts.scm | 4 | ||||
-rw-r--r-- | guix/scripts/build.scm | 18 | ||||
-rw-r--r-- | guix/scripts/describe.scm | 6 | ||||
-rw-r--r-- | guix/scripts/environment.scm | 4 | ||||
-rw-r--r-- | guix/scripts/home.scm | 4 | ||||
-rw-r--r-- | guix/scripts/home/edit.scm | 6 | ||||
-rw-r--r-- | guix/scripts/import.scm | 5 | ||||
-rw-r--r-- | guix/scripts/package.scm | 6 | ||||
-rw-r--r-- | guix/scripts/pull.scm | 6 | ||||
-rw-r--r-- | guix/scripts/shell.scm | 10 | ||||
-rw-r--r-- | guix/scripts/system.scm | 9 | ||||
-rw-r--r-- | guix/scripts/system/edit.scm | 6 | ||||
-rw-r--r-- | guix/status.scm | 10 | ||||
-rw-r--r-- | guix/ui.scm | 49 |
14 files changed, 81 insertions, 62 deletions
diff --git a/guix/scripts.scm b/guix/scripts.scm index 4de8bc23b3..395df864a3 100644 --- a/guix/scripts.scm +++ b/guix/scripts.scm @@ -321,11 +321,11 @@ THRESHOLDS is a pair (ABSOLUTE-THRESHOLD . RELATIVE-THRESHOLD)." absolute-threshold-in-bytes)) (warning (G_ "only ~,1f GiB of free space available on ~a~%") (/ available 1. GiB) (%store-prefix)) - (display-hint (format #f (G_ "Consider deleting old profile + (display-hint (G_ "Consider deleting old profile generations and collecting garbage, along these lines: @example guix gc --delete-generations=1m -@end example\n")))))) +@end example\n"))))) ;;; scripts.scm ends here diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index b4437172d7..6a4a32fc0a 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net> @@ -377,12 +377,12 @@ use '--no-offload' instead~%"))) arg) (if closest (display-hint - (format #f (G_ "Did you mean @code{~a}? + (G_ "Did you mean @code{~a}? Try @option{--list-targets} to view available targets.~%") - closest)) + closest) (display-hint - (format #f (G_ "\ -Try @option{--list-targets} to view available targets.~%")))) + (G_ "\ +Try @option{--list-targets} to view available targets.~%"))) (exit 1)))))))) (define %standard-native-build-options @@ -404,12 +404,12 @@ Try @option{--list-targets} to view available targets.~%")))) arg) (if closest (display-hint - (format #f (G_ "Did you mean @code{~a}? + (G_ "Did you mean @code{~a}? Try @option{--list-systems} to view available system types.~%") - closest)) + closest) (display-hint - (format #f (G_ "\ -Try @option{--list-systems} to view available system types.~%")))) + (G_ "\ +Try @option{--list-systems} to view available system types.~%"))) (exit 1)))))))) diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index 80cd0ce00a..5523aa0ec2 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019, 2020, 2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ekaitz Zarraga <ekaitz@elenq.tech> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> @@ -154,10 +154,10 @@ within a Git checkout." (channel (repository->guix-channel (dirname program)))) (unless channel (report-error (G_ "failed to determine origin~%")) - (display-hint (format #f (G_ "Perhaps this + (display-hint (G_ "Perhaps this @command{guix} command was not obtained with @command{guix pull}? Its version string is ~a.~%") - %guix-version)) + %guix-version) (exit 1)) (match fmt diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 46435ae48e..44cfcb4f76 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -664,8 +664,8 @@ command name." (let ((closest (string-closest executable available #:threshold 12))) (unless (or (not closest) (string=? closest executable)) - (display-hint (format #f (G_ "Did you mean '~a'?~%") - closest))))))))) + (display-hint (G_ "Did you mean '~a'?~%") + closest)))))))) (define* (launch-environment/fork command profile manifest #:key pure? (white-list '())) diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index d86094bc43..8ff8182a79 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -572,10 +572,10 @@ argument list and OPTS is the option alist." (cut import-manifest manifest destination <>)) (info (G_ "'~a' populated with all the Home configuration files~%") destination) - (display-hint (format #f (G_ "\ + (display-hint (G_ "\ Run @command{guix home reconfigure ~a/home-configuration.scm} to effectively deploy the home environment described by these files.\n") - destination)))) + destination))) ((describe) (let ((list-installed-regex (assoc-ref opts 'list-installed))) (match (generation-number %guix-home) diff --git a/guix/scripts/home/edit.scm b/guix/scripts/home/edit.scm index a6c05675b3..d039179a10 100644 --- a/guix/scripts/home/edit.scm +++ b/guix/scripts/home/edit.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,8 +40,8 @@ '())) (closest (string-closest type available))) (unless (or (not closest) (string=? closest type)) - (display-hint (format #f (G_ "Did you mean @code{~a}?~%") - closest)))) + (display-hint (G_ "Did you mean @code{~a}?~%") + closest))) (exit 1)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 2bca927d63..fe1d7a8dda 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2014, 2020-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2014, 2020-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2019, 2022 Ricardo Wurmus <rekado@elephly.net> @@ -106,6 +106,5 @@ Run IMPORTER with ARGS.\n")) (let ((hint (string-closest importer importers #:threshold 3))) (report-error (G_ "~a: invalid importer~%") importer) (when hint - (display-hint - (format #f (G_ "Did you mean @code{~a}?~%") hint))) + (display-hint (G_ "Did you mean @code{~a}?~%") hint)) (exit 1)))))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index b9090307ac..945e2f2cca 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com> @@ -322,7 +322,7 @@ of manifest entries, in the context of PROFILE." (settings (search-path-environment-variables entries (list profile) #:kind 'prefix))) (unless (null? settings) - (display-hint (format #f (G_ "Consider setting the necessary environment + (display-hint (G_ "Consider setting the necessary environment variables by running: @example @@ -331,7 +331,7 @@ GUIX_PROFILE=\"~a\" @end example Alternately, see @command{guix package --search-paths -p ~s}.") - profile profile))))) + profile profile)))) ;;; diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 7b6c58dbc3..2be8de3b9c 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013-2015, 2017-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2015, 2017-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr> ;;; @@ -469,9 +469,9 @@ true, display what would be built without actually building it." ;; Is the 'guix' command previously in $PATH the same as the new ;; one? If the answer is "no", then suggest 'hash guix'. (unless (member guix-command new) - (display-hint (format #f (G_ "After setting @code{PATH}, run + (display-hint (G_ "After setting @code{PATH}, run @command{hash guix} to make sure your shell refers to @file{~a}.") - (first new)))) + (first new))) (return #f)) (return #f))))) diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm index 64b5c2e8e9..92bbfb04d0 100644 --- a/guix/scripts/shell.scm +++ b/guix/scripts/shell.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021-2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -305,16 +305,16 @@ Return the modified OPTS." (report-error (G_ "not loading '~a' because not authorized to do so~%") file) - (display-hint (format #f (G_ "To allow automatic loading of + (display-hint (G_ "To allow automatic loading of @file{~a} when running @command{guix shell}, you must explicitly authorize its directory, like so: @example echo ~a >> ~a @end example\n") - file - (dirname file) - (authorized-directory-file))) + file + (dirname file) + (authorized-directory-file)) (exit 1))))))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6fd915cb5e..c0bc295c00 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com> @@ -633,9 +633,9 @@ any, are available. Raise an error if they're not." (G_ "device '~a' not found: ~a~%") device (strerror errno)) (unless (string-prefix? "/" device) - (display-hint (format #f (G_ "If '~a' is a file system + (display-hint (G_ "If '~a' is a file system label, write @code{(file-system-label ~s)} in your @code{device} field.") - device device))))))) + device device)))))) literal) (for-each (lambda (fs) (let ((label (file-system-label->string @@ -1417,8 +1417,7 @@ argument list and OPTS is the option alist." (let ((hint (string-closest arg actions #:threshold 3))) (report-error (G_ "~a: unknown action~%") arg) (when hint - (display-hint - (format #f (G_ "Did you mean @code{~a}?~%") hint))) + (display-hint (G_ "Did you mean @code{~a}?~%") hint)) (exit 1))))) (define (match-pair car) diff --git a/guix/scripts/system/edit.scm b/guix/scripts/system/edit.scm index d966ee0aaa..0afb071650 100644 --- a/guix/scripts/system/edit.scm +++ b/guix/scripts/system/edit.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,8 +39,8 @@ '())) (closest (string-closest type available))) (unless (or (not closest) (string=? closest type)) - (display-hint (format #f (G_ "Did you mean @code{~a}?~%") - closest)))) + (display-hint (G_ "Did you mean @code{~a}?~%") + closest))) (exit 1)) diff --git a/guix/status.scm b/guix/status.scm index 5580c80ea9..a192cd789a 100644 --- a/guix/status.scm +++ b/guix/status.scm @@ -533,15 +533,15 @@ substitutes being downloaded." (when (and (pair? properties) (eq? (assq-ref properties 'type) 'profile-hook) (eq? (assq-ref properties 'hook) 'package-cache)) - (display-hint (format #f (G_ "This usually indicates a bug in one of + (display-hint (G_ "This usually indicates a bug in one of the channels you are pulling from, or some incompatibility among them. You can check the build log and report the issue to the channel developers. The channels you are pulling from are: ~a.") - (string-join - (map symbol->string - (or (assq-ref properties 'channels) - '(guix)))))))) + (string-join + (map symbol->string + (or (assq-ref properties 'channels) + '(guix))))))) (match (derivation-log-file drv) (#f (format port (failure (G_ "Could not find build log for '~a'.")) diff --git a/guix/ui.scm b/guix/ui.scm index 9f81ff3b8e..b6c3bd04ba 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -296,9 +296,22 @@ VARIABLE and return it, or #f if none was found." (define %hint-color (color BOLD CYAN)) -(define* (display-hint message #:optional (port (current-error-port))) - "Display MESSAGE, a l10n message possibly containing Texinfo markup, to -PORT." +(define (texinfo-quote str) + "Quote at signs and braces in STR to obtain its Texinfo represention." + (list->string + (string-fold-right (lambda (chr result) + (if (memq chr '(#\@ #\{ #\})) + (cons* #\@ chr result) + (cons chr result))) + '() + str))) + +(define* (display-hint message + #:key (port (current-error-port)) + #:rest arguments) + "Display MESSAGE, a l10n message possibly containing Texinfo markup and +'format' escape, to PORT. ARGUMENTS is a (possibly empty) list of strings or +other objects that must match the 'format' escapes in MESSAGE." (define colorize (if (color-output? port) (lambda (str) @@ -309,7 +322,16 @@ PORT." (display ;; XXX: We should arrange so that the initial indent is wider. (parameterize ((%text-width (max 15 (- (terminal-columns) 5)))) - (texi->plain-text message)) + (texi->plain-text (match arguments + (() message) + (_ (apply format #f message + (map (match-lambda + ((? string? str) + (texinfo-quote str)) + (obj + (texinfo-quote + (object->string obj)))) + arguments)))))) port)) (define* (report-unbound-variable-error args #:key frame) @@ -324,8 +346,8 @@ arguments." (#f (display-hint (G_ "Did you forget a @code{use-modules} form?"))) ((? module? module) - (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?") - (module-name module)))))))) + (display-hint (G_ "Did you forget @code{(use-modules ~a)}?") + (module-name module))))))) (define (check-module-matches-file module file) "Check whether FILE starts with 'define-module MODULE' and print a hint if @@ -334,10 +356,10 @@ it doesn't." ;; definitions and try loading them with 'guix build -L …', so help them ;; diagnose the problem. (define (hint) - (display-hint (format #f (G_ "File @file{~a} should probably start with: + (display-hint (G_ "File @file{~a} should probably start with: @example\n(define-module ~a)\n@end example") - file module))) + file module)) (catch 'system-error (lambda () @@ -663,12 +685,12 @@ interpreted." (name1 (manifest-entry-name (top-most-entry first))) (name2 (manifest-entry-name (top-most-entry second)))) (if (string=? name1 name2) - (display-hint (format #f (G_ "You cannot have two different versions + (display-hint (G_ "You cannot have two different versions or variants of @code{~a} in the same profile.") - name1)) - (display-hint (format #f (G_ "Try upgrading both @code{~a} and @code{~a}, + name1) + (display-hint (G_ "Try upgrading both @code{~a} and @code{~a}, or remove one of them from the profile.") - name1 name2))))) + name1 name2)))) ;; On Guile 3.0, in 'call-with-error-handling' we need to re-raise. To ;; preserve useful backtraces in case of unhandled errors, we want that to @@ -2226,8 +2248,7 @@ found." (format (current-error-port) (G_ "guix: ~a: command not found~%") command) (when hint - (display-hint (format #f (G_ "Did you mean @code{~a}?") - hint))) + (display-hint (G_ "Did you mean @code{~a}?") hint)) (show-guix-usage))))) (file (load file) |