2014-02-19 19:58:24 +00:00
|
|
|
|
;;; GNU Guix --- Functional package management for GNU
|
2022-04-17 13:05:43 +00:00
|
|
|
|
;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
|
2015-02-04 08:39:48 +00:00
|
|
|
|
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
2020-08-16 13:33:43 +00:00
|
|
|
|
;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
|
2016-09-05 11:53:39 +00:00
|
|
|
|
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
|
2017-01-24 22:50:33 +00:00
|
|
|
|
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
|
2017-03-14 17:12:34 +00:00
|
|
|
|
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
|
2018-04-08 23:04:10 +00:00
|
|
|
|
;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
|
2018-06-14 02:41:18 +00:00
|
|
|
|
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
|
2018-07-22 23:23:53 +00:00
|
|
|
|
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
2018-08-17 11:09:07 +00:00
|
|
|
|
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
|
2019-06-13 17:17:05 +00:00
|
|
|
|
;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
|
2021-04-12 21:00:27 +00:00
|
|
|
|
;;; Copyright © 2019, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
2019-09-13 09:53:59 +00:00
|
|
|
|
;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
|
2019-11-05 01:29:24 +00:00
|
|
|
|
;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
|
2020-05-14 16:44:15 +00:00
|
|
|
|
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
|
2021-01-01 10:02:11 +00:00
|
|
|
|
;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
|
2021-08-15 18:15:37 +00:00
|
|
|
|
;;; Copyright © 2021 Christine Lemmer-Webber <cwebber@dustycloud.org>
|
2021-01-15 20:46:42 +00:00
|
|
|
|
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
|
2021-07-24 13:38:03 +00:00
|
|
|
|
;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
|
2023-01-12 10:37:51 +00:00
|
|
|
|
;;; Copyright © 2022, 2023 Andrew Tropin <andrew@trop.in>
|
|
|
|
|
;;; Copyright © 2023 Declan Tsien <declantsien@riseup.net>
|
2023-01-27 21:06:13 +00:00
|
|
|
|
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
|
2014-02-19 19:58:24 +00:00
|
|
|
|
;;;
|
|
|
|
|
;;; 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 services networking)
|
|
|
|
|
#:use-module (gnu services)
|
2018-04-29 22:40:21 +00:00
|
|
|
|
#:use-module (gnu services base)
|
2020-04-19 16:01:13 +00:00
|
|
|
|
#:use-module (gnu services configuration)
|
2020-05-14 16:44:15 +00:00
|
|
|
|
#:use-module (gnu services linux)
|
2016-01-27 12:45:01 +00:00
|
|
|
|
#:use-module (gnu services shepherd)
|
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-09-17 21:44:26 +00:00
|
|
|
|
#:use-module (gnu services dbus)
|
2022-05-23 19:39:08 +00:00
|
|
|
|
#:use-module (gnu services admin)
|
2014-07-12 21:14:10 +00:00
|
|
|
|
#:use-module (gnu system shadow)
|
2015-11-03 17:08:47 +00:00
|
|
|
|
#:use-module (gnu system pam)
|
2022-04-17 13:05:43 +00:00
|
|
|
|
#:use-module ((gnu system file-systems) #:select (file-system-mapping))
|
2014-02-19 19:58:24 +00:00
|
|
|
|
#:use-module (gnu packages admin)
|
2019-06-13 17:17:05 +00:00
|
|
|
|
#:use-module (gnu packages base)
|
|
|
|
|
#:use-module (gnu packages bash)
|
2021-01-01 10:02:11 +00:00
|
|
|
|
#:use-module (gnu packages cluster)
|
2015-12-31 20:10:11 +00:00
|
|
|
|
#:use-module (gnu packages connman)
|
2018-03-29 22:21:39 +00:00
|
|
|
|
#:use-module (gnu packages freedesktop)
|
2014-02-19 19:58:24 +00:00
|
|
|
|
#:use-module (gnu packages linux)
|
2014-07-12 21:14:10 +00:00
|
|
|
|
#:use-module (gnu packages tor)
|
2019-06-13 17:17:05 +00:00
|
|
|
|
#:use-module (gnu packages usb-modeswitch)
|
2014-09-23 21:46:01 +00:00
|
|
|
|
#:use-module (gnu packages messaging)
|
2017-01-27 13:37:42 +00:00
|
|
|
|
#:use-module (gnu packages networking)
|
2014-11-05 09:13:43 +00:00
|
|
|
|
#:use-module (gnu packages ntp)
|
2015-11-16 05:56:24 +00:00
|
|
|
|
#:use-module (gnu packages gnome)
|
2021-01-15 20:46:42 +00:00
|
|
|
|
#:use-module (gnu packages ipfs)
|
|
|
|
|
#:use-module (gnu build linux-container)
|
2022-04-17 13:05:43 +00:00
|
|
|
|
#:autoload (guix least-authority) (least-authority-wrapper)
|
2014-04-28 21:07:08 +00:00
|
|
|
|
#:use-module (guix gexp)
|
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-09-17 21:44:26 +00:00
|
|
|
|
#:use-module (guix records)
|
2017-02-06 22:48:48 +00:00
|
|
|
|
#:use-module (guix modules)
|
2019-10-18 21:12:35 +00:00
|
|
|
|
#:use-module (guix packages)
|
2019-01-10 13:50:09 +00:00
|
|
|
|
#:use-module (guix deprecation)
|
2022-10-01 13:12:57 +00:00
|
|
|
|
#:use-module (guix diagnostics)
|
|
|
|
|
#:autoload (guix ui) (display-hint)
|
|
|
|
|
#:use-module (guix i18n)
|
2019-09-03 01:14:59 +00:00
|
|
|
|
#:use-module (rnrs enums)
|
2015-11-27 22:04:49 +00:00
|
|
|
|
#:use-module (srfi srfi-1)
|
|
|
|
|
#:use-module (srfi srfi-9)
|
2014-11-05 09:13:43 +00:00
|
|
|
|
#:use-module (srfi srfi-26)
|
2020-06-11 12:09:57 +00:00
|
|
|
|
#:use-module (srfi srfi-43)
|
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-09-17 21:44:26 +00:00
|
|
|
|
#:use-module (ice-9 match)
|
2020-06-11 12:09:57 +00:00
|
|
|
|
#:use-module (json)
|
2018-04-30 08:37:28 +00:00
|
|
|
|
#:re-export (static-networking-service
|
|
|
|
|
static-networking-service-type)
|
2023-01-27 21:06:13 +00:00
|
|
|
|
#:export (%facebook-host-aliases ;deprecated
|
|
|
|
|
block-facebook-hosts-service-type
|
|
|
|
|
|
2018-10-17 22:45:05 +00:00
|
|
|
|
dhcp-client-service-type
|
2022-10-01 13:12:57 +00:00
|
|
|
|
dhcp-client-configuration
|
|
|
|
|
dhcp-client-configuration?
|
|
|
|
|
dhcp-client-configuration-package
|
|
|
|
|
dhcp-client-configuration-interfaces
|
2017-12-16 08:52:42 +00:00
|
|
|
|
|
|
|
|
|
dhcpd-service-type
|
|
|
|
|
dhcpd-configuration
|
|
|
|
|
dhcpd-configuration?
|
|
|
|
|
dhcpd-configuration-package
|
|
|
|
|
dhcpd-configuration-config-file
|
|
|
|
|
dhcpd-configuration-version
|
|
|
|
|
dhcpd-configuration-run-directory
|
|
|
|
|
dhcpd-configuration-lease-file
|
|
|
|
|
dhcpd-configuration-pid-file
|
|
|
|
|
dhcpd-configuration-interfaces
|
|
|
|
|
|
2016-07-19 13:19:14 +00:00
|
|
|
|
ntp-configuration
|
|
|
|
|
ntp-configuration?
|
2019-09-03 01:14:59 +00:00
|
|
|
|
ntp-configuration-ntp
|
|
|
|
|
ntp-configuration-servers
|
|
|
|
|
ntp-allow-large-adjustment?
|
|
|
|
|
|
|
|
|
|
%ntp-servers
|
|
|
|
|
ntp-server
|
|
|
|
|
ntp-server-type
|
|
|
|
|
ntp-server-address
|
|
|
|
|
ntp-server-options
|
|
|
|
|
|
2016-07-19 13:19:14 +00:00
|
|
|
|
ntp-service-type
|
|
|
|
|
|
2019-09-03 01:14:59 +00:00
|
|
|
|
%openntpd-servers
|
2017-11-28 08:19:11 +00:00
|
|
|
|
openntpd-configuration
|
|
|
|
|
openntpd-configuration?
|
|
|
|
|
openntpd-service-type
|
|
|
|
|
|
2017-03-14 17:12:34 +00:00
|
|
|
|
inetd-configuration
|
|
|
|
|
inetd-entry
|
|
|
|
|
inetd-service-type
|
|
|
|
|
|
2021-04-12 21:00:27 +00:00
|
|
|
|
opendht-configuration
|
|
|
|
|
opendht-configuration-peer-discovery?
|
|
|
|
|
opendht-configuration-verbose?
|
|
|
|
|
opendht-configuration-bootstrap-host
|
|
|
|
|
opendht-configuration-port
|
|
|
|
|
opendht-configuration-proxy-server-port
|
|
|
|
|
opendht-configuration-proxy-server-port-tls
|
|
|
|
|
opendht-configuration->command-line-arguments
|
|
|
|
|
|
|
|
|
|
opendht-shepherd-service
|
|
|
|
|
opendht-service-type
|
|
|
|
|
|
2016-07-19 13:19:14 +00:00
|
|
|
|
tor-configuration
|
|
|
|
|
tor-configuration?
|
2015-11-27 22:04:49 +00:00
|
|
|
|
tor-hidden-service
|
2016-07-19 13:19:14 +00:00
|
|
|
|
tor-service-type
|
|
|
|
|
|
2017-01-20 13:43:53 +00:00
|
|
|
|
network-manager-configuration
|
|
|
|
|
network-manager-configuration?
|
|
|
|
|
network-manager-configuration-dns
|
2019-10-18 20:50:17 +00:00
|
|
|
|
network-manager-configuration-vpn-plugins
|
2017-01-20 13:43:53 +00:00
|
|
|
|
network-manager-service-type
|
|
|
|
|
|
2017-02-20 15:25:44 +00:00
|
|
|
|
connman-configuration
|
|
|
|
|
connman-configuration?
|
|
|
|
|
connman-service-type
|
|
|
|
|
|
2018-03-29 22:21:39 +00:00
|
|
|
|
modem-manager-configuration
|
|
|
|
|
modem-manager-configuration?
|
|
|
|
|
modem-manager-service-type
|
2018-04-08 23:04:10 +00:00
|
|
|
|
|
2019-06-13 17:17:05 +00:00
|
|
|
|
usb-modeswitch-configuration
|
|
|
|
|
usb-modeswitch-configuration?
|
|
|
|
|
usb-modeswitch-configuration-usb-modeswitch
|
|
|
|
|
usb-modeswitch-configuration-usb-modeswitch-data
|
|
|
|
|
usb-modeswitch-service-type
|
|
|
|
|
|
2018-04-08 23:04:10 +00:00
|
|
|
|
wpa-supplicant-configuration
|
|
|
|
|
wpa-supplicant-configuration?
|
|
|
|
|
wpa-supplicant-configuration-wpa-supplicant
|
2020-06-24 22:33:38 +00:00
|
|
|
|
wpa-supplicant-configuration-requirement
|
2018-04-08 23:04:10 +00:00
|
|
|
|
wpa-supplicant-configuration-pid-file
|
|
|
|
|
wpa-supplicant-configuration-dbus?
|
|
|
|
|
wpa-supplicant-configuration-interface
|
|
|
|
|
wpa-supplicant-configuration-config-file
|
|
|
|
|
wpa-supplicant-configuration-extra-options
|
2017-01-27 13:37:42 +00:00
|
|
|
|
wpa-supplicant-service-type
|
|
|
|
|
|
2020-04-19 16:01:13 +00:00
|
|
|
|
hostapd-configuration
|
|
|
|
|
hostapd-configuration?
|
|
|
|
|
hostapd-configuration-package
|
|
|
|
|
hostapd-configuration-interface
|
|
|
|
|
hostapd-configuration-ssid
|
|
|
|
|
hostapd-configuration-broadcast-ssid?
|
|
|
|
|
hostapd-configuration-channel
|
|
|
|
|
hostapd-configuration-driver
|
|
|
|
|
hostapd-service-type
|
|
|
|
|
|
2020-04-19 20:06:32 +00:00
|
|
|
|
simulated-wifi-service-type
|
|
|
|
|
|
2017-01-27 13:37:42 +00:00
|
|
|
|
openvswitch-service-type
|
2018-08-17 11:09:07 +00:00
|
|
|
|
openvswitch-configuration
|
|
|
|
|
|
|
|
|
|
iptables-configuration
|
|
|
|
|
iptables-configuration?
|
|
|
|
|
iptables-configuration-iptables
|
|
|
|
|
iptables-configuration-ipv4-rules
|
|
|
|
|
iptables-configuration-ipv6-rules
|
2019-09-13 09:53:59 +00:00
|
|
|
|
iptables-service-type
|
|
|
|
|
|
|
|
|
|
nftables-service-type
|
|
|
|
|
nftables-configuration
|
|
|
|
|
nftables-configuration?
|
|
|
|
|
nftables-configuration-package
|
|
|
|
|
nftables-configuration-ruleset
|
2019-11-05 01:29:24 +00:00
|
|
|
|
%default-nftables-ruleset
|
|
|
|
|
|
|
|
|
|
pagekite-service-type
|
|
|
|
|
pagekite-configuration
|
|
|
|
|
pagekite-configuration?
|
|
|
|
|
pagekite-configuration-package
|
|
|
|
|
pagekite-configuration-kitename
|
|
|
|
|
pagekite-configuration-kitesecret
|
|
|
|
|
pagekite-configuration-frontend
|
|
|
|
|
pagekite-configuration-kites
|
2020-06-11 12:09:57 +00:00
|
|
|
|
pagekite-configuration-extra-file
|
|
|
|
|
|
|
|
|
|
yggdrasil-service-type
|
|
|
|
|
yggdrasil-configuration
|
|
|
|
|
yggdrasil-configuration?
|
|
|
|
|
yggdrasil-configuration-autoconf?
|
|
|
|
|
yggdrasil-configuration-config-file
|
|
|
|
|
yggdrasil-configuration-log-level
|
|
|
|
|
yggdrasil-configuration-log-to
|
|
|
|
|
yggdrasil-configuration-json-config
|
2021-01-01 10:02:11 +00:00
|
|
|
|
yggdrasil-configuration-package
|
|
|
|
|
|
2021-01-15 20:46:42 +00:00
|
|
|
|
ipfs-service-type
|
|
|
|
|
ipfs-configuration
|
|
|
|
|
ipfs-configuration?
|
|
|
|
|
ipfs-configuration-package
|
|
|
|
|
ipfs-configuration-gateway
|
|
|
|
|
ipfs-configuration-api
|
|
|
|
|
|
2021-01-01 10:02:11 +00:00
|
|
|
|
keepalived-configuration
|
|
|
|
|
keepalived-configuration?
|
|
|
|
|
keepalived-service-type))
|
2014-02-19 19:58:24 +00:00
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
;;;
|
|
|
|
|
;;; Networking services.
|
|
|
|
|
;;;
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
2023-01-27 21:06:13 +00:00
|
|
|
|
(define facebook-host-aliases
|
2014-10-07 19:33:12 +00:00
|
|
|
|
;; This is the list of known Facebook hosts to be added to /etc/hosts if you
|
|
|
|
|
;; are to block it.
|
2023-01-27 21:06:13 +00:00
|
|
|
|
(let ((domains '("facebook.com" "www.facebook.com"
|
|
|
|
|
"login.facebook.com" "www.login.facebook.com"
|
|
|
|
|
"fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com"
|
|
|
|
|
"static.ak.fbcdn.net" "static.ak.connect.facebook.com"
|
|
|
|
|
"connect.facebook.net" "www.connect.facebook.net"
|
|
|
|
|
"apps.facebook.com")))
|
|
|
|
|
(append-map (lambda (name)
|
|
|
|
|
(map (lambda (addr)
|
|
|
|
|
(host addr name))
|
|
|
|
|
(list "127.0.0.1" "::1"))) domains)))
|
|
|
|
|
|
|
|
|
|
(define-deprecated %facebook-host-aliases
|
|
|
|
|
block-facebook-hosts-service-type
|
|
|
|
|
(string-join
|
|
|
|
|
(map (lambda (x)
|
|
|
|
|
(string-append (host-address x) "\t"
|
|
|
|
|
(host-canonical-name x) "\n"))
|
|
|
|
|
facebook-host-aliases)))
|
2014-10-07 19:33:12 +00:00
|
|
|
|
|
2023-01-27 21:06:13 +00:00
|
|
|
|
(define block-facebook-hosts-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'block-facebook-hosts)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension hosts-service-type
|
|
|
|
|
(const facebook-host-aliases))))
|
|
|
|
|
(default-value #f)
|
|
|
|
|
(description "Add a list of known Facebook hosts to @file{/etc/hosts}")))
|
2022-10-01 13:12:57 +00:00
|
|
|
|
|
|
|
|
|
(define-record-type* <dhcp-client-configuration>
|
|
|
|
|
dhcp-client-configuration make-dhcp-client-configuration
|
|
|
|
|
dhcp-client-configuration?
|
|
|
|
|
(package dhcp-client-configuration-package ;file-like
|
|
|
|
|
(default isc-dhcp))
|
|
|
|
|
(interfaces dhcp-client-configuration-interfaces
|
|
|
|
|
(default 'all))) ;'all | list of strings
|
|
|
|
|
|
|
|
|
|
(define dhcp-client-shepherd-service
|
|
|
|
|
(match-lambda
|
2022-11-19 21:34:13 +00:00
|
|
|
|
((? dhcp-client-configuration? config)
|
|
|
|
|
(let ((package (dhcp-client-configuration-package config))
|
|
|
|
|
(interfaces (dhcp-client-configuration-interfaces config))
|
|
|
|
|
(pid-file "/var/run/dhclient.pid"))
|
2022-10-01 13:12:57 +00:00
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(documentation "Set up networking via DHCP.")
|
|
|
|
|
(requirement '(user-processes udev))
|
|
|
|
|
|
|
|
|
|
;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
|
|
|
|
|
;; networking is unavailable, but also means that the interface is not up
|
|
|
|
|
;; yet when 'start' completes. To wait for the interface to be ready, one
|
|
|
|
|
;; should instead monitor udev events.
|
|
|
|
|
(provision '(networking))
|
|
|
|
|
|
|
|
|
|
(start #~(lambda _
|
|
|
|
|
(define dhclient
|
|
|
|
|
(string-append #$package "/sbin/dhclient"))
|
|
|
|
|
|
|
|
|
|
;; When invoked without any arguments, 'dhclient' discovers all
|
|
|
|
|
;; non-loopback interfaces *that are up*. However, the relevant
|
|
|
|
|
;; interfaces are typically down at this point. Thus we perform
|
|
|
|
|
;; our own interface discovery here.
|
|
|
|
|
(define valid?
|
|
|
|
|
(lambda (interface)
|
|
|
|
|
(and (arp-network-interface? interface)
|
|
|
|
|
(not (loopback-network-interface? interface))
|
|
|
|
|
;; XXX: Make sure the interfaces are up so that
|
|
|
|
|
;; 'dhclient' can actually send/receive over them.
|
|
|
|
|
;; Ignore those that cannot be activated.
|
|
|
|
|
(false-if-exception
|
|
|
|
|
(set-network-interface-up interface)))))
|
|
|
|
|
(define ifaces
|
|
|
|
|
(filter valid?
|
|
|
|
|
#$(match interfaces
|
|
|
|
|
('all
|
|
|
|
|
#~(all-network-interface-names))
|
|
|
|
|
(_
|
|
|
|
|
#~'#$interfaces))))
|
|
|
|
|
|
|
|
|
|
(false-if-exception (delete-file #$pid-file))
|
|
|
|
|
(let ((pid (fork+exec-command
|
|
|
|
|
(cons* dhclient "-nw"
|
|
|
|
|
"-pf" #$pid-file ifaces))))
|
|
|
|
|
(and (zero? (cdr (waitpid pid)))
|
|
|
|
|
(read-pid-file #$pid-file)))))
|
|
|
|
|
(stop #~(make-kill-destructor))))))
|
|
|
|
|
(package
|
|
|
|
|
(warning (G_ "'dhcp-client' service now expects a \
|
|
|
|
|
'dhcp-client-configuration' record~%"))
|
|
|
|
|
(display-hint (G_ "The value associated with instances of
|
|
|
|
|
@code{dhcp-client-service-type} must now be a @code{dhcp-client-configuration}
|
|
|
|
|
record instead of a package. Please adjust your configuration accordingly."))
|
|
|
|
|
(dhcp-client-shepherd-service
|
|
|
|
|
(dhcp-client-configuration
|
|
|
|
|
(package package))))))
|
|
|
|
|
|
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-09-17 21:44:26 +00:00
|
|
|
|
(define dhcp-client-service-type
|
2022-10-01 13:12:57 +00:00
|
|
|
|
(service-type (name 'dhcp-client)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
dhcp-client-shepherd-service)))
|
|
|
|
|
(default-value (dhcp-client-configuration))
|
|
|
|
|
(description "Run @command{dhcp}, a Dynamic Host Configuration
|
2021-01-13 21:14:00 +00:00
|
|
|
|
Protocol (DHCP) client, on all the non-loopback network interfaces.")))
|
2014-02-19 19:58:24 +00:00
|
|
|
|
|
2017-12-16 08:52:42 +00:00
|
|
|
|
(define-record-type* <dhcpd-configuration>
|
|
|
|
|
dhcpd-configuration make-dhcpd-configuration
|
|
|
|
|
dhcpd-configuration?
|
2021-11-18 21:44:26 +00:00
|
|
|
|
(package dhcpd-configuration-package ;file-like
|
2017-12-16 08:52:42 +00:00
|
|
|
|
(default isc-dhcp))
|
|
|
|
|
(config-file dhcpd-configuration-config-file ;file-like
|
|
|
|
|
(default #f))
|
|
|
|
|
(version dhcpd-configuration-version ;"4", "6", or "4o6"
|
2018-04-27 08:34:38 +00:00
|
|
|
|
(default "4"))
|
2017-12-16 08:52:42 +00:00
|
|
|
|
(run-directory dhcpd-configuration-run-directory
|
|
|
|
|
(default "/run/dhcpd"))
|
|
|
|
|
(lease-file dhcpd-configuration-lease-file
|
|
|
|
|
(default "/var/db/dhcpd.leases"))
|
|
|
|
|
(pid-file dhcpd-configuration-pid-file
|
|
|
|
|
(default "/run/dhcpd/dhcpd.pid"))
|
|
|
|
|
;; list of strings, e.g. (list "enp0s25")
|
|
|
|
|
(interfaces dhcpd-configuration-interfaces
|
|
|
|
|
(default '())))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (dhcpd-shepherd-service config)
|
|
|
|
|
(match-record config <dhcpd-configuration>
|
|
|
|
|
(package config-file version run-directory
|
|
|
|
|
lease-file pid-file interfaces)
|
|
|
|
|
(unless config-file
|
|
|
|
|
(error "Must supply a config-file"))
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
;; Allow users to easily run multiple versions simultaneously.
|
|
|
|
|
(provision (list (string->symbol
|
|
|
|
|
(string-append "dhcpv" version "-daemon"))))
|
|
|
|
|
(documentation (string-append "Run the DHCPv" version " daemon"))
|
|
|
|
|
(requirement '(networking))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
'(#$(file-append package "/sbin/dhcpd")
|
|
|
|
|
#$(string-append "-" version)
|
|
|
|
|
"-lf" #$lease-file
|
|
|
|
|
"-pf" #$pid-file
|
|
|
|
|
"-cf" #$config-file
|
|
|
|
|
#$@interfaces)
|
|
|
|
|
#:pid-file #$pid-file))
|
|
|
|
|
(stop #~(make-kill-destructor))))))
|
|
|
|
|
|
|
|
|
|
(define (dhcpd-activation config)
|
|
|
|
|
(match-record config <dhcpd-configuration>
|
|
|
|
|
(package config-file version run-directory
|
|
|
|
|
lease-file pid-file interfaces)
|
|
|
|
|
(with-imported-modules '((guix build utils))
|
|
|
|
|
#~(begin
|
|
|
|
|
(unless (file-exists? #$run-directory)
|
|
|
|
|
(mkdir #$run-directory))
|
|
|
|
|
;; According to the DHCP manual (man dhcpd.leases), the lease
|
|
|
|
|
;; database must be present for dhcpd to start successfully.
|
|
|
|
|
(unless (file-exists? #$lease-file)
|
|
|
|
|
(with-output-to-file #$lease-file
|
|
|
|
|
(lambda _ (display ""))))
|
|
|
|
|
;; Validate the config.
|
|
|
|
|
(invoke/quiet
|
|
|
|
|
#$(file-append package "/sbin/dhcpd")
|
|
|
|
|
#$(string-append "-" version)
|
|
|
|
|
"-t" "-cf" #$config-file)))))
|
2017-12-16 08:52:42 +00:00
|
|
|
|
|
|
|
|
|
(define dhcpd-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'dhcpd)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type dhcpd-shepherd-service)
|
2020-05-08 14:15:33 +00:00
|
|
|
|
(service-extension activation-service-type dhcpd-activation)))
|
|
|
|
|
(description "Run a DHCP (Dynamic Host Configuration Protocol) daemon. The
|
|
|
|
|
daemon is responsible for allocating IP addresses to its client.")))
|
2017-12-16 08:52:42 +00:00
|
|
|
|
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; NTP.
|
|
|
|
|
;;;
|
|
|
|
|
|
2022-05-23 19:39:08 +00:00
|
|
|
|
|
|
|
|
|
(define %ntp-log-rotation
|
|
|
|
|
(list (log-rotation
|
|
|
|
|
(files '("/var/log/ntpd.log")))))
|
|
|
|
|
|
2019-09-03 01:14:59 +00:00
|
|
|
|
(define ntp-server-types (make-enumeration
|
|
|
|
|
'(pool
|
|
|
|
|
server
|
|
|
|
|
peer
|
|
|
|
|
broadcast
|
|
|
|
|
manycastclient)))
|
|
|
|
|
|
|
|
|
|
(define-record-type* <ntp-server>
|
|
|
|
|
ntp-server make-ntp-server
|
|
|
|
|
ntp-server?
|
|
|
|
|
;; The type can be one of the symbols of the NTP-SERVER-TYPE? enumeration.
|
|
|
|
|
(type ntp-server-type
|
|
|
|
|
(default 'server))
|
|
|
|
|
(address ntp-server-address) ; a string
|
|
|
|
|
;; The list of options can contain single option names or tuples in the form
|
|
|
|
|
;; '(name value).
|
|
|
|
|
(options ntp-server-options
|
|
|
|
|
(default '())))
|
|
|
|
|
|
|
|
|
|
(define (ntp-server->string ntp-server)
|
|
|
|
|
;; Serialize the NTP server object as a string, ready to use in the NTP
|
|
|
|
|
;; configuration file.
|
|
|
|
|
(define (flatten lst)
|
|
|
|
|
(reverse
|
|
|
|
|
(let loop ((x lst)
|
|
|
|
|
(res '()))
|
|
|
|
|
(if (list? x)
|
|
|
|
|
(fold loop res x)
|
2019-10-30 21:46:17 +00:00
|
|
|
|
(cons (format #f "~a" x) res)))))
|
2019-09-03 01:14:59 +00:00
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(match-record ntp-server <ntp-server>
|
|
|
|
|
(type address options)
|
|
|
|
|
;; XXX: It'd be neater if fields were validated at the syntax level (for
|
|
|
|
|
;; static ones at least). Perhaps the Guix record type could support a
|
|
|
|
|
;; predicate property on a field?
|
|
|
|
|
(unless (enum-set-member? type ntp-server-types)
|
|
|
|
|
(error "Invalid NTP server type" type))
|
|
|
|
|
(string-join (cons* (symbol->string type)
|
|
|
|
|
address
|
|
|
|
|
(flatten options)))))
|
2019-09-03 01:14:59 +00:00
|
|
|
|
|
|
|
|
|
(define %ntp-servers
|
|
|
|
|
;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
|
|
|
|
|
;; Within Guix, Leo Famulari <leo@famulari.name> is the administrative contact
|
|
|
|
|
;; for this NTP pool "zone".
|
2022-01-06 06:29:26 +00:00
|
|
|
|
;; The full list of available URLs are 0.guix.pool.ntp.org,
|
|
|
|
|
;; 1.guix.pool.ntp.org, 2.guix.pool.ntp.org, and 3.guix.pool.ntp.org.
|
2019-09-03 01:14:59 +00:00
|
|
|
|
(list
|
|
|
|
|
(ntp-server
|
|
|
|
|
(type 'pool)
|
|
|
|
|
(address "0.guix.pool.ntp.org")
|
|
|
|
|
(options '("iburst"))))) ;as recommended in the ntpd manual
|
|
|
|
|
|
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-09-17 21:44:26 +00:00
|
|
|
|
(define-record-type* <ntp-configuration>
|
|
|
|
|
ntp-configuration make-ntp-configuration
|
|
|
|
|
ntp-configuration?
|
|
|
|
|
(ntp ntp-configuration-ntp
|
|
|
|
|
(default ntp))
|
2019-09-03 01:14:59 +00:00
|
|
|
|
(servers %ntp-configuration-servers ;list of <ntp-server> objects
|
2018-10-19 20:46:23 +00:00
|
|
|
|
(default %ntp-servers))
|
2016-10-20 13:14:17 +00:00
|
|
|
|
(allow-large-adjustment? ntp-allow-large-adjustment?
|
2019-09-02 15:42:24 +00:00
|
|
|
|
(default #t))) ;as recommended in the ntpd manual
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
2019-09-03 01:14:59 +00:00
|
|
|
|
(define (ntp-configuration-servers ntp-configuration)
|
|
|
|
|
;; A wrapper to support the deprecated form of this field.
|
|
|
|
|
(let ((ntp-servers (%ntp-configuration-servers ntp-configuration)))
|
|
|
|
|
(match ntp-servers
|
|
|
|
|
(((? string?) (? string?) ...)
|
|
|
|
|
(format (current-error-port) "warning: Defining NTP servers as strings is \
|
|
|
|
|
deprecated. Please use <ntp-server> records instead.\n")
|
|
|
|
|
(map (lambda (addr)
|
|
|
|
|
(ntp-server
|
|
|
|
|
(type 'server)
|
|
|
|
|
(address addr)
|
|
|
|
|
(options '()))) ntp-servers))
|
|
|
|
|
((($ <ntp-server>) ($ <ntp-server>) ...)
|
|
|
|
|
ntp-servers))))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (ntp-shepherd-service config)
|
|
|
|
|
(match-record config <ntp-configuration>
|
|
|
|
|
(ntp servers allow-large-adjustment?)
|
|
|
|
|
(let ((servers (ntp-configuration-servers config)))
|
|
|
|
|
;; TODO: Add authentication support.
|
|
|
|
|
(define config
|
|
|
|
|
(string-append "driftfile /var/run/ntpd/ntp.drift\n"
|
|
|
|
|
(string-join (map ntp-server->string servers)
|
|
|
|
|
"\n")
|
|
|
|
|
"
|
2014-11-05 09:13:43 +00:00
|
|
|
|
# Disable status queries as a workaround for CVE-2013-5211:
|
|
|
|
|
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
|
2019-09-03 01:05:06 +00:00
|
|
|
|
restrict default kod nomodify notrap nopeer noquery limited
|
|
|
|
|
restrict -6 default kod nomodify notrap nopeer noquery limited
|
2014-11-05 09:13:43 +00:00
|
|
|
|
|
|
|
|
|
# Yet, allow use of the local 'ntpq'.
|
|
|
|
|
restrict 127.0.0.1
|
2019-09-03 01:14:59 +00:00
|
|
|
|
restrict -6 ::1
|
|
|
|
|
|
|
|
|
|
# This is required to use servers from a pool directive when using the 'nopeer'
|
|
|
|
|
# option by default, as documented in the 'ntp.conf' manual.
|
|
|
|
|
restrict source notrap nomodify noquery\n"))
|
2014-11-05 09:13:43 +00:00
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define ntpd.conf
|
|
|
|
|
(plain-file "ntpd.conf" config))
|
|
|
|
|
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(provision '(ntpd))
|
|
|
|
|
(documentation "Run the Network Time Protocol (NTP) daemon.")
|
|
|
|
|
(requirement '(user-processes networking))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list (string-append #$ntp "/bin/ntpd") "-n"
|
|
|
|
|
"-c" #$ntpd.conf "-u" "ntpd"
|
|
|
|
|
#$@(if allow-large-adjustment?
|
|
|
|
|
'("-g")
|
|
|
|
|
'()))
|
|
|
|
|
#:log-file "/var/log/ntpd.log"))
|
|
|
|
|
(stop #~(make-kill-destructor)))))))
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
|
|
|
|
(define %ntp-accounts
|
|
|
|
|
(list (user-account
|
|
|
|
|
(name "ntpd")
|
|
|
|
|
(group "nogroup")
|
|
|
|
|
(system? #t)
|
|
|
|
|
(comment "NTP daemon user")
|
|
|
|
|
(home-directory "/var/empty")
|
system: Use 'file-append' to denote file names.
* gnu/services/avahi.scm, gnu/services/base.scm,
gnu/services/databases.scm, gnu/services/dbus.scm,
gnu/services/desktop.scm, gnu/services/dict.scm,
gnu/services/mail.scm, gnu/services/networking.scm,
gnu/services/sddm.scm, gnu/services/spice.scm,
gnu/services/ssh.scm, gnu/services/web.scm,
gnu/services/xorg.scm, gnu/system.scm: Replace the
#~(string-append #$pkg "/bin/foo") idiom with
(file-append pkg "/bin/foo").
2016-09-10 10:03:47 +00:00
|
|
|
|
(shell (file-append shadow "/sbin/nologin")))))
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
2016-09-05 11:53:39 +00:00
|
|
|
|
|
|
|
|
|
(define (ntp-service-activation config)
|
|
|
|
|
"Return the activation gexp for CONFIG."
|
|
|
|
|
(with-imported-modules '((guix build utils))
|
|
|
|
|
#~(begin
|
2017-01-24 22:50:33 +00:00
|
|
|
|
(use-modules (guix build utils))
|
2016-09-05 11:53:39 +00:00
|
|
|
|
(define %user
|
|
|
|
|
(getpw "ntpd"))
|
|
|
|
|
|
|
|
|
|
(let ((directory "/var/run/ntpd"))
|
|
|
|
|
(mkdir-p directory)
|
|
|
|
|
(chown directory (passwd:uid %user) (passwd:gid %user))))))
|
|
|
|
|
|
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-09-17 21:44:26 +00:00
|
|
|
|
(define ntp-service-type
|
|
|
|
|
(service-type (name 'ntp)
|
|
|
|
|
(extensions
|
services: Rename 'dmd' services to 'shepherd'.
* gnu/services/shepherd.scm (dmd-root-service-type, %dmd-root-service)
(dmd-service-type, <dmd-service>, dmd-service, dmd-service?)
(make-dmd-service, dmd-service-documentation, dmd-service-provision)
(dmd-service-requirement, dmd-service-respawn, dmd-service-start)
(dmd-service-stop, dmd-service-auto-start?, dmd-service-modules)
(dmd-service-imported-modules, dmd-service-file-name, dmd-service-file)
(dmd-service-back-edges): Rename to...
(shepherd-root-service-type, %shepherd-root-service, shepherd-service-type)
(<shepherd-service>, shepherd-service, shepherd-service?)
(make-shepherd-service, shepherd-service-documentation)
(shepherd-service-provision, shepherd-service-requirement)
(shepherd-service-respawn, shepherd-service-start)
(shepherd-service-stop, shepherd-service-auto-start?)
(shepherd-service-modules, shepherd-service-imported-modules)
(shepherd-service-file-name, shepherd-service-file)
(shepherd-service-back-edges): ...this
* gnu/services.scm: Adjust comments.
* gnu/services/avahi.scm (avahi-dmd-service): Rename to...
(avahi-shepherd-service): ... this.
* gnu/services/base.scm (%root-file-system-dmd-service)
(file-system->dmd-service-name, mapped-device->dmd-service-name)
(dependency->dmd-service-name, file-system-dmd-service)
(mingetty-dmd-service, nscd-dmd-service, guix-dmd-service)
(guix-publish-dmd-service, udev-dmd-service, gpm-dmd-service): Rename to...
(%root-file-system-shepherd-service)
(file-system->shepherd-service-name, mapped-device->shepherd-service-name)
(dependency->shepherd-service-name, file-system-shepherd-service)
(mingetty-shepherd-service, nscd-shepherd-service, guix-shepherd-service)
(guix-publish-shepherd-service, udev-shepherd-service)
(gpm-shepherd-service): ... this.
* gnu/services/databases.scm (postgresql-dmd-service): Rename to...
(postgresql-shepherd-service): ... this.
* gnu/services/desktop.scm (upower-dmd-service, elogind-dmd-service):
Rename to...
(upower-shepherd-service, elogind-shepherd-service): ... this.
* gnu/services/dbus.scm (dbus-dmd-service): Rename to...
(dbus-shepherd-service): ... this.
* gnu/services/lirc.scm (lirc-dmd-service): Rename to...
(lirc-shepherd-service): ... this.
* gnu/services/mail.scm (dovecot-dmd-service): Rename to...
(dovecot-shepherd-service): ... this.
* gnu/services/networking.scm (ntp-dmd-service, tor-dmd-service)
(bitlbee-dmd-service, wicd-dmd-service, network-manager-dmd-service): Rename to...
(dbus-shepherd-service): ... this.
* gnu/services/ssh.scm (lsh-dmd-service): Rename to...
(lsh-shepherd-service): ... this.
* gnu/services/web.scm (nginx-dmd-service): Rename to...
(nginx-shepherd-service): ... this.
* gnu/services/xorg.scm (slim-dmd-service): Rename to...
(slim-shepherd-service): ... this.
* gnu/system.scm (essential-services): Use '%shepherd-root-service'.
* gnu/system/install.scm (cow-store-service-type): Adjust accordingly.
* guix/scripts/system.scm (dmd-service-node-label, dmd-service-node-type)
(export-dmd-graph): Likewise.
* tests/guix-system.sh: Likewise.
* tests/services.scm ("dmd-service-back-edges"): Rename to...
("shepherd-service-back-edges"): Adjust accordingly.
* doc/guix.texi: Likewise.
* doc/images/service-graph.dot: Use 'shepherd' service name.
2016-01-27 20:02:31 +00:00
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
ntp-shepherd-service)
|
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-09-17 21:44:26 +00:00
|
|
|
|
(service-extension account-service-type
|
2016-09-05 11:53:39 +00:00
|
|
|
|
(const %ntp-accounts))
|
|
|
|
|
(service-extension activation-service-type
|
2022-05-23 19:39:08 +00:00
|
|
|
|
ntp-service-activation)
|
|
|
|
|
(service-extension rottlog-service-type
|
|
|
|
|
(const %ntp-log-rotation))))
|
2017-09-13 20:55:04 +00:00
|
|
|
|
(description
|
|
|
|
|
"Run the @command{ntpd}, the Network Time Protocol (NTP)
|
|
|
|
|
daemon of the @uref{http://www.ntp.org, Network Time Foundation}. The daemon
|
2018-10-19 20:46:23 +00:00
|
|
|
|
will keep the system clock synchronized with that of the given servers.")
|
|
|
|
|
(default-value (ntp-configuration))))
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
2017-11-28 08:19:11 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; OpenNTPD.
|
|
|
|
|
;;;
|
|
|
|
|
|
2019-09-03 01:14:59 +00:00
|
|
|
|
(define %openntpd-servers
|
|
|
|
|
(map ntp-server-address %ntp-servers))
|
|
|
|
|
|
2017-11-28 08:19:11 +00:00
|
|
|
|
(define-record-type* <openntpd-configuration>
|
|
|
|
|
openntpd-configuration make-openntpd-configuration
|
|
|
|
|
openntpd-configuration?
|
|
|
|
|
(openntpd openntpd-configuration-openntpd
|
|
|
|
|
(default openntpd))
|
|
|
|
|
(listen-on openntpd-listen-on
|
|
|
|
|
(default '("127.0.0.1"
|
|
|
|
|
"::1")))
|
|
|
|
|
(query-from openntpd-query-from
|
|
|
|
|
(default '()))
|
|
|
|
|
(sensor openntpd-sensor
|
|
|
|
|
(default '()))
|
|
|
|
|
(server openntpd-server
|
|
|
|
|
(default '()))
|
2019-09-03 01:14:59 +00:00
|
|
|
|
(servers openntpd-servers
|
|
|
|
|
(default %openntpd-servers))
|
2017-11-28 08:19:11 +00:00
|
|
|
|
(constraint-from openntpd-constraint-from
|
|
|
|
|
(default '()))
|
|
|
|
|
(constraints-from openntpd-constraints-from
|
2021-01-11 17:04:59 +00:00
|
|
|
|
(default '())))
|
2017-11-28 08:19:11 +00:00
|
|
|
|
|
2019-09-07 00:24:43 +00:00
|
|
|
|
(define (openntpd-configuration->string config)
|
2019-09-07 03:37:37 +00:00
|
|
|
|
|
|
|
|
|
(define (quote-field? name)
|
|
|
|
|
(member name '("constraints from")))
|
|
|
|
|
|
2017-11-28 08:19:11 +00:00
|
|
|
|
(match-record config <openntpd-configuration>
|
2019-09-07 00:24:43 +00:00
|
|
|
|
(listen-on query-from sensor server servers constraint-from
|
|
|
|
|
constraints-from)
|
2019-09-07 03:37:37 +00:00
|
|
|
|
(string-append
|
2019-09-07 00:24:43 +00:00
|
|
|
|
(string-join
|
2019-09-07 03:37:37 +00:00
|
|
|
|
(concatenate
|
|
|
|
|
(filter-map (lambda (field values)
|
|
|
|
|
(match values
|
|
|
|
|
(() #f) ;discard entry with filter-map
|
|
|
|
|
((val ...) ;validate value type
|
|
|
|
|
(map (lambda (value)
|
|
|
|
|
(if (quote-field? field)
|
|
|
|
|
(format #f "~a \"~a\"" field value)
|
|
|
|
|
(format #f "~a ~a" field value)))
|
|
|
|
|
values))))
|
|
|
|
|
;; The entry names.
|
|
|
|
|
'("listen on" "query from" "sensor" "server" "servers"
|
|
|
|
|
"constraint from" "constraints from")
|
|
|
|
|
;; The corresponding entry values.
|
|
|
|
|
(list listen-on query-from sensor server servers
|
|
|
|
|
constraint-from constraints-from)))
|
|
|
|
|
"\n")
|
|
|
|
|
"\n"))) ;add a trailing newline
|
2019-09-07 00:24:43 +00:00
|
|
|
|
|
|
|
|
|
(define (openntpd-shepherd-service config)
|
2021-01-11 17:04:59 +00:00
|
|
|
|
(let ((openntpd (openntpd-configuration-openntpd config)))
|
2019-09-06 12:12:26 +00:00
|
|
|
|
|
|
|
|
|
(define ntpd.conf
|
2019-09-07 00:24:43 +00:00
|
|
|
|
(plain-file "ntpd.conf" (openntpd-configuration->string config)))
|
2019-09-06 12:12:26 +00:00
|
|
|
|
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(provision '(ntpd))
|
|
|
|
|
(documentation "Run the Network Time Protocol (NTP) daemon.")
|
|
|
|
|
(requirement '(user-processes networking))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list (string-append #$openntpd "/sbin/ntpd")
|
|
|
|
|
"-f" #$ntpd.conf
|
2021-01-11 17:04:59 +00:00
|
|
|
|
"-d") ;; don't daemonize
|
2019-09-06 12:12:26 +00:00
|
|
|
|
;; When ntpd is daemonized it repeatedly tries to respawn
|
|
|
|
|
;; while running, leading shepherd to disable it. To
|
|
|
|
|
;; prevent spamming stderr, redirect output to logfile.
|
2022-05-23 19:39:08 +00:00
|
|
|
|
#:log-file "/var/log/ntpd.log"))
|
2022-11-11 17:56:35 +00:00
|
|
|
|
(stop #~(make-kill-destructor))
|
|
|
|
|
(actions (list (shepherd-configuration-action ntpd.conf)))))))
|
2017-11-28 08:19:11 +00:00
|
|
|
|
|
|
|
|
|
(define (openntpd-service-activation config)
|
|
|
|
|
"Return the activation gexp for CONFIG."
|
|
|
|
|
(with-imported-modules '((guix build utils))
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
|
|
|
|
|
(mkdir-p "/var/db")
|
|
|
|
|
(mkdir-p "/var/run")
|
|
|
|
|
(unless (file-exists? "/var/db/ntpd.drift")
|
|
|
|
|
(with-output-to-file "/var/db/ntpd.drift"
|
|
|
|
|
(lambda _
|
|
|
|
|
(format #t "0.0")))))))
|
|
|
|
|
|
|
|
|
|
(define openntpd-service-type
|
|
|
|
|
(service-type (name 'openntpd)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
openntpd-shepherd-service)
|
|
|
|
|
(service-extension account-service-type
|
|
|
|
|
(const %ntp-accounts))
|
2018-05-18 15:25:07 +00:00
|
|
|
|
(service-extension profile-service-type
|
|
|
|
|
(compose list openntpd-configuration-openntpd))
|
2017-11-28 08:19:11 +00:00
|
|
|
|
(service-extension activation-service-type
|
2022-05-23 19:39:08 +00:00
|
|
|
|
openntpd-service-activation)
|
|
|
|
|
(service-extension rottlog-service-type
|
|
|
|
|
(const %ntp-log-rotation))))
|
2017-11-28 08:19:11 +00:00
|
|
|
|
(default-value (openntpd-configuration))
|
|
|
|
|
(description
|
|
|
|
|
"Run the @command{ntpd}, the Network Time Protocol (NTP)
|
|
|
|
|
daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}. The
|
|
|
|
|
daemon will keep the system clock synchronized with that of the given servers.")))
|
|
|
|
|
|
2017-03-14 17:12:34 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Inetd.
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <inetd-configuration> inetd-configuration
|
|
|
|
|
make-inetd-configuration
|
|
|
|
|
inetd-configuration?
|
|
|
|
|
(program inetd-configuration-program ;file-like
|
|
|
|
|
(default (file-append inetutils "/libexec/inetd")))
|
|
|
|
|
(entries inetd-configuration-entries ;list of <inetd-entry>
|
|
|
|
|
(default '())))
|
|
|
|
|
|
|
|
|
|
(define-record-type* <inetd-entry> inetd-entry make-inetd-entry
|
|
|
|
|
inetd-entry?
|
|
|
|
|
(node inetd-entry-node ;string or #f
|
|
|
|
|
(default #f))
|
|
|
|
|
(name inetd-entry-name) ;string, from /etc/services
|
|
|
|
|
|
|
|
|
|
(socket-type inetd-entry-socket-type) ;stream | dgram | raw |
|
|
|
|
|
;rdm | seqpacket
|
|
|
|
|
(protocol inetd-entry-protocol) ;string, from /etc/protocols
|
|
|
|
|
|
|
|
|
|
(wait? inetd-entry-wait? ;Boolean
|
|
|
|
|
(default #t))
|
|
|
|
|
(user inetd-entry-user) ;string
|
|
|
|
|
|
|
|
|
|
(program inetd-entry-program ;string or file-like object
|
|
|
|
|
(default "internal"))
|
|
|
|
|
(arguments inetd-entry-arguments ;list of strings or file-like objects
|
|
|
|
|
(default '())))
|
|
|
|
|
|
|
|
|
|
(define (inetd-config-file entries)
|
|
|
|
|
(apply mixed-text-file "inetd.conf"
|
|
|
|
|
(map
|
|
|
|
|
(lambda (entry)
|
|
|
|
|
(let* ((node (inetd-entry-node entry))
|
|
|
|
|
(name (inetd-entry-name entry))
|
|
|
|
|
(socket
|
|
|
|
|
(if node (string-append node ":" name) name))
|
|
|
|
|
(type
|
|
|
|
|
(match (inetd-entry-socket-type entry)
|
|
|
|
|
((or 'stream 'dgram 'raw 'rdm 'seqpacket)
|
|
|
|
|
(symbol->string (inetd-entry-socket-type entry)))))
|
|
|
|
|
(protocol (inetd-entry-protocol entry))
|
|
|
|
|
(wait (if (inetd-entry-wait? entry) "wait" "nowait"))
|
|
|
|
|
(user (inetd-entry-user entry))
|
|
|
|
|
(program (inetd-entry-program entry))
|
|
|
|
|
(args (inetd-entry-arguments entry)))
|
|
|
|
|
#~(string-append
|
|
|
|
|
(string-join
|
|
|
|
|
(list #$@(list socket type protocol wait user program) #$@args)
|
|
|
|
|
" ") "\n")))
|
|
|
|
|
entries)))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (inetd-shepherd-service config)
|
|
|
|
|
(let ((entries (inetd-configuration-entries config)))
|
|
|
|
|
(if (null? entries)
|
|
|
|
|
'() ;do nothing
|
|
|
|
|
(let ((program (inetd-configuration-program config)))
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(documentation "Run inetd.")
|
|
|
|
|
(provision '(inetd))
|
|
|
|
|
(requirement '(user-processes networking syslogd))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list #$program #$(inetd-config-file entries))
|
|
|
|
|
#:pid-file "/var/run/inetd.pid"))
|
|
|
|
|
(stop #~(make-kill-destructor))))))))
|
2017-03-14 17:12:34 +00:00
|
|
|
|
|
|
|
|
|
(define-public inetd-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'inetd)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
inetd-shepherd-service)))
|
|
|
|
|
|
|
|
|
|
;; The service can be extended with additional lists of entries.
|
|
|
|
|
(compose concatenate)
|
|
|
|
|
(extend (lambda (config entries)
|
|
|
|
|
(inetd-configuration
|
|
|
|
|
(inherit config)
|
|
|
|
|
(entries (append (inetd-configuration-entries config)
|
2017-09-13 20:55:04 +00:00
|
|
|
|
entries)))))
|
|
|
|
|
(description
|
|
|
|
|
"Start @command{inetd}, the @dfn{Internet superserver}. It is responsible
|
|
|
|
|
for listening on Internet sockets and spawning the corresponding services on
|
|
|
|
|
demand.")))
|
2017-03-14 17:12:34 +00:00
|
|
|
|
|
2021-04-12 21:00:27 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; OpenDHT, the distributed hash table network used by Jami
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-maybe/no-serialization number)
|
|
|
|
|
(define-maybe/no-serialization string)
|
|
|
|
|
|
|
|
|
|
;;; To generate the documentation of the following configuration record, you
|
|
|
|
|
;;; can evaluate: (configuration->documentation 'opendht-configuration)
|
|
|
|
|
(define-configuration/no-serialization opendht-configuration
|
|
|
|
|
(opendht
|
2021-11-18 21:44:26 +00:00
|
|
|
|
(file-like opendht)
|
2021-04-12 21:00:27 +00:00
|
|
|
|
"The @code{opendht} package to use.")
|
|
|
|
|
(peer-discovery?
|
|
|
|
|
(boolean #false)
|
|
|
|
|
"Whether to enable the multicast local peer discovery mechanism.")
|
|
|
|
|
(enable-logging?
|
|
|
|
|
(boolean #false)
|
|
|
|
|
"Whether to enable logging messages to syslog. It is disabled by default
|
|
|
|
|
as it is rather verbose.")
|
|
|
|
|
(debug?
|
|
|
|
|
(boolean #false)
|
|
|
|
|
"Whether to enable debug-level logging messages. This has no effect if
|
|
|
|
|
logging is disabled.")
|
|
|
|
|
(bootstrap-host
|
|
|
|
|
(maybe-string "bootstrap.jami.net:4222")
|
|
|
|
|
"The node host name that is used to make the first connection to the
|
|
|
|
|
network. A specific port value can be provided by appending the @code{:PORT}
|
|
|
|
|
suffix. By default, it uses the Jami bootstrap nodes, but any host can be
|
2022-05-17 11:39:28 +00:00
|
|
|
|
specified here. It's also possible to disable bootstrapping by explicitly
|
2022-08-24 12:40:41 +00:00
|
|
|
|
setting this field to @code{%unset-value}.")
|
2021-04-12 21:00:27 +00:00
|
|
|
|
(port
|
|
|
|
|
(maybe-number 4222)
|
2022-07-27 19:18:51 +00:00
|
|
|
|
"The UDP port to bind to. When left unspecified, an available port is
|
|
|
|
|
automatically selected.")
|
2021-04-12 21:00:27 +00:00
|
|
|
|
(proxy-server-port
|
2022-05-17 11:39:28 +00:00
|
|
|
|
maybe-number
|
2021-04-12 21:00:27 +00:00
|
|
|
|
"Spawn a proxy server listening on the specified port.")
|
|
|
|
|
(proxy-server-port-tls
|
2022-05-17 11:39:28 +00:00
|
|
|
|
maybe-number
|
2021-04-12 21:00:27 +00:00
|
|
|
|
"Spawn a proxy server listening to TLS connections on the specified
|
|
|
|
|
port."))
|
|
|
|
|
|
|
|
|
|
(define %opendht-accounts
|
|
|
|
|
;; User account and groups for Tor.
|
|
|
|
|
(list (user-group (name "opendht") (system? #t))
|
|
|
|
|
(user-account
|
|
|
|
|
(name "opendht")
|
|
|
|
|
(group "opendht")
|
|
|
|
|
(system? #t)
|
|
|
|
|
(comment "OpenDHT daemon user")
|
|
|
|
|
(home-directory "/var/empty")
|
|
|
|
|
(shell (file-append shadow "/sbin/nologin")))))
|
|
|
|
|
|
|
|
|
|
(define (opendht-configuration->command-line-arguments config)
|
|
|
|
|
"Derive the command line arguments used to launch the OpenDHT daemon from
|
|
|
|
|
CONFIG, an <opendht-configuration> object."
|
|
|
|
|
(match-record config <opendht-configuration>
|
|
|
|
|
(opendht bootstrap-host enable-logging? port debug? peer-discovery?
|
|
|
|
|
proxy-server-port proxy-server-port-tls)
|
2022-04-27 16:35:21 +00:00
|
|
|
|
(let ((dhtnode (least-authority-wrapper
|
|
|
|
|
;; XXX: Work around lack of support for multiple outputs
|
|
|
|
|
;; in 'file-append'.
|
|
|
|
|
(computed-file "dhtnode"
|
|
|
|
|
#~(symlink
|
|
|
|
|
(string-append #$opendht:tools
|
|
|
|
|
"/bin/dhtnode")
|
|
|
|
|
#$output))
|
|
|
|
|
#:name "dhtnode"
|
|
|
|
|
#:mappings (list (file-system-mapping
|
|
|
|
|
(source "/dev/log") ;for syslog
|
|
|
|
|
(target source)))
|
|
|
|
|
#:namespaces (delq 'net %namespaces))))
|
2021-04-12 21:00:27 +00:00
|
|
|
|
`(,dhtnode
|
|
|
|
|
"--service" ;non-forking mode
|
|
|
|
|
,@(if (string? bootstrap-host)
|
|
|
|
|
(list "--bootstrap" bootstrap-host))
|
|
|
|
|
,@(if enable-logging?
|
|
|
|
|
(list "--syslog")
|
|
|
|
|
'())
|
|
|
|
|
,@(if (number? port)
|
|
|
|
|
(list "--port" (number->string port))
|
|
|
|
|
'())
|
|
|
|
|
,@(if debug?
|
|
|
|
|
(list "--verbose")
|
|
|
|
|
'())
|
|
|
|
|
,@(if peer-discovery?
|
|
|
|
|
(list "--peer-discovery")
|
|
|
|
|
'())
|
|
|
|
|
,@(if (number? proxy-server-port)
|
|
|
|
|
(list "--proxyserver" (number->string proxy-server-port))
|
|
|
|
|
'())
|
|
|
|
|
,@(if (number? proxy-server-port-tls)
|
|
|
|
|
(list "--proxyserverssl" (number->string proxy-server-port-tls))
|
|
|
|
|
'())))))
|
|
|
|
|
|
|
|
|
|
(define (opendht-shepherd-service config)
|
|
|
|
|
"Return a <shepherd-service> running OpenDHT."
|
2022-04-27 16:35:21 +00:00
|
|
|
|
(shepherd-service
|
|
|
|
|
(documentation "Run an OpenDHT node.")
|
|
|
|
|
(provision '(opendht dhtnode dhtproxy))
|
|
|
|
|
(requirement '(networking syslogd))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list #$@(opendht-configuration->command-line-arguments config))
|
|
|
|
|
#:user "opendht"
|
|
|
|
|
#:group "opendht"))
|
|
|
|
|
(stop #~(make-kill-destructor))))
|
2021-04-12 21:00:27 +00:00
|
|
|
|
|
|
|
|
|
(define opendht-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'opendht)
|
|
|
|
|
(default-value (opendht-configuration))
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
(compose list opendht-shepherd-service))
|
|
|
|
|
(service-extension account-service-type
|
|
|
|
|
(const %opendht-accounts))))
|
|
|
|
|
(description "Run the OpenDHT @command{dhtnode} command that allows
|
|
|
|
|
participating in the distributed hash table based OpenDHT network. The
|
|
|
|
|
service can be configured to act as a proxy to the distributed network, which
|
|
|
|
|
can be useful for portable devices where minimizing energy consumption is
|
|
|
|
|
paramount. OpenDHT was originally based on Kademlia and adapted for
|
|
|
|
|
applications in communication. It is used by Jami, for example.")))
|
|
|
|
|
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Tor.
|
|
|
|
|
;;;
|
|
|
|
|
|
2015-11-27 22:04:49 +00:00
|
|
|
|
(define-record-type* <tor-configuration>
|
|
|
|
|
tor-configuration make-tor-configuration
|
|
|
|
|
tor-configuration?
|
|
|
|
|
(tor tor-configuration-tor
|
|
|
|
|
(default tor))
|
2017-04-15 22:06:43 +00:00
|
|
|
|
(config-file tor-configuration-config-file
|
|
|
|
|
(default (plain-file "empty" "")))
|
2015-11-27 22:04:49 +00:00
|
|
|
|
(hidden-services tor-configuration-hidden-services
|
2018-07-31 08:13:48 +00:00
|
|
|
|
(default '()))
|
|
|
|
|
(socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix
|
2021-02-15 22:57:04 +00:00
|
|
|
|
(default 'tcp))
|
|
|
|
|
(control-socket? tor-control-socket-path
|
|
|
|
|
(default #f)))
|
2015-11-27 22:04:49 +00:00
|
|
|
|
|
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-09-17 21:44:26 +00:00
|
|
|
|
(define %tor-accounts
|
|
|
|
|
;; User account and groups for Tor.
|
|
|
|
|
(list (user-group (name "tor") (system? #t))
|
|
|
|
|
(user-account
|
|
|
|
|
(name "tor")
|
|
|
|
|
(group "tor")
|
|
|
|
|
(system? #t)
|
|
|
|
|
(comment "Tor daemon user")
|
|
|
|
|
(home-directory "/var/empty")
|
system: Use 'file-append' to denote file names.
* gnu/services/avahi.scm, gnu/services/base.scm,
gnu/services/databases.scm, gnu/services/dbus.scm,
gnu/services/desktop.scm, gnu/services/dict.scm,
gnu/services/mail.scm, gnu/services/networking.scm,
gnu/services/sddm.scm, gnu/services/spice.scm,
gnu/services/ssh.scm, gnu/services/web.scm,
gnu/services/xorg.scm, gnu/system.scm: Replace the
#~(string-append #$pkg "/bin/foo") idiom with
(file-append pkg "/bin/foo").
2016-09-10 10:03:47 +00:00
|
|
|
|
(shell (file-append shadow "/sbin/nologin")))))
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
2015-11-27 22:04:49 +00:00
|
|
|
|
(define-record-type <hidden-service>
|
|
|
|
|
(hidden-service name mapping)
|
|
|
|
|
hidden-service?
|
|
|
|
|
(name hidden-service-name) ;string
|
|
|
|
|
(mapping hidden-service-mapping)) ;list of port/address tuples
|
|
|
|
|
|
|
|
|
|
(define (tor-configuration->torrc config)
|
|
|
|
|
"Return a 'torrc' file for CONFIG."
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(match-record config <tor-configuration>
|
|
|
|
|
(tor config-file hidden-services socks-socket-type control-socket?)
|
|
|
|
|
(computed-file
|
|
|
|
|
"torrc"
|
|
|
|
|
(with-imported-modules '((guix build utils))
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (guix build utils)
|
|
|
|
|
(ice-9 match))
|
|
|
|
|
|
|
|
|
|
(call-with-output-file #$output
|
|
|
|
|
(lambda (port)
|
|
|
|
|
(display "\
|
2018-06-14 02:41:18 +00:00
|
|
|
|
### These lines were generated from your system configuration:
|
2015-11-27 22:29:51 +00:00
|
|
|
|
DataDirectory /var/lib/tor
|
2015-11-27 22:08:00 +00:00
|
|
|
|
Log notice syslog\n" port)
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(when (eq? 'unix '#$socks-socket-type)
|
|
|
|
|
(display "\
|
2018-07-31 08:13:48 +00:00
|
|
|
|
SocksPort unix:/var/run/tor/socks-sock
|
|
|
|
|
UnixSocksGroupWritable 1\n" port))
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(when #$control-socket?
|
|
|
|
|
(display "\
|
2021-02-15 22:57:04 +00:00
|
|
|
|
ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
|
|
|
|
|
ControlSocketsGroupWritable 1\n"
|
2022-11-19 21:34:13 +00:00
|
|
|
|
port))
|
2015-11-27 22:04:49 +00:00
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(for-each (match-lambda
|
|
|
|
|
((service (ports hosts) ...)
|
|
|
|
|
(format port "\
|
2015-11-27 22:29:51 +00:00
|
|
|
|
HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
|
2022-11-19 21:34:13 +00:00
|
|
|
|
service)
|
|
|
|
|
(for-each (lambda (tcp-port host)
|
|
|
|
|
(format port "\
|
2015-11-27 22:04:49 +00:00
|
|
|
|
HiddenServicePort ~a ~a~%"
|
2022-11-19 21:34:13 +00:00
|
|
|
|
tcp-port host))
|
|
|
|
|
ports hosts)))
|
|
|
|
|
'#$(map (match-lambda
|
|
|
|
|
(($ <hidden-service> name mapping)
|
|
|
|
|
(cons name mapping)))
|
|
|
|
|
hidden-services))
|
|
|
|
|
|
|
|
|
|
(display "\
|
2018-06-14 02:41:18 +00:00
|
|
|
|
### End of automatically generated lines.\n\n" port)
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
;; Append the user's config file.
|
|
|
|
|
(call-with-input-file #$config-file
|
|
|
|
|
(lambda (input)
|
|
|
|
|
(dump-port input port)))
|
|
|
|
|
#t)))))))
|
2015-11-27 22:04:49 +00:00
|
|
|
|
|
services: Rename 'dmd' services to 'shepherd'.
* gnu/services/shepherd.scm (dmd-root-service-type, %dmd-root-service)
(dmd-service-type, <dmd-service>, dmd-service, dmd-service?)
(make-dmd-service, dmd-service-documentation, dmd-service-provision)
(dmd-service-requirement, dmd-service-respawn, dmd-service-start)
(dmd-service-stop, dmd-service-auto-start?, dmd-service-modules)
(dmd-service-imported-modules, dmd-service-file-name, dmd-service-file)
(dmd-service-back-edges): Rename to...
(shepherd-root-service-type, %shepherd-root-service, shepherd-service-type)
(<shepherd-service>, shepherd-service, shepherd-service?)
(make-shepherd-service, shepherd-service-documentation)
(shepherd-service-provision, shepherd-service-requirement)
(shepherd-service-respawn, shepherd-service-start)
(shepherd-service-stop, shepherd-service-auto-start?)
(shepherd-service-modules, shepherd-service-imported-modules)
(shepherd-service-file-name, shepherd-service-file)
(shepherd-service-back-edges): ...this
* gnu/services.scm: Adjust comments.
* gnu/services/avahi.scm (avahi-dmd-service): Rename to...
(avahi-shepherd-service): ... this.
* gnu/services/base.scm (%root-file-system-dmd-service)
(file-system->dmd-service-name, mapped-device->dmd-service-name)
(dependency->dmd-service-name, file-system-dmd-service)
(mingetty-dmd-service, nscd-dmd-service, guix-dmd-service)
(guix-publish-dmd-service, udev-dmd-service, gpm-dmd-service): Rename to...
(%root-file-system-shepherd-service)
(file-system->shepherd-service-name, mapped-device->shepherd-service-name)
(dependency->shepherd-service-name, file-system-shepherd-service)
(mingetty-shepherd-service, nscd-shepherd-service, guix-shepherd-service)
(guix-publish-shepherd-service, udev-shepherd-service)
(gpm-shepherd-service): ... this.
* gnu/services/databases.scm (postgresql-dmd-service): Rename to...
(postgresql-shepherd-service): ... this.
* gnu/services/desktop.scm (upower-dmd-service, elogind-dmd-service):
Rename to...
(upower-shepherd-service, elogind-shepherd-service): ... this.
* gnu/services/dbus.scm (dbus-dmd-service): Rename to...
(dbus-shepherd-service): ... this.
* gnu/services/lirc.scm (lirc-dmd-service): Rename to...
(lirc-shepherd-service): ... this.
* gnu/services/mail.scm (dovecot-dmd-service): Rename to...
(dovecot-shepherd-service): ... this.
* gnu/services/networking.scm (ntp-dmd-service, tor-dmd-service)
(bitlbee-dmd-service, wicd-dmd-service, network-manager-dmd-service): Rename to...
(dbus-shepherd-service): ... this.
* gnu/services/ssh.scm (lsh-dmd-service): Rename to...
(lsh-shepherd-service): ... this.
* gnu/services/web.scm (nginx-dmd-service): Rename to...
(nginx-shepherd-service): ... this.
* gnu/services/xorg.scm (slim-dmd-service): Rename to...
(slim-shepherd-service): ... this.
* gnu/system.scm (essential-services): Use '%shepherd-root-service'.
* gnu/system/install.scm (cow-store-service-type): Adjust accordingly.
* guix/scripts/system.scm (dmd-service-node-label, dmd-service-node-type)
(export-dmd-graph): Likewise.
* tests/guix-system.sh: Likewise.
* tests/services.scm ("dmd-service-back-edges"): Rename to...
("shepherd-service-back-edges"): Adjust accordingly.
* doc/guix.texi: Likewise.
* doc/images/service-graph.dot: Use 'shepherd' service name.
2016-01-27 20:02:31 +00:00
|
|
|
|
(define (tor-shepherd-service config)
|
2018-07-22 23:23:53 +00:00
|
|
|
|
"Return a <shepherd-service> running Tor."
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(let* ((torrc (tor-configuration->torrc config))
|
|
|
|
|
(tor (least-authority-wrapper
|
|
|
|
|
(file-append (tor-configuration-tor config) "/bin/tor")
|
|
|
|
|
#:name "tor"
|
|
|
|
|
#:mappings (list (file-system-mapping
|
|
|
|
|
(source "/var/lib/tor")
|
|
|
|
|
(target source)
|
|
|
|
|
(writable? #t))
|
|
|
|
|
(file-system-mapping
|
|
|
|
|
(source "/dev/log") ;for syslog
|
|
|
|
|
(target source))
|
|
|
|
|
(file-system-mapping
|
|
|
|
|
(source "/var/run/tor")
|
|
|
|
|
(target source)
|
|
|
|
|
(writable? #t))
|
|
|
|
|
(file-system-mapping
|
|
|
|
|
(source torrc)
|
|
|
|
|
(target source)))
|
|
|
|
|
#:namespaces (delq 'net %namespaces))))
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(provision '(tor))
|
|
|
|
|
|
|
|
|
|
;; Tor needs at least one network interface to be up, hence the
|
|
|
|
|
;; dependency on 'loopback'.
|
|
|
|
|
(requirement '(user-processes loopback syslogd))
|
|
|
|
|
|
|
|
|
|
;; XXX: #:pid-file won't work because the wrapped 'tor'
|
|
|
|
|
;; program would print its PID within the user namespace
|
|
|
|
|
;; instead of its actual PID outside. There's no inetd or
|
|
|
|
|
;; systemd socket activation support either (there's
|
|
|
|
|
;; 'sd_notify' though), so we're stuck with that.
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list #$tor "-f" #$torrc)
|
|
|
|
|
#:user "tor" #:group "tor"))
|
|
|
|
|
(stop #~(make-kill-destructor))
|
|
|
|
|
(actions (list (shepherd-configuration-action torrc)))
|
|
|
|
|
(documentation "Run the Tor anonymous network overlay.")))))
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
2018-07-25 09:51:41 +00:00
|
|
|
|
(define (tor-activation config)
|
2018-07-22 23:23:53 +00:00
|
|
|
|
"Set up directories for Tor and its hidden services, if any."
|
2015-11-27 22:04:49 +00:00
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
|
2015-11-27 22:29:51 +00:00
|
|
|
|
(define %user
|
|
|
|
|
(getpw "tor"))
|
|
|
|
|
|
2015-11-27 22:04:49 +00:00
|
|
|
|
(define (initialize service)
|
2015-11-27 22:29:51 +00:00
|
|
|
|
(let ((directory (string-append "/var/lib/tor/hidden-services/"
|
|
|
|
|
service)))
|
2015-11-27 22:04:49 +00:00
|
|
|
|
(mkdir-p directory)
|
2015-11-27 22:29:51 +00:00
|
|
|
|
(chown directory (passwd:uid %user) (passwd:gid %user))
|
2015-11-27 22:04:49 +00:00
|
|
|
|
|
|
|
|
|
;; The daemon bails out if we give wider permissions.
|
|
|
|
|
(chmod directory #o700)))
|
|
|
|
|
|
2018-07-22 23:23:53 +00:00
|
|
|
|
;; Allow Tor to write its PID file.
|
|
|
|
|
(mkdir-p "/var/run/tor")
|
|
|
|
|
(chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
|
|
|
|
|
;; Set the group permissions to rw so that if the system administrator
|
|
|
|
|
;; has specified UnixSocksGroupWritable=1 in their torrc file, members
|
|
|
|
|
;; of the "tor" group will be able to use the SOCKS socket.
|
|
|
|
|
(chmod "/var/run/tor" #o750)
|
|
|
|
|
|
|
|
|
|
;; Allow Tor to access the hidden services' directories.
|
2015-11-27 22:29:51 +00:00
|
|
|
|
(mkdir-p "/var/lib/tor")
|
|
|
|
|
(chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
|
|
|
|
|
(chmod "/var/lib/tor" #o700)
|
|
|
|
|
|
2016-12-03 22:36:10 +00:00
|
|
|
|
;; Make sure /var/lib is accessible to the 'tor' user.
|
|
|
|
|
(chmod "/var/lib" #o755)
|
|
|
|
|
|
2015-11-27 22:04:49 +00:00
|
|
|
|
(for-each initialize
|
|
|
|
|
'#$(map hidden-service-name
|
|
|
|
|
(tor-configuration-hidden-services config)))))
|
|
|
|
|
|
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-09-17 21:44:26 +00:00
|
|
|
|
(define tor-service-type
|
|
|
|
|
(service-type (name 'tor)
|
|
|
|
|
(extensions
|
services: Rename 'dmd' services to 'shepherd'.
* gnu/services/shepherd.scm (dmd-root-service-type, %dmd-root-service)
(dmd-service-type, <dmd-service>, dmd-service, dmd-service?)
(make-dmd-service, dmd-service-documentation, dmd-service-provision)
(dmd-service-requirement, dmd-service-respawn, dmd-service-start)
(dmd-service-stop, dmd-service-auto-start?, dmd-service-modules)
(dmd-service-imported-modules, dmd-service-file-name, dmd-service-file)
(dmd-service-back-edges): Rename to...
(shepherd-root-service-type, %shepherd-root-service, shepherd-service-type)
(<shepherd-service>, shepherd-service, shepherd-service?)
(make-shepherd-service, shepherd-service-documentation)
(shepherd-service-provision, shepherd-service-requirement)
(shepherd-service-respawn, shepherd-service-start)
(shepherd-service-stop, shepherd-service-auto-start?)
(shepherd-service-modules, shepherd-service-imported-modules)
(shepherd-service-file-name, shepherd-service-file)
(shepherd-service-back-edges): ...this
* gnu/services.scm: Adjust comments.
* gnu/services/avahi.scm (avahi-dmd-service): Rename to...
(avahi-shepherd-service): ... this.
* gnu/services/base.scm (%root-file-system-dmd-service)
(file-system->dmd-service-name, mapped-device->dmd-service-name)
(dependency->dmd-service-name, file-system-dmd-service)
(mingetty-dmd-service, nscd-dmd-service, guix-dmd-service)
(guix-publish-dmd-service, udev-dmd-service, gpm-dmd-service): Rename to...
(%root-file-system-shepherd-service)
(file-system->shepherd-service-name, mapped-device->shepherd-service-name)
(dependency->shepherd-service-name, file-system-shepherd-service)
(mingetty-shepherd-service, nscd-shepherd-service, guix-shepherd-service)
(guix-publish-shepherd-service, udev-shepherd-service)
(gpm-shepherd-service): ... this.
* gnu/services/databases.scm (postgresql-dmd-service): Rename to...
(postgresql-shepherd-service): ... this.
* gnu/services/desktop.scm (upower-dmd-service, elogind-dmd-service):
Rename to...
(upower-shepherd-service, elogind-shepherd-service): ... this.
* gnu/services/dbus.scm (dbus-dmd-service): Rename to...
(dbus-shepherd-service): ... this.
* gnu/services/lirc.scm (lirc-dmd-service): Rename to...
(lirc-shepherd-service): ... this.
* gnu/services/mail.scm (dovecot-dmd-service): Rename to...
(dovecot-shepherd-service): ... this.
* gnu/services/networking.scm (ntp-dmd-service, tor-dmd-service)
(bitlbee-dmd-service, wicd-dmd-service, network-manager-dmd-service): Rename to...
(dbus-shepherd-service): ... this.
* gnu/services/ssh.scm (lsh-dmd-service): Rename to...
(lsh-shepherd-service): ... this.
* gnu/services/web.scm (nginx-dmd-service): Rename to...
(nginx-shepherd-service): ... this.
* gnu/services/xorg.scm (slim-dmd-service): Rename to...
(slim-shepherd-service): ... this.
* gnu/system.scm (essential-services): Use '%shepherd-root-service'.
* gnu/system/install.scm (cow-store-service-type): Adjust accordingly.
* guix/scripts/system.scm (dmd-service-node-label, dmd-service-node-type)
(export-dmd-graph): Likewise.
* tests/guix-system.sh: Likewise.
* tests/services.scm ("dmd-service-back-edges"): Rename to...
("shepherd-service-back-edges"): Adjust accordingly.
* doc/guix.texi: Likewise.
* doc/images/service-graph.dot: Use 'shepherd' service name.
2016-01-27 20:02:31 +00:00
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
tor-shepherd-service)
|
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-09-17 21:44:26 +00:00
|
|
|
|
(service-extension account-service-type
|
2015-11-27 22:04:49 +00:00
|
|
|
|
(const %tor-accounts))
|
|
|
|
|
(service-extension activation-service-type
|
2022-07-31 16:22:45 +00:00
|
|
|
|
tor-activation)))
|
2015-11-27 22:04:49 +00:00
|
|
|
|
|
|
|
|
|
;; This can be extended with hidden services.
|
|
|
|
|
(compose concatenate)
|
|
|
|
|
(extend (lambda (config services)
|
|
|
|
|
(tor-configuration
|
|
|
|
|
(inherit config)
|
|
|
|
|
(hidden-services
|
|
|
|
|
(append (tor-configuration-hidden-services config)
|
2017-04-15 22:06:43 +00:00
|
|
|
|
services)))))
|
2017-09-13 20:55:04 +00:00
|
|
|
|
(default-value (tor-configuration))
|
|
|
|
|
(description
|
|
|
|
|
"Run the @uref{https://torproject.org, Tor} anonymous
|
|
|
|
|
networking daemon.")))
|
2014-11-05 09:13:43 +00:00
|
|
|
|
|
2015-11-27 22:04:49 +00:00
|
|
|
|
(define tor-hidden-service-type
|
|
|
|
|
;; A type that extends Tor with hidden services.
|
|
|
|
|
(service-type (name 'tor-hidden-service)
|
|
|
|
|
(extensions
|
2017-09-13 20:55:04 +00:00
|
|
|
|
(list (service-extension tor-service-type list)))
|
|
|
|
|
(description
|
|
|
|
|
"Define a new Tor @dfn{hidden service}.")))
|
2015-11-27 22:04:49 +00:00
|
|
|
|
|
|
|
|
|
(define (tor-hidden-service name mapping)
|
|
|
|
|
"Define a new Tor @dfn{hidden service} called @var{name} and implementing
|
|
|
|
|
@var{mapping}. @var{mapping} is a list of port/host tuples, such as:
|
|
|
|
|
|
|
|
|
|
@example
|
|
|
|
|
'((22 \"127.0.0.1:22\")
|
|
|
|
|
(80 \"127.0.0.1:8080\"))
|
|
|
|
|
@end example
|
|
|
|
|
|
|
|
|
|
In this example, port 22 of the hidden service is mapped to local port 22, and
|
|
|
|
|
port 80 is mapped to local port 8080.
|
|
|
|
|
|
2015-11-27 22:29:51 +00:00
|
|
|
|
This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
|
|
|
|
|
the @file{hostname} file contains the @code{.onion} host name for the hidden
|
2015-11-27 22:04:49 +00:00
|
|
|
|
service.
|
|
|
|
|
|
|
|
|
|
See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
|
|
|
|
|
project's documentation} for more information."
|
|
|
|
|
(service tor-hidden-service-type
|
|
|
|
|
(hidden-service name mapping)))
|
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-09-17 21:44:26 +00:00
|
|
|
|
|
2018-03-29 22:21:39 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; ModemManager
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <modem-manager-configuration>
|
|
|
|
|
modem-manager-configuration make-modem-manager-configuration
|
|
|
|
|
modem-manager-configuration?
|
|
|
|
|
(modem-manager modem-manager-configuration-modem-manager
|
|
|
|
|
(default modem-manager)))
|
|
|
|
|
|
2015-11-16 05:56:24 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; NetworkManager
|
|
|
|
|
;;;
|
|
|
|
|
|
2017-01-20 13:43:53 +00:00
|
|
|
|
(define-record-type* <network-manager-configuration>
|
|
|
|
|
network-manager-configuration make-network-manager-configuration
|
|
|
|
|
network-manager-configuration?
|
|
|
|
|
(network-manager network-manager-configuration-network-manager
|
|
|
|
|
(default network-manager))
|
|
|
|
|
(dns network-manager-configuration-dns
|
2017-09-21 22:00:41 +00:00
|
|
|
|
(default "default"))
|
2021-11-18 21:44:26 +00:00
|
|
|
|
(vpn-plugins network-manager-configuration-vpn-plugins ;list of file-like
|
2022-12-01 13:21:39 +00:00
|
|
|
|
(default '()))
|
|
|
|
|
(iwd? network-manager-configuration-iwd? (default #f)))
|
2017-01-20 13:43:53 +00:00
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (network-manager-activation config)
|
2019-06-19 16:09:01 +00:00
|
|
|
|
;; Activation gexp for NetworkManager
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(match-record config <network-manager-configuration>
|
|
|
|
|
(network-manager dns vpn-plugins)
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
(mkdir-p "/etc/NetworkManager/system-connections")
|
|
|
|
|
#$@(if (equal? dns "dnsmasq")
|
|
|
|
|
;; create directory to store dnsmasq lease file
|
|
|
|
|
'((mkdir-p "/var/lib/misc"))
|
|
|
|
|
'()))))
|
2015-11-16 05:56:24 +00:00
|
|
|
|
|
2017-09-21 22:00:41 +00:00
|
|
|
|
(define (vpn-plugin-directory plugins)
|
|
|
|
|
"Return a directory containing PLUGINS, the NM VPN plugins."
|
|
|
|
|
(directory-union "network-manager-vpn-plugins" plugins))
|
|
|
|
|
|
2019-10-18 21:12:35 +00:00
|
|
|
|
(define (network-manager-accounts config)
|
|
|
|
|
"Return the list of <user-account> and <user-group> for CONFIG."
|
|
|
|
|
(define nologin
|
|
|
|
|
(file-append shadow "/sbin/nologin"))
|
|
|
|
|
|
|
|
|
|
(define accounts
|
|
|
|
|
(append-map (lambda (package)
|
|
|
|
|
(map (lambda (name)
|
|
|
|
|
(user-account (system? #t)
|
|
|
|
|
(name name)
|
|
|
|
|
(group "network-manager")
|
|
|
|
|
(comment "NetworkManager helper")
|
|
|
|
|
(home-directory "/var/empty")
|
|
|
|
|
(create-home-directory? #f)
|
|
|
|
|
(shell nologin)))
|
|
|
|
|
(or (assoc-ref (package-properties package)
|
|
|
|
|
'user-accounts)
|
|
|
|
|
'())))
|
|
|
|
|
(network-manager-configuration-vpn-plugins config)))
|
|
|
|
|
|
|
|
|
|
(match accounts
|
|
|
|
|
(()
|
|
|
|
|
'())
|
|
|
|
|
(_
|
|
|
|
|
(cons (user-group (name "network-manager") (system? #t))
|
|
|
|
|
accounts))))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (network-manager-environment config)
|
|
|
|
|
(match-record config <network-manager-configuration>
|
|
|
|
|
(network-manager dns vpn-plugins)
|
|
|
|
|
;; Define this variable in the global environment such that
|
|
|
|
|
;; "nmcli connection import type openvpn file foo.ovpn" works.
|
|
|
|
|
`(("NM_VPN_PLUGIN_DIR"
|
|
|
|
|
. ,(file-append (vpn-plugin-directory vpn-plugins)
|
|
|
|
|
"/lib/NetworkManager/VPN")))))
|
|
|
|
|
|
|
|
|
|
(define (network-manager-shepherd-service config)
|
|
|
|
|
(match-record config <network-manager-configuration>
|
|
|
|
|
(network-manager dns vpn-plugins iwd?)
|
|
|
|
|
(let ((conf (plain-file "NetworkManager.conf"
|
|
|
|
|
(string-append
|
|
|
|
|
"[main]\ndns=" dns "\n"
|
|
|
|
|
(if iwd? "[device]\nwifi.backend=iwd\n" ""))))
|
|
|
|
|
(vpn (vpn-plugin-directory vpn-plugins)))
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(documentation "Run the NetworkManager.")
|
|
|
|
|
(provision '(networking))
|
|
|
|
|
(requirement (append '(user-processes dbus-system loopback)
|
|
|
|
|
(if iwd? '(iwd) '(wpa-supplicant))))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list (string-append #$network-manager
|
|
|
|
|
"/sbin/NetworkManager")
|
|
|
|
|
(string-append "--config=" #$conf)
|
|
|
|
|
"--no-daemon")
|
|
|
|
|
#:environment-variables
|
|
|
|
|
(list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
|
|
|
|
|
"/lib/NetworkManager/VPN")
|
|
|
|
|
;; Override non-existent default users
|
|
|
|
|
"NM_OPENVPN_USER="
|
|
|
|
|
"NM_OPENVPN_GROUP=")))
|
|
|
|
|
(stop #~(make-kill-destructor)))))))
|
2015-11-16 05:56:24 +00:00
|
|
|
|
|
|
|
|
|
(define network-manager-service-type
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(let ((config->packages
|
|
|
|
|
(lambda (config)
|
|
|
|
|
(match-record config <network-manager-configuration>
|
|
|
|
|
(network-manager vpn-plugins)
|
|
|
|
|
`(,network-manager ,@vpn-plugins)))))
|
2017-01-20 13:43:53 +00:00
|
|
|
|
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'network-manager)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
network-manager-shepherd-service)
|
2019-07-03 12:03:25 +00:00
|
|
|
|
(service-extension dbus-root-service-type config->packages)
|
|
|
|
|
(service-extension polkit-service-type
|
|
|
|
|
(compose
|
|
|
|
|
list
|
|
|
|
|
network-manager-configuration-network-manager))
|
2019-10-18 21:12:35 +00:00
|
|
|
|
(service-extension account-service-type
|
|
|
|
|
network-manager-accounts)
|
2017-01-20 13:43:53 +00:00
|
|
|
|
(service-extension activation-service-type
|
2019-06-19 16:09:01 +00:00
|
|
|
|
network-manager-activation)
|
2017-09-21 22:00:41 +00:00
|
|
|
|
(service-extension session-environment-service-type
|
|
|
|
|
network-manager-environment)
|
2017-01-20 13:43:53 +00:00
|
|
|
|
;; Add network-manager to the system profile.
|
2019-07-03 12:03:25 +00:00
|
|
|
|
(service-extension profile-service-type config->packages)))
|
2017-09-13 20:55:04 +00:00
|
|
|
|
(default-value (network-manager-configuration))
|
|
|
|
|
(description
|
|
|
|
|
"Run @uref{https://wiki.gnome.org/Projects/NetworkManager,
|
|
|
|
|
NetworkManager}, a network management daemon that aims to simplify wired and
|
|
|
|
|
wireless networking."))))
|
2015-11-16 05:56:24 +00:00
|
|
|
|
|
2015-12-31 20:10:11 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Connman
|
|
|
|
|
;;;
|
|
|
|
|
|
2017-02-20 15:25:44 +00:00
|
|
|
|
(define-record-type* <connman-configuration>
|
|
|
|
|
connman-configuration make-connman-configuration
|
|
|
|
|
connman-configuration?
|
|
|
|
|
(connman connman-configuration-connman
|
|
|
|
|
(default connman))
|
|
|
|
|
(disable-vpn? connman-configuration-disable-vpn?
|
2023-01-12 10:37:51 +00:00
|
|
|
|
(default #f))
|
|
|
|
|
(iwd? connman-configuration-iwd?
|
2017-02-20 15:25:44 +00:00
|
|
|
|
(default #f)))
|
|
|
|
|
|
|
|
|
|
(define (connman-activation config)
|
|
|
|
|
(let ((disable-vpn? (connman-configuration-disable-vpn? config)))
|
|
|
|
|
(with-imported-modules '((guix build utils))
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
(mkdir-p "/var/lib/connman/")
|
|
|
|
|
(unless #$disable-vpn?
|
|
|
|
|
(mkdir-p "/var/lib/connman-vpn/"))))))
|
|
|
|
|
|
|
|
|
|
(define (connman-shepherd-service config)
|
2015-12-31 20:10:11 +00:00
|
|
|
|
"Return a shepherd service for Connman"
|
2017-02-20 15:25:44 +00:00
|
|
|
|
(and
|
|
|
|
|
(connman-configuration? config)
|
|
|
|
|
(let ((connman (connman-configuration-connman config))
|
2023-01-12 10:37:51 +00:00
|
|
|
|
(disable-vpn? (connman-configuration-disable-vpn? config))
|
|
|
|
|
(iwd? (connman-configuration-iwd? config)))
|
2017-02-20 15:25:44 +00:00
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(documentation "Run Connman")
|
|
|
|
|
(provision '(networking))
|
|
|
|
|
(requirement
|
2023-01-12 10:37:51 +00:00
|
|
|
|
(append '(user-processes dbus-system loopback)
|
|
|
|
|
(if iwd? '(iwd) '())))
|
2017-02-20 15:25:44 +00:00
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list (string-append #$connman
|
|
|
|
|
"/sbin/connmand")
|
2020-08-16 13:33:43 +00:00
|
|
|
|
"--nodaemon"
|
|
|
|
|
"--nodnsproxy"
|
2023-01-12 10:37:51 +00:00
|
|
|
|
#$@(if disable-vpn? '("--noplugin=vpn") '())
|
|
|
|
|
#$@(if iwd? '("--wifi=iwd_agent") '()))
|
2019-04-23 21:41:35 +00:00
|
|
|
|
|
|
|
|
|
;; As connman(8) notes, when passing '-n', connman
|
|
|
|
|
;; "directs log output to the controlling terminal in
|
|
|
|
|
;; addition to syslog." Redirect stdout and stderr
|
|
|
|
|
;; to avoid spamming the console (XXX: for some reason
|
|
|
|
|
;; redirecting to /dev/null doesn't work.)
|
|
|
|
|
#:log-file "/var/log/connman.log"))
|
2017-02-20 15:25:44 +00:00
|
|
|
|
(stop #~(make-kill-destructor)))))))
|
2015-12-31 20:10:11 +00:00
|
|
|
|
|
2022-05-23 19:39:08 +00:00
|
|
|
|
(define %connman-log-rotation
|
|
|
|
|
(list (log-rotation
|
|
|
|
|
(files '("/var/log/connman.log")))))
|
|
|
|
|
|
2015-12-31 20:10:11 +00:00
|
|
|
|
(define connman-service-type
|
2017-02-20 15:25:44 +00:00
|
|
|
|
(let ((connman-package (compose list connman-configuration-connman)))
|
|
|
|
|
(service-type (name 'connman)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
connman-shepherd-service)
|
2018-05-18 15:26:03 +00:00
|
|
|
|
(service-extension polkit-service-type
|
|
|
|
|
connman-package)
|
2017-02-20 15:25:44 +00:00
|
|
|
|
(service-extension dbus-root-service-type
|
|
|
|
|
connman-package)
|
|
|
|
|
(service-extension activation-service-type
|
|
|
|
|
connman-activation)
|
|
|
|
|
;; Add connman to the system profile.
|
|
|
|
|
(service-extension profile-service-type
|
2022-05-23 19:39:08 +00:00
|
|
|
|
connman-package)
|
|
|
|
|
(service-extension rottlog-service-type
|
|
|
|
|
(const %connman-log-rotation))))
|
2018-05-17 18:15:46 +00:00
|
|
|
|
(default-value (connman-configuration))
|
2017-09-13 20:55:04 +00:00
|
|
|
|
(description
|
|
|
|
|
"Run @url{https://01.org/connman,Connman},
|
|
|
|
|
a network connection manager."))))
|
2016-11-09 20:38:38 +00:00
|
|
|
|
|
2018-03-29 22:21:39 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Modem manager
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define modem-manager-service-type
|
|
|
|
|
(let ((config->package
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(lambda (config)
|
|
|
|
|
(list (modem-manager-configuration-modem-manager config)))))
|
2018-03-29 22:21:39 +00:00
|
|
|
|
(service-type (name 'modem-manager)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension dbus-root-service-type
|
|
|
|
|
config->package)
|
|
|
|
|
(service-extension udev-service-type
|
|
|
|
|
config->package)
|
|
|
|
|
(service-extension polkit-service-type
|
|
|
|
|
config->package)))
|
|
|
|
|
(default-value (modem-manager-configuration))
|
|
|
|
|
(description
|
|
|
|
|
"Run @uref{https://wiki.gnome.org/Projects/ModemManager,
|
|
|
|
|
ModemManager}, a modem management daemon that aims to simplify dialup
|
|
|
|
|
networking."))))
|
|
|
|
|
|
2019-06-13 17:17:05 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; USB_ModeSwitch
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <usb-modeswitch-configuration>
|
|
|
|
|
usb-modeswitch-configuration make-usb-modeswitch-configuration
|
|
|
|
|
usb-modeswitch-configuration?
|
|
|
|
|
(usb-modeswitch usb-modeswitch-configuration-usb-modeswitch
|
|
|
|
|
(default usb-modeswitch))
|
|
|
|
|
(usb-modeswitch-data usb-modeswitch-configuration-usb-modeswitch-data
|
|
|
|
|
(default usb-modeswitch-data))
|
|
|
|
|
(config-file usb-modeswitch-configuration-config-file
|
|
|
|
|
(default #~(string-append #$usb-modeswitch:dispatcher
|
|
|
|
|
"/etc/usb_modeswitch.conf"))))
|
|
|
|
|
|
|
|
|
|
(define (usb-modeswitch-sh usb-modeswitch config-file)
|
|
|
|
|
"Build a copy of usb_modeswitch.sh located in package USB-MODESWITCH,
|
|
|
|
|
modified to pass the CONFIG-FILE in its calls to usb_modeswitch_dispatcher,
|
|
|
|
|
and wrap it to actually find the dispatcher in USB-MODESWITCH. The script
|
|
|
|
|
will be run by USB_ModeSwitch’s udev rules file when a modeswitchable USB
|
|
|
|
|
device is detected."
|
|
|
|
|
(computed-file
|
|
|
|
|
"usb_modeswitch-sh"
|
|
|
|
|
(with-imported-modules '((guix build utils))
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
(let ((cfg-param
|
|
|
|
|
#$(if config-file
|
|
|
|
|
#~(string-append " --config-file=" #$config-file)
|
|
|
|
|
"")))
|
|
|
|
|
(mkdir #$output)
|
|
|
|
|
(install-file (string-append #$usb-modeswitch:dispatcher
|
|
|
|
|
"/lib/udev/usb_modeswitch")
|
|
|
|
|
#$output)
|
|
|
|
|
|
|
|
|
|
;; insert CFG-PARAM into usb_modeswitch_dispatcher command-lines
|
|
|
|
|
(substitute* (string-append #$output "/usb_modeswitch")
|
|
|
|
|
(("(exec usb_modeswitch_dispatcher .*)( 2>>)" _ left right)
|
|
|
|
|
(string-append left cfg-param right))
|
|
|
|
|
(("(exec usb_modeswitch_dispatcher .*)( &)" _ left right)
|
|
|
|
|
(string-append left cfg-param right)))
|
|
|
|
|
|
|
|
|
|
;; wrap-program needs bash in PATH:
|
|
|
|
|
(putenv (string-append "PATH=" #$bash "/bin"))
|
|
|
|
|
(wrap-program (string-append #$output "/usb_modeswitch")
|
|
|
|
|
`("PATH" ":" = (,(string-append #$coreutils "/bin")
|
|
|
|
|
,(string-append
|
|
|
|
|
#$usb-modeswitch:dispatcher
|
|
|
|
|
"/bin")))))))))
|
|
|
|
|
|
|
|
|
|
(define (usb-modeswitch-configuration->udev-rules config)
|
|
|
|
|
"Build a rules file for extending udev-service-type from the rules in the
|
|
|
|
|
usb-modeswitch package specified in CONFIG. The rules file will invoke
|
|
|
|
|
usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right
|
|
|
|
|
config file."
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(match-record config <usb-modeswitch-configuration>
|
|
|
|
|
(usb-modeswitch usb-modeswitch-data config-file)
|
|
|
|
|
(computed-file
|
|
|
|
|
"usb_modeswitch.rules"
|
|
|
|
|
(with-imported-modules '((guix build utils))
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
(let ((in (string-append #$usb-modeswitch-data
|
|
|
|
|
"/udev/40-usb_modeswitch.rules"))
|
|
|
|
|
(out (string-append #$output "/lib/udev/rules.d"))
|
|
|
|
|
(script #$(usb-modeswitch-sh usb-modeswitch config-file)))
|
|
|
|
|
(mkdir-p out)
|
|
|
|
|
(chdir out)
|
|
|
|
|
(install-file in out)
|
|
|
|
|
(substitute* "40-usb_modeswitch.rules"
|
|
|
|
|
(("PROGRAM=\"usb_modeswitch")
|
|
|
|
|
(string-append "PROGRAM=\"" script "/usb_modeswitch"))
|
|
|
|
|
(("RUN\\+=\"usb_modeswitch")
|
|
|
|
|
(string-append "RUN+=\"" script "/usb_modeswitch")))))))))
|
2019-06-13 17:17:05 +00:00
|
|
|
|
|
|
|
|
|
(define usb-modeswitch-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'usb-modeswitch)
|
|
|
|
|
(extensions
|
|
|
|
|
(list
|
|
|
|
|
(service-extension
|
|
|
|
|
udev-service-type
|
|
|
|
|
(lambda (config)
|
|
|
|
|
(let ((rules (usb-modeswitch-configuration->udev-rules config)))
|
|
|
|
|
(list rules))))))
|
|
|
|
|
(default-value (usb-modeswitch-configuration))
|
|
|
|
|
(description "Run @uref{http://www.draisberghof.de/usb_modeswitch/,
|
|
|
|
|
USB_ModeSwitch}, a mode switching tool for controlling USB devices with
|
|
|
|
|
multiple @dfn{modes}. When plugged in for the first time many USB
|
|
|
|
|
devices (primarily high-speed WAN modems) act like a flash storage containing
|
|
|
|
|
installers for Windows drivers. USB_ModeSwitch replays the sequence the
|
|
|
|
|
Windows drivers would send to switch their mode from storage to modem (or
|
|
|
|
|
whatever the thing is supposed to do).")))
|
|
|
|
|
|
2016-11-09 20:38:38 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; WPA supplicant
|
|
|
|
|
;;;
|
|
|
|
|
|
2018-04-08 23:04:10 +00:00
|
|
|
|
(define-record-type* <wpa-supplicant-configuration>
|
|
|
|
|
wpa-supplicant-configuration make-wpa-supplicant-configuration
|
|
|
|
|
wpa-supplicant-configuration?
|
2021-11-18 21:44:26 +00:00
|
|
|
|
(wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ;file-like
|
2018-04-08 23:04:10 +00:00
|
|
|
|
(default wpa-supplicant))
|
2020-06-24 22:33:38 +00:00
|
|
|
|
(requirement wpa-supplicant-configuration-requirement ;list of symbols
|
2020-09-24 18:18:20 +00:00
|
|
|
|
(default '(user-processes loopback syslogd)))
|
2018-04-08 23:04:10 +00:00
|
|
|
|
(pid-file wpa-supplicant-configuration-pid-file ;string
|
|
|
|
|
(default "/var/run/wpa_supplicant.pid"))
|
|
|
|
|
(dbus? wpa-supplicant-configuration-dbus? ;Boolean
|
|
|
|
|
(default #t))
|
|
|
|
|
(interface wpa-supplicant-configuration-interface ;#f | string
|
|
|
|
|
(default #f))
|
|
|
|
|
(config-file wpa-supplicant-configuration-config-file ;#f | <file-like>
|
|
|
|
|
(default #f))
|
|
|
|
|
(extra-options wpa-supplicant-configuration-extra-options ;list of strings
|
|
|
|
|
(default '())))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (wpa-supplicant-shepherd-service config)
|
|
|
|
|
(match-record config <wpa-supplicant-configuration>
|
|
|
|
|
(wpa-supplicant requirement pid-file dbus?
|
|
|
|
|
interface config-file extra-options)
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(documentation "Run the WPA supplicant daemon")
|
|
|
|
|
(provision '(wpa-supplicant))
|
|
|
|
|
(requirement (if dbus?
|
|
|
|
|
(cons 'dbus-system requirement)
|
|
|
|
|
requirement))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list (string-append #$wpa-supplicant
|
|
|
|
|
"/sbin/wpa_supplicant")
|
|
|
|
|
(string-append "-P" #$pid-file)
|
|
|
|
|
"-B" ;run in background
|
|
|
|
|
"-s" ;log to syslogd
|
|
|
|
|
#$@(if dbus?
|
|
|
|
|
#~("-u")
|
|
|
|
|
#~())
|
|
|
|
|
#$@(if interface
|
|
|
|
|
#~((string-append "-i" #$interface))
|
|
|
|
|
#~())
|
|
|
|
|
#$@(if config-file
|
|
|
|
|
#~((string-append "-c" #$config-file))
|
|
|
|
|
#~())
|
|
|
|
|
#$@extra-options)
|
|
|
|
|
#:pid-file #$pid-file))
|
|
|
|
|
(stop #~(make-kill-destructor))))))
|
2016-11-09 20:38:38 +00:00
|
|
|
|
|
|
|
|
|
(define wpa-supplicant-service-type
|
2018-04-08 23:04:10 +00:00
|
|
|
|
(let ((config->package
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(lambda (config)
|
|
|
|
|
(list (wpa-supplicant-configuration-wpa-supplicant config)))))
|
2018-04-08 23:04:10 +00:00
|
|
|
|
(service-type (name 'wpa-supplicant)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
wpa-supplicant-shepherd-service)
|
|
|
|
|
(service-extension dbus-root-service-type config->package)
|
|
|
|
|
(service-extension profile-service-type config->package)))
|
|
|
|
|
(description "Run the WPA Supplicant daemon, a service that
|
|
|
|
|
implements authentication, key negotiation and more for wireless networks.")
|
|
|
|
|
(default-value (wpa-supplicant-configuration)))))
|
2016-11-09 20:38:38 +00:00
|
|
|
|
|
2020-04-19 16:01:13 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Hostapd.
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <hostapd-configuration>
|
|
|
|
|
hostapd-configuration make-hostapd-configuration
|
|
|
|
|
hostapd-configuration?
|
|
|
|
|
(package hostapd-configuration-package
|
|
|
|
|
(default hostapd))
|
|
|
|
|
(interface hostapd-configuration-interface ;string
|
|
|
|
|
(default "wlan0"))
|
|
|
|
|
(ssid hostapd-configuration-ssid) ;string
|
|
|
|
|
(broadcast-ssid? hostapd-configuration-broadcast-ssid? ;Boolean
|
|
|
|
|
(default #t))
|
|
|
|
|
(channel hostapd-configuration-channel ;integer
|
|
|
|
|
(default 1))
|
|
|
|
|
(driver hostapd-configuration-driver ;string
|
|
|
|
|
(default "nl80211"))
|
|
|
|
|
;; See <https://w1.fi/cgit/hostap/plain/hostapd/hostapd.conf> for a list of
|
|
|
|
|
;; additional options we could add.
|
|
|
|
|
(extra-settings hostapd-configuration-extra-settings ;string
|
|
|
|
|
(default "")))
|
|
|
|
|
|
|
|
|
|
(define (hostapd-configuration-file config)
|
|
|
|
|
"Return the configuration file for CONFIG, a <hostapd-configuration>."
|
|
|
|
|
(match-record config <hostapd-configuration>
|
|
|
|
|
(interface ssid broadcast-ssid? channel driver extra-settings)
|
|
|
|
|
(plain-file "hostapd.conf"
|
|
|
|
|
(string-append "\
|
|
|
|
|
# Generated from your Guix configuration.
|
|
|
|
|
|
|
|
|
|
interface=" interface "
|
|
|
|
|
ssid=" ssid "
|
|
|
|
|
ignore_broadcast_ssid=" (if broadcast-ssid? "0" "1") "
|
|
|
|
|
channel=" (number->string channel) "\n"
|
|
|
|
|
extra-settings "\n"))))
|
|
|
|
|
|
|
|
|
|
(define* (hostapd-shepherd-services config #:key (requirement '()))
|
|
|
|
|
"Return Shepherd services for hostapd."
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(provision '(hostapd))
|
|
|
|
|
(requirement `(user-processes ,@requirement))
|
|
|
|
|
(documentation "Run the hostapd WiFi access point daemon.")
|
|
|
|
|
(start #~(make-forkexec-constructor
|
2020-05-27 16:07:14 +00:00
|
|
|
|
(list #$(file-append (hostapd-configuration-package config)
|
|
|
|
|
"/sbin/hostapd")
|
2020-04-19 16:01:13 +00:00
|
|
|
|
#$(hostapd-configuration-file config))
|
|
|
|
|
#:log-file "/var/log/hostapd.log"))
|
|
|
|
|
(stop #~(make-kill-destructor)))))
|
|
|
|
|
|
2022-05-23 19:39:08 +00:00
|
|
|
|
(define %hostapd-log-rotation
|
|
|
|
|
(list (log-rotation
|
|
|
|
|
(files '("/var/log/hostapd.log")))))
|
|
|
|
|
|
2020-04-19 16:01:13 +00:00
|
|
|
|
(define hostapd-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'hostapd)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
2022-05-23 19:39:08 +00:00
|
|
|
|
hostapd-shepherd-services)
|
|
|
|
|
(service-extension rottlog-service-type
|
|
|
|
|
(const %hostapd-log-rotation))))
|
2020-04-19 16:01:13 +00:00
|
|
|
|
(description
|
|
|
|
|
"Run the @uref{https://w1.fi/hostapd/, hostapd} daemon for Wi-Fi access
|
|
|
|
|
points and authentication servers.")))
|
|
|
|
|
|
2020-04-19 20:06:32 +00:00
|
|
|
|
(define (simulated-wifi-shepherd-services config)
|
|
|
|
|
"Return Shepherd services to run hostapd with CONFIG, a
|
|
|
|
|
<hostapd-configuration>, as well as services to set up WiFi hardware
|
|
|
|
|
simulation."
|
|
|
|
|
(append (hostapd-shepherd-services config
|
|
|
|
|
#:requirement
|
|
|
|
|
'(unblocked-wifi
|
2020-05-14 16:44:15 +00:00
|
|
|
|
kernel-module-loader))
|
2020-04-19 20:06:32 +00:00
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(provision '(unblocked-wifi))
|
2020-05-14 16:44:15 +00:00
|
|
|
|
(requirement '(file-systems kernel-module-loader))
|
2020-04-19 20:06:32 +00:00
|
|
|
|
(documentation
|
|
|
|
|
"Unblock WiFi devices for use by mac80211_hwsim.")
|
|
|
|
|
(start #~(lambda _
|
|
|
|
|
(invoke #$(file-append util-linux "/sbin/rfkill")
|
|
|
|
|
"unblock" "0")
|
|
|
|
|
(invoke #$(file-append util-linux "/sbin/rfkill")
|
|
|
|
|
"unblock" "1")))
|
|
|
|
|
(one-shot? #t)))))
|
|
|
|
|
|
|
|
|
|
(define simulated-wifi-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'simulated-wifi)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
2020-05-14 16:44:15 +00:00
|
|
|
|
simulated-wifi-shepherd-services)
|
|
|
|
|
(service-extension kernel-module-loader-service-type
|
|
|
|
|
(const '("mac80211_hwsim")))))
|
2020-04-19 20:06:32 +00:00
|
|
|
|
(default-value (hostapd-configuration
|
|
|
|
|
(interface "wlan1")
|
|
|
|
|
(ssid "Test Network")))
|
|
|
|
|
(description "Run hostapd to simulate WiFi connectivity.")))
|
|
|
|
|
|
2017-01-27 13:37:42 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Open vSwitch
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <openvswitch-configuration>
|
|
|
|
|
openvswitch-configuration make-openvswitch-configuration
|
|
|
|
|
openvswitch-configuration?
|
|
|
|
|
(package openvswitch-configuration-package
|
|
|
|
|
(default openvswitch)))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (openvswitch-activation config)
|
|
|
|
|
(let ((ovsdb-tool (file-append (openvswitch-configuration-package config)
|
|
|
|
|
"/bin/ovsdb-tool")))
|
|
|
|
|
(with-imported-modules '((guix build utils))
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
(mkdir-p "/var/run/openvswitch")
|
|
|
|
|
(mkdir-p "/var/lib/openvswitch")
|
|
|
|
|
(let ((conf.db "/var/lib/openvswitch/conf.db"))
|
|
|
|
|
(unless (file-exists? conf.db)
|
|
|
|
|
(system* #$ovsdb-tool "create" conf.db)))))))
|
|
|
|
|
|
|
|
|
|
(define (openvswitch-shepherd-service config)
|
|
|
|
|
(let* ((package (openvswitch-configuration-package config))
|
|
|
|
|
(ovsdb-server (file-append package "/sbin/ovsdb-server"))
|
|
|
|
|
(ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(provision '(ovsdb))
|
|
|
|
|
(documentation "Run the Open vSwitch database server.")
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list #$ovsdb-server "--pidfile"
|
|
|
|
|
"--remote=punix:/var/run/openvswitch/db.sock")
|
|
|
|
|
#:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
|
|
|
|
|
(stop #~(make-kill-destructor)))
|
|
|
|
|
(shepherd-service
|
|
|
|
|
(provision '(vswitchd))
|
|
|
|
|
(requirement '(ovsdb))
|
|
|
|
|
(documentation "Run the Open vSwitch daemon.")
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list #$ovs-vswitchd "--pidfile")
|
|
|
|
|
#:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
|
|
|
|
|
(stop #~(make-kill-destructor))))))
|
2017-01-27 13:37:42 +00:00
|
|
|
|
|
|
|
|
|
(define openvswitch-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'openvswitch)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension activation-service-type
|
|
|
|
|
openvswitch-activation)
|
|
|
|
|
(service-extension profile-service-type
|
|
|
|
|
(compose list openvswitch-configuration-package))
|
|
|
|
|
(service-extension shepherd-root-service-type
|
2017-09-13 20:55:04 +00:00
|
|
|
|
openvswitch-shepherd-service)))
|
|
|
|
|
(description
|
|
|
|
|
"Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
|
|
|
|
|
switch designed to enable massive network automation through programmatic
|
2019-03-24 23:17:41 +00:00
|
|
|
|
extension.")
|
|
|
|
|
(default-value (openvswitch-configuration))))
|
2017-01-27 13:37:42 +00:00
|
|
|
|
|
2018-08-17 11:09:07 +00:00
|
|
|
|
;;;
|
|
|
|
|
;;; iptables
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define %iptables-accept-all-rules
|
|
|
|
|
(plain-file "iptables-accept-all.rules"
|
|
|
|
|
"*filter
|
|
|
|
|
:INPUT ACCEPT
|
|
|
|
|
:FORWARD ACCEPT
|
|
|
|
|
:OUTPUT ACCEPT
|
|
|
|
|
COMMIT
|
|
|
|
|
"))
|
|
|
|
|
|
|
|
|
|
(define-record-type* <iptables-configuration>
|
|
|
|
|
iptables-configuration make-iptables-configuration iptables-configuration?
|
|
|
|
|
(iptables iptables-configuration-iptables
|
|
|
|
|
(default iptables))
|
|
|
|
|
(ipv4-rules iptables-configuration-ipv4-rules
|
|
|
|
|
(default %iptables-accept-all-rules))
|
|
|
|
|
(ipv6-rules iptables-configuration-ipv6-rules
|
|
|
|
|
(default %iptables-accept-all-rules)))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (iptables-shepherd-service config)
|
|
|
|
|
(match-record config <iptables-configuration>
|
|
|
|
|
(iptables ipv4-rules ipv6-rules)
|
|
|
|
|
(let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
|
|
|
|
|
(ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
|
|
|
|
|
(shepherd-service
|
|
|
|
|
(documentation "Packet filtering framework")
|
|
|
|
|
(provision '(iptables))
|
|
|
|
|
(start #~(lambda _
|
|
|
|
|
(invoke #$iptables-restore #$ipv4-rules)
|
|
|
|
|
(invoke #$ip6tables-restore #$ipv6-rules)))
|
|
|
|
|
(stop #~(lambda _
|
|
|
|
|
(invoke #$iptables-restore #$%iptables-accept-all-rules)
|
|
|
|
|
(invoke #$ip6tables-restore #$%iptables-accept-all-rules)))))))
|
2018-08-17 11:09:07 +00:00
|
|
|
|
|
|
|
|
|
(define iptables-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'iptables)
|
|
|
|
|
(description
|
|
|
|
|
"Run @command{iptables-restore}, setting up the specified rules.")
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
(compose list iptables-shepherd-service))))))
|
|
|
|
|
|
2019-09-13 09:53:59 +00:00
|
|
|
|
;;;
|
|
|
|
|
;;; nftables
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define %default-nftables-ruleset
|
|
|
|
|
(plain-file "nftables.conf"
|
|
|
|
|
"# A simple and safe firewall
|
|
|
|
|
table inet filter {
|
|
|
|
|
chain input {
|
|
|
|
|
type filter hook input priority 0; policy drop;
|
|
|
|
|
|
|
|
|
|
# early drop of invalid connections
|
|
|
|
|
ct state invalid drop
|
|
|
|
|
|
|
|
|
|
# allow established/related connections
|
|
|
|
|
ct state { established, related } accept
|
|
|
|
|
|
|
|
|
|
# allow from loopback
|
|
|
|
|
iifname lo accept
|
|
|
|
|
|
|
|
|
|
# allow icmp
|
|
|
|
|
ip protocol icmp accept
|
|
|
|
|
ip6 nexthdr icmpv6 accept
|
|
|
|
|
|
|
|
|
|
# allow ssh
|
|
|
|
|
tcp dport ssh accept
|
|
|
|
|
|
|
|
|
|
# reject everything else
|
|
|
|
|
reject with icmpx type port-unreachable
|
|
|
|
|
}
|
|
|
|
|
chain forward {
|
|
|
|
|
type filter hook forward priority 0; policy drop;
|
|
|
|
|
}
|
|
|
|
|
chain output {
|
|
|
|
|
type filter hook output priority 0; policy accept;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
"))
|
|
|
|
|
|
|
|
|
|
(define-record-type* <nftables-configuration>
|
|
|
|
|
nftables-configuration
|
|
|
|
|
make-nftables-configuration
|
|
|
|
|
nftables-configuration?
|
|
|
|
|
(package nftables-configuration-package
|
|
|
|
|
(default nftables))
|
|
|
|
|
(ruleset nftables-configuration-ruleset ; file-like object
|
|
|
|
|
(default %default-nftables-ruleset)))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (nftables-shepherd-service config)
|
|
|
|
|
(match-record config <nftables-configuration>
|
|
|
|
|
(package ruleset)
|
|
|
|
|
(let ((nft (file-append package "/sbin/nft")))
|
|
|
|
|
(shepherd-service
|
|
|
|
|
(documentation "Packet filtering and classification")
|
|
|
|
|
(provision '(nftables))
|
|
|
|
|
(start #~(lambda _
|
|
|
|
|
(invoke #$nft "--file" #$ruleset)))
|
|
|
|
|
(stop #~(lambda _
|
|
|
|
|
(invoke #$nft "flush" "ruleset")))))))
|
2019-09-13 09:53:59 +00:00
|
|
|
|
|
|
|
|
|
(define nftables-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'nftables)
|
|
|
|
|
(description
|
|
|
|
|
"Run @command{nft}, setting up the specified ruleset.")
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
(compose list nftables-shepherd-service))
|
|
|
|
|
(service-extension profile-service-type
|
|
|
|
|
(compose list nftables-configuration-package))))
|
|
|
|
|
(default-value (nftables-configuration))))
|
|
|
|
|
|
2019-11-05 01:29:24 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; PageKite
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <pagekite-configuration>
|
|
|
|
|
pagekite-configuration
|
|
|
|
|
make-pagekite-configuration
|
|
|
|
|
pagekite-configuration?
|
|
|
|
|
(package pagekite-configuration-package
|
|
|
|
|
(default pagekite))
|
|
|
|
|
(kitename pagekite-configuration-kitename
|
|
|
|
|
(default #f))
|
|
|
|
|
(kitesecret pagekite-configuration-kitesecret
|
|
|
|
|
(default #f))
|
|
|
|
|
(frontend pagekite-configuration-frontend
|
|
|
|
|
(default #f))
|
|
|
|
|
(kites pagekite-configuration-kites
|
|
|
|
|
(default '("http:@kitename:localhost:80:@kitesecret")))
|
|
|
|
|
(extra-file pagekite-configuration-extra-file
|
|
|
|
|
(default #f)))
|
|
|
|
|
|
|
|
|
|
(define (pagekite-configuration-file config)
|
|
|
|
|
(match-record config <pagekite-configuration>
|
|
|
|
|
(package kitename kitesecret frontend kites extra-file)
|
|
|
|
|
(mixed-text-file "pagekite.rc"
|
|
|
|
|
(if extra-file
|
|
|
|
|
(string-append "optfile = " extra-file "\n")
|
|
|
|
|
"")
|
|
|
|
|
(if kitename
|
|
|
|
|
(string-append "kitename = " kitename "\n")
|
|
|
|
|
"")
|
|
|
|
|
(if kitesecret
|
|
|
|
|
(string-append "kitesecret = " kitesecret "\n")
|
|
|
|
|
"")
|
|
|
|
|
(if frontend
|
|
|
|
|
(string-append "frontend = " frontend "\n")
|
|
|
|
|
"defaults\n")
|
|
|
|
|
(string-join (map (lambda (kite)
|
|
|
|
|
(string-append "service_on = " kite))
|
|
|
|
|
kites)
|
|
|
|
|
"\n"
|
|
|
|
|
'suffix))))
|
|
|
|
|
|
|
|
|
|
(define (pagekite-shepherd-service config)
|
|
|
|
|
(match-record config <pagekite-configuration>
|
|
|
|
|
(package kitename kitesecret frontend kites extra-file)
|
|
|
|
|
(with-imported-modules (source-module-closure
|
|
|
|
|
'((gnu build shepherd)
|
|
|
|
|
(gnu system file-systems)))
|
|
|
|
|
(shepherd-service
|
|
|
|
|
(documentation "Run the PageKite service.")
|
|
|
|
|
(provision '(pagekite))
|
|
|
|
|
(requirement '(networking))
|
|
|
|
|
(modules '((gnu build shepherd)
|
|
|
|
|
(gnu system file-systems)))
|
|
|
|
|
(start #~(make-forkexec-constructor/container
|
|
|
|
|
(list #$(file-append package "/bin/pagekite")
|
|
|
|
|
"--clean"
|
|
|
|
|
"--nullui"
|
|
|
|
|
"--nocrashreport"
|
|
|
|
|
"--runas=pagekite:pagekite"
|
|
|
|
|
(string-append "--optfile="
|
|
|
|
|
#$(pagekite-configuration-file config)))
|
|
|
|
|
#:log-file "/var/log/pagekite.log"
|
|
|
|
|
#:mappings #$(if extra-file
|
|
|
|
|
#~(list (file-system-mapping
|
|
|
|
|
(source #$extra-file)
|
|
|
|
|
(target source)))
|
|
|
|
|
#~'())))
|
|
|
|
|
;; SIGTERM doesn't always work for some reason.
|
|
|
|
|
(stop #~(make-kill-destructor SIGINT))))))
|
|
|
|
|
|
2022-05-23 19:39:08 +00:00
|
|
|
|
(define %pagekite-log-rotation
|
|
|
|
|
(list (log-rotation
|
|
|
|
|
(files '("/var/log/pagekite.log")))))
|
|
|
|
|
|
2019-11-05 01:29:24 +00:00
|
|
|
|
(define %pagekite-accounts
|
|
|
|
|
(list (user-group (name "pagekite") (system? #t))
|
|
|
|
|
(user-account
|
|
|
|
|
(name "pagekite")
|
|
|
|
|
(group "pagekite")
|
|
|
|
|
(system? #t)
|
|
|
|
|
(comment "PageKite user")
|
|
|
|
|
(home-directory "/var/empty")
|
|
|
|
|
(shell (file-append shadow "/sbin/nologin")))))
|
|
|
|
|
|
|
|
|
|
(define pagekite-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'pagekite)
|
|
|
|
|
(default-value (pagekite-configuration))
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
(compose list pagekite-shepherd-service))
|
|
|
|
|
(service-extension account-service-type
|
2022-05-23 19:39:08 +00:00
|
|
|
|
(const %pagekite-accounts))
|
|
|
|
|
(service-extension rottlog-service-type
|
|
|
|
|
(const %pagekite-log-rotation))))
|
2019-11-05 01:29:24 +00:00
|
|
|
|
(description
|
|
|
|
|
"Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
|
|
|
|
|
local servers publicly accessible on the web, even behind NATs and firewalls.")))
|
|
|
|
|
|
2020-06-11 12:09:57 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Yggdrasil
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <yggdrasil-configuration>
|
|
|
|
|
yggdrasil-configuration
|
|
|
|
|
make-yggdrasil-configuration
|
|
|
|
|
yggdrasil-configuration?
|
|
|
|
|
(package yggdrasil-configuration-package
|
|
|
|
|
(default yggdrasil))
|
|
|
|
|
(json-config yggdrasil-configuration-json-config
|
|
|
|
|
(default '()))
|
|
|
|
|
(config-file yggdrasil-config-file
|
|
|
|
|
(default "/etc/yggdrasil-private.conf"))
|
|
|
|
|
(autoconf? yggdrasil-configuration-autoconf?
|
|
|
|
|
(default #f))
|
|
|
|
|
(log-level yggdrasil-configuration-log-level
|
|
|
|
|
(default 'info))
|
|
|
|
|
(log-to yggdrasil-configuration-log-to
|
|
|
|
|
(default 'stdout)))
|
|
|
|
|
|
|
|
|
|
(define (yggdrasil-configuration-file config)
|
|
|
|
|
(define (scm->yggdrasil-json x)
|
|
|
|
|
(define key-value?
|
|
|
|
|
dotted-list?)
|
|
|
|
|
(define (param->camel str)
|
|
|
|
|
(string-concatenate
|
|
|
|
|
(map
|
|
|
|
|
string-capitalize
|
|
|
|
|
(string-split str (cut eqv? <> #\-)))))
|
|
|
|
|
(cond
|
|
|
|
|
((key-value? x)
|
|
|
|
|
(let ((k (car x))
|
|
|
|
|
(v (cdr x)))
|
|
|
|
|
(cons
|
|
|
|
|
(if (symbol? k)
|
|
|
|
|
(param->camel (symbol->string k))
|
|
|
|
|
k)
|
|
|
|
|
v)))
|
|
|
|
|
((list? x) (map scm->yggdrasil-json x))
|
|
|
|
|
((vector? x) (vector-map scm->yggdrasil-json x))
|
|
|
|
|
(else x)))
|
|
|
|
|
(computed-file
|
|
|
|
|
"yggdrasil.conf"
|
|
|
|
|
#~(call-with-output-file #$output
|
|
|
|
|
(lambda (port)
|
|
|
|
|
;; it's HJSON, so comments are a-okay
|
|
|
|
|
(display "# Generated by yggdrasil-service\n" port)
|
|
|
|
|
(display #$(scm->json-string
|
|
|
|
|
(scm->yggdrasil-json
|
|
|
|
|
(yggdrasil-configuration-json-config config)))
|
|
|
|
|
port)))))
|
|
|
|
|
|
|
|
|
|
(define (yggdrasil-shepherd-service config)
|
|
|
|
|
"Return a <shepherd-service> for yggdrasil with CONFIG."
|
|
|
|
|
(define yggdrasil-command
|
|
|
|
|
#~(append
|
|
|
|
|
(list (string-append
|
|
|
|
|
#$(yggdrasil-configuration-package config)
|
|
|
|
|
"/bin/yggdrasil")
|
|
|
|
|
"-useconffile"
|
|
|
|
|
#$(yggdrasil-configuration-file config))
|
|
|
|
|
(if #$(yggdrasil-configuration-autoconf? config)
|
|
|
|
|
'("-autoconf")
|
|
|
|
|
'())
|
|
|
|
|
(let ((extraconf #$(yggdrasil-config-file config)))
|
|
|
|
|
(if extraconf
|
|
|
|
|
(list "-extraconffile" extraconf)
|
|
|
|
|
'()))
|
|
|
|
|
(list "-loglevel"
|
|
|
|
|
#$(symbol->string
|
|
|
|
|
(yggdrasil-configuration-log-level config))
|
|
|
|
|
"-logto"
|
|
|
|
|
#$(symbol->string
|
|
|
|
|
(yggdrasil-configuration-log-to config)))))
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(documentation "Connect to the Yggdrasil mesh network")
|
|
|
|
|
(provision '(yggdrasil))
|
|
|
|
|
(requirement '(networking))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
#$yggdrasil-command
|
|
|
|
|
#:log-file "/var/log/yggdrasil.log"
|
|
|
|
|
#:group "yggdrasil"))
|
|
|
|
|
(stop #~(make-kill-destructor)))))
|
|
|
|
|
|
2022-05-23 19:39:08 +00:00
|
|
|
|
(define %yggdrasil-log-rotation
|
|
|
|
|
(list (log-rotation
|
|
|
|
|
(files '("/var/log/yggdrasil.log")))))
|
|
|
|
|
|
2020-06-11 12:09:57 +00:00
|
|
|
|
(define %yggdrasil-accounts
|
|
|
|
|
(list (user-group (name "yggdrasil") (system? #t))))
|
|
|
|
|
|
|
|
|
|
(define yggdrasil-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'yggdrasil)
|
|
|
|
|
(description
|
|
|
|
|
"Connect to the Yggdrasil mesh network.
|
2022-04-19 09:02:18 +00:00
|
|
|
|
See @command{yggdrasil -genconf} for config options.")
|
2020-06-11 12:09:57 +00:00
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension shepherd-root-service-type
|
|
|
|
|
yggdrasil-shepherd-service)
|
|
|
|
|
(service-extension account-service-type
|
|
|
|
|
(const %yggdrasil-accounts))
|
|
|
|
|
(service-extension profile-service-type
|
2022-05-23 19:39:08 +00:00
|
|
|
|
(compose list yggdrasil-configuration-package))
|
|
|
|
|
(service-extension rottlog-service-type
|
|
|
|
|
(const %yggdrasil-log-rotation))))))
|
2020-06-11 12:09:57 +00:00
|
|
|
|
|
2021-01-15 20:46:42 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; IPFS
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <ipfs-configuration>
|
|
|
|
|
ipfs-configuration
|
|
|
|
|
make-ipfs-configuration
|
|
|
|
|
ipfs-configuration?
|
|
|
|
|
(package ipfs-configuration-package
|
|
|
|
|
(default go-ipfs))
|
|
|
|
|
(gateway ipfs-configuration-gateway
|
|
|
|
|
(default "/ip4/127.0.0.1/tcp/8082"))
|
|
|
|
|
(api ipfs-configuration-api
|
|
|
|
|
(default "/ip4/127.0.0.1/tcp/5001")))
|
|
|
|
|
|
|
|
|
|
(define %ipfs-home "/var/lib/ipfs")
|
|
|
|
|
|
|
|
|
|
(define %ipfs-accounts
|
|
|
|
|
(list (user-account
|
|
|
|
|
(name "ipfs")
|
|
|
|
|
(group "ipfs")
|
|
|
|
|
(system? #t)
|
|
|
|
|
(comment "IPFS daemon user")
|
|
|
|
|
(home-directory "/var/lib/ipfs")
|
|
|
|
|
(shell (file-append shadow "/sbin/nologin")))
|
|
|
|
|
(user-group
|
|
|
|
|
(name "ipfs")
|
|
|
|
|
(system? #t))))
|
|
|
|
|
|
|
|
|
|
(define (ipfs-binary config)
|
2022-04-17 13:05:43 +00:00
|
|
|
|
(define command
|
|
|
|
|
(file-append (ipfs-configuration-package config) "/bin/ipfs"))
|
|
|
|
|
|
|
|
|
|
(least-authority-wrapper
|
|
|
|
|
command
|
|
|
|
|
#:name "ipfs"
|
|
|
|
|
#:mappings (list %ipfs-home-mapping)
|
|
|
|
|
#:namespaces (delq 'net %namespaces)))
|
2021-01-15 20:46:42 +00:00
|
|
|
|
|
|
|
|
|
(define %ipfs-home-mapping
|
2022-04-17 13:05:43 +00:00
|
|
|
|
(file-system-mapping
|
|
|
|
|
(source %ipfs-home)
|
|
|
|
|
(target %ipfs-home)
|
|
|
|
|
(writable? #t)))
|
2021-01-15 20:46:42 +00:00
|
|
|
|
|
|
|
|
|
(define %ipfs-environment
|
|
|
|
|
#~(list #$(string-append "HOME=" %ipfs-home)))
|
|
|
|
|
|
|
|
|
|
(define (ipfs-shepherd-service config)
|
|
|
|
|
"Return a <shepherd-service> for IPFS with CONFIG."
|
|
|
|
|
(define ipfs-daemon-command
|
|
|
|
|
#~(list #$(ipfs-binary config) "daemon"))
|
2022-04-17 13:05:43 +00:00
|
|
|
|
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(provision '(ipfs))
|
|
|
|
|
;; While IPFS is most useful when the machine is connected
|
|
|
|
|
;; to the network, only loopback is required for starting
|
|
|
|
|
;; the service.
|
|
|
|
|
(requirement '(loopback))
|
|
|
|
|
(documentation "Connect to the IPFS network")
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
#$ipfs-daemon-command
|
|
|
|
|
#:log-file "/var/log/ipfs.log"
|
|
|
|
|
#:user "ipfs" #:group "ipfs"
|
|
|
|
|
#:environment-variables #$%ipfs-environment))
|
|
|
|
|
(stop #~(make-kill-destructor)))))
|
2021-01-15 20:46:42 +00:00
|
|
|
|
|
2022-05-23 19:39:08 +00:00
|
|
|
|
(define %ipfs-log-rotation
|
|
|
|
|
(list (log-rotation
|
|
|
|
|
(files '("/var/log/ipfs.log")))))
|
|
|
|
|
|
2021-01-15 20:46:42 +00:00
|
|
|
|
(define (%ipfs-activation config)
|
|
|
|
|
"Return an activation gexp for IPFS with CONFIG"
|
2022-04-17 13:05:43 +00:00
|
|
|
|
(define (exec-command . args)
|
|
|
|
|
;; Exec the given ifps command with the right authority.
|
|
|
|
|
#~(let ((pid (primitive-fork)))
|
|
|
|
|
(if (zero? pid)
|
|
|
|
|
(dynamic-wind
|
|
|
|
|
(const #t)
|
|
|
|
|
(lambda ()
|
|
|
|
|
;; Run ipfs init and ipfs config from a container,
|
|
|
|
|
;; in case the IPFS daemon was compromised at some point
|
|
|
|
|
;; and ~/.ipfs is now a symlink to somewhere outside
|
|
|
|
|
;; %ipfs-home.
|
|
|
|
|
(let ((pw (getpwnam "ipfs")))
|
|
|
|
|
(setgroups '#())
|
|
|
|
|
(setgid (passwd:gid pw))
|
|
|
|
|
(setuid (passwd:uid pw))
|
|
|
|
|
(environ #$%ipfs-environment)
|
|
|
|
|
(execl #$(ipfs-binary config) #$@args)))
|
|
|
|
|
(lambda ()
|
|
|
|
|
(primitive-exit 127)))
|
|
|
|
|
(waitpid pid))))
|
|
|
|
|
|
2021-01-15 20:46:42 +00:00
|
|
|
|
(define settings
|
|
|
|
|
`(("Addresses.API" ,(ipfs-configuration-api config))
|
|
|
|
|
("Addresses.Gateway" ,(ipfs-configuration-gateway config))))
|
2022-04-17 13:05:43 +00:00
|
|
|
|
|
2021-01-15 20:46:42 +00:00
|
|
|
|
(define inner-gexp
|
|
|
|
|
#~(begin
|
|
|
|
|
(umask #o077)
|
|
|
|
|
;; Create $HOME/.ipfs structure
|
2022-04-17 13:05:43 +00:00
|
|
|
|
#$(exec-command "ipfs" "init")
|
2021-01-15 20:46:42 +00:00
|
|
|
|
;; Apply settings
|
2022-04-17 13:05:43 +00:00
|
|
|
|
#$@(map (match-lambda
|
|
|
|
|
((setting value)
|
|
|
|
|
(exec-command "ipfs" "config" setting value)))
|
|
|
|
|
settings)))
|
|
|
|
|
|
2021-01-15 20:46:42 +00:00
|
|
|
|
(define inner-script
|
|
|
|
|
(program-file "ipfs-activation-inner" inner-gexp))
|
2022-04-16 20:27:13 +00:00
|
|
|
|
|
2021-01-15 20:46:42 +00:00
|
|
|
|
;; The activation may happen from the initrd, which uses
|
|
|
|
|
;; a statically-linked guile, while the guix container
|
|
|
|
|
;; procedures require a working dynamic-link.
|
2022-04-17 13:05:43 +00:00
|
|
|
|
#~(system* #$inner-script))
|
2021-01-15 20:46:42 +00:00
|
|
|
|
|
|
|
|
|
(define ipfs-service-type
|
|
|
|
|
(service-type
|
|
|
|
|
(name 'ipfs)
|
|
|
|
|
(extensions
|
|
|
|
|
(list (service-extension account-service-type
|
|
|
|
|
(const %ipfs-accounts))
|
|
|
|
|
(service-extension activation-service-type
|
|
|
|
|
%ipfs-activation)
|
|
|
|
|
(service-extension shepherd-root-service-type
|
2022-05-23 19:39:08 +00:00
|
|
|
|
ipfs-shepherd-service)
|
|
|
|
|
(service-extension rottlog-service-type
|
|
|
|
|
(const %ipfs-log-rotation))))
|
2021-01-15 20:46:42 +00:00
|
|
|
|
(default-value (ipfs-configuration))
|
|
|
|
|
(description
|
|
|
|
|
"Run @command{ipfs daemon}, the reference implementation
|
2021-04-12 16:43:39 +00:00
|
|
|
|
of the IPFS peer-to-peer storage network.")))
|
2021-01-15 20:46:42 +00:00
|
|
|
|
|
2021-01-01 10:02:11 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Keepalived
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(define-record-type* <keepalived-configuration>
|
|
|
|
|
keepalived-configuration make-keepalived-configuration
|
|
|
|
|
keepalived-configuration?
|
2021-11-18 21:44:26 +00:00
|
|
|
|
(keepalived keepalived-configuration-keepalived ;file-like
|
2021-01-01 10:02:11 +00:00
|
|
|
|
(default keepalived))
|
|
|
|
|
(config-file keepalived-configuration-config-file ;file-like
|
|
|
|
|
(default #f)))
|
|
|
|
|
|
2022-11-19 21:34:13 +00:00
|
|
|
|
(define (keepalived-shepherd-service config)
|
|
|
|
|
(match-record config <keepalived-configuration>
|
|
|
|
|
(keepalived config-file)
|
|
|
|
|
(list (shepherd-service
|
|
|
|
|
(provision '(keepalived))
|
|
|
|
|
(documentation "Run keepalived.")
|
|
|
|
|
(requirement '(loopback))
|
|
|
|
|
(start #~(make-forkexec-constructor
|
|
|
|
|
(list (string-append #$keepalived "/sbin/keepalived")
|
|
|
|
|
"--dont-fork" "--log-console" "--log-detail"
|
|
|
|
|
"--pid=/var/run/keepalived.pid"
|
|
|
|
|
(string-append "--use-file=" #$config-file))
|
|
|
|
|
#:pid-file "/var/run/keepalived.pid"
|
|
|
|
|
#:log-file "/var/log/keepalived.log"))
|
|
|
|
|
(respawn? #f)
|
|
|
|
|
(stop #~(make-kill-destructor))))))
|
2021-01-01 10:02:11 +00:00
|
|
|
|
|
2022-05-23 19:39:08 +00:00
|
|
|
|
(define %keepalived-log-rotation
|
|
|
|
|
(list (log-rotation
|
|
|
|
|
(files '("/var/log/keepalived.log")))))
|
|
|
|
|
|
2021-01-01 10:02:11 +00:00
|
|
|
|
(define keepalived-service-type
|
|
|
|
|
(service-type (name 'keepalived)
|
|
|
|
|
(extensions (list (service-extension shepherd-root-service-type
|
2022-05-23 19:39:08 +00:00
|
|
|
|
keepalived-shepherd-service)
|
|
|
|
|
(service-extension rottlog-service-type
|
|
|
|
|
(const %keepalived-log-rotation))))
|
2021-01-01 10:02:11 +00:00
|
|
|
|
(description
|
|
|
|
|
"Run @uref{https://www.keepalived.org/, Keepalived}
|
|
|
|
|
routing software.")))
|
|
|
|
|
|
2014-02-19 19:58:24 +00:00
|
|
|
|
;;; networking.scm ends here
|