diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-11-11 22:27:24 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-11-11 22:42:42 +0100 |
| commit | 906b1b09861e5fcc8ef0b0de8e692d5fea95a976 (patch) | |
| tree | d45d547c9ff856a5eab74b90e0ce5fa659a4471e | |
| parent | f34c56be3a53c10d9a267331a0a6119c79c815a0 (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.scm | 24 |
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))) ;;; |