gnu/services/dmd.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014 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 monads)
  21   #:use-module (gnu services)
  22   #:use-module (ice-9 match)
  23   #:use-module (srfi srfi-1)
  24   #:export (dmd-configuration-file))
  25
  26 ;;; Commentary:
  27 ;;;
  28 ;;; Instantiating system services as a dmd configuration file.
  29 ;;;
  30 ;;; Code:
  31
  32 (define (dmd-configuration-file services etc)
  33   "Return the dmd configuration file for SERVICES, that initializes /etc from
  34 ETC (the name of a directory in the store) on startup."
  35   (define config
  36     `(begin
  37        (use-modules (ice-9 ftw))
  38
  39        (register-services
  40         ,@(map (lambda (service)
  41                 `(make <service>
  42                    #:docstring ',(service-documentation service)
  43                    #:provides ',(service-provision service)
  44                    #:requires ',(service-requirement service)
  45                    #:respawn? ',(service-respawn? service)
  46                    #:start ,(service-start service)
  47                    #:stop ,(service-stop service)))
  48                services))
  49
  50        ;; /etc is a mixture of static and dynamic settings.  Here is where we
  51        ;; initialize it from the static part.
  52        (format #t "populating /etc from ~a...~%" ,etc)
  53        (let ((rm-f (lambda (f)
  54                      (false-if-exception (delete-file f)))))
  55          (rm-f "/etc/static")
  56          (symlink ,etc "/etc/static")
  57          (for-each (lambda (file)
  58                      ;; TODO: Handle 'shadow' specially so that changed
  59                      ;; password aren't lost.
  60                      (let ((target (string-append "/etc/" file))
  61                            (source (string-append "/etc/static/" file)))
  62                        (rm-f target)
  63                        (symlink source target)))
  64                    (scandir ,etc
  65                             (lambda (file)
  66                               (not (member file '("." ".."))))))
  67
  68          ;; Prevent ETC from being GC'd.
  69          (rm-f "/var/nix/gcroots/etc-directory")
  70          (symlink ,etc "/var/nix/gcroots/etc-directory"))
  71
  72        (format #t "starting services...~%")
  73        (for-each start ',(append-map service-provision services))))
  74
  75   (text-file "dmd.conf" (object->string config)))
  76
  77 ;;; dmd.scm ends here