diff options
Diffstat (limited to 'gnu/services.scm')
| -rw-r--r-- | gnu/services.scm | 102 |
1 files changed, 43 insertions, 59 deletions
diff --git a/gnu/services.scm b/gnu/services.scm index 50e76df818..5479bfae19 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -238,42 +238,33 @@ directory." (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. - (letrec-syntax ((fail-safe (syntax-rules () - ((_ exp rest ...) - (begin - (catch 'system-error - (lambda () exp) - (const #f)) - (fail-safe rest ...))) - ((_) - #t)))) - ;; Ignore I/O errors so the system can boot. - (fail-safe - (delete-file-recursively "/tmp") - (delete-file-recursively "/var/run") - (mkdir "/tmp") - (chmod "/tmp" #o1777) - (mkdir "/var/run") - (chmod "/var/run" #o755))))))) + (with-monad %store-monad + (with-imported-modules '((guix build utils)) + (return #~(begin + (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. + (letrec-syntax ((fail-safe (syntax-rules () + ((_ exp rest ...) + (begin + (catch 'system-error + (lambda () exp) + (const #f)) + (fail-safe rest ...))) + ((_) + #t)))) + ;; Ignore I/O errors so the system can boot. + (fail-safe + (delete-file-recursively "/tmp") + (delete-file-recursively "/var/run") + (mkdir "/tmp") + (chmod "/tmp" #o1777) + (mkdir "/var/run") + (chmod "/var/run" #o755)))))))) (define cleanup-service-type ;; Service that cleans things up in /tmp and similar. @@ -309,10 +300,10 @@ file." one) (_ (computed-file name - #~(begin - (use-modules (guix build union)) - (union-build #$output '#$things)) - #:modules '((guix build union)))))) + (with-imported-modules '((guix build union)) + #~(begin + (use-modules (guix build union)) + (union-build #$output '#$things))))))) (define* (activation-service->script service) "Return as a monadic value the activation script for SERVICE, a service of @@ -337,29 +328,22 @@ ACTIVATION-SCRIPT-TYPE." (cut gexp->file "activate-service" <>) gexps)) - (mlet* %store-monad ((actions (service-activations)) - (modules (imported-modules %modules)) - (compiled (compiled-modules %modules))) + (mlet* %store-monad ((actions (service-activations))) (gexp->file "activate" - #~(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 (gnu build activation)) + (with-imported-modules %modules + #~(begin + (use-modules (gnu build activation)) - ;; Make sure /bin/sh is valid and current. - (activate-/bin/sh - (string-append #$(canonical-package bash) "/bin/sh")) + ;; Make sure /bin/sh is valid and current. + (activate-/bin/sh + (string-append #$(canonical-package bash) "/bin/sh")) - ;; Run the services' activation snippets. - ;; TODO: Use 'load-compiled'. - (for-each primitive-load '#$actions) + ;; Run the services' activation snippets. + ;; TODO: Use 'load-compiled'. + (for-each primitive-load '#$actions) - ;; Set up /run/current-system. - (activate-current-system))))) + ;; Set up /run/current-system. + (activate-current-system)))))) (define (gexps->activation-gexp gexps) "Return a gexp that runs the activation script containing GEXPS." |