gnu/services/dmd.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu services dmd)
  20   #:use-module (guix ui)
  21   #:use-module (guix sets)
  22   #:use-module (guix gexp)
  23   #:use-module (guix store)
  24   #:use-module (guix monads)
  25   #:use-module (guix derivations)                 ;imported-modules, etc.
  26   #:use-module (gnu services)
  27   #:use-module (ice-9 match)
  28   #:use-module (srfi srfi-1)
  29   #:use-module (srfi srfi-34)
  30   #:use-module (srfi srfi-35)
  31   #:export (dmd-configuration-file))
  32
  33 ;;; Commentary:
  34 ;;;
  35 ;;; Instantiating system services as a dmd configuration file.
  36 ;;;
  37 ;;; Code:
  38
  39 (define (assert-no-duplicates services)
  40   "Raise an error if SERVICES provide the same dmd service more than once.
  41
  42 This is a constraint that dmd's 'register-service' verifies but we'd better
  43 verify it here statically than wait until PID 1 halts with an assertion
  44 failure."
  45   (fold (lambda (service set)
  46           (define (assert-unique symbol)
  47             (when (set-contains? set symbol)
  48               (raise (condition
  49                       (&message
  50                        (message
  51                         (format #f (_ "service '~a' provided more than once")
  52                                 symbol)))))))
  53
  54           (for-each assert-unique (service-provision service))
  55           (fold set-insert set (service-provision service)))
  56         (setq)
  57         services))
  58
  59 (define (dmd-configuration-file services)
  60   "Return the dmd configuration file for SERVICES."
  61   (define modules
  62     ;; Extra modules visible to dmd.conf.
  63     '((guix build syscalls)
  64       (gnu build file-systems)
  65       (guix build utils)))
  66
  67   (assert-no-duplicates services)
  68
  69   (mlet %store-monad ((modules  (imported-modules modules))
  70                       (compiled (compiled-modules modules)))
  71     (define config
  72       #~(begin
  73           (eval-when (expand load eval)
  74             (set! %load-path (cons #$modules %load-path))
  75             (set! %load-compiled-path
  76                   (cons #$compiled %load-compiled-path)))
  77
  78           (use-modules (ice-9 ftw)
  79                        (guix build syscalls)
  80                        (guix build utils)
  81                        ((gnu build file-systems)
  82                         #:select (check-file-system canonicalize-device-spec)))
  83
  84           (register-services
  85            #$@(map (lambda (service)
  86                      #~(make <service>
  87                          #:docstring '#$(service-documentation service)
  88                          #:provides '#$(service-provision service)
  89                          #:requires '#$(service-requirement service)
  90                          #:respawn? '#$(service-respawn? service)
  91                          #:start #$(service-start service)
  92                          #:stop #$(service-stop service)))
  93                    services))
  94
  95           ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
  96           (setenv "PATH" "/run/current-system/profile/bin")
  97
  98           (format #t "starting services...~%")
  99           (for-each start
 100                     '#$(append-map service-provision
 101                                    (filter service-auto-start? services)))))
 102
 103     (gexp->file "dmd.conf" config)))
 104
 105 ;;; dmd.scm ends here