system: Add 'essential-services' field to <operating-system>.

* gnu/system.scm (<operating-system>)[essential-services]: New field.
(operating-system-directory-base-entries): Remove #:container? keyword
and keep only the not-container branch.
(essential-services): Likewise.
(operating-system-services): Likewise, and call
'operating-system-essential-services' instead of 'essential-services'.
(operating-system-activation-script): Remove #:container?.
(operating-system-boot-script): Likewise.
(operating-system-derivation): Likewise.
* gnu/system/linux-container.scm (container-essential-services): New procedure.
(containerized-operating-system): Use it and set the
'essential-services' field.
(container-script): Remove call to 'operating-system-derivation'.
* gnu/system/vm.scm (system-docker-image): Likewise.
* doc/guix.texi (operating-system Reference): Document 'essential-services'.

1 files changed, 43 insertions, 26 deletions

diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 3fe3482d7f..37a053cdc3 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -29,12 +29,31 @@
   #:use-module (gnu build linux-container)
   #:use-module (gnu services)
   #:use-module (gnu services base)
+  #:use-module (gnu services shepherd)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
   #:export (system-container
             containerized-operating-system
             container-script))
 
+(define (container-essential-services os)
+  "Return a list of essential services corresponding to OS, a
+non-containerized OS.  This procedure essentially strips essential services
+from OS that are needed on the bare metal and not in a container."
+  (define base
+    (remove (lambda (service)
+              (memq (service-kind service)
+                    (list (service-kind %linux-bare-metal-service)
+                          firmware-service-type
+                          system-service-type)))
+            (operating-system-essential-services os)))
+
+  (cons (service system-service-type
+                 (let ((locale (operating-system-locale-directory os)))
+                   (with-monad %store-monad
+                     (return `(("locale" ,locale))))))
+        (append base (list %containerized-shepherd-service))))
+
 (define (containerized-operating-system os mappings)
   "Return an operating system based on OS for use in a Linux container
 environment.  MAPPINGS is a list of <file-system-mapping> to realize in the
@@ -62,8 +81,10 @@ containerized OS."
           mingetty-service-type
           agetty-service-type))
 
-  (operating-system (inherit os)
+  (operating-system
+    (inherit os)
     (swap-devices '()) ; disable swap
+    (essential-services (container-essential-services os))
     (services (remove (lambda (service)
                         (memq (service-kind service)
                               useless-services))
@@ -81,30 +102,26 @@ that will be shared with the host system."
                                (operating-system-file-systems os)))
          (specs        (map file-system->spec file-systems)))
 
-    (mlet* %store-monad ((os-drv (operating-system-derivation
-                                  os
-                                  #:container? #t)))
-
-      (define script
-        (with-imported-modules (source-module-closure
-                                '((guix build utils)
-                                  (gnu build linux-container)))
-          #~(begin
-              (use-modules (gnu build linux-container)
-                           (gnu system file-systems) ;spec->file-system
-                           (guix build utils))
+    (define script
+      (with-imported-modules (source-module-closure
+                              '((guix build utils)
+                                (gnu build linux-container)))
+        #~(begin
+            (use-modules (gnu build linux-container)
+                         (gnu system file-systems) ;spec->file-system
+                         (guix build utils))
 
-              (call-with-container (map spec->file-system '#$specs)
-                (lambda ()
-                  (setenv "HOME" "/root")
-                  (setenv "TMPDIR" "/tmp")
-                  (setenv "GUIX_NEW_SYSTEM" #$os-drv)
-                  (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
-                  (primitive-load (string-append #$os-drv "/boot")))
-                ;; A range of 65536 uid/gids is used to cover 16 bits worth of
-                ;; users and groups, which is sufficient for most cases.
-                ;;
-                ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
-                #:host-uids 65536))))
+            (call-with-container (map spec->file-system '#$specs)
+              (lambda ()
+                (setenv "HOME" "/root")
+                (setenv "TMPDIR" "/tmp")
+                (setenv "GUIX_NEW_SYSTEM" #$os)
+                (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
+                (primitive-load (string-append #$os "/boot")))
+              ;; A range of 65536 uid/gids is used to cover 16 bits worth of
+              ;; users and groups, which is sufficient for most cases.
+              ;;
+              ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
+              #:host-uids 65536))))
 
-      (gexp->script "run-container" script))))
+    (gexp->script "run-container" script)))