summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-11-11 22:27:24 +0100
committerLudovic Courtès <ludo@gnu.org>2014-11-11 22:42:42 +0100
commit906b1b09861e5fcc8ef0b0de8e692d5fea95a976 (patch)
treed45d547c9ff856a5eab74b90e0ce5fa659a4471e
parentf34c56be3a53c10d9a267331a0a6119c79c815a0 (diff)
guix system: Decorate GRUB entries of old generations with date and number.
* guix/scripts/system.scm (seconds->string): New procedure. (previous-grub-entries)[system->grub-entry]: Add 'number' and 'time' parameters. Adjust call accordingly.
-rw-r--r--guix/scripts/system.scm24
1 files changed, 19 insertions, 5 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index ebad13e5e0..92364fda27 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -34,6 +34,7 @@
#:use-module (gnu system grub)
#:use-module (gnu packages grub)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
@@ -216,9 +217,15 @@ it atomically, and then run OS's activation script."
#f
(apply throw args)))))
+(define (seconds->string seconds)
+ "Return a string representing the date for SECONDS."
+ (let ((time (make-time time-utc 0 seconds)))
+ (date->string (time-utc->date time)
+ "~Y-~m-~d ~H:~M")))
+
(define* (previous-grub-entries #:optional (profile %system-profile))
"Return a list of 'menu-entry' for the generations of PROFILE."
- (define (system->grub-entry system)
+ (define (system->grub-entry system number time)
(unless-file-not-found
(call-with-input-file (string-append system "/parameters")
(lambda (port)
@@ -228,7 +235,9 @@ it atomically, and then run OS's activation script."
('kernel linux)
_ ...)
(menu-entry
- (label label)
+ (label (string-append label " (#"
+ (number->string number) ", "
+ (seconds->string time) ")"))
(linux linux)
(linux-arguments
(list (string-append "--root=" root)
@@ -240,9 +249,14 @@ it atomically, and then run OS's activation script."
system)
#f))))))
- (let ((systems (map (cut generation-file-name profile <>)
- (generation-numbers profile))))
- (filter-map system->grub-entry systems)))
+ (let* ((numbers (generation-numbers profile))
+ (systems (map (cut generation-file-name profile <>)
+ numbers))
+ (times (map (lambda (system)
+ (unless-file-not-found
+ (stat:mtime (lstat system))))
+ systems)))
+ (filter-map system->grub-entry systems numbers times)))
;;;