summaryrefslogtreecommitdiff
path: root/gnu/services/networking.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-09-17 23:44:26 +0200
committerLudovic Courtès <ludo@gnu.org>2015-10-10 22:55:15 +0200
commit0adfe95a3eee335847c3127edde3de550e692440 (patch)
tree1c5a059d8f261f09254c0e420e61e1344c9edb45 /gnu/services/networking.scm
parente79467f63a06811ba5dd8c8b0cc79553c5dd4e3a (diff)
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.
Diffstat (limited to 'gnu/services/networking.scm')
-rw-r--r--gnu/services/networking.scm546
1 files changed, 340 insertions, 206 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 50ffac5796..52a843b54b 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -19,7 +19,10 @@
(define-module (gnu services networking)
#:use-module (gnu services)
+ #:use-module (gnu services dmd)
+ #:use-module (gnu services dbus)
#:use-module (gnu system shadow)
+ #:use-module (gnu system linux) ;PAM
#:use-module (gnu packages admin)
#:use-module (gnu packages linux)
#:use-module (gnu packages tor)
@@ -27,8 +30,9 @@
#:use-module (gnu packages ntp)
#:use-module (gnu packages wicd)
#:use-module (guix gexp)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
#:export (%facebook-host-aliases
static-networking-service
dhcp-client-service
@@ -78,6 +82,72 @@ fe80::1%lo0 www.connect.facebook.net
fe80::1%lo0 apps.facebook.com\n")
+(define-record-type* <static-networking>
+ static-networking make-static-networking
+ static-networking?
+ (interface static-networking-interface)
+ (ip static-networking-ip)
+ (gateway static-networking-gateway)
+ (provision static-networking-provision)
+ (name-servers static-networking-name-servers)
+ (net-tools static-networking-net-tools))
+
+(define static-networking-service-type
+ (dmd-service-type
+ (match-lambda
+ (($ <static-networking> interface ip gateway provision
+ name-servers net-tools)
+ (let ((loopback? (memq 'loopback provision)))
+
+ ;; TODO: Eventually replace 'route' with bindings for the appropriate
+ ;; ioctls.
+ (dmd-service
+
+ ;; Unless we're providing the loopback interface, wait for udev to be up
+ ;; and running so that INTERFACE is actually usable.
+ (requirement (if loopback? '() '(udev)))
+
+ (documentation
+ "Bring up the networking interface using a static IP address.")
+ (provision provision)
+ (start #~(lambda _
+ ;; Return #t if successfully started.
+ (let* ((addr (inet-pton AF_INET #$ip))
+ (sockaddr (make-socket-address AF_INET addr 0)))
+ (configure-network-interface #$interface sockaddr
+ (logior IFF_UP
+ #$(if loopback?
+ #~IFF_LOOPBACK
+ 0))))
+ #$(if gateway
+ #~(zero? (system* (string-append #$net-tools
+ "/sbin/route")
+ "add" "-net" "default"
+ "gw" #$gateway))
+ #t)
+ #$(if (pair? name-servers)
+ #~(call-with-output-file "/etc/resolv.conf"
+ (lambda (port)
+ (display
+ "# Generated by 'static-networking-service'.\n"
+ port)
+ (for-each (lambda (server)
+ (format port "nameserver ~a~%"
+ server))
+ '#$name-servers)))
+ #t)))
+ (stop #~(lambda _
+ ;; Return #f is successfully stopped.
+ (let ((sock (socket AF_INET SOCK_STREAM 0)))
+ (set-network-interface-flags sock #$interface 0)
+ (close-port sock))
+ (not #$(if gateway
+ #~(system* (string-append #$net-tools
+ "/sbin/route")
+ "del" "-net" "default")
+ #t))))
+ (respawn? #f)))))))
+
(define* (static-networking-service interface ip
#:key
gateway
@@ -87,111 +157,70 @@ fe80::1%lo0 apps.facebook.com\n")
"Return a service that starts @var{interface} with address @var{ip}. If
@var{gateway} is true, it must be a string specifying the default network
gateway."
- (define loopback?
- (memq 'loopback provision))
-
- ;; TODO: Eventually replace 'route' with bindings for the appropriate
- ;; ioctls.
- (service
-
- ;; Unless we're providing the loopback interface, wait for udev to be up
- ;; and running so that INTERFACE is actually usable.
- (requirement (if loopback? '() '(udev)))
-
- (documentation
- "Bring up the networking interface using a static IP address.")
- (provision provision)
- (start #~(lambda _
- ;; Return #t if successfully started.
- (let* ((addr (inet-pton AF_INET #$ip))
- (sockaddr (make-socket-address AF_INET addr 0)))
- (configure-network-interface #$interface sockaddr
- (logior IFF_UP
- #$(if loopback?
- #~IFF_LOOPBACK
- 0))))
- #$(if gateway
- #~(zero? (system* (string-append #$net-tools
- "/sbin/route")
- "add" "-net" "default"
- "gw" #$gateway))
- #t)
- #$(if (pair? name-servers)
- #~(call-with-output-file "/etc/resolv.conf"
- (lambda (port)
- (display
- "# Generated by 'static-networking-service'.\n"
- port)
- (for-each (lambda (server)
- (format port "nameserver ~a~%"
- server))
- '#$name-servers)))
- #t)))
- (stop #~(lambda _
- ;; Return #f is successfully stopped.
- (let ((sock (socket AF_INET SOCK_STREAM 0)))
- (set-network-interface-flags sock #$interface 0)
- (close-port sock))
- (not #$(if gateway
- #~(system* (string-append #$net-tools
- "/sbin/route")
- "del" "-net" "default")
- #t))))
- (respawn? #f)))
+ (service static-networking-service-type
+ (static-networking (interface interface) (ip ip)
+ (gateway gateway)
+ (provision provision)
+ (name-servers name-servers)
+ (net-tools net-tools))))
+
+(define dhcp-client-service-type
+ (dmd-service-type
+ (lambda (dhcp)
+ (define dhclient
+ #~(string-append #$dhcp "/sbin/dhclient"))
+
+ (define pid-file
+ "/var/run/dhclient.pid")
+
+ (dmd-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 _
+ ;; 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?
+ (negate loopback-network-interface?))
+ (define ifaces
+ (filter valid? (all-network-interface-names)))
+
+ ;; XXX: Make sure the interfaces are up so that 'dhclient' can
+ ;; actually send/receive over them.
+ (for-each set-network-interface-up ifaces)
+
+ (false-if-exception (delete-file #$pid-file))
+ (let ((pid (fork+exec-command
+ (cons* #$dhclient "-nw"
+ "-pf" #$pid-file ifaces))))
+ (and (zero? (cdr (waitpid pid)))
+ (let loop ()
+ (catch 'system-error
+ (lambda ()
+ (call-with-input-file #$pid-file read))
+ (lambda args
+ ;; 'dhclient' returned before PID-FILE was created,
+ ;; so try again.
+ (let ((errno (system-error-errno args)))
+ (if (= ENOENT errno)
+ (begin
+ (sleep 1)
+ (loop))
+ (apply throw args))))))))))
+ (stop #~(make-kill-destructor))))))
(define* (dhcp-client-service #:key (dhcp isc-dhcp))
"Return a service that runs @var{dhcp}, a Dynamic Host Configuration
Protocol (DHCP) client, on all the non-loopback network interfaces."
-
- (define dhclient
- #~(string-append #$dhcp "/sbin/dhclient"))
-
- (define pid-file
- "/var/run/dhclient.pid")
-
- (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 _
- ;; 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?
- (negate loopback-network-interface?))
- (define ifaces
- (filter valid? (all-network-interface-names)))
-
- ;; XXX: Make sure the interfaces are up so that 'dhclient' can
- ;; actually send/receive over them.
- (for-each set-network-interface-up ifaces)
-
- (false-if-exception (delete-file #$pid-file))
- (let ((pid (fork+exec-command
- (cons* #$dhclient "-nw"
- "-pf" #$pid-file ifaces))))
- (and (zero? (cdr (waitpid pid)))
- (let loop ()
- (catch 'system-error
- (lambda ()
- (call-with-input-file #$pid-file read))
- (lambda args
- ;; 'dhclient' returned before PID-FILE was created,
- ;; so try again.
- (let ((errno (system-error-errno args)))
- (if (= ENOENT errno)
- (begin
- (sleep 1)
- (loop))
- (apply throw args))))))))))
- (stop #~(make-kill-destructor))))
+ (service dhcp-client-service-type dhcp))
(define %ntp-servers
;; Default set of NTP servers.
@@ -199,19 +228,30 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
"1.pool.ntp.org"
"2.pool.ntp.org"))
-(define* (ntp-service #:key (ntp ntp)
- (servers %ntp-servers))
- "Return a service that runs the daemon from @var{ntp}, the
-@uref{http://www.ntp.org, Network Time Protocol package}. The daemon will
-keep the system clock synchronized with that of @var{servers}."
- ;; TODO: Add authentication support.
-
- (define config
- (string-append "driftfile /var/run/ntp.drift\n"
- (string-join (map (cut string-append "server " <>)
- servers)
- "\n")
- "
+
+;;;
+;;; NTP.
+;;;
+
+;; TODO: Export.
+(define-record-type* <ntp-configuration>
+ ntp-configuration make-ntp-configuration
+ ntp-configuration?
+ (ntp ntp-configuration-ntp
+ (default ntp))
+ (servers ntp-configuration-servers))
+
+(define ntp-dmd-service
+ (match-lambda
+ (($ <ntp-configuration> ntp servers)
+ (let ()
+ ;; TODO: Add authentication support.
+ (define config
+ (string-append "driftfile /var/run/ntp.drift\n"
+ (string-join (map (cut string-append "server " <>)
+ servers)
+ "\n")
+ "
# Disable status queries as a workaround for CVE-2013-5211:
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
restrict default kod nomodify notrap nopeer noquery
@@ -221,55 +261,154 @@ restrict -6 default kod nomodify notrap nopeer noquery
restrict 127.0.0.1
restrict -6 ::1\n"))
- (let ((ntpd.conf (plain-file "ntpd.conf" config)))
- (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")))
- (stop #~(make-kill-destructor))
- (user-accounts (list (user-account
- (name "ntpd")
- (group "nogroup")
- (system? #t)
- (comment "NTP daemon user")
- (home-directory "/var/empty")
- (shell
- #~(string-append #$shadow "/sbin/nologin"))))))))
+ (define ntpd.conf
+ (plain-file "ntpd.conf" config))
+
+ (list (dmd-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")))
+ (stop #~(make-kill-destructor))))))))
+
+(define %ntp-accounts
+ (list (user-account
+ (name "ntpd")
+ (group "nogroup")
+ (system? #t)
+ (comment "NTP daemon user")
+ (home-directory "/var/empty")
+ (shell #~(string-append #$shadow "/sbin/nologin")))))
+
+(define ntp-service-type
+ (service-type (name 'ntp)
+ (extensions
+ (list (service-extension dmd-root-service-type
+ ntp-dmd-service)
+ (service-extension account-service-type
+ (const %ntp-accounts))))))
+
+(define* (ntp-service #:key (ntp ntp)
+ (servers %ntp-servers))
+ "Return a service that runs the daemon from @var{ntp}, the
+@uref{http://www.ntp.org, Network Time Protocol package}. The daemon will
+keep the system clock synchronized with that of @var{servers}."
+ (service ntp-service-type
+ (ntp-configuration (ntp ntp) (servers servers))))
+
+
+;;;
+;;; Tor.
+;;;
+
+(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")
+ (shell #~(string-append #$shadow "/sbin/nologin")))))
+
+(define (tor-dmd-service tor)
+ "Return a <dmd-service> running TOR."
+ (let ((torrc (plain-file "torrc" "User tor\n")))
+ (list (dmd-service
+ (provision '(tor))
+
+ ;; Tor needs at least one network interface to be up, hence the
+ ;; dependency on 'loopback'.
+ (requirement '(user-processes loopback))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
+ (stop #~(make-kill-destructor))
+ (documentation "Run the Tor anonymous network overlay.")))))
+
+(define tor-service-type
+ (service-type (name 'tor)
+ (extensions
+ (list (service-extension dmd-root-service-type
+ tor-dmd-service)
+ (service-extension account-service-type
+ (const %tor-accounts))))))
(define* (tor-service #:key (tor tor))
"Return a service to run the @uref{https://torproject.org,Tor} daemon.
The daemon runs with the default settings (in particular the default exit
policy) as the @code{tor} unprivileged user."
- (let ((torrc (plain-file "torrc" "User tor\n")))
- (service
- (provision '(tor))
-
- ;; Tor needs at least one network interface to be up, hence the
- ;; dependency on 'loopback'.
- (requirement '(user-processes loopback))
-
- (start #~(make-forkexec-constructor
- (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
- (stop #~(make-kill-destructor))
-
- (user-groups (list (user-group
- (name "tor")
- (system? #t))))
- (user-accounts (list (user-account
- (name "tor")
- (group "tor")
- (system? #t)
- (comment "Tor daemon user")
- (home-directory "/var/empty")
- (shell
- #~(string-append #$shadow "/sbin/nologin")))))
-
- (documentation "Run the Tor anonymous network overlay."))))
+ (service tor-service-type tor))
+
+
+;;;
+;;; BitlBee.
+;;;
+
+(define-record-type* <bitlbee-configuration>
+ bitlbee-configuration make-bitlbee-configuration
+ bitlbee-configuration?
+ (bitlbee bitlbee-configuration-bitlbee
+ (default bitlbee))
+ (interface bitlbee-configuration-interface)
+ (port bitlbee-configuration-port)
+ (extra-settings bitlbee-configuration-extra-settings))
+
+(define bitlbee-dmd-service
+ (match-lambda
+ (($ <bitlbee-configuration> bitlbee interface port extra-settings)
+ (let ((conf (plain-file "bitlbee.conf"
+ (string-append "
+ [settings]
+ User = bitlbee
+ ConfigDir = /var/lib/bitlbee
+ DaemonInterface = " interface "
+ DaemonPort = " (number->string port) "
+" extra-settings))))
+
+ (list (dmd-service
+ (provision '(bitlbee))
+ (requirement '(user-processes loopback))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$bitlbee "/sbin/bitlbee")
+ "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
+ (stop #~(make-kill-destructor))))))))
+
+(define %bitlbee-accounts
+ ;; User group and account to run BitlBee.
+ (list (user-group (name "bitlbee") (system? #t))
+ (user-account
+ (name "bitlbee")
+ (group "bitlbee")
+ (system? #t)
+ (comment "BitlBee daemon user")
+ (home-directory "/var/empty")
+ (shell #~(string-append #$shadow "/sbin/nologin")))))
+
+(define %bitlbee-activation
+ ;; Activation gexp for BitlBee.
+ #~(begin
+ (use-modules (guix build utils))
+
+ ;; This directory is used to store OTR data.
+ (mkdir-p "/var/lib/bitlbee")
+ (let ((user (getpwnam "bitlbee")))
+ (chown "/var/lib/bitlbee"
+ (passwd:uid user) (passwd:gid user)))))
+
+(define bitlbee-service-type
+ (service-type (name 'bitlbee)
+ (extensions
+ (list (service-extension dmd-root-service-type
+ bitlbee-dmd-service)
+ (service-extension account-service-type
+ (const %bitlbee-accounts))
+ (service-extension activation-service-type
+ (const %bitlbee-activation))))))
(define* (bitlbee-service #:key (bitlbee bitlbee)
(interface "127.0.0.1") (port 6667)
@@ -284,57 +423,52 @@ come from any networking interface.
In addition, @var{extra-settings} specifies a string to append to the
configuration file."
- (let ((conf (plain-file "bitlbee.conf"
- (string-append "
- [settings]
- User = bitlbee
- ConfigDir = /var/lib/bitlbee
- DaemonInterface = " interface "
- DaemonPort = " (number->string port) "
-" extra-settings))))
- (service
- (provision '(bitlbee))
- (requirement '(user-processes loopback))
- (activate #~(begin
- (use-modules (guix build utils))
-
- ;; This directory is used to store OTR data.
- (mkdir-p "/var/lib/bitlbee")
- (let ((user (getpwnam "bitlbee")))
- (chown "/var/lib/bitlbee"
- (passwd:uid user) (passwd:gid user)))))
- (start #~(make-forkexec-constructor
- (list (string-append #$bitlbee "/sbin/bitlbee")
- "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
- (stop #~(make-kill-destructor))
- (user-groups (list (user-group (name "bitlbee") (system? #t))))
- (user-accounts (list (user-account
- (name "bitlbee")
- (group "bitlbee")
- (system? #t)
- (comment "BitlBee daemon user")
- (home-directory "/var/empty")
- (shell #~(string-append #$shadow
- "/sbin/nologin"))))))))
+ (service bitlbee-service-type
+ (bitlbee-configuration
+ (bitlbee bitlbee)
+ (interface interface) (port port)
+ (extra-settings extra-settings))))
+
+
+;;;
+;;; Wicd.
+;;;
+
+(define %wicd-activation
+ ;; Activation gexp for Wicd.
+ #~(begin
+ (use-modules (guix build utils))
+
+ (mkdir-p "/etc/wicd")
+ (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
+ (unless (file-exists? file-name)
+ (copy-file (string-append #$wicd file-name)
+ file-name)))))
+
+(define (wicd-dmd-service wicd)
+ "Return a dmd service for WICD."
+ (list (dmd-service
+ (documentation "Run the Wicd network manager.")
+ (provision '(networking))
+ (requirement '(user-processes dbus-system loopback))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$wicd "/sbin/wicd")
+ "--no-daemon")))
+ (stop #~(make-kill-destructor)))))
+
+(define wicd-service-type
+ (service-type (name 'wicd)
+ (extensions
+ (list (service-extension dmd-root-service-type
+ wicd-dmd-service)
+ (service-extension dbus-root-service-type
+ list)
+ (service-extension activation-service-type
+ (const %wicd-activation))))))
(define* (wicd-service #:key (wicd wicd))
"Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
manager that aims to simplify wired and wireless networking."
- (service
- (documentation "Run the Wicd network manager.")
- (provision '(networking))
- (requirement '(user-processes dbus-system loopback))
- (start #~(make-forkexec-constructor
- (list (string-append #$wicd "/sbin/wicd")
- "--no-daemon")))
- (stop #~(make-kill-destructor))
- (activate
- #~(begin
- (use-modules (guix build utils))
- (mkdir-p "/etc/wicd")
- (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
- (unless (file-exists? file-name)
- (copy-file (string-append #$wicd file-name)
- file-name)))))))
+ (service wicd-service-type wicd))
;;; networking.scm ends here