mirror/guix
mirror/guix
1
Fork 0
mirror of https://https.git.savannah.gnu.org/git/guix.git/ synced 2025-07-13 10:30:43 +02:00
Code Releases Activity

ui: 'display-hint' quotes extra arguments for Texinfo.

Browse source 
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 2023-02-24 11:15:45 +01:00
parent 92a0e60a96
commit 43c36c5c9f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
15 changed files with 85 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

6
gnu/services/monitoring.scm
View file

@ -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.

4
guix/scripts.scm
View file

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

18
guix/scripts/build.scm
View file

@ -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))))))))

6
guix/scripts/describe.scm
View file

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

4
guix/scripts/environment.scm
View file

@ -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 '()))

4
guix/scripts/home.scm
View file

@ -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)

6
guix/scripts/home/edit.scm
View file

@ -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))

5
guix/scripts/import.scm
View file

@ -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))))))

6
guix/scripts/package.scm
View file

@ -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))))
;;;

6
guix/scripts/pull.scm
View file

@ -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)))))

6
guix/scripts/shell.scm
View file

@ -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,7 +305,7 @@ 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:
@ -314,7 +314,7 @@ echo ~a >> ~a
@end example\n")
file
(dirname file)
(authorized-directory-file)))
(authorized-directory-file))
(exit 1)))))))

9
guix/scripts/system.scm
View file

@ -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)

6
guix/scripts/system/edit.scm
View file

@ -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))

4
guix/status.scm
View file

@ -533,7 +533,7 @@ 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.
@ -541,7 +541,7 @@ The channels you are pulling from are: ~a.")
(string-join
(map symbol->string
(or (assq-ref properties 'channels)
'(guix))))))))
'(guix)))))))
(match (derivation-log-file drv)
(#f
(format port (failure (G_ "Could not find build log for '~a'."))

49
guix/ui.scm
View file

@ -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)