mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
system: Simplify kernel argument handling.
* gnu/system.scm (bootable-kernel-arguments): Remove 'kernel-arguments' parameter and return only the base list of kernel arguments. Rename 'system.drv' to 'system'. (operating-system-kernel-arguments): Adjust accordingly and remove 'system.drv' parameter. (read-boot-parameters-file): Adjust accordingly. Remove 'if params' since dominating code assumed PARAMS is always true. (operating-system-boot-parameters): Remove 'system.drv' parameter; add #:system-kernel-arguments? instead and honor it. (operating-system-bootcfg): Adjust accordingly. (operating-system-boot-parameters-file): Likewise. * gnu/system/vm.scm (system-qemu-image/shared-store-script): Remove 'os-drv' variable. Adjust call to 'operating-system-kernel-arguments'.
This commit is contained in:
parent
46c296dcc4
commit
a7ef45d9de
2 changed files with 47 additions and 49 deletions
|
@ -127,23 +127,21 @@ (define-module (gnu system)
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define (bootable-kernel-arguments kernel-arguments system.drv root-device)
|
(define (bootable-kernel-arguments system root-device)
|
||||||
"Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be
|
"Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE."
|
||||||
booted from ROOT-DEVICE"
|
(list (string-append "--root="
|
||||||
(cons* (string-append "--root="
|
(cond ((uuid? root-device)
|
||||||
(cond ((uuid? root-device)
|
|
||||||
|
|
||||||
;; Note: Always use the DCE format because that's
|
;; Note: Always use the DCE format because that's
|
||||||
;; what (gnu build linux-boot) expects for the
|
;; what (gnu build linux-boot) expects for the
|
||||||
;; '--root' kernel command-line option.
|
;; '--root' kernel command-line option.
|
||||||
(uuid->string (uuid-bytevector root-device)
|
(uuid->string (uuid-bytevector root-device)
|
||||||
'dce))
|
'dce))
|
||||||
((file-system-label? root-device)
|
((file-system-label? root-device)
|
||||||
(file-system-label->string root-device))
|
(file-system-label->string root-device))
|
||||||
(else root-device)))
|
(else root-device)))
|
||||||
#~(string-append "--system=" #$system.drv)
|
#~(string-append "--system=" #$system)
|
||||||
#~(string-append "--load=" #$system.drv "/boot")
|
#~(string-append "--load=" #$system "/boot")))
|
||||||
kernel-arguments))
|
|
||||||
|
|
||||||
;; System-wide configuration.
|
;; System-wide configuration.
|
||||||
;; TODO: Add per-field docstrings/stexi.
|
;; TODO: Add per-field docstrings/stexi.
|
||||||
|
@ -209,12 +207,11 @@ (define-record-type* <operating-system> operating-system
|
||||||
(sudoers-file operating-system-sudoers-file ; file-like
|
(sudoers-file operating-system-sudoers-file ; file-like
|
||||||
(default %sudoers-specification)))
|
(default %sudoers-specification)))
|
||||||
|
|
||||||
(define (operating-system-kernel-arguments os system.drv root-device)
|
(define (operating-system-kernel-arguments os root-device)
|
||||||
"Return all the kernel arguments, including the ones not specified
|
"Return all the kernel arguments, including the ones not specified
|
||||||
directly by the user."
|
directly by the user."
|
||||||
(bootable-kernel-arguments (operating-system-user-kernel-arguments os)
|
(append (bootable-kernel-arguments os root-device)
|
||||||
system.drv
|
(operating-system-user-kernel-arguments os)))
|
||||||
root-device))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -328,14 +325,11 @@ (define (read-boot-parameters-file system)
|
||||||
The object has its kernel-arguments extended in order to make it bootable."
|
The object has its kernel-arguments extended in order to make it bootable."
|
||||||
(let* ((file (string-append system "/parameters"))
|
(let* ((file (string-append system "/parameters"))
|
||||||
(params (call-with-input-file file read-boot-parameters))
|
(params (call-with-input-file file read-boot-parameters))
|
||||||
(root (boot-parameters-root-device params))
|
(root (boot-parameters-root-device params)))
|
||||||
(kernel-arguments (boot-parameters-kernel-arguments params)))
|
(boot-parameters
|
||||||
(if params
|
(inherit params)
|
||||||
(boot-parameters
|
(kernel-arguments (append (bootable-kernel-arguments system root)
|
||||||
(inherit params)
|
(boot-parameters-kernel-arguments params))))))
|
||||||
(kernel-arguments (bootable-kernel-arguments kernel-arguments
|
|
||||||
system root)))
|
|
||||||
#f)))
|
|
||||||
|
|
||||||
(define (boot-parameters->menu-entry conf)
|
(define (boot-parameters->menu-entry conf)
|
||||||
(menu-entry
|
(menu-entry
|
||||||
|
@ -942,10 +936,11 @@ (define* (operating-system-bootcfg os #:optional (old-entries '()))
|
||||||
"Return the bootloader configuration file for OS. Use OLD-ENTRIES
|
"Return the bootloader configuration file for OS. Use OLD-ENTRIES
|
||||||
(which is a list of <menu-entry>) to populate the \"old entries\" menu."
|
(which is a list of <menu-entry>) to populate the \"old entries\" menu."
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((system (operating-system-derivation os))
|
((root-fs -> (operating-system-root-file-system os))
|
||||||
(root-fs -> (operating-system-root-file-system os))
|
|
||||||
(root-device -> (file-system-device root-fs))
|
(root-device -> (file-system-device root-fs))
|
||||||
(params (operating-system-boot-parameters os system root-device))
|
(params (operating-system-boot-parameters os root-device
|
||||||
|
#:system-kernel-arguments?
|
||||||
|
#t))
|
||||||
(entry -> (boot-parameters->menu-entry params))
|
(entry -> (boot-parameters->menu-entry params))
|
||||||
(bootloader-conf -> (operating-system-bootloader os)))
|
(bootloader-conf -> (operating-system-bootloader os)))
|
||||||
(define generate-config-file
|
(define generate-config-file
|
||||||
|
@ -956,10 +951,11 @@ (define generate-config-file
|
||||||
(lower-object (generate-config-file bootloader-conf (list entry)
|
(lower-object (generate-config-file bootloader-conf (list entry)
|
||||||
#:old-entries old-entries))))
|
#:old-entries old-entries))))
|
||||||
|
|
||||||
(define (operating-system-boot-parameters os system.drv root-device)
|
(define* (operating-system-boot-parameters os root-device
|
||||||
"Return a monadic <boot-parameters> record that describes the boot parameters
|
#:key system-kernel-arguments?)
|
||||||
of OS. SYSTEM.DRV is either a derivation or #f. If it's a derivation, adds
|
"Return a monadic <boot-parameters> record that describes the boot
|
||||||
kernel arguments for that derivation to <boot-parameters>."
|
parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments
|
||||||
|
such as '--root' and '--load' to <boot-parameters>."
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((initrd (operating-system-initrd-file os))
|
((initrd (operating-system-initrd-file os))
|
||||||
(store -> (operating-system-store-file-system os))
|
(store -> (operating-system-store-file-system os))
|
||||||
|
@ -972,9 +968,9 @@ (define (operating-system-boot-parameters os system.drv root-device)
|
||||||
(root-device root-device)
|
(root-device root-device)
|
||||||
(kernel (operating-system-kernel-file os))
|
(kernel (operating-system-kernel-file os))
|
||||||
(kernel-arguments
|
(kernel-arguments
|
||||||
(if system.drv
|
(if system-kernel-arguments?
|
||||||
(operating-system-kernel-arguments os system.drv root-device)
|
(operating-system-kernel-arguments os root-device)
|
||||||
(operating-system-user-kernel-arguments os)))
|
(operating-system-user-kernel-arguments os)))
|
||||||
(initrd initrd)
|
(initrd initrd)
|
||||||
(bootloader-name bootloader-name)
|
(bootloader-name bootloader-name)
|
||||||
(store-device (ensure-not-/dev (file-system-device store)))
|
(store-device (ensure-not-/dev (file-system-device store)))
|
||||||
|
@ -990,19 +986,22 @@ (define (device->sexp device)
|
||||||
(_
|
(_
|
||||||
device)))
|
device)))
|
||||||
|
|
||||||
(define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
|
(define* (operating-system-boot-parameters-file os
|
||||||
|
#:key system-kernel-arguments?)
|
||||||
"Return a file that describes the boot parameters of OS. The primary use of
|
"Return a file that describes the boot parameters of OS. The primary use of
|
||||||
this file is the reconstruction of GRUB menu entries for old configurations.
|
this file is the reconstruction of GRUB menu entries for old configurations.
|
||||||
SYSTEM.DRV is optional. If given, adds kernel arguments for that system to the
|
|
||||||
returned file (since the returned file is then usually stored into the
|
When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments such as '--root'
|
||||||
content-addressed \"system\" directory, it's usually not a good idea
|
and '--load' to the returned file (since the returned file is then usually
|
||||||
to give it because the content hash would change by the content hash
|
stored into the content-addressed \"system\" directory, it's usually not a
|
||||||
|
good idea to give it because the content hash would change by the content hash
|
||||||
being stored into the \"parameters\" file)."
|
being stored into the \"parameters\" file)."
|
||||||
(mlet* %store-monad ((root -> (operating-system-root-file-system os))
|
(mlet* %store-monad ((root -> (operating-system-root-file-system os))
|
||||||
(device -> (file-system-device root))
|
(device -> (file-system-device root))
|
||||||
(params (operating-system-boot-parameters os
|
(params (operating-system-boot-parameters
|
||||||
system.drv
|
os device
|
||||||
device)))
|
#:system-kernel-arguments?
|
||||||
|
system-kernel-arguments?)))
|
||||||
(gexp->file "parameters"
|
(gexp->file "parameters"
|
||||||
#~(boot-parameters
|
#~(boot-parameters
|
||||||
(version 0)
|
(version 0)
|
||||||
|
|
|
@ -897,21 +897,20 @@ (define* (system-qemu-image/shared-store-script os
|
||||||
DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image;
|
DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image;
|
||||||
it is mostly useful when FULL-BOOT? is true."
|
it is mostly useful when FULL-BOOT? is true."
|
||||||
(mlet* %store-monad ((os -> (virtualized-operating-system os mappings full-boot?))
|
(mlet* %store-monad ((os -> (virtualized-operating-system os mappings full-boot?))
|
||||||
(os-drv (operating-system-derivation os))
|
|
||||||
(image (system-qemu-image/shared-store
|
(image (system-qemu-image/shared-store
|
||||||
os
|
os
|
||||||
#:full-boot? full-boot?
|
#:full-boot? full-boot?
|
||||||
#:disk-image-size disk-image-size)))
|
#:disk-image-size disk-image-size)))
|
||||||
(define kernel-arguments
|
(define kernel-arguments
|
||||||
#~(list #$@(if graphic? #~() #~("console=ttyS0"))
|
#~(list #$@(if graphic? #~() #~("console=ttyS0"))
|
||||||
#+@(operating-system-kernel-arguments os os-drv "/dev/vda1")))
|
#+@(operating-system-kernel-arguments os "/dev/vda1")))
|
||||||
|
|
||||||
(define qemu-exec
|
(define qemu-exec
|
||||||
#~(list (string-append #$qemu "/bin/" #$(qemu-command (%current-system)))
|
#~(list (string-append #$qemu "/bin/" #$(qemu-command (%current-system)))
|
||||||
#$@(if full-boot?
|
#$@(if full-boot?
|
||||||
#~()
|
#~()
|
||||||
#~("-kernel" #$(operating-system-kernel-file os)
|
#~("-kernel" #$(operating-system-kernel-file os)
|
||||||
"-initrd" #$(file-append os-drv "/initrd")
|
"-initrd" #$(file-append os "/initrd")
|
||||||
(format #f "-append ~s"
|
(format #f "-append ~s"
|
||||||
(string-join #$kernel-arguments " "))))
|
(string-join #$kernel-arguments " "))))
|
||||||
#$@(common-qemu-options image
|
#$@(common-qemu-options image
|
||||||
|
|
Loading…
Reference in a new issue