summary refs log tree commit diff
path: root/gnu/system.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-03-22 17:48:37 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-25 23:37:06 +0100
commit69cae3d3356a69b7fe69481338f760545995485e (patch)
tree4d191f2b530837a0be058f3f804ab984c715962c /gnu/system.scm
parentcf848cc0a17a3a58d600116896f6e7abfb0440d4 (diff)
downloadguix-69cae3d3356a69b7fe69481338f760545995485e.tar.gz
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'.
Diffstat (limited to 'gnu/system.scm')
-rw-r--r--gnu/system.scm73
1 files changed, 33 insertions, 40 deletions
diff --git a/gnu/system.scm b/gnu/system.scm
index 035bbd82a1..9887d72c41 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -69,6 +69,7 @@
 
             operating-system-bootloader
             operating-system-services
+            operating-system-essential-services
             operating-system-user-services
             operating-system-packages
             operating-system-host-name
@@ -201,6 +202,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-record)))
   (services operating-system-user-services        ; list of services
             (default %base-services))
 
@@ -438,27 +442,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)))
 
@@ -468,8 +467,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
 
@@ -497,20 +495,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))))
 
 
 ;;;
@@ -808,20 +802,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)))
 
@@ -841,17 +834,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