From 43c36c5c9f7a31649eb059fd16ed82bde20da3fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 24 Feb 2023 11:15:45 +0100 Subject: ui: 'display-hint' quotes extra arguments for Texinfo. Fixes . 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. --- guix/ui.scm | 49 +++++++++++++++++++++++++++++++++++-------------- 1 file changed, 35 insertions(+), 14 deletions(-) (limited to 'guix/ui.scm') 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) -- cgit v1.2.3