From ee2a6304f3bcf19df895310aedff372ed7e17c34 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 17 Jul 2015 01:07:50 +0200
Subject: [PATCH] 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 e4662cbfe1..2f8c52c8b6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4825,6 +4825,10 @@ The package object of the operating system kernel to use@footnote{Currently
 only the Linux-libre kernel is supported.  In the future, it will be
 possible to use the GNU@tie{}Hurd.}.
 
+@item @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 efad14596a..ed37c320f7 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -68,6 +68,7 @@ (define-module (gnu system)
             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 @@ (define-record-type* <operating-system> operating-system
   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 @@ (define* (operating-system-grub.cfg os #:optional (old-entries '()))
                            (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 @@ (define (operating-system-parameters-file os)
                                    (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 2520493e2e..b293009127 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -493,7 +493,8 @@ (define builder
        #~(" -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 6084ab8a37..45f598219d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -249,16 +249,19 @@ (define (system->grub-entry system number time)
            (('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'~%")