diff options
Diffstat (limited to 'gnu/system.scm')
| -rw-r--r-- | gnu/system.scm | 165 |
1 files changed, 82 insertions, 83 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 99bc09873d..a5a8f40d66 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -127,23 +127,21 @@ ;;; ;;; Code: -(define (bootable-kernel-arguments kernel-arguments system.drv root-device) - "Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be -booted from ROOT-DEVICE" - (cons* (string-append "--root=" - (cond ((uuid? root-device) - - ;; Note: Always use the DCE format because that's - ;; what (gnu build linux-boot) expects for the - ;; '--root' kernel command-line option. - (uuid->string (uuid-bytevector root-device) - 'dce)) - ((file-system-label? root-device) - (file-system-label->string root-device)) - (else root-device))) - #~(string-append "--system=" #$system.drv) - #~(string-append "--load=" #$system.drv "/boot") - kernel-arguments)) +(define (bootable-kernel-arguments system root-device) + "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE." + (list (string-append "--root=" + (cond ((uuid? root-device) + + ;; Note: Always use the DCE format because that's + ;; what (gnu build linux-boot) expects for the + ;; '--root' kernel command-line option. + (uuid->string (uuid-bytevector root-device) + 'dce)) + ((file-system-label? root-device) + (file-system-label->string root-device)) + (else root-device))) + #~(string-append "--system=" #$system) + #~(string-append "--load=" #$system "/boot"))) ;; System-wide configuration. ;; TODO: Add per-field docstrings/stexi. @@ -156,7 +154,7 @@ booted from ROOT-DEVICE" (default '())) ; list of gexps/strings (bootloader operating-system-bootloader) ; <bootloader-configuration> - (initrd operating-system-initrd ; (list fs) -> M derivation + (initrd operating-system-initrd ; (list fs) -> file-like (default base-initrd)) (initrd-modules operating-system-initrd-modules ; list of strings (thunked) ; it's system-dependent @@ -209,12 +207,11 @@ booted from ROOT-DEVICE" (sudoers-file operating-system-sudoers-file ; file-like (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 directly by the user." - (bootable-kernel-arguments (operating-system-user-kernel-arguments os) - system.drv - root-device)) + (append (bootable-kernel-arguments os root-device) + (operating-system-user-kernel-arguments os))) ;;; @@ -328,14 +325,11 @@ format is unrecognized. The object has its kernel-arguments extended in order to make it bootable." (let* ((file (string-append system "/parameters")) (params (call-with-input-file file read-boot-parameters)) - (root (boot-parameters-root-device params)) - (kernel-arguments (boot-parameters-kernel-arguments params))) - (if params - (boot-parameters - (inherit params) - (kernel-arguments (bootable-kernel-arguments kernel-arguments - system root))) - #f))) + (root (boot-parameters-root-device params))) + (boot-parameters + (inherit params) + (kernel-arguments (append (bootable-kernel-arguments system root) + (boot-parameters-kernel-arguments params)))))) (define (boot-parameters->menu-entry conf) (menu-entry @@ -448,7 +442,7 @@ value of the SYSTEM-SERVICE-TYPE service." (return `(("locale" ,locale))) (mlet %store-monad ((kernel -> (operating-system-kernel os)) - (initrd (operating-system-initrd-file os)) + (initrd -> (operating-system-initrd-file os)) (params (operating-system-boot-parameters-file os))) (return `(("kernel" ,kernel) ("parameters" ,params) @@ -876,12 +870,11 @@ hardware-related operations as necessary when booting a Linux container." (define make-initrd (operating-system-initrd os)) - (mlet %store-monad ((initrd (make-initrd boot-file-systems - #:linux (operating-system-kernel os) - #:linux-modules - (operating-system-initrd-modules os) - #:mapped-devices mapped-devices))) - (return (file-append initrd "/initrd")))) + (make-initrd boot-file-systems + #:linux (operating-system-kernel os) + #:linux-modules + (operating-system-initrd-modules os) + #:mapped-devices mapped-devices)) (define (locale-name->definition* name) "Variant of 'locale-name->definition' that raises an error upon failure." @@ -939,42 +932,45 @@ listed in OS. The C library expects to find it under (store-file-system (operating-system-file-systems os))) (define* (operating-system-bootcfg os #:optional (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." - (mlet* %store-monad - ((system (operating-system-derivation os)) - (root-fs -> (operating-system-root-file-system os)) - (root-device -> (file-system-device root-fs)) - (params (operating-system-boot-parameters os system root-device)) - (entry -> (boot-parameters->menu-entry params)) - (bootloader-conf -> (operating-system-bootloader os))) - ((bootloader-configuration-file-generator - (bootloader-configuration-bootloader bootloader-conf)) - bootloader-conf (list entry) #:old-entries old-entries))) - -(define (operating-system-boot-parameters os system.drv root-device) - "Return a monadic <boot-parameters> record that describes the boot parameters -of OS. SYSTEM.DRV is either a derivation or #f. If it's a derivation, adds -kernel arguments for that derivation to <boot-parameters>." - (mlet* %store-monad - ((initrd (operating-system-initrd-file os)) - (store -> (operating-system-store-file-system os)) - (bootloader -> (bootloader-configuration-bootloader - (operating-system-bootloader os))) - (bootloader-name -> (bootloader-name bootloader)) - (label -> (kernel->boot-label (operating-system-kernel os)))) - (return (boot-parameters - (label label) - (root-device root-device) - (kernel (operating-system-kernel-file os)) - (kernel-arguments - (if system.drv - (operating-system-kernel-arguments os system.drv root-device) - (operating-system-user-kernel-arguments os))) - (initrd initrd) - (bootloader-name bootloader-name) - (store-device (ensure-not-/dev (file-system-device store))) - (store-mount-point (file-system-mount-point store)))))) + "Return the bootloader configuration file for OS. Use OLD-ENTRIES, +a list of <menu-entry>, to populate the \"old entries\" menu." + (let* ((root-fs (operating-system-root-file-system os)) + (root-device (file-system-device root-fs)) + (params (operating-system-boot-parameters + os root-device + #:system-kernel-arguments? #t)) + (entry (boot-parameters->menu-entry params)) + (bootloader-conf (operating-system-bootloader os))) + (define generate-config-file + (bootloader-configuration-file-generator + (bootloader-configuration-bootloader bootloader-conf))) + + (generate-config-file bootloader-conf (list entry) + #:old-entries old-entries))) + +(define* (operating-system-boot-parameters os root-device + #:key system-kernel-arguments?) + "Return a monadic <boot-parameters> record that describes the boot +parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments +such as '--root' and '--load' to <boot-parameters>." + (let* ((initrd (operating-system-initrd-file os)) + (store (operating-system-store-file-system os)) + (bootloader (bootloader-configuration-bootloader + (operating-system-bootloader os))) + (bootloader-name (bootloader-name bootloader)) + (label (kernel->boot-label (operating-system-kernel os)))) + (boot-parameters + (label label) + (root-device root-device) + (kernel (operating-system-kernel-file os)) + (kernel-arguments + (if system-kernel-arguments? + (operating-system-kernel-arguments os root-device) + (operating-system-user-kernel-arguments os))) + (initrd initrd) + (bootloader-name bootloader-name) + (store-device (ensure-not-/dev (file-system-device store))) + (store-mount-point (file-system-mount-point store))))) (define (device->sexp device) "Serialize DEVICE as an sexp (really, as an object with a read syntax.)" @@ -986,19 +982,22 @@ kernel arguments for that derivation to <boot-parameters>." (_ 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 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 -content-addressed \"system\" directory, it's usually not a good idea -to give it because the content hash would change by the content hash + +When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments such as '--root' +and '--load' to the returned file (since the returned file is then usually +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)." - (mlet* %store-monad ((root -> (operating-system-root-file-system os)) - (device -> (file-system-device root)) - (params (operating-system-boot-parameters os - system.drv - device))) + (let* ((root (operating-system-root-file-system os)) + (device (file-system-device root)) + (params (operating-system-boot-parameters + os device + #:system-kernel-arguments? + system-kernel-arguments?))) (gexp->file "parameters" #~(boot-parameters (version 0) |