summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-26 21:19:42 +0100
committerLudovic Courtès <ludo@gnu.org>2015-10-27 00:01:20 +0100
commit5b516ef3696270f21327d9f63a9ccb4f1b83f346 (patch)
tree56d4e5b199a4d87e5107f28987d33b166adce7d5 /guix
parentad18c7e64c844350f295a2f79605800a7718ed78 (diff)
guix system: Factorize boot parameter parsing.
* guix/scripts/system.scm (<boot-parameters>): New record type. (read-boot-parameters): New procedure. (previous-grub-entries)[system->grub-entry]: Use it.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/system.scm74
1 files changed, 50 insertions, 24 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d973e60730..6db6a01ac9 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -25,6 +25,7 @@
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (guix monads)
+ #:use-module (guix records)
#:use-module (guix profiles)
#:use-module (guix scripts)
#:use-module (guix scripts build)
@@ -186,6 +187,39 @@ the ownership of '~a' may be incorrect!~%")
;;;
+;;; Boot parameters
+;;;
+
+(define-record-type* <boot-parameters>
+ boot-parameters make-boot-parameters boot-parameters?
+ (label boot-parameters-label)
+ (root-device boot-parameters-root-device)
+ (kernel boot-parameters-kernel)
+ (kernel-arguments boot-parameters-kernel-arguments))
+
+(define (read-boot-parameters port)
+ "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object or #f if the format is unrecognized."
+ (match (read port)
+ (('boot-parameters ('version 0)
+ ('label label) ('root-device root)
+ ('kernel linux)
+ rest ...)
+ (boot-parameters
+ (label label)
+ (root-device root)
+ (kernel linux)
+ (kernel-arguments
+ (match (assq 'kernel-arguments rest)
+ ((_ args) args)
+ (#f '()))))) ;the old format
+ (x ;unsupported format
+ (warning (_ "unrecognized boot parameters for '~a'~%")
+ system)
+ #f)))
+
+
+;;;
;;; Reconfiguration.
;;;
@@ -247,30 +281,22 @@ it atomically, and then run OS's activation script."
"Return a list of 'menu-entry' for the generations of PROFILE."
(define (system->grub-entry system number time)
(unless-file-not-found
- (call-with-input-file (string-append system "/parameters")
- (lambda (port)
- (match (read port)
- (('boot-parameters ('version 0)
- ('label label) ('root-device root)
- ('kernel linux)
- rest ...)
- (menu-entry
- (label (string-append label " (#"
- (number->string number) ", "
- (seconds->string time) ")"))
- (linux linux)
- (linux-arguments
- (cons* (string-append "--root=" root)
- #~(string-append "--system=" #$system)
- #~(string-append "--load=" #$system "/boot")
- (match (assq 'kernel-arguments rest)
- ((_ args) args)
- (#f '())))) ;old format
- (initrd #~(string-append #$system "/initrd"))))
- (_ ;unsupported format
- (warning (_ "unrecognized boot parameters for '~a'~%")
- system)
- #f))))))
+ (let ((file (string-append system "/parameters")))
+ (match (call-with-input-file file read-boot-parameters)
+ (($ <boot-parameters> label root kernel kernel-arguments)
+ (menu-entry
+ (label (string-append label " (#"
+ (number->string number) ", "
+ (seconds->string time) ")"))
+ (linux kernel)
+ (linux-arguments
+ (cons* (string-append "--root=" root)
+ #~(string-append "--system=" #$system)
+ #~(string-append "--load=" #$system "/boot")
+ kernel-arguments))
+ (initrd #~(string-append #$system "/initrd"))))
+ (#f ;invalid format
+ #f)))))
(let* ((numbers (generation-numbers profile))
(systems (map (cut generation-file-name profile <>)