Merge branch 'master' into core-updates

1 files changed, 60 insertions, 49 deletions

diff --git a/gnu/system.scm b/gnu/system.scm
index 6bccdaa8c2..0489b9720d 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
@@ -34,6 +34,7 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages guile)
+  #:use-module (gnu packages guile-xyz)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages pciutils)
@@ -66,9 +67,11 @@
   #:use-module (rnrs bytevectors)
   #:export (operating-system
             operating-system?
+            this-operating-system
 
             operating-system-bootloader
             operating-system-services
+            operating-system-essential-services
             operating-system-user-services
             operating-system-packages
             operating-system-host-name
@@ -76,6 +79,8 @@
             operating-system-kernel
             operating-system-kernel-file
             operating-system-kernel-arguments
+            operating-system-label
+            operating-system-default-label
             operating-system-initrd-modules
             operating-system-initrd
             operating-system-users
@@ -151,12 +156,19 @@
 (define-record-type* <operating-system> operating-system
   make-operating-system
   operating-system?
+  this-operating-system
+
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
   (kernel-arguments operating-system-user-kernel-arguments
-                    (default '()))                ; list of gexps/strings
+                    (default '("quiet")))         ; list of gexps/strings
   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
+  (label operating-system-label                   ; string
+         (thunked)
+         (default (operating-system-default-label this-operating-system)))
 
+  (keyboard-layout operating-system-keyboard-layout ;#f | <keyboard-layout>
+                   (default #f))
   (initrd operating-system-initrd                 ; (list fs) -> file-like
           (default base-initrd))
   (initrd-modules operating-system-initrd-modules ; list of strings
@@ -199,6 +211,9 @@
   (name-service-switch operating-system-name-service-switch ; <name-service-switch>
                        (default %default-nss))
 
+  (essential-services operating-system-essential-services ; list of services
+                      (thunked)
+                      (default (essential-services this-operating-system)))
   (services operating-system-user-services        ; list of services
             (default %base-services))
 
@@ -436,27 +451,22 @@ OS."
   (file-append (operating-system-kernel os)
                "/" (system-linux-image-file-name os)))
 
-(define* (operating-system-directory-base-entries os #:key container?)
+(define* (operating-system-directory-base-entries os)
   "Return the basic entries of the 'system' directory of OS for use as the
 value of the SYSTEM-SERVICE-TYPE service."
   (let ((locale (operating-system-locale-directory os)))
-    (with-monad %store-monad
-      (if container?
-          (return `(("locale" ,locale)))
-          (mlet %store-monad
-              ((kernel  ->  (operating-system-kernel os))
-               (initrd  ->  (operating-system-initrd-file os))
-               (params      (operating-system-boot-parameters-file os)))
-            (return `(("kernel" ,kernel)
-                      ("parameters" ,params)
-                      ("initrd" ,initrd)
-                      ("locale" ,locale))))))))   ;used by libc
-
-(define* (essential-services os #:key container?)
+    (mlet %store-monad ((kernel -> (operating-system-kernel os))
+                        (initrd -> (operating-system-initrd-file os))
+                        (params    (operating-system-boot-parameters-file os)))
+      (return `(("kernel" ,kernel)
+                ("parameters" ,params)
+                ("initrd" ,initrd)
+                ("locale" ,locale))))))   ;used by libc
+
+(define* (essential-services os)
   "Return the list of essential services for OS.  These are special services
 that implement part of what's declared in OS are responsible for low-level
-bookkeeping.  CONTAINER? determines whether to return the list of services for
-a container or that of a \"bare metal\" system."
+bookkeeping."
   (define known-fs
     (map file-system-mount-point (operating-system-file-systems os)))
 
@@ -466,8 +476,7 @@ a container or that of a \"bare metal\" system."
          (swaps     (swap-services os))
          (procs     (service user-processes-service-type))
          (host-name (host-name-service (operating-system-host-name os)))
-         (entries   (operating-system-directory-base-entries
-                     os #:container? container?)))
+         (entries   (operating-system-directory-base-entries os)))
     (cons* (service system-service-type entries)
            %boot-service
 
@@ -484,7 +493,9 @@ a container or that of a \"bare metal\" system."
                                     (operating-system-groups os))
                             (operating-system-skeletons os))
            (operating-system-etc-service os)
-           (service fstab-service-type '())
+           (service fstab-service-type
+                    (filter file-system-needed-for-boot?
+                            (operating-system-file-systems os)))
            (session-environment-service
             (operating-system-environment-variables os))
            host-name procs root-fs
@@ -495,20 +506,16 @@ a container or that of a \"bare metal\" system."
            other-fs
            (append mappings swaps
 
-                   ;; Add the firmware service, unless we are building for a
-                   ;; container.
-                   (if container?
-                       (list %containerized-shepherd-service)
-                       (list %linux-bare-metal-service
-                             (service firmware-service-type
-                                      (operating-system-firmware os))))))))
-
-(define* (operating-system-services os #:key container?)
-  "Return all the services of OS, including \"internal\" services that do not
-explicitly appear in OS."
+                   ;; Add the firmware service.
+                   (list %linux-bare-metal-service
+                         (service firmware-service-type
+                                  (operating-system-firmware os)))))))
+
+(define* (operating-system-services os)
+  "Return all the services of OS, including \"essential\" services."
   (instantiate-missing-services
    (append (operating-system-user-services os)
-           (essential-services os #:container? container?))))
+           (operating-system-essential-services os))))
 
 
 ;;;
@@ -556,6 +563,7 @@ explicitly appear in OS."
          ;; variant propagated by 'guile-final' and the GMP variant propagated
          ;; by 'gnutls', itself propagated by 'guix'.
          guile-2.2
+         guile-readline guile-colorized
 
          ;; The packages below are also in %FINAL-INPUTS, so take them from
          ;; there to avoid duplication.
@@ -806,20 +814,19 @@ use 'plain-file' instead~%")
 root ALL=(ALL) ALL
 %wheel ALL=(ALL) ALL\n"))
 
-(define* (operating-system-activation-script os #:key container?)
+(define* (operating-system-activation-script os)
   "Return the activation script for OS---i.e., the code that \"activates\" the
 stateful part of OS, including user accounts and groups, special directories,
 etc."
-  (let* ((services   (operating-system-services os #:container? container?))
+  (let* ((services   (operating-system-services os))
          (activation (fold-services services
                                     #:target-type activation-service-type)))
     (activation-service->script activation)))
 
-(define* (operating-system-boot-script os #:key container?)
+(define* (operating-system-boot-script os)
   "Return the boot script for OS---i.e., the code started by the initrd once
-we're running in the final root.  When CONTAINER? is true, skip all
-hardware-related operations as necessary when booting a Linux container."
-  (let* ((services (operating-system-services os #:container? container?))
+we're running in the final root."
+  (let* ((services (operating-system-services os))
          (boot     (fold-services services #:target-type boot-service-type)))
     (service-value boot)))
 
@@ -839,17 +846,17 @@ hardware-related operations as necessary when booting a Linux container."
                               #:target-type
                               shepherd-root-service-type))))
 
-(define* (operating-system-derivation os #:key container?)
+(define* (operating-system-derivation os)
   "Return a derivation that builds OS."
-  (let* ((services (operating-system-services os #:container? container?))
+  (let* ((services (operating-system-services os))
          (system   (fold-services services)))
     ;; SYSTEM contains the derivation as a monadic value.
     (service-value system)))
 
-(define* (operating-system-profile os #:key container?)
+(define* (operating-system-profile os)
   "Return a derivation that builds the system profile of OS."
   (mlet* %store-monad
-      ((services -> (operating-system-services os #:container? container?))
+      ((services -> (operating-system-services os))
        (profile (fold-services services
                                #:target-type profile-service-type)))
     (match profile
@@ -878,7 +885,8 @@ hardware-related operations as necessary when booting a Linux container."
                #:linux (operating-system-kernel os)
                #:linux-modules
                (operating-system-initrd-modules os)
-               #:mapped-devices mapped-devices))
+               #:mapped-devices mapped-devices
+               #:keyboard-layout (operating-system-keyboard-layout os)))
 
 (define (locale-name->definition* name)
   "Variant of 'locale-name->definition' that raises an error upon failure."
@@ -912,15 +920,18 @@ listed in OS.  The C library expects to find it under
   (cond ((package? kernel)
          (string-append "GNU with "
                         (string-titlecase (package-name kernel)) " "
-                        (package-version kernel)
-                        " (beta)"))
+                        (package-version kernel)))
         ((inferior-package? kernel)
          (string-append "GNU with "
                         (string-titlecase (inferior-package-name kernel)) " "
-                        (inferior-package-version kernel)
-                        " (beta)"))
+                        (inferior-package-version kernel)))
         (else "GNU")))
 
+(define (operating-system-default-label os)
+  "Return the default label for OS, as it will appear in the bootloader menu
+entry."
+  (kernel->boot-label (operating-system-kernel os)))
+
 (define (store-file-system file-systems)
   "Return the file system object among FILE-SYSTEMS that contains the store."
   (match (filter (lambda (fs)
@@ -969,7 +980,7 @@ such as '--root' and '--load' to <boot-parameters>."
          (bootloader      (bootloader-configuration-bootloader
                            (operating-system-bootloader os)))
          (bootloader-name (bootloader-name bootloader))
-         (label           (kernel->boot-label (operating-system-kernel os))))
+         (label           (operating-system-label os)))
     (boot-parameters
      (label label)
      (root-device root-device)