;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
system-service-type
boot-service-type
+ cleanup-service-type
activation-service-type
activation-service->script
%linux-bare-metal-service
;;; A service type describe how its instances extend instances of other
;;; service types. For instance, some services extend the instance of
;;; ACCOUNT-SERVICE-TYPE by providing it with accounts and groups to create;
-;;; others extend DMD-ROOT-SERVICE-TYPE by passing it instances of
-;;; <dmd-service>.
+;;; others extend SHEPHERD-ROOT-SERVICE-TYPE by passing it instances of
+;;; <shepherd-service>.
;;;
;;; When applicable, the service type defines how it can itself be extended,
;;; by providing one procedure to compose extensions, and one procedure to
(define-syntax modify-services
(syntax-rules ()
- "Modify the services listed in SERVICES according to CLAUSES. Each clause
-must have the form:
+ "Modify the services listed in SERVICES according to CLAUSES and return
+the resulting list of services. Each clause must have the form:
(TYPE VARIABLE => BODY)
(define (compute-boot-script _ mexps)
(mlet %store-monad ((gexps (sequence %store-monad mexps)))
(gexp->file "boot"
- #~(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.
- (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 shepherd.
+ #~(begin #$@gexps))))
(define (boot-script-entry mboot)
"Return, as a monadic value, an entry for the boot script in the system
;; 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.
+ (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.
+ (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
(chdir #$output)
#$@(map (match-lambda
((target source)
- #~(symlink #$source #$target)))
+ #~(begin
+ ;; Stat the source to abort early if it
+ ;; does not exist.
+ (stat #$source)
+
+ (symlink #$source #$target))))
files))))
(define (directory-union name things)
(gnu build file-systems)
(guix build utils)
(guix build syscalls)
+ (guix build bournish)
(guix elf)))
(define (service-activations)
(define (packages->profile-entry packages)
"Return a system entry for the profile containing PACKAGES."
(mlet %store-monad ((profile (profile-derivation
- (manifest (map package->manifest-entry
- (delete-duplicates packages eq?))))))
+ (packages->manifest
+ (delete-duplicates packages eq?)))))
(return `(("profile" ,profile)))))
(define profile-service-type