nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2016-01-04 22:58:05 +01:00
parent 94af9daa73
commit be7be9e8dd
2 changed files with 46 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
gnu/services.scm
View File

@ -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

8
gnu/system.scm
View File

@ -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)