guix/gnu/system/linux.scm
Ludovic Courtès 0adfe95a3e services: Introduce extensible services.
This patch rewrites GuixSD services to make them extensible.

* gnu-system.am (GNU_SYSTEM_MODULES): Add gnu/services/dbus.scm.
* gnu/services.scm (<service>): Replace with new record type.
  (<service-extension>, <service-type>): New record types.
  (write-service-type, compute-boot-script, second-argument): New
  procedures.
  (%boot-service, boot-service-type): New variables.
  (file-union, directory-union, modprobe-wrapper,
  activation-service->script, activation-script,
  gexps->activation-gexp): New procedures.
  (activation-service-type, %activation-service): New variables.
  (etc-directory, files->etc-directory, etc-service): New procedures.
  (etc-service-type, setuid-program-service, firmware-service-type): New
  variables.
  (firmware->activation-gexp): New procedure.
  (&service-error, &missing-target-service-error,
  &ambiguous-target-service-error): New condition types.
  (service-back-edges, fold-services): New procedures.
* gnu/services/avahi.scm (<avahi-configuration>): New record type.
  (configuration-file): Replace keyword parameters with a single
  'config' parameter.
  (%avahi-accounts, %avahi-activation, avahi-service-type): New
  variables.
  (avahi-dmd-service): New procedure.
  (avahi-service): Rewrite using 'service' and 'avahi-configuration'.
* gnu/services/base.scm (%root-file-system-dmd-service,
  root-file-system-service-type): New variables.
  (root-file-system-service): Use them.
  (file-system->dmd-service-name): New procedure.
  (file-system-service-type): New variable.
  (file-system-service): Use it.  Replace keyword parameters with a
  single 'file-system' object.
  (user-unmount-service-type): New variable.
  (user-unmount-service): Use it.
  (user-processes-service-type): New variable.
  (user-processes-service): Use it.
  (host-name-service-type): New variable.
  (host-name-service): Use it.
  (console-keymap-service-type): New variable.
  (console-keymap-service): Use it.
  (console-font-service-type): New variable.
  (console-font-service): Use it.
  (mingetty-pam-service, mingetty-dmd-service): New procedures.
  (mingetty-service-type): New variable.
  (mingetty-service): Use it.
  (nscd-dmd-service): New procedure.
  (nscd-activation, nscd-service-type): New variables.
  (nscd-service): Use the latter.
  (syslog-service-type): New variable.
  (syslog-service): Use it.
  (<guix-configuration>): New record type.
  (%default-guix-configuration): New variable.
  (guix-dmd-service, guix-accounts, guix-activation): New procedures.
  (guix-service-type): New variable.
  (guix-service): Replace list of keyword parameters with a single
  'config' parameter.  Rewrite using 'service'.
  (<udev-configuration>): New record type.
  (udev-dmd-service): New procedure.
  (udev-service-type): New variable.
  (udev-service): Use it.
  (device-mapping-service-type): New variable.
  (device-mapping-service): Use it.
  (swap-service-type): New variable.
  (swap-service): Use it.
* gnu/services/databases.scm (<postgresql-configuration>): New record
  type.
  (%postgresql-accounts, postgresql-activation): New variables.
  (postgresql-dmd-service): New procedure.
  (postgresql-service): Rewrite using 'service' and
  'postgresql-configuration'.
* gnu/services/dbus.scm: New file.
* gnu/services/desktop.scm (dbus-configuration-directory, dbus-service):
  Remove.
  (wrapped-dbus-service): New procedure.
  (<upower-configuration>): New record type.
  (upower-configuration-file): Replace keyword parameters with single
  <upower-configuration> parameter.
  (%upower-accounts, %upower-activation): New variables.
  (upower-dbus-service, upower-dmd-service): New procedures.
  (upower-service-type): New variable.
  (upower-service): Rewrite using 'service' and 'upower-configuration'.
  (%colord-activation, %colord-accounts): New variables.
  (colord-dmd-service): New procedure.
  (colord-service-type): New variable.
  (colord-service): Rewrite using 'service'.
  (<geoclue-configuration>): New record type.
  (geoclue-configuration-file): Replace keyword parameters with a single
  'config' parameter.
  (geoclue-dbus-service, geoclue-dmd-service): New procedures.
  (%geoclue-accounts, geoclue-service-type): New variables.
  (geoclue-service): Rewrite using 'service' and
  'geoclue-configuration'.
  (%polkit-accounts, %polkit-pam-services, polkit-service-type): New
  variables.
  (polkit-dmd-service): New procedure.
  (polkit-service): Rewrite using 'service'.
  (<elogind-configuration>)[elogind]: New field.
  (elogind-dmd-service): New procedure.
  (elogind-service-type): New variable.
  (elogind-service): Rewrite using 'service'.
  (%desktop-services): Remove argument to 'dbus-service'.  Remove 'map'
  over %BASE-SERVICES.
