index : guix	koszko koszko-scripts
	Wojtek's customized Guix

aboutsummaryrefslogtreecommitdiff

log msg author committer range

*.eps
*.go
*.log
*.mo
*.pdf
*.png
*.tar.xz
*.tmp
*~
.#*
\#*\#
,*
/ABOUT-NLS
/INSTALL
/aclocal.m4
/autom4te.cache
/build-aux/ar-lib
/build-aux/compile
/build-aux/config.guess
/build-aux/config.rpath
/build-aux/config.sub
/build-aux/depcomp
/build-aux/install-sh
/build-aux/mdate-sh
/build-aux/missing
/build-aux/test-driver
/build-aux/texinfo.tex
/config.status
/configure
/doc/*.1
/doc/.dirstamp
/doc/contributing.*.texi
/doc/guix*.aux
/doc/guix*.cp
/doc/guix*.cps
/doc/guix*.fn
/doc/guix*.fns
/doc/guix*.html
/doc/guix*.info
/doc/guix*.info-[0-9]
/doc/guix*.ky
/doc/guix*.pg
/doc/guix*.toc
/doc/guix*.t2p
/doc/guix*.tp
/doc/guix*.vr
/doc/guix*.vrs
/doc/guix.*.texi
/doc/guix-cookbook.*.texi
/doc/guix.aux
/doc/guix.cp
/doc/guix.cps
/doc/guix.fn
/doc/guix.fns
/doc/guix.html
/doc/guix.info
/doc/guix.info-[0-9]
/doc/guix.ky
/doc/guix.pg
/doc/guix.toc
/doc/guix.t2p
/doc/guix.tp
/doc/guix.vr
/doc/guix.vrs
/doc/os-config-bare-bones.texi
/doc/os-config-desktop.texi
/doc/stamp-vti
/doc/version.texi
/doc/version-*.texi
/etc/committer.scm
/etc/gnu-store.mount
/etc/guix-daemon.cil
/etc/guix-daemon.conf
/etc/guix-daemon.service
/etc/guix-publish.conf
/etc/guix-publish.service
/etc/guix-gc.service
/etc/init.d/guix-daemon
/etc/openrc/guix-daemon
/guix-*
/guix/config.scm
/libformat.a
/libstore.a
/libutil.a
/m4/*
/m4/ChangeLog
/m4/gettext.m4
/m4/iconv.m4
/m4/lib-ld.m4
/m4/lib-link.m4
/m4/lib-prefix.m4
/m4/nls.m4
/m4/po.m4
/m4/progtest.m4
/nix/config.h
/nix/config.h.in
/po/doc/*.mo
/po/doc/*.pot
/po/guix/*.gmo
/po/guix/*.insert-header
/po/guix/*.mo
/po/guix/ChangeLog
/po/guix/Makefile.in.in
/po/guix/Makevars.template
/po/guix/POTFILES
/po/guix/Rules-quot
/po/guix/boldquot.sed
/po/guix/en@boldquot.*
/po/guix/en@quot.*
/po/guix/guix.pot
/po/guix/insert-header.sin
/po/guix/quot.sed
/po/guix/remove-potcdate.sed
/po/guix/remove-potcdate.sin
/po/guix/stamp-po
/po/packages/*.gmo
/po/packages/*.insert-header
/po/packages/*.mo
/po/packages/ChangeLog
/po/packages/Makefile.in.in
/po/packages/Makevars.template
/po/packages/POTFILES
/po/packages/Rules-quot
/po/packages/boldquot.sed
/po/packages/en@boldquot.*
/po/packages/en@quot.*
/po/packages/guix-packages.pot
/po/packages/insert-header.sin
/po/packages/quot.sed
/po/packages/remove-potcdate.sed
/po/packages/remove-potcdate.sin
/po/packages/stamp-po
/pre-inst-env
/release-*
/scripts/guix
/t-*/
/test-env
/test-tmp
/tests/*.trs
/tests/services/*.trs
GPATH
GRTAGS
GTAGS
Makefile
Makefile.in
config.cache
stamp-h[0-9]
.am[0-9]*/
.dirstamp
.deps
tmp
/doc/os-config-lightweight-desktop.texi
/nix/scripts/download
/.tarball-version
/.version
/doc/stamp-*
/gnu/packages/bootstrap
/gnu/packages/aux-files/guile-guile-launcher.o
/guile
.DS_Store
.mumi/current-issue

generated by cgit

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu system dmd)
  #:use-module (guix store)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix records)
  #:use-module ((gnu packages base)
                #:select (glibc-final))
  #:use-module ((gnu packages system)
                #:select (mingetty inetutils))
  #:use-module ((gnu packages package-management)
                #:select (guix))
  #:use-module ((gnu packages linux)
                #:select (net-tools))
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (guix monads)
  #:export (service?
            service
            service-provision
            service-requirement
            service-respawn?
            service-start
            service-stop
            service-inputs

            host-name-service
            syslog-service
            mingetty-service
            nscd-service
            guix-service
            static-networking-service

            dmd-configuration-file))

;;; Commentary:
;;;
;;; System services as cajoled by dmd.
;;;
;;; Code:

