nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2015-10-26 21:19:42 +01:00
parent ad18c7e64c
commit 5b516ef369
1 changed files with 50 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
guix/scripts/system.scm
View File

@ -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)
@ -184,6 +185,39 @@ the ownership of '~a' may be incorrect!~%")
(mwhen grub?
(install-grub* grub.cfg device target)))))
;;;
;;; 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 <>)