Merge branch 'master' into core-updates

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)