From 69daee23af49aeafcb1d250c90860f9253da719e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 3 May 2017 15:57:02 +0200 Subject: ui: Rename '_' to 'G_'. This avoids collisions with '_' when the latter is used as a 'match' pattern for instance. See . * guix/ui.scm: Rename '_' to 'G_'. * po/guix/Makevars (XGETTEXT_OPTIONS): Adjust accordingly. * build-aux/compile-all.scm (warnings): Remove 'format'. * gnu/packages.scm, gnu/services.scm, gnu/services/shepherd.scm, gnu/system.scm, gnu/system/shadow.scm, guix/gnupg.scm, guix/http-client.scm, guix/import/cpan.scm, guix/import/elpa.scm, guix/import/pypi.scm, guix/nar.scm, guix/scripts.scm, guix/scripts/archive.scm, guix/scripts/authenticate.scm, guix/scripts/build.scm, guix/scripts/challenge.scm, guix/scripts/container.scm, guix/scripts/container/exec.scm, guix/scripts/copy.scm, guix/scripts/download.scm, guix/scripts/edit.scm, guix/scripts/environment.scm, guix/scripts/gc.scm, guix/scripts/graph.scm, guix/scripts/hash.scm, guix/scripts/import.scm, guix/scripts/import/cpan.scm, guix/scripts/import/cran.scm, guix/scripts/import/crate.scm, guix/scripts/import/elpa.scm, guix/scripts/import/gem.scm, guix/scripts/import/gnu.scm, guix/scripts/import/hackage.scm, guix/scripts/import/nix.scm, guix/scripts/import/pypi.scm, guix/scripts/import/stackage.scm, guix/scripts/lint.scm, guix/scripts/offload.scm, guix/scripts/pack.scm, guix/scripts/package.scm, guix/scripts/perform-download.scm, guix/scripts/publish.scm, guix/scripts/pull.scm, guix/scripts/refresh.scm, guix/scripts/size.scm, guix/scripts/substitute.scm, guix/scripts/system.scm, guix/ssh.scm, guix/upstream.scm: Use 'G_' instead of '_'. Most of this change was obtained by running: "sed -i -e's/(_ "/(G_ "/g' `find -name \*.scm`". --- guix/scripts/package.scm | 78 ++++++++++++++++++++++++------------------------ 1 file changed, 39 insertions(+), 39 deletions(-) (limited to 'guix/scripts/package.scm') diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 6be9d00aec..92676c2228 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -104,7 +104,7 @@ indirectly, or PROFILE." (define (rtfm) (format (current-error-port) - (_ "Try \"info '(guix) Invoking guix package'\" for \ + (G_ "Try \"info '(guix) Invoking guix package'\" for \ more information.~%")) (exit 1)) @@ -126,21 +126,21 @@ more information.~%")) ;; parent directory is root-owned and we're running ;; unprivileged. (format (current-error-port) - (_ "error: while creating directory `~a': ~a~%") + (G_ "error: while creating directory `~a': ~a~%") %profile-directory (strerror (system-error-errno args))) (format (current-error-port) - (_ "Please create the `~a' directory, with you as the owner.~%") + (G_ "Please create the `~a' directory, with you as the owner.~%") %profile-directory) (rtfm)))) ;; Bail out if it's not owned by the user. (unless (or (not s) (= (stat:uid s) (getuid))) (format (current-error-port) - (_ "error: directory `~a' is not owned by you~%") + (G_ "error: directory `~a' is not owned by you~%") %profile-directory) (format (current-error-port) - (_ "Please change the owner of `~a' to user ~s.~%") + (G_ "Please change the owner of `~a' to user ~s.~%") %profile-directory (or (getenv "USER") (getenv "LOGNAME") (getuid))) @@ -175,17 +175,17 @@ denote ranges as interpreted by 'matching-generations'." => (lambda (numbers) (when (memv current numbers) - (warning (_ "not removing generation ~a, which is current~%") + (warning (G_ "not removing generation ~a, which is current~%") current)) ;; Make sure we don't inadvertently remove the current ;; generation. (let ((numbers (delv current numbers))) (when (null-list? numbers) - (leave (_ "no matching generation~%"))) + (leave (G_ "no matching generation~%"))) (delete-generations store profile numbers)))) (else - (leave (_ "invalid syntax: ~a~%") pattern))))) + (leave (G_ "invalid syntax: ~a~%") pattern))))) (define* (build-and-use-profile store profile manifest #:key @@ -211,7 +211,7 @@ specified in MANIFEST, a manifest object." (dry-run? #t) ((and (file-exists? profile) (and=> (readlink* profile) (cut string=? prof <>))) - (format (current-error-port) (_ "nothing to be done~%"))) + (format (current-error-port) (G_ "nothing to be done~%"))) (else (let* ((number (generation-number profile)) @@ -269,7 +269,7 @@ synopsis or description matches all of REGEXPS." "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a ." (define (supersede old new) - (info (_ "package '~a' has been superseded by '~a'~%") + (info (G_ "package '~a' has been superseded by '~a'~%") (manifest-entry-name old) (package-name new)) (manifest-transaction-install-entry (package->manifest-entry new (manifest-entry-output old)) @@ -341,7 +341,7 @@ ENTRIES, a list of manifest entries, in the context of PROFILE." (settings (search-path-environment-variables entries profiles #:kind kind))) (unless (null? settings) - (format #t (_ "The following environment variable definitions may be needed:~%")) + (format #t (G_ "The following environment variable definitions may be needed:~%")) (format #t "~{ ~a~%~}" settings)))) @@ -357,68 +357,68 @@ ENTRIES, a list of manifest entries, in the context of PROFILE." (substitutes? . #t))) (define (show-help) - (display (_ "Usage: guix package [OPTION]... + (display (G_ "Usage: guix package [OPTION]... Install, remove, or upgrade packages in a single transaction.\n")) - (display (_ " + (display (G_ " -i, --install PACKAGE ... install PACKAGEs")) - (display (_ " + (display (G_ " -e, --install-from-expression=EXP install the package EXP evaluates to")) - (display (_ " + (display (G_ " -f, --install-from-file=FILE install the package that the code within FILE evaluates to")) - (display (_ " + (display (G_ " -r, --remove PACKAGE ... remove PACKAGEs")) - (display (_ " + (display (G_ " -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP")) - (display (_ " + (display (G_ " -m, --manifest=FILE create a new profile generation with the manifest from FILE")) - (display (_ " + (display (G_ " --do-not-upgrade[=REGEXP] do not upgrade any packages matching REGEXP")) - (display (_ " + (display (G_ " --roll-back roll back to the previous generation")) - (display (_ " + (display (G_ " --search-paths[=KIND] display needed environment variable definitions")) - (display (_ " + (display (G_ " -l, --list-generations[=PATTERN] list generations matching PATTERN")) - (display (_ " + (display (G_ " -d, --delete-generations[=PATTERN] delete generations matching PATTERN")) - (display (_ " + (display (G_ " -S, --switch-generation=PATTERN switch to a generation matching PATTERN")) - (display (_ " + (display (G_ " -p, --profile=PROFILE use PROFILE instead of the user's default profile")) (newline) - (display (_ " + (display (G_ " --bootstrap use the bootstrap Guile to build the profile")) - (display (_ " + (display (G_ " --verbose produce verbose output")) (newline) - (display (_ " + (display (G_ " -s, --search=REGEXP search in synopsis and description using REGEXP")) - (display (_ " + (display (G_ " -I, --list-installed[=REGEXP] list installed packages matching REGEXP")) - (display (_ " + (display (G_ " -A, --list-available[=REGEXP] list available packages matching REGEXP")) - (display (_ " + (display (G_ " --show=PACKAGE show details about PACKAGE")) (newline) (show-build-options-help) (newline) (show-transformation-options-help) (newline) - (display (_ " + (display (G_ " -h, --help display this help and exit")) - (display (_ " + (display (G_ " -V, --version display version information and exit")) (newline) (show-bug-report-information)) @@ -504,7 +504,7 @@ Install, remove, or upgrade packages in a single transaction.\n")) (#f 'exact) (x - (leave (_ "~a: unsupported \ + (leave (G_ "~a: unsupported \ kind of search path~%") x))))) (values (cons `(query search-paths ,kind) @@ -697,7 +697,7 @@ processed, #f otherwise." (list-generation display-profile-content (car numbers)) (diff-profiles profile numbers))))) (else - (leave (_ "invalid syntax: ~a~%") + (leave (G_ "invalid syntax: ~a~%") pattern))) #t) @@ -788,7 +788,7 @@ processed, #f otherwise." (let ((number (relative-generation-spec->number profile spec))) (if number (switch-to-generation* profile number) - (leave (_ "cannot switch to generation '~a'~%") spec))))) + (leave (G_ "cannot switch to generation '~a'~%") spec))))) (define* (delete-generations-action store profile pattern opts #:key dry-run?) @@ -804,9 +804,9 @@ processed, #f otherwise." (bootstrap? (assoc-ref opts 'bootstrap?)) (substitutes? (assoc-ref opts 'substitutes?))) (if dry-run? - (format #t (_ "would install new manifest from '~a' with ~d entries~%") + (format #t (G_ "would install new manifest from '~a' with ~d entries~%") file (length (manifest-entries manifest))) - (format #t (_ "installing new manifest from '~a' with ~d entries~%") + (format #t (G_ "installing new manifest from '~a' with ~d entries~%") file (length (manifest-entries manifest)))) (build-and-use-profile store profile manifest #:bootstrap? bootstrap? @@ -877,7 +877,7 @@ processed, #f otherwise." ;; Process non-option argument ARG by calling back ARG-HANDLER. (if arg-handler (arg-handler arg result) - (leave (_ "~A: extraneous argument~%") arg))) + (leave (G_ "~A: extraneous argument~%") arg))) (let ((opts (parse-command-line args %options (list %default-options #f) #:argument-handler handle-argument))) -- cgit v1.2.3 From 7fd952e05203d975fcb6cdabd2f742ade1b31b66 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 10 May 2017 15:25:59 +0200 Subject: scripts: Warn about old distro. Fixes . Suggested by Mark H Weaver . * guix/scripts.scm (%distro-age-warning): New variable. (warn-about-old-distro): New procedure. * guix/scripts/package.scm (process-actions): Call 'warn-about-old-distro'. * guix/scripts/system.scm (process-action): Likewise. --- guix/scripts.scm | 49 ++++++++++++++++++++++++++++++++++++++++++++++-- guix/scripts/package.scm | 2 ++ guix/scripts/system.scm | 2 ++ 3 files changed, 51 insertions(+), 2 deletions(-) (limited to 'guix/scripts/package.scm') diff --git a/guix/scripts.scm b/guix/scripts.scm index da35e71ac2..8c8c8ef9c9 100644 --- a/guix/scripts.scm +++ b/guix/scripts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès ;;; Copyright © 2014 Deck Pickard ;;; Copyright © 2015, 2016 Alex Kost ;;; @@ -27,13 +27,16 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:export (args-fold* parse-command-line maybe-build build-package - build-package-source)) + build-package-source + %distro-age-warning + warn-about-old-distro)) ;;; Commentary: ;;; @@ -136,4 +139,46 @@ Show what and how will/would be built." #:dry-run? dry-run?) (return (show-derivation-outputs derivation)))))) +(define %distro-age-warning + ;; The age (in seconds) above which we warn that the distro is too old. + (make-parameter (match (and=> (getenv "GUIX_DISTRO_AGE_WARNING") + string->duration) + (#f (* 7 24 3600)) + (age (time-second age))))) + +(define* (warn-about-old-distro #:optional (old (%distro-age-warning)) + #:key (suggested-command + "guix package -u")) + "Emit a warning if Guix is older than OLD seconds." + (let-syntax ((false-if-not-found + (syntax-rules () + ((_ exp) + (catch 'system-error + (lambda () + exp) + (lambda args + (if (= ENOENT (system-error-errno args)) + #f + (apply throw args)))))))) + (define (seconds->days seconds) + (round (/ seconds (* 3600 24)))) + + (define age + (match (false-if-not-found + (lstat (string-append (config-directory) "/latest"))) + (#f #f) + (stat (- (time-second (current-time time-utc)) + (stat:mtime stat))))) + + (when (and age (>= age old)) + (warning (N_ "Your Guix installation is ~a days old.\n" + "Your Guix installation is ~a day old.\n" + (seconds->days age)) + (seconds->days age))) + (when (or (not age) (>= age old)) + (warning (G_ "Consider running 'guix pull' followed by +'~a' to get up-to-date packages and security updates.\n") + suggested-command) + (newline (guix-warning-port))))) + ;;; scripts.scm ends here diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 92676c2228..1f3f49fc6f 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -859,6 +859,8 @@ processed, #f otherwise." (manifest-transaction-install step2))))) (new (manifest-perform-transaction manifest step3))) + (warn-about-old-distro) + (unless (manifest-transaction-null? step3) (show-manifest-transaction store manifest step3 #:dry-run? dry-run?) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 2872bcae6b..9c09767508 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -847,6 +847,8 @@ resulting from command-line parsing." ((shepherd-graph) (export-shepherd-graph os (current-output-port))) (else + (warn-about-old-distro #:suggested-command + "guix system reconfigure") (perform-action action os #:dry-run? dry? #:derivations-only? (assoc-ref opts -- cgit v1.2.3 From 807ba51950720d5321ea1c95234805ccdf9b479b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 23 May 2017 22:45:03 +0200 Subject: guix package: Swallow EPIPE upon 'guix package --list-generations'. Fixes . Reported by Alex Vong . * guix/scripts/package.scm (process-query) <'list-generations>: Wrap body in 'leave-on-EPIPE'. --- guix/scripts/package.scm | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) (limited to 'guix/scripts/package.scm') diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1f3f49fc6f..f050fad976 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -681,24 +681,26 @@ processed, #f otherwise." (unless (null-list? (cdr numbers)) (display-profile-content-diff profile (car numbers) (cadr numbers)) (diff-profiles profile (cdr numbers)))) - (cond ((not (file-exists? profile)) ; XXX: race condition - (raise (condition (&profile-not-found-error - (profile profile))))) - ((string-null? pattern) - (list-generation display-profile-content - (car (profile-generations profile))) - (diff-profiles profile (profile-generations profile))) - ((matching-generations pattern profile) - => - (lambda (numbers) - (if (null-list? numbers) - (exit 1) - (leave-on-EPIPE - (list-generation display-profile-content (car numbers)) - (diff-profiles profile numbers))))) - (else - (leave (G_ "invalid syntax: ~a~%") - pattern))) + + (leave-on-EPIPE + (cond ((not (file-exists? profile)) ; XXX: race condition + (raise (condition (&profile-not-found-error + (profile profile))))) + ((string-null? pattern) + (list-generation display-profile-content + (car (profile-generations profile))) + (diff-profiles profile (profile-generations profile))) + ((matching-generations pattern profile) + => + (lambda (numbers) + (if (null-list? numbers) + (exit 1) + (begin + (list-generation display-profile-content (car numbers)) + (diff-profiles profile numbers))))) + (else + (leave (G_ "invalid syntax: ~a~%") + pattern)))) #t) (('list-installed regexp) -- cgit v1.2.3