summaryrefslogtreecommitdiff
path: root/gnu/services.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services.scm')
-rw-r--r--gnu/services.scm102
1 files changed, 43 insertions, 59 deletions
diff --git a/gnu/services.scm b/gnu/services.scm
index 50e76df8182..5479bfae193 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -238,42 +238,33 @@ directory."
238(define (cleanup-gexp _) 238(define (cleanup-gexp _)
239 "Return as a monadic value a gexp to clean up /tmp and similar places upon 239 "Return as a monadic value a gexp to clean up /tmp and similar places upon
240boot." 240boot."
241 (define %modules 241 (with-monad %store-monad
242 '((guix build utils))) 242 (with-imported-modules '((guix build utils))
243 243 (return #~(begin
244 (mlet %store-monad ((modules (imported-modules %modules)) 244 (use-modules (guix build utils))
245 (compiled (compiled-modules %modules))) 245
246 (return #~(begin 246 ;; Clean out /tmp and /var/run.
247 (eval-when (expand load eval) 247 ;;
248 ;; Make sure 'use-modules' below succeeds. 248 ;; XXX This needs to happen before service activations, so it
249 (set! %load-path (cons #$modules %load-path)) 249 ;; has to be here, but this also implicitly assumes that /tmp
250 (set! %load-compiled-path 250 ;; and /var/run are on the root partition.
251 (cons #$compiled %load-compiled-path))) 251 (letrec-syntax ((fail-safe (syntax-rules ()
252 252 ((_ exp rest ...)
253 (use-modules (guix build utils)) 253 (begin
254 254 (catch 'system-error
255 ;; Clean out /tmp and /var/run. 255 (lambda () exp)
256 ;; 256 (const #f))
257 ;; XXX This needs to happen before service activations, so it 257 (fail-safe rest ...)))
258 ;; has to be here, but this also implicitly assumes that /tmp 258 ((_)
259 ;; and /var/run are on the root partition. 259 #t))))
260 (letrec-syntax ((fail-safe (syntax-rules () 260 ;; Ignore I/O errors so the system can boot.
261 ((_ exp rest ...) 261 (fail-safe
262 (begin 262 (delete-file-recursively "/tmp")
263 (catch 'system-error 263 (delete-file-recursively "/var/run")
264 (lambda () exp) 264 (mkdir "/tmp")
265 (const #f)) 265 (chmod "/tmp" #o1777)
266 (fail-safe rest ...))) 266 (mkdir "/var/run")
267 ((_) 267 (chmod "/var/run" #o755))))))))
268 #t))))
269 ;; Ignore I/O errors so the system can boot.
270 (fail-safe
271 (delete-file-recursively "/tmp")
272 (delete-file-recursively "/var/run")
273 (mkdir "/tmp")
274 (chmod "/tmp" #o1777)
275 (mkdir "/var/run")
276 (chmod "/var/run" #o755)))))))
277 268
278(define cleanup-service-type 269(define cleanup-service-type
279 ;; Service that cleans things up in /tmp and similar. 270 ;; Service that cleans things up in /tmp and similar.
@@ -309,10 +300,10 @@ file."
309 one) 300 one)
310 (_ 301 (_
311 (computed-file name 302 (computed-file name
312 #~(begin 303 (with-imported-modules '((guix build union))
313 (use-modules (guix build union)) 304 #~(begin
314 (union-build #$output '#$things)) 305 (use-modules (guix build union))
315 #:modules '((guix build union)))))) 306 (union-build #$output '#$things)))))))
316 307
317(define* (activation-service->script service) 308(define* (activation-service->script service)
318 "Return as a monadic value the activation script for SERVICE, a service of 309 "Return as a monadic value the activation script for SERVICE, a service of
@@ -337,29 +328,22 @@ ACTIVATION-SCRIPT-TYPE."
337 (cut gexp->file "activate-service" <>) 328 (cut gexp->file "activate-service" <>)
338 gexps)) 329 gexps))
339 330
340 (mlet* %store-monad ((actions (service-activations)) 331 (mlet* %store-monad ((actions (service-activations)))
341 (modules (imported-modules %modules))
342 (compiled (compiled-modules %modules)))
343 (gexp->file "activate" 332 (gexp->file "activate"
344 #~(begin 333 (with-imported-modules %modules
345 (eval-when (expand load eval) 334 #~(begin
346 ;; Make sure 'use-modules' below succeeds. 335 (use-modules (gnu build activation))
347 (set! %load-path (cons #$modules %load-path))
348 (set! %load-compiled-path
349 (cons #$compiled %load-compiled-path)))
350
351 (use-modules (gnu build activation))
352 336
353 ;; Make sure /bin/sh is valid and current. 337 ;; Make sure /bin/sh is valid and current.
354 (activate-/bin/sh 338 (activate-/bin/sh
355 (string-append #$(canonical-package bash) "/bin/sh")) 339 (string-append #$(canonical-package bash) "/bin/sh"))
356 340
357 ;; Run the services' activation snippets. 341 ;; Run the services' activation snippets.
358 ;; TODO: Use 'load-compiled'. 342 ;; TODO: Use 'load-compiled'.
359 (for-each primitive-load '#$actions) 343 (for-each primitive-load '#$actions)
360 344
361 ;; Set up /run/current-system. 345 ;; Set up /run/current-system.
362 (activate-current-system))))) 346 (activate-current-system))))))
363 347
364(define (gexps->activation-gexp gexps) 348(define (gexps->activation-gexp gexps)
365 "Return a gexp that runs the activation script containing GEXPS." 349 "Return a gexp that runs the activation script containing GEXPS."