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.
This commit is contained in:
Ludovic Courtès
parent
92a0e60a96
commit
43c36c5c9f
|
|
@ -662,9 +662,11 @@ $DB['PASSWORD'] = " (let ((file (location-file %location))
|
|||
(string-append "trim(file_get_contents('"
|
||||
db-secret-file "'));\n"))
|
||||
(begin
|
||||
(display-hint (format #f (G_ "~a:~a:~a: ~a:
|
||||
(display-hint (G_ "~a:~a:~a: ~a:
|
||||
Consider using @code{db-secret-file} instead of @code{db-password} for better
|
||||
security.") file line column 'zabbix-front-end-configuration))
|
||||
security.")
|
||||
file line column
|
||||
'zabbix-front-end-configuration)
|
||||
(format #f "'~a';~%" db-password))))
|
||||
"
|
||||
// Schema name. Used for IBM DB2 and PostgreSQL.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 '()))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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'."))
|
||||
|
|
|
|||
49
guix/ui.scm
49
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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue