From be7be9e8dd9411d8d5bcea75c506326393ea2842 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 4 Jan 2016 22:58:05 +0100
Subject: services: Move /tmp cleanup to a separate service.

* gnu/services.scm (compute-boot-script): Remove /tmp and /var/run
deletion code from here.
(cleanup-gexp): New procedure with /tmp and /var/run deletion code
formerly in 'compute-boot-script'.
(cleanup-service-type): New variable.
* gnu/system.scm (essential-services): Add an instance of
CLEANUP-SERVICE-TYPE.
---
 gnu/services.scm | 69 ++++++++++++++++++++++++++++++++------------------------
 gnu/system.scm   |  8 +++++--
 2 files changed, 46 insertions(+), 31 deletions(-)

(limited to 'gnu')

diff --git a/gnu/services.scm b/gnu/services.scm
index 134342101d..27a4883f71 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -63,6 +63,7 @@
 
             system-service-type
             boot-service-type
+            cleanup-service-type
             activation-service-type
             activation-service->script
             %linux-bare-metal-service
@@ -206,36 +207,10 @@ containing the given entries."
                 (extend system-derivation)))
 
 (define (compute-boot-script _ mexps)
-  (define %modules
-    '((guix build utils)))
-
-  (mlet* %store-monad ((gexps    (sequence %store-monad mexps))
-                       (modules  (imported-modules %modules))
-                       (compiled (compiled-modules %modules)))
+  (mlet %store-monad ((gexps (sequence %store-monad mexps)))
     (gexp->file "boot"
-                #~(begin
-                    (eval-when (expand load eval)
-                      ;; Make sure 'use-modules' below succeeds.
-                      (set! %load-path (cons #$modules %load-path))
-                      (set! %load-compiled-path
-                        (cons #$compiled %load-compiled-path)))
-
-                    (use-modules (guix build utils))
-
-                    ;; Clean out /tmp and /var/run.
-                    ;;
-                    ;; XXX This needs to happen before service activations, so
-                    ;; it has to be here, but this also implicitly assumes
-                    ;; that /tmp and /var/run are on the root partition.
-                    (false-if-exception (delete-file-recursively "/tmp"))
-                    (false-if-exception (delete-file-recursively "/var/run"))
-                    (false-if-exception (mkdir "/tmp"))
-                    (false-if-exception (chmod "/tmp" #o1777))
-                    (false-if-exception (mkdir "/var/run"))
-                    (false-if-exception (chmod "/var/run" #o755))
-
-                    ;; Activate the system and spawn dmd.
-                    #$@gexps))))
+                ;; Clean up and activate the system, then spawn dmd.
+                #~(begin #$@gexps))))
 
 (define (boot-script-entry mboot)
   "Return, as a monadic value, an entry for the boot script in the system
@@ -258,6 +233,42 @@ directory."
   ;; The service that produces the boot script.
   (service boot-service-type #t))
 
+(define (cleanup-gexp _)
+  "Return as a monadic value a gexp to clean up /tmp and similar places upon
+boot."
+  (define %modules
+    '((guix build utils)))
+
+  (mlet %store-monad ((modules  (imported-modules %modules))
+                      (compiled (compiled-modules %modules)))
+    (return #~(begin
+                (eval-when (expand load eval)
+                  ;; Make sure 'use-modules' below succeeds.
+                  (set! %load-path (cons #$modules %load-path))
+                  (set! %load-compiled-path
+                    (cons #$compiled %load-compiled-path)))
+
+                (use-modules (guix build utils))
+
+                ;; Clean out /tmp and /var/run.
+                ;;
+                ;; XXX This needs to happen before service activations, so it
+                ;; has to be here, but this also implicitly assumes that /tmp
+                ;; and /var/run are on the root partition.
+                (false-if-exception (delete-file-recursively "/tmp"))
+                (false-if-exception (delete-file-recursively "/var/run"))
+                (false-if-exception (mkdir "/tmp"))
+                (false-if-exception (chmod "/tmp" #o1777))
+                (false-if-exception (mkdir "/var/run"))
+                (false-if-exception (chmod "/var/run" #o755))))))
+
+(define cleanup-service-type
+  ;; Service that cleans things up in /tmp and similar.
+  (service-type (name 'cleanup)
+                (extensions
+                 (list (service-extension boot-service-type
+                                          cleanup-gexp)))))
+
 (define* (file-union name files)                  ;FIXME: Factorize.
   "Return a <computed-file> that builds a directory containing all of FILES.
 Each item in FILES must be a list where the first element is the file name to
diff --git a/gnu/system.scm b/gnu/system.scm
index 6dfcc0fe3a..4aedb7ee36 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -295,8 +295,12 @@ a container or that of a \"bare metal\" system."
            %boot-service
 
            ;; %DMD-ROOT-SERVICE must come first so that the gexp that execs
-           ;; dmd comes last in the boot script (XXX).
-           %dmd-root-service %activation-service
+           ;; dmd comes last in the boot script (XXX).  Likewise, the cleanup
+           ;; service must come last so that its gexp runs before activation
+           ;; code.
+           %dmd-root-service
+           %activation-service
+           (service cleanup-service-type #f)
 
            (pam-root-service (operating-system-pam-services os))
            (account-service (append (operating-system-accounts os)
-- 
cgit 1.4.1