Subject: bug#26544: closed (Merged to master: [PATCH v4 *] system: Move "--load" and other guix-specific parameters from the grub module to the generic system module.)

From: [email-masked] (GNU bug Tracking System)
Date: Fri, 05 May 2017 13:36:03 +0000

Your bug report

#26544: [PATCH] system: Move "--load" and other guix-specific parameters from the grub module to the generic system module.

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
26544: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=26544
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Merged to master: [PATCH v4 *] system: Move "--load" and other guix-specific parameters from the grub module to the generic system module.
From: Danny Milosavljevic <[email-masked]>
To: [email-masked]
Date: Fri, 5 May 2017 15:35:03 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

I've merged this patchset to master: [PATCH v4 00/10] system: Move "--load" and other guix-specific parameters from the grub module to the generic system module.

Please make sure to run "make" in guix after pulling.

Subject: [PATCH] system: Move "--load" and other guix-specific parameters from the grub module to the generic system module.
From: Danny Milosavljevic <[email-masked]>
To: [email-masked]
Cc: Danny Milosavljevic <[email-masked]>
Date: Mon, 17 Apr 2017 19:00:30 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

* gnu/system.scm (bootable-kernel-arguments): New variable.
(operating-system-parameters-file): Rename to ...
(operating-system-boot-parameters-file): ... this and split off ...
(operating-system-boot-parameters): ... new variable.
(operating-system-bootcfg): Use operating-system-boot-parameters.
(operating-system-directory-base-entries):
Use operating-system-boot-parameters-file instead of
operating-system-parameters-file.
(operating-system-all-kernel-arguments): New variable. Export it.
(operating-system-kernel-arguments): Remove export.
(read-boot-parameters-file): New variable. Export it.
(read-boot-parameters): Remove export.
* gnu/system/grub.scm (boot-parameters->menu-entry): New variable.
(grub-configuration-file): Use boot-parameters->menu-entry.
* gnu/system/vm.scm (system-qemu-image/shared-store-script): Use
operating-system-all-kernel-arguments.
* guix/scripts/system.scm (profile-grub-entries): Rename to ...
(profile-boot-parameters): ... this and return boot-parameters directly.
(reinstall-grub): Use read-boot-parameters-file.
Use profile-boot-parameters instead of profile-grub-entries.
(display-system-generation): Use read-boot-parameters-file.
Use profile-boot-parameters instead of profile-grub-entries.
---
 gnu/system.scm          | 116 ++++++++++++++++++++++++++++++++----------------
 gnu/system/grub.scm     |  13 +++++-
 gnu/system/vm.scm       |  10 ++---
 guix/scripts/system.scm |  56 +++++++----------------
 4 files changed, 109 insertions(+), 86 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 89c4150f9..f83eb9e58 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -73,7 +73,7 @@
             operating-system-hosts-file
             operating-system-kernel
             operating-system-kernel-file
-            operating-system-kernel-arguments
+            operating-system-all-kernel-arguments
             operating-system-initrd
             operating-system-users
             operating-system-groups
@@ -109,7 +109,7 @@
             boot-parameters-kernel
             boot-parameters-kernel-arguments
             boot-parameters-initrd
-            read-boot-parameters
+            read-boot-parameters-file
 
             local-host-aliases
             %setuid-programs
@@ -122,6 +122,12 @@
 ;;;
 ;;; Code:
 
+(define (bootable-kernel-arguments kernel-arguments system root-device)
+  (cons* (string-append "--root=" root-device)
+         #~(string-append "--system=" #$system)
+         #~(string-append "--load=" #$system "/boot")
+         kernel-arguments))
+
 ;; System-wide configuration.
 ;; TODO: Add per-field docstrings/stexi.
 (define-record-type* <operating-system> operating-system
@@ -182,6 +188,11 @@
   (sudoers-file operating-system-sudoers-file     ; file-like
                 (default %sudoers-specification)))
 
+(define (operating-system-all-kernel-arguments os system root-device)
+  (bootable-kernel-arguments (operating-system-kernel-arguments os)
+                             system
+                             root-device))
+
 
 ;;;
 ;;; Services.
