diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-10-26 21:19:42 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-10-27 00:01:20 +0100 |
commit | 5b516ef3696270f21327d9f63a9ccb4f1b83f346 (patch) | |
tree | 56d4e5b199a4d87e5107f28987d33b166adce7d5 | |
parent | ad18c7e64c844350f295a2f79605800a7718ed78 (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.
-rw-r--r-- | guix/scripts/system.scm | 74 |
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 <>) |