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

56
guix/scripts/system.scm
View File

@ -25,6 +25,7 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix scripts build) #:use-module (guix scripts build)
@ -184,6 +185,39 @@ the ownership of '~a' may be incorrect!~%")
(mwhen grub? (mwhen grub?
(install-grub* grub.cfg device target))))) (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. ;;; 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." "Return a list of 'menu-entry' for the generations of PROFILE."
(define (system->grub-entry system number time) (define (system->grub-entry system number time)
(unless-file-not-found (unless-file-not-found
(call-with-input-file (string-append system "/parameters") (let ((file (string-append system "/parameters")))
(lambda (port) (match (call-with-input-file file read-boot-parameters)
(match (read port) (($ <boot-parameters> label root kernel kernel-arguments)
(('boot-parameters ('version 0)
('label label) ('root-device root)
('kernel linux)
rest ...)
(menu-entry (menu-entry
(label (string-append label " (#" (label (string-append label " (#"
(number->string number) ", " (number->string number) ", "
(seconds->string time) ")")) (seconds->string time) ")"))
(linux linux) (linux kernel)
(linux-arguments (linux-arguments
(cons* (string-append "--root=" root) (cons* (string-append "--root=" root)
#~(string-append "--system=" #$system) #~(string-append "--system=" #$system)
#~(string-append "--load=" #$system "/boot") #~(string-append "--load=" #$system "/boot")
(match (assq 'kernel-arguments rest) kernel-arguments))
((_ args) args)
(#f '())))) ;old format
(initrd #~(string-append #$system "/initrd")))) (initrd #~(string-append #$system "/initrd"))))
(_ ;unsupported format (#f ;invalid format
(warning (_ "unrecognized boot parameters for '~a'~%") #f)))))
system)
#f))))))
(let* ((numbers (generation-numbers profile)) (let* ((numbers (generation-numbers profile))
(systems (map (cut generation-file-name profile <>) (systems (map (cut generation-file-name profile <>)