@@ -278,7 +289,7 @@ value of the SYSTEM-SERVICE-TYPE service."
         (mlet %store-monad
             ((kernel  ->  (operating-system-kernel os))
              (initrd      (operating-system-initrd-file os))
-             (params      (operating-system-parameters-file os)))
+             (params      (operating-system-boot-parameters-file os)))
           (return `(("kernel" ,kernel)
                     ("parameters" ,params)
                     ("initrd" ,initrd)
@@ -735,31 +746,13 @@ populate the \"old entries\" menu."
   (mlet* %store-monad
       ((system      (operating-system-derivation os))
        (root-fs ->  (operating-system-root-file-system os))
-       (store-fs -> (operating-system-store-file-system os))
-       (label ->    (kernel->boot-label (operating-system-kernel os)))
-       (kernel ->   (operating-system-kernel-file os))
-       (initrd      (operating-system-initrd-file os))
        (root-device -> (if (eq? 'uuid (file-system-title root-fs))
                            (uuid->string (file-system-device root-fs))
                            (file-system-device root-fs)))
-       (entries ->  (list (menu-entry
-                           (label label)
-
-                           ;; The device where the kernel and initrd live.
-                           (device (fs->boot-device store-fs))
-                           (device-mount-point
-                            (file-system-mount-point store-fs))
-
-                           (linux kernel)
-                           (linux-arguments
-                            (cons* (string-append "--root=" root-device)
-                                   #~(string-append "--system=" #$system)
-                                   #~(string-append "--load=" #$system
-                                                    "/boot")
-                                   (operating-system-kernel-arguments os)))
-                           (initrd initrd)))))
-    (grub-configuration-file (operating-system-bootloader os) entries
-                             #:old-entries old-entries)))
+       (entry (operating-system-boot-parameters os system root-device)))
+    (grub-configuration-file (operating-system-bootloader os)
+                             (list entry)
+                              #:old-entries old-entries)))
 
 (define (fs->boot-device fs)
   "Given FS, a <file-system> object, return a value suitable for use as the
@@ -769,26 +762,51 @@ device in a <menu-entry>."
     ((label) (file-system-device fs))
     (else #f)))
 
-(define (operating-system-parameters-file os)
+(define (operating-system-boot-parameters os system root-device)
+  "Return a monadic <boot-parameters> record that describes the boot parameters of OS.
+SYSTEM is optional.  If given, adds kernel arguments for that system to <boot-parameters>."
+  (mlet* %store-monad
+      ((initrd (operating-system-initrd-file os))
+       (store -> (operating-system-store-file-system os))
+       (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
+               (operating-system-all-kernel-arguments os system root-device)
+               (operating-system-kernel-arguments os)))
+             (initrd initrd)
+             (store-device (fs->boot-device store))
+             (store-mount-point (file-system-mount-point store))))))
+
+(define* (operating-system-boot-parameters-file os #:optional (system #f))
   "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."
-  (mlet %store-monad ((initrd   (operating-system-initrd-file os))
-                      (root ->  (operating-system-root-file-system os))
-                      (store -> (operating-system-store-file-system os))
-                      (label -> (kernel->boot-label
-                                 (operating-system-kernel os))))
+this file is the reconstruction of GRUB menu entries for old configurations.
+SYSTEM 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
+being stored into the \"parameters\" file)."
+  (mlet* %store-monad ( ;(initrd   (operating-system-initrd-file os))
+                       (root ->  (operating-system-root-file-system os))
+                       ;(store -> (operating-system-store-file-system os))
+                       ;(label -> (kernel->boot-label
+                       ;           (operating-system-kernel os)))
+                       (params (operating-system-boot-parameters os system (file-system-device root))))
     (gexp->file "parameters"
                 #~(boot-parameters
                    (version 0)
-                   (label #$label)
-                   (root-device #$(file-system-device root))
-                   (kernel #$(operating-system-kernel-file os))
+                   (label #$(boot-parameters-label params))
+                   (root-device #$(boot-parameters-root-device params))
+                   (kernel #$(boot-parameters-kernel params))
                    (kernel-arguments
-                    #$(operating-system-kernel-arguments os))
-                   (initrd #$initrd)
+                    #$(boot-parameters-kernel-arguments params))
+                   (initrd #$(boot-parameters-initrd params))
                    (store
-                    (device #$(fs->boot-device store))
-                    (mount-point #$(file-system-mount-point store))))
+                    (device #$(boot-parameters-store-device params))
+                    (mount-point #$(boot-parameters-store-mount-point params))))
                 #:set-load-path? #f)))
 
 
@@ -866,4 +884,24 @@ this file is the reconstruction of GRUB menu entries for old configurations."
               system)
      #f)))
 
+(define (read-boot-parameters-file sysgen)
+  "Read boot parameters from SYSGEN's (system or generation) \"parameters\"
+file and returns the corresponding <boot-parameters> object or #f if the
+format is unrecognized.
+The object has its kernel-arguments extended in order to make it bootable."
+  (let* ((file (string-append sysgen "/parameters"))
+         (params (call-with-input-file file read-boot-parameters))
+         (root (boot-parameters-root-device params))
+         (root-device (if (bytevector? root)
+                          (uuid->string root)
+                          root))
+         (kernel-arguments (boot-parameters-kernel-arguments params)))
+    (if params
+      (boot-parameters
+        (inherit params)
+        (kernel-arguments (bootable-kernel-arguments kernel-arguments
+                                                     sysgen
+                                                     root-device)))
+      #f)))
+
 ;;; system.scm ends here
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index cde4b9e23..f2838d633 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -267,6 +267,15 @@ code."
         (#f
          #~(format #f "search --file --set ~a" #$file)))))
 
+(define (boot-parameters->menu-entry conf)
+  (menu-entry
+   (label (boot-parameters-label conf))
+   (device (boot-parameters-store-device conf))
+   (device-mount-point (boot-parameters-store-mount-point conf))
+   (linux (boot-parameters-kernel conf))
+   (linux-arguments (boot-parameters-kernel-arguments conf))
+   (initrd (boot-parameters-initrd conf))))
+
 (define* (grub-configuration-file config entries
                                   #:key
                                   (system (%current-system))
@@ -276,7 +285,7 @@ code."
 <file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
 corresponding to old generations of the system."
   (define all-entries
-    (append entries
+    (append (map boot-parameters->menu-entry entries)
             (grub-configuration-menu-entries config)))
 
   (define entry->gexp
@@ -323,7 +332,7 @@ set timeout=~a~%"
             #$@(if (pair? old-entries)
                    #~((format port "
 submenu \"GNU system, old configurations...\" {~%")
-                      #$@(map entry->gexp old-entries)
+                      #$@(map entry->gexp (map boot-parameters->menu-entry old-entries))
                       (format port "}~%"))
                    #~()))))
 
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 374d8b663..40db61abb 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -490,12 +490,10 @@ it is mostly useful when FULL-BOOT?  is true."
                                 #:full-boot? full-boot?
                                 #:disk-image-size disk-image-size)))
     (define kernel-arguments
-      #~(list "--root=/dev/vda1"
-              (string-append "--system=" #$os-drv)
-              (string-append "--load=" #$os-drv "/boot")
-              #$@(if graphic? #~() #~("console=ttyS0"))
-              #+@(operating-system-kernel-arguments os)))
-
+      #~(list #$@(if graphic? #~() #~("console=ttyS0"))
+              #+@(operating-system-all-kernel-arguments os
+                                                        os-drv
+                                                        "/dev/vda1")))
     (define qemu-exec
       #~(list (string-append #$qemu "/bin/" #$(qemu-command (%current-system)))
               #$@(if full-boot?
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 8fabdb5c1..6a99d1fca 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -370,8 +370,7 @@ NUMBERS, which is a list of generation numbers."
   (define (system->boot-parameters system number time)
     (unless-file-not-found
      (let* ((file             (string-append system "/parameters"))
-            (params           (call-with-input-file file
-                                read-boot-parameters)))
+            (params           (read-boot-parameters-file file)))
        params)))
   (let* ((systems (map (cut generation-file-name profile <>)
                        numbers))
@@ -381,44 +380,26 @@ NUMBERS, which is a list of generation numbers."
                        systems)))
     (filter-map system->boot-parameters systems numbers times)))
 
-(define* (profile-grub-entries #:optional (profile %system-profile)
+(define* (profile-boot-parameters #:optional (profile %system-profile)
                                   (numbers (generation-numbers profile)))
-  "Return a list of 'menu-entry' for the generations of PROFILE specified by
+  "Return a list of 'boot-parameters' for the generations of PROFILE specified by
 NUMBERS, which is a list of generation numbers."
-  (define (system->grub-entry system number time)
+  (define (system->boot-parameters system number time)
     (unless-file-not-found
-     (let* ((file             (string-append system "/parameters"))
-            (params           (call-with-input-file file
-                                read-boot-parameters))
-            (label            (boot-parameters-label params))
-            (root             (boot-parameters-root-device params))
-            (root-device      (if (bytevector? root)
-                                  (uuid->string root)
-                                  root))
-            (kernel           (boot-parameters-kernel params))
-            (kernel-arguments (boot-parameters-kernel-arguments params))
-            (initrd           (boot-parameters-initrd params)))
-       (menu-entry
-        (label (string-append label " (#"
-                              (number->string number) ", "
-                              (seconds->string time) ")"))
-        (device (boot-parameters-store-device params))
-        (device-mount-point (boot-parameters-store-mount-point params))
-        (linux kernel)
-        (linux-arguments
-         (cons* (string-append "--root=" root-device)
-                (string-append "--system=" system)
-                (string-append "--load=" system "/boot")
-                kernel-arguments))
-        (initrd initrd)))))
-
+     (let* ((params           (read-boot-parameters-file system))
+            (label            (boot-parameters-label params)))
+       (boot-parameters
+         (inherit params)
+         (label (string-append label " (#"
+                               (number->string number) ", "
+                               (seconds->string time) ")"))))))
   (let* ((systems (map (cut generation-file-name profile <>)
                        numbers))
          (times   (map (lambda (system)
                          (unless-file-not-found
                           (stat:mtime (lstat system))))
                        systems)))
-    (filter-map system->grub-entry systems numbers times)))
+    (filter-map system->boot-parameters systems numbers times)))
 
 
 ;;;
@@ -447,18 +428,16 @@ generation as its default entry.  STORE is an open connection to the store."
   "Re-install grub for existing system profile generation NUMBER.  STORE is an
 open connection to the store."
   (let* ((generation (generation-file-name %system-profile number))
-         (file (string-append generation "/parameters"))
-         (params (unless-file-not-found
-                  (call-with-input-file file read-boot-parameters)))
+         (params (read-boot-parameters-file generation))
          (root-device (boot-parameters-root-device params))
          ;; We don't currently keep track of past menu entries' details.  The
          ;; default values will allow the system to boot, even if they differ
          ;; from the actual past values for this generation's entry.
          (grub-config (grub-configuration (device root-device)))
          ;; Make the specified system generation the default entry.
-         (entries (profile-grub-entries %system-profile (list number)))
+         (entries (profile-boot-parameters %system-profile (list number)))
          (old-generations (delv number (generation-numbers %system-profile)))
-         (old-entries (profile-grub-entries %system-profile old-generations))
+         (old-entries (profile-boot-parameters %system-profile old-generations))
          (grub.cfg (run-with-store store
                      (grub-configuration-file grub-config
                                               entries
@@ -533,8 +512,7 @@ list of services."
   "Display a summary of system generation NUMBER in a human-readable format."
   (unless (zero? number)
     (let* ((generation  (generation-file-name profile number))
-           (param-file  (string-append generation "/parameters"))
-           (params      (call-with-input-file param-file read-boot-parameters))
+           (params      (read-boot-parameters-file generation))
            (label       (boot-parameters-label params))
            (root        (boot-parameters-root-device params))
            (root-device (if (bytevector? root)
@@ -643,7 +621,7 @@ output when building a system derivation, such as a disk image."
                       (operating-system-bootcfg os
                                                 (if (eq? 'init action)
                                                     '()
-                                                    (profile-grub-entries)))))
+                                                    (profile-boot-parameters)))))
 
        ;; For 'init' and 'reconfigure', always build GRUB.CFG, even if
        ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC