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.
This commit is contained in:
Ludovic Courtès 2014-11-11 22:27:24 +01:00
parent f34c56be3a
commit 906b1b0986
1 changed files with 19 additions and 5 deletions

View File

@ -34,6 +34,7 @@
#:use-module (gnu system grub) #:use-module (gnu system grub)
#:use-module (gnu packages grub) #:use-module (gnu packages grub)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -216,9 +217,15 @@ it atomically, and then run OS's activation script."
#f #f
(apply throw args))))) (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)) (define* (previous-grub-entries #:optional (profile %system-profile))
"Return a list of 'menu-entry' for the generations of 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 (unless-file-not-found
(call-with-input-file (string-append system "/parameters") (call-with-input-file (string-append system "/parameters")
(lambda (port) (lambda (port)
@ -228,7 +235,9 @@ it atomically, and then run OS's activation script."
('kernel linux) ('kernel linux)
_ ...) _ ...)
(menu-entry (menu-entry
(label label) (label (string-append label " (#"
(number->string number) ", "
(seconds->string time) ")"))
(linux linux) (linux linux)
(linux-arguments (linux-arguments
(list (string-append "--root=" root) (list (string-append "--root=" root)
@ -240,9 +249,14 @@ it atomically, and then run OS's activation script."
system) system)
#f)))))) #f))))))
(let ((systems (map (cut generation-file-name profile <>) (let* ((numbers (generation-numbers profile))
(generation-numbers profile)))) (systems (map (cut generation-file-name profile <>)
(filter-map system->grub-entry systems))) numbers))
(times (map (lambda (system)
(unless-file-not-found
(stat:mtime (lstat system))))
systems)))
(filter-map system->grub-entry systems numbers times)))
;;; ;;;