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 | |
| parent | 30d2397f73d6fa9e77eed70ec6df8afd3b9f5f5e (diff) | |
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.
| -rw-r--r-- | guix/scripts.scm | 49 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 2 |
3 files changed, 51 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 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 |