Browse Source

system: Make service procedures non-monadic.

* gnu/services/avahi.scm (configuration-file): Use 'plain-file' instead
  of 'text-file'.
  (avahi-service): Turn into a regular procedure that returns a <service>.
* gnu/services/base.scm (root-file-system-service, file-system-service,
  user-unmount-service, user-processes-service, host-name-service,
  console-keymap-service, console-font-service, mingetty-service,
  nscd.conf-file, nscd-service): Likewise.
  (%default-syslog.conf): New variable.
  (syslog-service): Use it.  Turn into a regular procedure.
  (guix-service, udev-rules-union, kvm-udev-rule, udev-service,
  device-mapping-service, swap-service): Likewise.
* gnu/services/databases.scm (%default-postgres-hba,
  %default-postgres-ident): Use 'plain-file' instead of 'text-file'.
  (%default-postgres-config): Use 'mixed-text-file' instead of
  'text-file*'.
  (postgresql-service):  Use 'program-file' instead of 'gexp->script'.
  Turn into a regular procedure.
* gnu/services/desktop.scm (dbus-configuration-directory): Use
  'computed-file' instead of 'gexp->derivation'.
  (upower-configuration-file, geoclue-configuration-file,
  elogind-configuration-file): Use 'plain-file' instead of 'text-file'.
  (dbus-service, upower-service, colord-service, geoclue-service,
  polkit-service, elogind-service): Turn into regular procedures.
  (%desktop-services): Remove use of 'mlet' when iterating on
  %BASE-SERVICES.
* gnu/services/lirc.scm (lirc-service): Turn into a regular procedure.
* gnu/services/networking.scm (static-networking-service,
  dhcp-client-service, ntp-service, tor-service, bitlbee-service,
  wicd-service): Likewise.
* gnu/services/ssh.scm (lsh-service): Likewise.
* gnu/services/web.scm (nginx-service): Likewise.
* gnu/services/xorg.scm (xorg-configuration-file): Use 'mixed-text-file'
  instead of 'text-file*'.
  (xorg-start-command, slim-service): Turn into regular procedures.
  (xinitrc): Use 'program-file' instead of 'gexp->script'.
* gnu/system/install.scm (cow-store-service,
  configuration-template-service): Turn into regular procedures.
* gnu/system.scm (other-file-system-services, device-mapping-services,
  swap-services, essential-services, operating-system-services,
  user-shells, operating-system-accounts): Remove now unnecessary
  'mlet' and turn into regular procedures.
  (operating-system-etc-directory, operating-system-activation-script,
  operating-system-boot-script): Adjust accordingly.
* doc/guix.texi (Base Services, Networking Services, X Window, Desktop
  Services, Database Services, Web Services, Various Services, Name
  Service Switch): Adjust accordingly.
wip-container
Ludovic Courtès 7 years ago
parent
commit
be1c2c54d9
  1. 66
      doc/guix.texi
  2. 88
      gnu/services/avahi.scm
  3. 908
      gnu/services/base.scm
  4. 74
      gnu/services/databases.scm
  5. 450
      gnu/services/desktop.scm
  6. 45
      gnu/services/lirc.scm
  7. 357
      gnu/services/networking.scm
  8. 34
      gnu/services/ssh.scm
  9. 37
      gnu/services/web.scm
  10. 129
      gnu/services/xorg.scm
  11. 104
      gnu/system.scm
  12. 84
      gnu/system/install.scm

66
doc/guix.texi