* gnu/services/dmd.scm (dmd-boot-gexp): New procedure.
  (dmd-root-service-type, %dmd-root-service): New variables.
  (dmd-service-type): New macro.
  (<dmd-service>): New record type.
* gnu/services/lirc.scm (<lirc-configuration>): New record type.
  (%lirc-activation): New variable.
  (lirc-dmd-service): New procedure.
  (lirc-service-type): New variable.
  (lirc-service): Rewrite using 'service' and 'lirc-configuration'.
* gnu/services/networking.scm (<static-networking>): New record type.
  (static-networking-service-type): New variable.
  (static-networking-service): Rewrite using 'service' and
  'static-networking'.
  (dhcp-client-service-type): New variable.
  (dhcp-client-service): Rewrite using 'service'.
  (<ntp-configuration>): New record type.
  (ntp-dmd-service): New procedure.
  (ntp-service-type): New variable.
  (ntp-service): New procedure.
  (%tor-accounts, tor-service-type): New variable.
  (tor-dmd-service): New procedure.
  (tor-service): Rewrite using 'service'.
  (<bitlbee-configuration>): New record type.
  (bitlbee-dmd-service): New procedure.
  (%bitlbee-accounts, %bitlbee-activation, bitlbee-service-type): New
  variables.
  (bitlbee-service): Rewrite using 'service'.
  (%wicd-activation): New variable.
  (wicd-dmd-service): New procedure.
  (wicd-service-type): New variable.
  (wicd-service): Rewrite using 'service'.
* gnu/services/ssh.scm (<lsh-configuration>): New record type.
  (activation): Rename to...
  (lsh-initialization): ... this.
  (lsh-activation, lsh-dmd-service, lsh-pam-services): New procedures.
  (lsh-service-type): New variable.
  (lsh-service): Rewrite using 'service' and 'lsh-configuration'.
* gnu/services/web.scm (<nginx-configuration>): New record type.
  (%nginx-accounts): New variable.
  (nginx-activation, nginx-dmd-service): New procedures.
  (nginx-service-type): New variable.
  (nginx-service): Rewrite using 'service' and 'nginx-configuration'.
* gnu/services/xorg.scm (<slim-configuration>): New record type.
  (slim-pam-service, slim-dmd-service): New procedures.
  (slim-service-type): New variable.
  (slim-service): Rewrite using 'service' and 'slim-configuration'.
* gnu/system.scm (file-union): Remove.
  (other-file-system-services): Adjust to new 'file-system-service'
  signature.
  (essential-services): Add #:container? parameter.  Add
  %DMD-ROOT-SERVICE, %ACTIVATION-SERVICE, and calls to
  'pam-root-service', 'account-service', 'operating-system-etc-service',
  and a SETUID-PROGRAM-SERVICE instance.
  (operating-system-services): Pass #:container? to 'essential-services.
  (etc-directory): Remove.
  (operating-system-etc-service): New procedure.  Rewrite as a call to
  'etc-service'.
  (operating-system-accounts): Change to not return accounts required by
  services.
  (operating-system-etc-directory): Rewrite as a call to 'fold-services'
  and 'etc-directory'.
  (user-group->gexp, user-account->gexp, modprobe-wrapper): Remove.
  (operating-system-activation-script): Rewrite as a call to
  'fold-services' and 'activation-service->script'.
  (operating-system-boot-script): Likewise.
  (operating-system-derivation): Add call to 'lower-object'.
  (emacs-site-file, emacs-site-directory, shells-file): Change to use
  'computed-file' and 'scheme-file' instead of the monadic procedures.
* gnu/system/install.scm (cow-store-service-type): New variable.
  (cow-store-service): Rewrite using 'service'.
  (/etc/configuration-files): New procedure.
  (configuration-template-service-type,
  %configuration-template-service): New variables.
  (configuration-template-service): Remove.
  (installation-services): Adjust accordingly.  Adjust argument to
  'guix-service'.
* gnu/system/linux.scm (/etc-entry, pam-root-service): New procedures.
  (pam-root-service-type): New variable.
* gnu/system/shadow.scm (user-group->gexp, user-account->gexp,
  account-activation, etc-skel, account-service): New procedures.
  (account-service-type): New variable.
* tests/services.scm: New file.
* doc/guix.texi (Base Services, Desktop Services): Adjust accordingly.
  (Defining Services): Rewrite.
* doc/images/service-graph.dot: New file.
* doc.am (DOT_FILES): Add it.
* po/guix/POTFILES.in: Add gnu/services.scm.
2015-10-10 22:55:15 +02:00

