ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

system: Simplify kernel argument handling.

Browse source 
* 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:
Ludovic Courtès 2018-11-15 14:36:16 +01:00
parent 46c296dcc4
commit a7ef45d9de
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 47 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
gnu/system.scm
View file

@ -127,10 +127,9 @@ (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
@ -141,9 +140,8 @@ (define (bootable-kernel-arguments kernel-arguments system.drv root-device)
((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)))
(if params
(boot-parameters (boot-parameters
(inherit params) (inherit params)
(kernel-arguments (bootable-kernel-arguments kernel-arguments (kernel-arguments (append (bootable-kernel-arguments system root)
system root))) (boot-parameters-kernel-arguments params))))))
#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,8 +968,8 @@ (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)
@ -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)

5
gnu/system/vm.scm
View file

@ -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