@ -5749,11 +5749,11 @@ this:
@end example
@end defvr
@deffn {Monadic Procedure} host-name-service @var{name}
@deffn {Scheme Procedure} host-name-service @var{name}
Return a service that sets the host name to @var{name}.
@end deffn
@deffn {Monadic Procedure} mingetty-service @var{tty} [#:motd] @
@deffn {Scheme Procedure} mingetty-service @var{tty} [#:motd] @
[#:auto-login #f] [#:login-program] [#:login-pause? #f] @
[#:allow-empty-passwords? #f]
Return a service to run mingetty on @var{tty}.
@ -5774,7 +5774,7 @@ the ``message of the day''.
@cindex name service cache daemon
@cindex nscd
@deffn {Monadic Procedure} nscd-service [@var{config}] [#:glibc glibc] @
@deffn {Scheme Procedure} nscd-service [@var{config}] [#:glibc glibc] @
[#:name-services '()]
Return a service that runs libc's name service cache daemon (nscd) with
the given @var{config}---an @code{<nscd-configuration>} object.
@ -5861,13 +5861,13 @@ external name servers do not even need to be queried.
@end defvr
@deffn {Monadic Procedure} syslog-service [#:config-file #f]
@deffn {Scheme Procedure} syslog-service [#:config-file #f]
Return a service that runs @code{syslogd}. If configuration file name
@var{config-file} is not specified, use some reasonable default
settings.
@end deffn
@deffn {Monadic Procedure} guix-service [#:guix guix] @
@deffn {Scheme Procedure} guix-service [#:guix guix] @
[#:builder-group "guixbuild"] [#:build-accounts 10] @
[#:authorize-hydra-key? #t] [#:use-substitutes? #t] @
[#:extra-options '()]
@ -5886,11 +5886,11 @@ Finally, @var{extra-options} is a list of additional command-line options
passed to @command{guix-daemon}.
@end deffn
@deffn {Monadic Procedure} udev-service [#:udev udev]
@deffn {Scheme Procedure} udev-service [#:udev udev]
Run @var{udev}, which populates the @file{/dev} directory dynamically.
@end deffn
@deffn {Monadic Procedure} console-keymap-service @var{file}
@deffn {Scheme Procedure} console-keymap-service @var{file}
Return a service to load console keymap from @var{file} using
@command{loadkeys} command.
@end deffn
@ -5903,12 +5903,12 @@ The @code{(gnu services networking)} module provides services to configure
the network interface.
@cindex DHCP, networking service
@deffn {Monadic Procedure} dhcp-client-service [#:dhcp @var{isc-dhcp}]
@deffn {Scheme Procedure} dhcp-client-service [#:dhcp @var{isc-dhcp}]
Return a service that runs @var{dhcp}, a Dynamic Host Configuration
Protocol (DHCP) client, on all the non-loopback network interfaces.
@end deffn
@deffn {Monadic Procedure} static-networking-service @var{interface} @var{ip} @
@deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @
[#:gateway #f] [#:name-services @code{'()}]
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
@ -5916,12 +5916,12 @@ gateway.
@end deffn
@cindex wicd
@deffn {Monadic Procedure} wicd-service [#:wicd @var{wicd}]
@deffn {Scheme Procedure} wicd-service [#:wicd @var{wicd}]
Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a
network manager that aims to simplify wired and wireless networking.
@end deffn
@deffn {Monadic Procedure} ntp-service [#:ntp @var{ntp}] @
@deffn {Scheme Procedure} ntp-service [#:ntp @var{ntp}] @
[#:name-service @var{%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
@ -5932,14 +5932,14 @@ keep the system clock synchronized with that of @var{servers}.
List of host names used as the default NTP servers.
@end defvr
@deffn {Monadic Procedure} tor-service [#:tor tor]
@deffn {Scheme Procedure} tor-service [#: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.
@end deffn
@deffn {Monadic Procedure} bitlbee-service [#:bitlbee bitlbee] @
@deffn {Scheme Procedure} bitlbee-service [#:bitlbee bitlbee] @
[#:interface "127.0.0.1"] [#:port 6667] @
[#:extra-settings ""]
Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that
@ -5956,7 +5956,7 @@ configuration file.
Furthermore, @code{(gnu services ssh)} provides the following service.
@deffn {Monadic Procedure} lsh-service [#:host-key "/etc/lsh/host-key"] @
@deffn {Scheme Procedure} lsh-service [#:host-key "/etc/lsh/host-key"] @
[#:daemonic? #t] [#:interfaces '()] [#:port-number 22] @
[#:allow-empty-passwords? #f] [#:root-login? #f] @
[#:syslog-output? #t] [#:x11-forwarding? #t] @
@ -6023,7 +6023,7 @@ browsers, from accessing Facebook.
The @code{(gnu services avahi)} provides the following definition.
@deffn {Monadic Procedure} avahi-service [#:avahi @var{avahi}] @
@deffn {Scheme Procedure} avahi-service [#:avahi @var{avahi}] @
[#:host-name #f] [#:publish? #t] [#:ipv4? #t] @
[#:ipv6? #t] [#:wide-area? #f] @
[#:domains-to-browse '()]
@ -6053,7 +6053,7 @@ Xorg---is provided by the @code{(gnu services xorg)} module. Note that
there is no @code{xorg-service} procedure. Instead, the X server is
started by the @dfn{login manager}, currently SLiM.
@deffn {Monadic Procedure} slim-service [#:allow-empty-passwords? #f] @
@deffn {Scheme Procedure} slim-service [#:allow-empty-passwords? #f] @
[#:auto-login? #f] [#:default-user ""] [#:startx] @
[#:theme @var{%default-slim-theme}] @
[#:theme-name @var{%default-slim-theme-name}]
@ -6089,7 +6089,7 @@ theme.
The G-Expression denoting the default SLiM theme and its name.
@end defvr
@deffn {Monadic Procedure} xorg-start-command [#:guile] @
@deffn {Scheme Procedure} xorg-start-command [#:guile] @
[#:configuration-file #f] [#:xorg-server @var{xorg-server}]
Return a derivation that builds a @var{guile} script to start the X server
from @var{xorg-server}. @var{configuration-file} is the server configuration
@ -6099,7 +6099,7 @@ file or a derivation that builds it; when omitted, the result of
Usually the X server is started by a login manager.
@end deffn
@deffn {Monadic Procedure} xorg-configuration-file @
@deffn {Scheme Procedure} xorg-configuration-file @
[#:drivers '()] [#:resolutions '()] [#:extra-config '()]
Return a configuration file for the Xorg server containing search paths for
all the common drivers.
@ -6150,7 +6150,7 @@ Reference, @code{services}}).
The actual service definitions provided by @code{(gnu services desktop)}
are described below.
@deffn {Monadic Procedure} dbus-service @var{services} @
@deffn {Scheme Procedure} dbus-service @var{services} @
[#:dbus @var{dbus}]
Return a service that runs the ``system bus'', using @var{dbus}, with
support for @var{services}.
@ -6165,7 +6165,7 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
@var{services} must be equal to @code{(list avahi)}.
@end deffn
@deffn {Monadic Procedure} elogind-service @
@deffn {Scheme Procedure} elogind-service @
[#:elogind @var{elogind}] [#:config @var{config}]
Return a service that runs the @code{elogind} login and
seat management daemon. @uref{https://github.com/andywingo/elogind,
@ -6236,7 +6236,7 @@ their default values are:
@end table
@end deffn
@deffn {Monadic Procedure} polkit-service @
@deffn {Scheme Procedure} polkit-service @
[#:polkit @var{polkit}]
Return a service that runs the Polkit privilege manager.
@uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit} allows
@ -6246,7 +6246,7 @@ whose session is active to shut down the machine, if there are no other
users active.
@end deffn
@deffn {Monadic Procedure} upower-service [#:upower @var{upower}] @
@deffn {Scheme Procedure} upower-service [#:upower @var{upower}] @
[#:watts-up-pro? #f] @
[#:poll-batteries? #t] @
[#:ignore-lid? #f] @
@ -6265,7 +6265,7 @@ levels, with the given configuration settings. It implements the
GNOME.
@end deffn
@deffn {Monadic Procedure} colord-service [#:colord @var{colord}]
@deffn {Scheme Procedure} colord-service [#:colord @var{colord}]
Return a service that runs @command{colord}, a system service with a D-Bus
interface to manage the color profiles of input and output devices such as
screens and scanners. It is notably used by the GNOME Color Manager graphical
@ -6293,7 +6293,7 @@ Firefox and Epiphany both query the user before allowing a web page to
know the user's location.
@end defvr
@deffn {Monadic Procedure} geoclue-service [#:colord @var{colord}] @
@deffn {Scheme Procedure} geoclue-service [#:colord @var{colord}] @
[#:whitelist '()] @
[#:wifi-geolocation-url "https://location.services.mozilla.com/v1/geolocate?key=geoclue"] @
[#:submit-data? #f]
@ -6313,7 +6313,7 @@ web site} for more information.
The @code{(gnu services databases)} module provides the following service.
@deffn {Monadic Procedure} postgresql-service [#:postgresql postgresql] @
@deffn {Scheme Procedure} postgresql-service [#:postgresql postgresql] @
[#:config-file] [#:data-directory ``/var/lib/postgresql/data'']
Return a service that runs @var{postgresql}, the PostgreSQL database
server.
@ -6328,7 +6328,7 @@ The PostgreSQL daemon loads its runtime configuration from
The @code{(gnu services web)} module provides the following service:
@deffn {Monadic Procedure} nginx-service [#:nginx nginx] @
@deffn {Scheme Procedure} nginx-service [#:nginx nginx] @
[#:log-directory ``/var/log/nginx''] @
[#:run-directory ``/var/run/nginx''] @
[#:config-file]
@ -6348,7 +6348,7 @@ directories are created when the service is activated.
The @code{(gnu services lirc)} module provides the following service.
@deffn {Monadic Procedure} lirc-service [#:lirc lirc] @
@deffn {Scheme Procedure} lirc-service [#:lirc lirc] @
[#:device #f] [#:driver #f] [#:config-file #f] @
[#:extra-options '()]
Return a service that runs @url{http://www.lirc.org,LIRC}, a daemon that
@ -6521,13 +6521,11 @@ configuration file:
(define %my-base-services
;; Replace the default nscd service with one that knows
;; about nss-mdns.
(map (lambda (mservice)
;; "Bind" the MSERVICE monadic value to inspect it.
(mlet %store-monad ((service mservice))
(if (member 'nscd (service-provision service))
(nscd-service (nscd-configuration)
#:name-services (list nss-mdns))
mservice)))
(map (lambda (service)
(if (member 'nscd (service-provision service))
(nscd-service (nscd-configuration)
#:name-services (list nss-mdns))
service))
%base-services))
@end example

88
gnu/services/avahi.scm

@ -21,7 +21,6 @@
#:use-module (gnu system shadow)
#:use-module (gnu packages avahi)
#:use-module (gnu packages admin)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix gexp)
#:export (avahi-service))
@ -39,21 +38,21 @@
(define (bool value)
(if value "yes\n" "no\n"))
(text-file "avahi-daemon.conf"
(string-append
"[server]\n"
(if host-name
(string-append "host-name=" host-name "\n")
"")
(plain-file "avahi-daemon.conf"
(string-append
"[server]\n"
(if host-name
(string-append "host-name=" host-name "\n")
"")
"browse-domains=" (string-join domains-to-browse)
"\n"
"use-ipv4=" (bool ipv4?)
"use-ipv6=" (bool ipv6?)
"[wide-area]\n"
"enable-wide-area=" (bool wide-area?)
"[publish]\n"
"disable-publishing=" (bool (not publish?)))))
"browse-domains=" (string-join domains-to-browse)
"\n"
"use-ipv4=" (bool ipv4?)
"use-ipv6=" (bool ipv6?)
"[wide-area]\n"
"enable-wide-area=" (bool wide-area?)
"[publish]\n"
"disable-publishing=" (bool (not publish?)))))
(define* (avahi-service #:key (avahi avahi)
host-name
@ -76,37 +75,36 @@ When @var{wide-area?} is true, DNS-SD over unicast DNS is enabled.
Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6
sockets."
(mlet %store-monad ((config (configuration-file #:host-name host-name
#:publish? publish?
#:ipv4? ipv4?
#:ipv6? ipv6?
#:wide-area? wide-area?
#:domains-to-browse
domains-to-browse)))
(return
(service
(documentation "Run the Avahi mDNS/DNS-SD responder.")
(provision '(avahi-daemon))
(requirement '(dbus-system networking))
(let ((config (configuration-file #:host-name host-name
#:publish? publish?
#:ipv4? ipv4?
#:ipv6? ipv6?
#:wide-area? wide-area?
#:domains-to-browse
domains-to-browse)))
(service
(documentation "Run the Avahi mDNS/DNS-SD responder.")
(provision '(avahi-daemon))
(requirement '(dbus-system networking))
(start #~(make-forkexec-constructor
(list (string-append #$avahi "/sbin/avahi-daemon")
"--syslog" "-f" #$config)))
(stop #~(make-kill-destructor))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/avahi-daemon")))
(start #~(make-forkexec-constructor
(list (string-append #$avahi "/sbin/avahi-daemon")
"--syslog" "-f" #$config)))
(stop #~(make-kill-destructor))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/avahi-daemon")))
(user-groups (list (user-group
(name "avahi")
(system? #t))))
(user-accounts (list (user-account
(name "avahi")
(group "avahi")
(system? #t)
(comment "Avahi daemon user")
(home-directory "/var/empty")
(shell
#~(string-append #$shadow "/sbin/nologin")))))))))
(user-groups (list (user-group
(name "avahi")
(system? #t))))
(user-accounts (list (user-account
(name "avahi")
(group "avahi")
(system? #t)
(comment "Avahi daemon user")
(home-directory "/var/empty")
(shell
#~(string-append #$shadow "/sbin/nologin"))))))))
;;; avahi.scm ends here

908
gnu/services/base.scm

File diff suppressed because it is too large

74
gnu/services/databases.scm

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,7 +23,6 @@
#:use-module (gnu packages admin)
#:use-module (gnu packages databases)
#:use-module (guix records)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix gexp)
#:export (postgresql-service))
@ -34,23 +34,20 @@
;;; Code:
(define %default-postgres-hba
(text-file "pg_hba.conf"
"
(plain-file "pg_hba.conf"
"
local all all trust
host all all 127.0.0.1/32 trust
host all all ::1/128 trust"))
(define %default-postgres-ident
(text-file "pg_ident.conf"
(plain-file "pg_ident.conf"
"# MAPNAME SYSTEM-USERNAME PG-USERNAME"))
(define %default-postgres-config
(mlet %store-monad ((hba %default-postgres-hba)
(ident %default-postgres-ident))
(text-file* "postgresql.conf"
;; The daemon will not start without these.
"hba_file = '" hba "'\n"
"ident_file = '" ident "'\n")))
(mixed-text-file "postgresql.conf"
"hba_file = '" %default-postgres-hba "'\n"
"ident_file = '" %default-postgres-ident "\n"))
(define* (postgresql-service #:key (postgresql postgresql)
(config-file %default-postgres-config)
@ -62,16 +59,15 @@ and stores the database cluster in @var{data-directory}."
;; Wrapper script that switches to the 'postgres' user before launching
;; daemon.
(define start-script
(mlet %store-monad ((config-file config-file))
(gexp->script "start-postgres"
#~(let ((user (getpwnam "postgres"))
(postgres (string-append #$postgresql
"/bin/postgres")))
(setgid (passwd:gid user))
(setuid (passwd:uid user))
(system* postgres
(string-append "--config-file=" #$config-file)
"-D" #$data-directory)))))
(program-file "start-postgres"
#~(let ((user (getpwnam "postgres"))
(postgres (string-append #$postgresql
"/bin/postgres")))
(setgid (passwd:gid user))
(setuid (passwd:uid user))
(system* postgres
(string-append "--config-file=" #$config-file)
"-D" #$data-directory))))
(define activate
#~(begin
@ -99,23 +95,21 @@ and stores the database cluster in @var{data-directory}."
(primitive-exit 1))))
(pid (waitpid pid))))))
(mlet %store-monad ((start-script start-script))
(return
(service
(provision '(postgres))
(documentation "Run the PostgreSQL daemon.")
(requirement '(user-processes loopback))
(start #~(make-forkexec-constructor #$start-script))
(stop #~(make-kill-destructor))
(activate activate)
(user-groups (list (user-group
(name "postgres")
(system? #t))))
(user-accounts (list (user-account
(name "postgres")
(group "postgres")
(system? #t)
(comment "PostgreSQL server user")
(home-directory "/var/empty")
(shell
#~(string-append #$shadow "/sbin/nologin")))))))))
(service
(provision '(postgres))
(documentation "Run the PostgreSQL daemon.")
(requirement '(user-processes loopback))
(start #~(make-forkexec-constructor #$start-script))
(stop #~(make-kill-destructor))
(activate activate)
(user-groups (list (user-group
(name "postgres")
(system? #t))))
(user-accounts (list (user-account
(name "postgres")
(group "postgres")
(system? #t)
(comment "PostgreSQL server user")
(home-directory "/var/empty")
(shell
#~(string-append #$shadow "/sbin/nologin")))))))

450
gnu/services/desktop.scm

@ -35,7 +35,6 @@
#:use-module (gnu packages polkit)
#:use-module ((gnu packages linux)
#:select (lvm2 fuse alsa-utils crda))
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix store)
#:use-module (guix gexp)
@ -104,7 +103,7 @@
(sxml->xml (services->sxml (list #$@services))
port)))))
(gexp->derivation "dbus-configuration" build))
(computed-file "dbus-configuration" build))
(define* (dbus-service services #:key (dbus dbus))
"Return a service that runs the \"system bus\", using @var{dbus}, with
@ -118,50 +117,49 @@ be notified of system-wide events.
@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration
and policy files. For example, to allow avahi-daemon to use the system bus,
@var{services} must be equal to @code{(list avahi)}."
(mlet %store-monad ((conf (dbus-configuration-directory dbus services)))
(return
(service
(documentation "Run the D-Bus system daemon.")
(provision '(dbus-system))
(requirement '(user-processes))
(start #~(make-forkexec-constructor
(list (string-append #$dbus "/bin/dbus-daemon")
"--nofork"
(string-append "--config-file=" #$conf "/system.conf"))))
(stop #~(make-kill-destructor))
(user-groups (list (user-group
(name "messagebus")
(system? #t))))
(user-accounts (list (user-account
(name "messagebus")
(group "messagebus")
(system? #t)
(comment "D-Bus system bus user")
(home-directory "/var/run/dbus")
(shell
#~(string-append #$shadow "/sbin/nologin")))))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/dbus")
(let ((user (getpwnam "messagebus")))
(chown "/var/run/dbus"
(passwd:uid user) (passwd:gid user)))
(unless (file-exists? "/etc/machine-id")
(format #t "creating /etc/machine-id...~%")
(let ((prog (string-append #$dbus "/bin/dbus-uuidgen")))
;; XXX: We can't use 'system' because the initrd's
;; guile system(3) only works when 'sh' is in $PATH.
(let ((pid (primitive-fork)))
(if (zero? pid)
(call-with-output-file "/etc/machine-id"
(lambda (port)
(close-fdes 1)
(dup2 (port->fdes port) 1)
(execl prog)))
(waitpid pid)))))))))))
(let ((conf (dbus-configuration-directory dbus services)))
(service
(documentation "Run the D-Bus system daemon.")
(provision '(dbus-system))
(requirement '(user-processes))
(start #~(make-forkexec-constructor
(list (string-append #$dbus "/bin/dbus-daemon")
"--nofork"
(string-append "--config-file=" #$conf "/system.conf"))))
(stop #~(make-kill-destructor))
(user-groups (list (user-group
(name "messagebus")
(system? #t))))
(user-accounts (list (user-account
(name "messagebus")
(group "messagebus")
(system? #t)
(comment "D-Bus system bus user")
(home-directory "/var/run/dbus")
(shell
#~(string-append #$shadow "/sbin/nologin")))))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/dbus")
(let ((user (getpwnam "messagebus")))
(chown "/var/run/dbus"
(passwd:uid user) (passwd:gid user)))
(unless (file-exists? "/etc/machine-id")
(format #t "creating /etc/machine-id...~%")
(let ((prog (string-append #$dbus "/bin/dbus-uuidgen")))
;; XXX: We can't use 'system' because the initrd's
;; guile system(3) only works when 'sh' is in $PATH.
(let ((pid (primitive-fork)))
(if (zero? pid)
(call-with-output-file "/etc/machine-id"
(lambda (port)
(close-fdes 1)
(dup2 (port->fdes port) 1)
(execl prog)))
(waitpid pid))))))))))
;;;
@ -175,24 +173,24 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
time-critical time-action
critical-power-action)
"Return an upower-daemon configuration file."
(text-file "UPower.conf"
(string-append
"[UPower]\n"
"EnableWattsUpPro=" (bool watts-up-pro?)
"NoPollBatteries=" (bool (not poll-batteries?))
"IgnoreLid=" (bool ignore-lid?)
"UsePercentageForPolicy=" (bool use-percentage-for-policy?)
"PercentageLow=" (number->string percentage-low) "\n"
"PercentageCritical=" (number->string percentage-critical) "\n"
"PercentageAction=" (number->string percentage-action) "\n"
"TimeLow=" (number->string time-low) "\n"
"TimeCritical=" (number->string time-critical) "\n"
"TimeAction=" (number->string time-action) "\n"
"CriticalPowerAction=" (match critical-power-action
('hybrid-sleep "HybridSleep")
('hibernate "Hibernate")
('power-off "PowerOff"))
"\n")))
(plain-file "UPower.conf"
(string-append
"[UPower]\n"
"EnableWattsUpPro=" (bool watts-up-pro?)
"NoPollBatteries=" (bool (not poll-batteries?))
"IgnoreLid=" (bool ignore-lid?)
"UsePercentageForPolicy=" (bool use-percentage-for-policy?)
"PercentageLow=" (number->string percentage-low) "\n"
"PercentageCritical=" (number->string percentage-critical) "\n"
"PercentageAction=" (number->string percentage-action) "\n"
"TimeLow=" (number->string time-low) "\n"
"TimeCritical=" (number->string time-critical) "\n"
"TimeAction=" (number->string time-action) "\n"
"CriticalPowerAction=" (match critical-power-action
('hybrid-sleep "HybridSleep")
('hibernate "Hibernate")
('power-off "PowerOff"))
"\n")))
(define* (upower-service #:key (upower upower)
(watts-up-pro? #f)
@ -210,47 +208,46 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
@command{upowerd}}, a system-wide monitor for power consumption and battery
levels, with the given configuration settings. It implements the
@code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME."
(mlet %store-monad ((config (upower-configuration-file
#:watts-up-pro? watts-up-pro?
#:poll-batteries? poll-batteries?
#:ignore-lid? ignore-lid?
#:use-percentage-for-policy? use-percentage-for-policy?
#:percentage-low percentage-low
#:percentage-critical percentage-critical
#:percentage-action percentage-action
#:time-low time-low
#:time-critical time-critical
#:time-action time-action
#:critical-power-action critical-power-action)))
(return
(service
(documentation "Run the UPower power and battery monitor.")
(provision '(upower-daemon))
(requirement '(dbus-system udev))
(start #~(make-forkexec-constructor
(list (string-append #$upower "/libexec/upowerd"))
#:environment-variables
(list (string-append "UPOWER_CONF_FILE_NAME=" #$config))))
(stop #~(make-kill-destructor))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/lib/upower")
(let ((user (getpwnam "upower")))
(chown "/var/lib/upower"
(passwd:uid user) (passwd:gid user)))))
(user-groups (list (user-group
(name "upower")
(system? #t))))
(user-accounts (list (user-account
(name "upower")
(group "upower")
(system? #t)
(comment "UPower daemon user")
(home-directory "/var/empty")
(shell
#~(string-append #$shadow "/sbin/nologin")))))))))
(let ((config (upower-configuration-file
#:watts-up-pro? watts-up-pro?
#:poll-batteries? poll-batteries?
#:ignore-lid? ignore-lid?
#:use-percentage-for-policy? use-percentage-for-policy?
#:percentage-low percentage-low
#:percentage-critical percentage-critical
#:percentage-action percentage-action
#:time-low time-low
#:time-critical time-critical
#:time-action time-action
#:critical-power-action critical-power-action)))
(service
(documentation "Run the UPower power and battery monitor.")
(provision '(upower-daemon))
(requirement '(dbus-system udev))
(start #~(make-forkexec-constructor
(list (string-append #$upower "/libexec/upowerd"))
#:environment-variables
(list (string-append "UPOWER_CONF_FILE_NAME=" #$config))))
(stop #~(make-kill-destructor))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/lib/upower")
(let ((user (getpwnam "upower")))
(chown "/var/lib/upower"
(passwd:uid user) (passwd:gid user)))))
(user-groups (list (user-group
(name "upower")
(system? #t))))
(user-accounts (list (user-account
(name "upower")
(group "upower")
(system? #t)
(comment "UPower daemon user")
(home-directory "/var/empty")
(shell
#~(string-append #$shadow "/sbin/nologin"))))))))
;;;
@ -263,34 +260,32 @@ interface to manage the color profiles of input and output devices such as
screens and scanners. It is notably used by the GNOME Color Manager graphical
tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web
site} for more information."
(with-monad %store-monad
(return
(service
(documentation "Run the colord color management service.")
(provision '(colord-daemon))
(requirement '(dbus-system udev))
(start #~(make-forkexec-constructor
(list (string-append #$colord "/libexec/colord"))))
(stop #~(make-kill-destructor))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/lib/colord")
(let ((user (getpwnam "colord")))
(chown "/var/lib/colord"
(passwd:uid user) (passwd:gid user)))))
(user-groups (list (user-group
(name "colord")
(system? #t))))
(user-accounts (list (user-account
(name "colord")
(group "colord")
(system? #t)
(comment "colord daemon user")
(home-directory "/var/empty")
(shell
#~(string-append #$shadow "/sbin/nologin")))))))))
(service
(documentation "Run the colord color management service.")
(provision '(colord-daemon))
(requirement '(dbus-system udev))
(start #~(make-forkexec-constructor
(list (string-append #$colord "/libexec/colord"))))
(stop #~(make-kill-destructor))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/lib/colord")
(let ((user (getpwnam "colord")))
(chown "/var/lib/colord"
(passwd:uid user) (passwd:gid user)))))
(user-groups (list (user-group
(name "colord")
(system? #t))))
(user-accounts (list (user-account
(name "colord")
(group "colord")
(system? #t)
(comment "colord daemon user")
(home-directory "/var/empty")
(shell
#~(string-append #$shadow "/sbin/nologin")))))))
;;;
@ -321,16 +316,16 @@ users are allowed."
wifi-submission-url submission-nick
applications)
"Return a geoclue configuration file."
(text-file "geoclue.conf"
(string-append
"[agent]\n"
"whitelist=" (string-join whitelist ";") "\n"
"[wifi]\n"
"url=" wifi-geolocation-url "\n"
"submit-data=" (bool submit-data?)
"submission-url=" wifi-submission-url "\n"
"submission-nick=" submission-nick "\n"
(string-join applications "\n"))))
(plain-file "geoclue.conf"
(string-append
"[agent]\n"
"whitelist=" (string-join whitelist ";") "\n"
"[wifi]\n"
"url=" wifi-geolocation-url "\n"
"submit-data=" (bool submit-data?)
"submission-url=" wifi-submission-url "\n"
"submission-nick=" submission-nick "\n"
(string-join applications "\n"))))
(define* (geoclue-service #:key (geoclue geoclue)
(whitelist '())
@ -350,37 +345,36 @@ and Epiphany web browsers are able to ask for the user's location, and in the
case of Icecat and Epiphany, both will ask the user for permission first. See
@uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web
site} for more information."
(mlet %store-monad ((config (geoclue-configuration-file
#:whitelist whitelist
#:wifi-geolocation-url wifi-geolocation-url
#:submit-data? submit-data?
#:wifi-submission-url wifi-submission-url
#:submission-nick submission-nick
#:applications applications)))
(return
(service
(documentation "Run the GeoClue location service.")
(provision '(geoclue-daemon))
(requirement '(dbus-system))
(start #~(make-forkexec-constructor
(list (string-append #$geoclue "/libexec/geoclue"))
#:user "geoclue"
#:environment-variables
(list (string-append "GEOCLUE_CONFIG_FILE=" #$config))))
(stop #~(make-kill-destructor))
(user-groups (list (user-group
(name "geoclue")
(system? #t))))
(user-accounts (list (user-account
(name "geoclue")
(group "geoclue")
(system? #t)
(comment "GeoClue daemon user")
(home-directory "/var/empty")
(shell
"/run/current-system/profile/sbin/nologin"))))))))
(let ((config (geoclue-configuration-file
#:whitelist whitelist
#:wifi-geolocation-url wifi-geolocation-url
#:submit-data? submit-data?
#:wifi-submission-url wifi-submission-url
#:submission-nick submission-nick
#:applications applications)))
(service
(documentation "Run the GeoClue location service.")
(provision '(geoclue-daemon))
(requirement '(dbus-system))
(start #~(make-forkexec-constructor
(list (string-append #$geoclue "/libexec/geoclue"))
#:user "geoclue"
#:environment-variables
(list (string-append "GEOCLUE_CONFIG_FILE=" #$config))))
(stop #~(make-kill-destructor))
(user-groups (list (user-group
(name "geoclue")
(system? #t))))
(user-accounts (list (user-account
(name "geoclue")
(group "geoclue")
(system? #t)
(comment "GeoClue daemon user")
(home-directory "/var/empty")
(shell
"/run/current-system/profile/sbin/nologin")))))))
;;;
@ -393,30 +387,28 @@ service. By querying the @command{polkit} service, a privileged system
component can know when it should grant additional capabilities to ordinary
users. For example, an ordinary user can be granted the capability to suspend
the system if the user is logged in locally."
(with-monad %store-monad
(return
(service
(documentation "Run the polkit privilege management service.")
(provision '(polkit-daemon))
(requirement '(dbus-system))
(start #~(make-forkexec-constructor
(list (string-append #$polkit "/lib/polkit-1/polkitd"))))
(stop #~(make-kill-destructor))
(user-groups (list (user-group
(name "polkitd")
(system? #t))))
(user-accounts (list (user-account
(name "polkitd")
(group "polkitd")
(system? #t)
(comment "Polkit daemon user")
(home-directory "/var/empty")
(shell
"/run/current-system/profile/sbin/nologin"))))
(pam-services (list (unix-pam-service "polkit-1")))))))
(service
(documentation "Run the polkit privilege management service.")
(provision '(polkit-daemon))
(requirement '(dbus-system))
(start #~(make-forkexec-constructor
(list (string-append #$polkit "/lib/polkit-1/polkitd"))))
(stop #~(make-kill-destructor))
(user-groups (list (user-group
(name "polkitd")
(system? #t))))
(user-accounts (list (user-account
(name "polkitd")
(group "polkitd")
(system? #t)
(comment "Polkit daemon user")
(home-directory "/var/empty")
(shell
"/run/current-system/profile/sbin/nologin"))))
(pam-services (list (unix-pam-service "polkit-1")))))
;;;
@ -520,7 +512,7 @@ the system if the user is logged in locally."
((_ config str)
(string-append str "\n"))))
(define-syntax-rule (ini-file config file clause ...)
(text-file file (string-append (ini-file-clause config clause) ...)))
(plain-file file (string-append (ini-file-clause config clause) ...)))
(ini-file
config "logind.conf"
"[Login]"
@ -562,18 +554,17 @@ service. The @command{elogind} service integrates with PAM to allow other
system components to know the set of logged-in users as well as their session
types (graphical, console, remote, etc.). It can also clean up after users
when they log out."
(mlet %store-monad ((config-file (elogind-configuration-file config)))
(return
(service
(documentation "Run the elogind login and seat management service.")
(provision '(elogind))
(requirement '(dbus-system))
(start #~(make-forkexec-constructor
(list (string-append #$elogind "/libexec/elogind/elogind"))
#:environment-variables
(list (string-append "ELOGIND_CONF_FILE=" #$config-file))))
(stop #~(make-kill-destructor))))))
(let ((config-file (elogind-configuration-file config)))
(service
(documentation "Run the elogind login and seat management service.")
(provision '(elogind))
(requirement '(dbus-system))
(start #~(make-forkexec-constructor
(list (string-append #$elogind "/libexec/elogind/elogind"))
#:environment-variables
(list (string-append "ELOGIND_CONF_FILE=" #$config-file))))
(stop #~(make-kill-destructor)))))
;;;
@ -599,25 +590,24 @@ when they log out."
(ntp-service)
(map (lambda (mservice)
(mlet %store-monad ((service mservice))
(cond
;; Provide an nscd ready to use nss-mdns.
((memq 'nscd (service-provision service))
(nscd-service (nscd-configuration)
#:name-services (list nss-mdns)))
;; Add more rules to udev-service.
;;
;; XXX Keep this in sync with the 'udev-service' call in
;; %base-services. Here we intend only to add 'upower',
;; 'colord', and 'elogind'.
((memq 'udev (service-provision service))
(udev-service #:rules
(list lvm2 fuse alsa-utils crda
upower colord elogind)))
(else mservice))))
(map (lambda (service)
(cond
;; Provide an nscd ready to use nss-mdns.
((memq 'nscd (service-provision service))
(nscd-service (nscd-configuration)
#:name-services (list nss-mdns)))
;; Add more rules to udev-service.
;;
;; XXX Keep this in sync with the 'udev-service' call in
;; %base-services. Here we intend only to add 'upower',
;; 'colord', and 'elogind'.
((memq 'udev (service-provision service))
(udev-service #:rules
(list lvm2 fuse alsa-utils crda
upower colord elogind)))
(else service)))
%base-services)))
;;; desktop.scm ends here

45
gnu/services/lirc.scm

@ -19,7 +19,6 @@
(define-module (gnu services lirc)
#:use-module (gnu services)
#:use-module (gnu packages lirc)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix gexp)
#:export (lirc-service))
@ -41,28 +40,26 @@ The daemon will use specified @var{device}, @var{driver} and
Finally, @var{extra-options} is a list of additional command-line options
passed to @command{lircd}."
(with-monad %store-monad
(return
(service
(provision '(lircd))
(documentation "Run the LIRC daemon.")
(requirement '(user-processes))
(start #~(make-forkexec-constructor
(list (string-append #$lirc "/sbin/lircd")
"--nodaemon"
#$@(if device
#~("--device" #$device)
#~())
#$@(if driver
#~("--driver" #$driver)
#~())
#$@(if config-file
#~(#$config-file)
#~())
#$@extra-options)))
(stop #~(make-kill-destructor))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/lirc")))))))
(service
(provision '(lircd))
(documentation "Run the LIRC daemon.")
(requirement '(user-processes))
(start #~(make-forkexec-constructor
(list (string-append #$lirc "/sbin/lircd")
"--nodaemon"
#$@(if device
#~("--device" #$device)
#~())
#$@(if driver
#~("--driver" #$driver)
#~())
#$@(if config-file
#~(#$config-file)
#~())
#$@extra-options)))
(stop #~(make-kill-destructor))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/lirc")))))
;;; lirc.scm ends here

357
gnu/services/networking.scm

@ -28,7 +28,6 @@
#:use-module (gnu packages wicd)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (srfi srfi-26)
#:export (%facebook-host-aliases
static-networking-service
@ -93,54 +92,52 @@ gateway."
;; TODO: Eventually replace 'route' with bindings for the appropriate
;; ioctls.
(with-monad %store-monad
(return
(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
(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")
"del" "-net" "default")
#t))))
(respawn? #f)))))
"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* (dhcp-client-service #:key (dhcp isc-dhcp))
"Return a service that runs @var{dhcp}, a Dynamic Host Configuration
@ -152,52 +149,49 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
(define pid-file
"/var/run/dhclient.pid")
(with-monad %store-monad
(return (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
(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 %ntp-servers
;; Default set of NTP servers.
@ -227,57 +221,55 @@ restrict -6 default kod nomodify notrap nopeer noquery
restrict 127.0.0.1
restrict -6 ::1\n"))
(mlet %store-monad ((ntpd.conf (text-file "ntpd.conf" config)))
(return
(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")))))))))
(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* (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."
(mlet %store-monad ((torrc (text-file "torrc" "User tor\n")))
(return
(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.")))))
(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."))))
(define* (bitlbee-service #:key (bitlbee bitlbee)
(interface "127.0.0.1") (port 6667)
@ -292,60 +284,57 @@ come from any networking interface.
In addition, @var{extra-settings} specifies a string to append to the
configuration file."
(mlet %store-monad ((conf (text-file "bitlbee.conf"
(string-append "
(let ((conf (plain-file "bitlbee.conf"
(string-append "
[settings]
User = bitlbee
ConfigDir = /var/lib/bitlbee
DaemonInterface = " interface "
DaemonPort = " (number->string port) "
" extra-settings))))
(return
(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
(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"))))))))
(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."
(with-monad %store-monad
(return
(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
(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)))))))
;;; networking.scm ends here

34
gnu/services/ssh.scm

@ -19,7 +19,6 @@
(define-module (gnu services ssh)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)