ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 13:49:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gnu/services/monitoring.scm
View file

@ -662,9 +662,11 @@ (define (zabbix-front-end-config config)
(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 @@ (define GiB (expt 2 30))
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 @@ (define %standard-cross-build-options
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 @@ (define %standard-native-build-options
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 @@ (define (display-checkout-info fmt)
(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 @@ (define not-dot?
(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 @@ (define-syntax-rule (with-store* store exp ...)
(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 @@ (define (service-type-not-found type)
'()))
(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 @@ (define-command (guix-import . args)
(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 @@ (define (display-search-path-hint entries 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 @@ (define (display-search-path-hint entries profile)
@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 @@ (define guix-command
;; 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)))))

10
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,16 +305,16 @@ (define disallow-implicit-load?
(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)))))))

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 @@ (define (file-system-location* fs)
(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 @@ (define (parse-sub-command arg result)
(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 @@ (define (service-type-not-found type)
'()))
(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))

10
guix/status.scm
View file

@ -533,15 +533,15 @@ (define erase-current-line*
(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
View file

@ -296,9 +296,22 @@ (define (module<? m1 m2)
(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 @@ (define colorize
(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 @@ (define* (report-unbound-variable-error args #:key frame)
(#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 @@ (define (check-module-matches-file module file)
;; 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 @@ (define (top-most-entry entry)
(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 @@ (define module
(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)