(define-record-type* <service>
  service make-service
  service?
  (documentation service-documentation            ; string
                 (default "[No documentation.]"))
  (provision     service-provision)               ; list of symbols
  (requirement   service-requirement              ; list of symbols
                 (default '()))
  (respawn?      service-respawn?                 ; Boolean
                 (default #t))
  (start         service-start)                   ; expression
  (stop          service-stop                     ; expression
                 (default #f))
  (inputs        service-inputs                   ; list of inputs
                 (default '())))

(define (host-name-service name)
  "Return a service that sets the host name to NAME."
  (with-monad %store-monad
    (return (service
             (documentation "Initialize the machine's host name.")
             (provision '(host-name))
             (start `(lambda _
                       (sethostname ,name)))
             (respawn? #f)))))

(define (mingetty-service tty)
  "Return a service to run mingetty on TTY."
  (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty")))
    (return
     (service
      (documentation (string-append "Run mingetty on " tty "."))
      (provision (list (symbol-append 'term- (string->symbol tty))))

      ;; Since the login prompt shows the host name, wait for the 'host-name'
      ;; service to be done.
      (requirement '(host-name))

      (start `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty))
      (stop  `(make-kill-destructor))
      (inputs `(("mingetty" ,mingetty)))))))

(define* (nscd-service #:key (glibc glibc-final))
  "Return a service that runs libc's name service cache daemon (nscd)."
  (mlet %store-monad ((nscd (package-file glibc "sbin/nscd")))
    (return (service
             (documentation "Run libc's name service cache daemon (nscd).")
             (provision '(nscd))
             (start `(make-forkexec-constructor ,nscd "-f" "/dev/null"
                                                "--foreground"))
             (stop  `(make-kill-destructor))

             (respawn? #f)
             (inputs `(("glibc" ,glibc)))))))

(define (syslog-service)
  "Return a service that runs 'syslogd' with reasonable default settings."

  ;; Snippet adapted from the GNU inetutils manual.
  (define contents "
     # Log all kernel messages, authentication messages of
     # level notice or higher and anything of level err or
     # higher to the console.
     # Don't log private authentication messages!
     *.err;kern.*;auth.notice;authpriv.none  /dev/console

     # Log anything (except mail) of level info or higher.
     # Don't log private authentication messages!
     *.info;mail.none;authpriv.none          /var/log/messages

     # Same, in a different place.
     *.info;mail.none;authpriv.none          /dev/tty12

     # The authpriv file has restricted access.
     authpriv.*                              /var/log/secure

     # Log all the mail messages in one place.
     mail.*                                  /var/log/maillog
")

  (mlet %store-monad
      ((syslog.conf (text-file "syslog.conf" contents))
       (syslogd     (package-file inetutils "libexec/syslogd")))
    (return
     (service
      (documentation "Run the syslog daemon (syslogd).")
      (provision '(syslogd))
      (start `(make-forkexec-constructor ,syslogd "--no-detach"
                                         "--rcfile" ,syslog.conf))
      (stop  `(make-kill-destructor))
      (inputs `(("inetutils" ,inetutils)
                ("syslog.conf" ,syslog.conf)))))))

(define* (guix-service #:key (guix guix) (builder-group "guixbuild"))
  "Return a service that runs the build daemon from GUIX."
  (mlet %store-monad ((daemon (package-file guix "bin/guix-daemon")))
    (return (service
             (provision '(guix-daemon))
             (start `(make-forkexec-constructor ,daemon
                                                "--build-users-group"
                                                ,builder-group))
             (stop  `(make-kill-destructor))
             (inputs `(("guix" ,guix)))))))

(define* (static-networking-service interface ip
                                    #:key
                                    gateway
                                    (inetutils inetutils)
                                    (net-tools net-tools))
  "Return a service that starts INTERFACE with address IP.  If GATEWAY is
true, it must be a string specifying the default network gateway."

  ;; TODO: Eventually we should do this using Guile's networking procedures,
  ;; like 'configure-qemu-networking' does, but the patch that does this is
  ;; not yet in stock Guile.
  (mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig"))
                      (route    (package-file net-tools "sbin/route")))
    (return
     (service
      (documentation
       (string-append "Set up networking on the '" interface
                      "' interface using a static IP address."))
      (provision '(networking))
      (start `(lambda _
                ;; Return #t if successfully started.
                (and (zero? (system* ,ifconfig ,interface ,ip "up"))
                     ,(if gateway
                          `(zero? (system* ,route "add" "-net" "default"
                                           "gw" ,gateway))
                          #t))))
      (stop  `(lambda _
                ;; Return #f is successfully stopped.
                (not (and (system* ,ifconfig ,interface "down")
                          (system* ,route "del" "-net" "default")))))
      (respawn? #f)
      (inputs `(("inetutils" ,inetutils)
                ,@(if gateway
                      `(("net-tools" ,net-tools))
                      '())))))))


(define (dmd-configuration-file services)
  "Return the dmd configuration file for SERVICES."
  (define config
    `(begin
       (register-services
        ,@(map (match-lambda
                (($ <service> documentation provision requirement
                    respawn? start stop)
                 `(make <service>
                    #:docstring ,documentation
                    #:provides ',provision
                    #:requires ',requirement
                    #:respawn? ,respawn?
                    #:start ,start
                    #:stop ,stop)))
               services))
       (for-each start ',(append-map service-provision services))))

  (text-file "dmd.conf" (object->string config)))

;;; dmd.scm ends here