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.
This commit is contained in:
Ludovic Courtès 2017-05-10 15:25:59 +02:00
parent 30d2397f73
commit 7fd952e052
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 51 additions and 2 deletions

View File

@ -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

View File

@ -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?)

View File

@ -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