216 lines
7.8 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 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 linux)
#:use-module (guix records)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (gnu services)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module ((guix utils) #:select (%current-system))
#:export (pam-service
pam-entry
pam-services->directory
unix-pam-service
base-pam-services
pam-root-service-type
pam-root-service))
;;; Commentary:
;;;
;;; Configuration of Linux-related things, including pluggable authentication
;;; modules (PAM).
;;;
;;; Code:
;; PAM services (see
;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
(define-record-type* <pam-service> pam-service
make-pam-service
pam-service?
(name pam-service-name) ; string
;; The four "management groups".
(account pam-service-account ; list of <pam-entry>
(default '()))
(auth pam-service-auth
(default '()))
(password pam-service-password
(default '()))
(session pam-service-session
(default '())))
(define-record-type* <pam-entry> pam-entry
make-pam-entry
pam-entry?
(control pam-entry-control) ; string
(module pam-entry-module) ; file name
(arguments pam-entry-arguments ; list of string-valued g-expressions
(default '())))
(define (pam-service->configuration service)
"Return the derivation building the configuration file for SERVICE, to be
dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
(define (entry->gexp type entry)
(match entry
(($ <pam-entry> control module (arguments ...))
#~(format #t "~a ~a ~a ~a~%"
#$type #$control #$module
(string-join (list #$@arguments))))))
(match service
(($ <pam-service> name account auth password session)
(define builder
#~(begin
(with-output-to-file #$output
(lambda ()
#$@(append (map (cut entry->gexp "account" <>) account)
(map (cut entry->gexp "auth" <>) auth)
(map (cut entry->gexp "password" <>) password)
(map (cut entry->gexp "session" <>) session))
#t))))
(computed-file name builder))))
(define (pam-services->directory services)
"Return the derivation to build the configuration directory to be used as
/etc/pam.d for SERVICES."
(let ((names (map pam-service-name services))
(files (map pam-service->configuration services)))
(define builder
#~(begin
(use-modules (ice-9 match)
(srfi srfi-1))
(mkdir #$output)
(for-each (match-lambda
((name file)
(symlink file (string-append #$output "/" name))))
;; Since <pam-service> objects cannot be compared with
;; 'equal?' since they contain gexps, which contain
;; closures, use 'delete-duplicates' on the build-side
;; instead. See <http://bugs.gnu.org/20037>.
(delete-duplicates '#$(zip names files)))))
(computed-file "pam.d" builder)))
(define %pam-other-services
;; The "other" PAM configuration, which denies everything (see
;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
(let ((deny (pam-entry
(control "required")
(module "pam_deny.so"))))
(pam-service
(name "other")
(account (list deny))
(auth (list deny))
(password (list deny))
(session (list deny)))))
(define unix-pam-service
(let ((unix (pam-entry
(control "required")
(module "pam_unix.so"))))
(lambda* (name #:key allow-empty-passwords? motd)
"Return a standard Unix-style PAM service for NAME. When
ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When MOTD is true, it
should be a file-like object used as the message-of-the-day."
;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
(let ((name* name))
(pam-service
(name name*)
(account (list unix))
(auth (list (if allow-empty-passwords?
(pam-entry
(control "required")
(module "pam_unix.so")
(arguments '("nullok")))
unix)))
(password (list (pam-entry
(control "required")
(module "pam_unix.so")
;; Store SHA-512 encrypted passwords in /etc/shadow.
(arguments '("sha512" "shadow")))))
(session (if motd
(list unix
(pam-entry
(control "optional")
(module "pam_motd.so")
(arguments
(list #~(string-append "motd=" #$motd)))))
(list unix))))))))
(define (rootok-pam-service command)
"Return a PAM service for COMMAND such that 'root' does not need to
authenticate to run COMMAND."
(let ((unix (pam-entry
(control "required")
(module "pam_unix.so"))))
(pam-service
(name command)
(account (list unix))
(auth (list (pam-entry
(control "sufficient")
(module "pam_rootok.so"))))
(password (list unix))
(session (list unix)))))
(define* (base-pam-services #:key allow-empty-passwords?)
"Return the list of basic PAM services everyone would want."
;; TODO: Add other Shadow programs?
(append (list %pam-other-services)
;; These programs are setuid-root.
(map (cut unix-pam-service <>
#:allow-empty-passwords? allow-empty-passwords?)
'("su" "passwd" "sudo"
"xlock" "xscreensaver"))
;; These programs are not setuid-root, and we want root to be able
;; to run them without having to authenticate (notably because
;; 'useradd' and 'groupadd' are run during system activation.)
(map rootok-pam-service
'("useradd" "userdel" "usermod"
"groupadd" "groupdel" "groupmod"))))
;;;
;;; PAM root service.
;;;
(define (/etc-entry services)
`(("pam.d" ,(pam-services->directory services))))
(define pam-root-service-type
(service-type (name 'pam)
(extensions (list (service-extension etc-service-type
/etc-entry)))
(compose concatenate)
(extend append)))
(define (pam-root-service base)
"The \"root\" PAM service, which collects <pam-service> instance and turns
them into a /etc/pam.d directory, including the <pam-service> listed in BASE."
(service pam-root-service-type base))
;;; linux.scm ends here