diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-05-10 15:25:59 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-05-10 22:09:08 +0200 |
| commit | 7fd952e05203d975fcb6cdabd2f742ade1b31b66 (patch) | |
| tree | f4c56daa415e6b8aaf5b9e4f46ae9ab009dc8dfd /guix/scripts.scm | |
| parent | 30d2397f73d6fa9e77eed70ec6df8afd3b9f5f5e (diff) | |
| download | gnu-guix-7fd952e05203d975fcb6cdabd2f742ade1b31b66.tar gnu-guix-7fd952e05203d975fcb6cdabd2f742ade1b31b66.tar.gz | |
scripts: Warn about old distro.
Fixes <http://bugs.gnu.org/25852>.
Suggested by Mark H Weaver <mhw@netris.org>.
* 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.
Diffstat (limited to 'guix/scripts.scm')
| -rw-r--r-- | guix/scripts.scm | 49 |
1 files changed, 47 insertions, 2 deletions
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 <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com> ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; @@ -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 |