02/02: system: Add 'kernel-arguments' field.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit ee2a6304f3bcf19df895310aedff372ed7e17c34
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jul 17 01:07:50 2015 +0200

    system: Add 'kernel-arguments' field.
    
    * gnu/system.scm (<operating-system>)[kernel-arguments]: New field.
      (operating-system-grub.cfg): Honor it.
      (operating-system-parameters-file): Add 'kernel-arguments' to the 
parameters
      file.
    * guix/scripts/system.scm (previous-grub-entries)[system->grub-entry]: Read
      the 'kernel-arguments' field of the parameters file, when available.
    * gnu/system/vm.scm (system-qemu-image/shared-store-script):
      Use (operating-system-kernel-arguments os) in '-append'.
    * doc/guix.texi (operating-system Reference): Document it.
---
 doc/guix.texi           |    4 ++++
 gnu/system.scm          |   16 +++++++++++-----
 gnu/system/vm.scm       |    3 ++-
 guix/scripts/system.scm |   11 +++++++----
 4 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index e4662cb..2f8c52c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4825,6 +4825,10 @@ The package object of the operating system kernel to 
address@hidden
 only the Linux-libre kernel is supported.  In the future, it will be
 possible to use the address@hidden
 
address@hidden @code{kernel-arguments} (default: @code{'()})
+List of strings or gexps representing additional arguments to pass on
+the kernel's command-line---e.g., @code{("console=ttyS0")}.
+
 @item @code{bootloader}
 The system bootloader configuration object.  @xref{GRUB Configuration}.
 
diff --git a/gnu/system.scm b/gnu/system.scm
index efad145..ed37c32 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -68,6 +68,7 @@
             operating-system-host-name
             operating-system-hosts-file
             operating-system-kernel
+            operating-system-kernel-arguments
             operating-system-initrd
             operating-system-users
             operating-system-groups
@@ -103,6 +104,8 @@
   operating-system?
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
+  (kernel-arguments operating-system-kernel-arguments
+                    (default '()))                ; list of gexps/strings
   (bootloader operating-system-bootloader)        ; <grub-configuration>
 
   (initrd operating-system-initrd                 ; (list fs) -> M derivation
@@ -866,11 +869,12 @@ listed in OS.  The C library expects to find it under
                            (label (kernel->grub-label kernel))
                            (linux kernel)
                            (linux-arguments
-                            (list (string-append "--root="
-                                                 (file-system-device root-fs))
-                                  #~(string-append "--system=" #$system)
-                                  #~(string-append "--load=" #$system
-                                                   "/boot")))
+                            (cons* (string-append "--root="
+                                                  (file-system-device root-fs))
+                                   #~(string-append "--system=" #$system)
+                                   #~(string-append "--load=" #$system
+                                                    "/boot")
+                                   (operating-system-kernel-arguments os)))
                            (initrd #~(string-append #$system "/initrd"))))))
     (grub-configuration-file (operating-system-bootloader os) entries
                              #:old-entries old-entries)))
@@ -887,6 +891,8 @@ this file is the reconstruction of GRUB menu entries for 
old configurations."
                                    (label #$label)
                                    (root-device #$(file-system-device root))
                                    (kernel #$(operating-system-kernel os))
+                                   (kernel-arguments
+                                    #$(operating-system-kernel-arguments os))
                                    (initrd #$initrd)))))
 
 (define (operating-system-derivation os)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 2520493..b293009 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -493,7 +493,8 @@ exec " #$qemu "/bin/" #$(qemu-command (%current-system))
        #~(" -kernel " #$(operating-system-kernel os) "/bzImage \
             -initrd " #$os-drv "/initrd \
             -append \"" #$(if graphic? "" "console=ttyS0 ")
-            "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" 
"))
+            "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1 "
+            (string-join (list #+@(operating-system-kernel-arguments os))) "\" 
"))
 #$(common-qemu-options image
                        (map file-system-mapping-source
                             (cons %store-mapping mappings)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 6084ab8..45f5982 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -249,16 +249,19 @@ it atomically, and then run OS's activation script."
            (('boot-parameters ('version 0)
                               ('label label) ('root-device root)
                               ('kernel linux)
-                              _ ...)
+                              rest ...)
             (menu-entry
              (label (string-append label " (#"
                                    (number->string number) ", "
                                    (seconds->string time) ")"))
              (linux linux)
              (linux-arguments
-              (list (string-append "--root=" root)
-                    #~(string-append "--system=" #$system)
-                    #~(string-append "--load=" #$system "/boot")))
+              (cons* (string-append "--root=" root)
+                     #~(string-append "--system=" #$system)
+                     #~(string-append "--load=" #$system "/boot")
+                     (match (assq 'kernel-arguments rest)
+                       ((_ args) args)
+                       (#f       '()))))          ;old format
              (initrd #~(string-append #$system "/initrd"))))
            (_                                     ;unsupported format
             (warning (_ "unrecognized boot parameters for '~a'~%")