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.master
parent
30d2397f73
commit
7fd952e052
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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 © 2014 Deck Pickard <deck.r.pickard@gmail.com>
|
||||||
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
|
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
|
@ -27,13 +27,16 @@
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (args-fold*
|
#:export (args-fold*
|
||||||
parse-command-line
|
parse-command-line
|
||||||
maybe-build
|
maybe-build
|
||||||
build-package
|
build-package
|
||||||
build-package-source))
|
build-package-source
|
||||||
|
%distro-age-warning
|
||||||
|
warn-about-old-distro))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -136,4 +139,46 @@ Show what and how will/would be built."
|
||||||
#:dry-run? dry-run?)
|
#:dry-run? dry-run?)
|
||||||
(return (show-derivation-outputs derivation))))))
|
(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
|
;;; scripts.scm ends here
|
||||||
|
|
|
@ -859,6 +859,8 @@ processed, #f otherwise."
|
||||||
(manifest-transaction-install step2)))))
|
(manifest-transaction-install step2)))))
|
||||||
(new (manifest-perform-transaction manifest step3)))
|
(new (manifest-perform-transaction manifest step3)))
|
||||||
|
|
||||||
|
(warn-about-old-distro)
|
||||||
|
|
||||||
(unless (manifest-transaction-null? step3)
|
(unless (manifest-transaction-null? step3)
|
||||||
(show-manifest-transaction store manifest step3
|
(show-manifest-transaction store manifest step3
|
||||||
#:dry-run? dry-run?)
|
#:dry-run? dry-run?)
|
||||||
|
|
|
@ -847,6 +847,8 @@ resulting from command-line parsing."
|
||||||
((shepherd-graph)
|
((shepherd-graph)
|
||||||
(export-shepherd-graph os (current-output-port)))
|
(export-shepherd-graph os (current-output-port)))
|
||||||
(else
|
(else
|
||||||
|
(warn-about-old-distro #:suggested-command
|
||||||
|
"guix system reconfigure")
|
||||||
(perform-action action os
|
(perform-action action os
|
||||||
#:dry-run? dry?
|
#:dry-run? dry?
|
||||||
#:derivations-only? (assoc-ref opts
|
#:derivations-only? (assoc-ref opts
|
||||||
|
|
Reference in New Issue