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.master
parent
ce8a6dfc43
commit
be1c2c54d9
|
@ -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))
|
||||
(map (lambda (service)
|
||||
(if (member 'nscd (service-provision service))
|
||||
(nscd-service (nscd-configuration)
|
||||
#:name-services (list nss-mdns))
|
||||
mservice)))
|
||||
service))
|
||||
%base-services))
|
||||
@end example
|
||||
|
||||
|
|
|
@ -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,7 +38,7 @@
|
|||
(define (bool value)
|
||||
(if value "yes\n" "no\n"))
|
||||
|
||||
(text-file "avahi-daemon.conf"
|
||||
(plain-file "avahi-daemon.conf"
|
||||
(string-append
|
||||
"[server]\n"
|
||||
(if host-name
|
||||
|
@ -76,14 +75,13 @@ 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
|
||||
(let ((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))
|
||||
|
@ -107,6 +105,6 @@ sockets."
|
|||
(comment "Avahi daemon user")
|
||||
(home-directory "/var/empty")
|
||||
(shell
|
||||
#~(string-append #$shadow "/sbin/nologin")))))))))
|
||||
#~(string-append #$shadow "/sbin/nologin"))))))))
|
||||
|
||||
;;; avahi.scm ends here
|
||||
|
|
|
@ -35,7 +35,6 @@
|
|||
#:use-module ((gnu build file-systems)
|
||||
#:select (mount-flags->bit-mask))
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (guix records)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
|
@ -80,8 +79,6 @@ system upon shutdown (aka. cleanly \"umounting\" root.)
|
|||
|
||||
This service must be the root of the service dependency graph so that its
|
||||
'stop' action is invoked when dmd is the only process left."
|
||||
(with-monad %store-monad
|
||||
(return
|
||||
(service
|
||||
(documentation "Take care of the root file system.")
|
||||
(provision '(root-file-system))
|
||||
|
@ -114,7 +111,7 @@ This service must be the root of the service dependency graph so that its
|
|||
#:update-mtab? #f)
|
||||
|
||||
#f)))))
|
||||
(respawn? #f)))))
|
||||
(respawn? #f)))
|
||||
|
||||
(define* (file-system-service device target type
|
||||
#:key (flags '()) (check? #t)
|
||||
|
@ -127,8 +124,6 @@ true, check the file system before mounting it. When CREATE-MOUNT-POINT? is
|
|||
true, create TARGET if it does not exist yet. FLAGS is a list of symbols,
|
||||
such as 'read-only' etc. Optionally, REQUIREMENTS may be a list of service
|
||||
names such as device-mapping services."
|
||||
(with-monad %store-monad
|
||||
(return
|
||||
(service
|
||||
(provision (list (symbol-append 'file-system- (string->symbol target))))
|
||||
(requirement `(root-file-system ,@requirements))
|
||||
|
@ -169,13 +164,11 @@ names such as device-mapping services."
|
|||
(chdir "/")
|
||||
|
||||
(umount #$target)
|
||||
#f))))))
|
||||
#f))))
|
||||
|
||||
(define (user-unmount-service known-mount-points)
|
||||
"Return a service whose sole purpose is to unmount file systems not listed
|
||||
in KNOWN-MOUNT-POINTS when it is stopped."
|
||||
(with-monad %store-monad
|
||||
(return
|
||||
(service
|
||||
(documentation "Unmount manually-mounted file systems.")
|
||||
(provision '(user-unmount))
|
||||
|
@ -199,7 +192,7 @@ in KNOWN-MOUNT-POINTS when it is stopped."
|
|||
(format #t "failed to unmount '~a': ~a~%"
|
||||
mount-point (strerror errno))))))
|
||||
(filter (negate known?) (mount-points)))
|
||||
#f))))))
|
||||
#f))))
|
||||
|
||||
(define %do-not-kill-file
|
||||
;; Name of the file listing PIDs of processes that must survive when halting
|
||||
|
@ -217,8 +210,7 @@ listed in REQUIREMENTS.
|
|||
|
||||
All the services that spawn processes must depend on this one so that they are
|
||||
stopped before 'kill' is called."
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(service
|
||||
(documentation "When stopped, terminate all user processes.")
|
||||
(provision '(user-processes))
|
||||
(requirement (cons 'root-file-system requirements))
|
||||
|
@ -286,17 +278,16 @@ stopped before 'kill' is called."
|
|||
|
||||
(display "all processes have been terminated\n")
|
||||
#f))
|
||||
(respawn? #f)))))
|
||||
(respawn? #f)))
|
||||
|
||||
(define (host-name-service name)
|
||||
"Return a service that sets the host name to @var{name}."
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(service
|
||||
(documentation "Initialize the machine's host name.")
|
||||
(provision '(host-name))
|
||||
(start #~(lambda _
|
||||
(sethostname #$name)))
|
||||
(respawn? #f)))))
|
||||
(respawn? #f)))
|
||||
|
||||
(define (unicode-start tty)
|
||||
"Return a gexp to start Unicode support on @var{tty}."
|
||||
|
@ -318,16 +309,13 @@ stopped before 'kill' is called."
|
|||
|
||||
(define (console-keymap-service file)
|
||||
"Return a service to load console keymap from @var{file}."
|
||||
(with-monad %store-monad
|
||||
(return
|
||||
(service
|
||||
(documentation
|
||||
(string-append "Load console keymap (loadkeys)."))
|
||||
(documentation (string-append "Load console keymap (loadkeys)."))
|
||||
(provision '(console-keymap))
|
||||
(start #~(lambda _
|
||||
(zero? (system* (string-append #$kbd "/bin/loadkeys")
|
||||
#$file))))
|
||||
(respawn? #f)))))
|
||||
(respawn? #f)))
|
||||
|
||||
(define* (console-font-service tty #:optional (font "LatGrkCyr-8x16"))
|
||||
"Return a service that sets up Unicode support in @var{tty} and loads
|
||||
|
@ -336,8 +324,7 @@ stopped before 'kill' is called."
|
|||
;; scripts as well as glyphs for em dash, quotation marks, and other Unicode
|
||||
;; codepoints notably found in the UTF-8 manual.
|
||||
(let ((device (string-append "/dev/" tty)))
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(service
|
||||
(documentation "Load a Unicode console font.")
|
||||
(provision (list (symbol-append 'console-font-
|
||||
(string->symbol tty))))
|
||||
|
@ -353,7 +340,7 @@ stopped before 'kill' is called."
|
|||
(system* (string-append #$kbd "/bin/setfont")
|
||||
"-C" #$device #$font)))))
|
||||
(stop #~(const #t))
|
||||
(respawn? #f))))))
|
||||
(respawn? #f))))
|
||||
|
||||
(define* (mingetty-service tty
|
||||
#:key
|
||||
|
@ -379,8 +366,6 @@ of the log-in program (the default is the @code{login} program from the Shadow
|
|||
tool suite.)
|
||||
|
||||
@var{motd} is a file-like object to use as the ``message of the day''."
|
||||
(with-monad %store-monad
|
||||
(return
|
||||
(service
|
||||
(documentation (string-append "Run mingetty on " tty "."))
|
||||
(provision (list (symbol-append 'term- (string->symbol tty))))
|
||||
|
@ -410,7 +395,7 @@ tool suite.)
|
|||
;; duplicates are removed.
|
||||
(list (unix-pam-service "login"
|
||||
#:allow-empty-passwords? allow-empty-passwords?
|
||||
#:motd motd)))))))
|
||||
#:motd motd)))))
|
||||
|
||||
(define-record-type* <nscd-configuration> nscd-configuration
|
||||
make-nscd-configuration
|
||||
|
@ -496,7 +481,7 @@ tool suite.)
|
|||
|
||||
(match config
|
||||
(($ <nscd-configuration> log-file debug-level caches)
|
||||
(text-file "nscd.conf"
|
||||
(plain-file "nscd.conf"
|
||||
(string-append "\
|
||||
# Configuration of libc's name service cache daemon (nscd).\n\n"
|
||||
(if log-file
|
||||
|
@ -518,8 +503,8 @@ tool suite.)
|
|||
given @var{config}---an @code{<nscd-configuration>} object. Optionally,
|
||||
@code{#:name-services} is a list of packages that provide name service switch
|
||||
(NSS) modules needed by nscd. @xref{Name Service Switch}, for an example."
|
||||
(mlet %store-monad ((nscd.conf (nscd.conf-file config)))
|
||||
(return (service
|
||||
(let ((nscd.conf (nscd.conf-file config)))
|
||||
(service
|
||||
(documentation "Run libc's name service cache daemon (nscd).")
|
||||
(provision '(nscd))
|
||||
(requirement '(user-processes))
|
||||
|
@ -542,15 +527,11 @@ given @var{config}---an @code{<nscd-configuration>} object. Optionally,
|
|||
":")))))
|
||||
(stop #~(make-kill-destructor))
|
||||
|
||||
(respawn? #f)))))
|
||||
|
||||
(define* (syslog-service #:key config-file)
|
||||
"Return a service that runs @code{syslogd}.
|
||||
If configuration file name @var{config-file} is not specified, use some
|
||||
reasonable default settings."
|
||||
(respawn? #f))))
|
||||
|
||||
;; Snippet adapted from the GNU inetutils manual.
|
||||
(define contents "
|
||||
(define %default-syslog.conf
|
||||
(plain-file "syslog.conf" "
|
||||
# Log all error messages, authentication messages of
|
||||
# level notice or higher and anything of level err or
|
||||
# higher to the console.
|
||||
|
@ -569,20 +550,19 @@ reasonable default settings."
|
|||
|
||||
# Log all the mail messages in one place.
|
||||
mail.* /var/log/maillog
|
||||
")
|
||||
|
||||
(mlet %store-monad
|
||||
((syslog.conf (text-file "syslog.conf" contents)))
|
||||
(return
|
||||
"))
|
||||
(define* (syslog-service #:key (config-file %default-syslog.conf))
|
||||
"Return a service that runs @code{syslogd}.
|
||||
If configuration file name @var{config-file} is not specified, use some
|
||||
reasonable default settings."
|
||||
(service
|
||||
(documentation "Run the syslog daemon (syslogd).")
|
||||
(provision '(syslogd))
|
||||
(requirement '(user-processes))
|
||||
(start
|
||||
#~(make-forkexec-constructor
|
||||
(start #~(make-forkexec-constructor
|
||||
(list (string-append #$inetutils "/libexec/syslogd")
|
||||
"--no-detach" "--rcfile" #$(or config-file syslog.conf))))
|
||||
(stop #~(make-kill-destructor))))))
|
||||
"--no-detach" "--rcfile" #$config-file)))
|
||||
(stop #~(make-kill-destructor))))
|
||||
|
||||
(define* (guix-build-accounts count #:key
|
||||
(group "guixbuild")
|
||||
|
@ -658,8 +638,7 @@ passed to @command{guix-daemon}."
|
|||
(and authorize-hydra-key?
|
||||
(hydra-key-authorization guix)))
|
||||
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(service
|
||||
(documentation "Run the Guix daemon.")
|
||||
(provision '(guix-daemon))
|
||||
(requirement '(user-processes))
|
||||
|
@ -675,8 +654,7 @@ passed to @command{guix-daemon}."
|
|||
;; Add 'lsof' (for the GC) and 'lsh' (for offloading) to the
|
||||
;; daemon's $PATH.
|
||||
#:environment-variables
|
||||
(list (string-append "PATH=" #$lsof "/bin:"
|
||||
#$lsh "/bin"))))
|
||||
(list (string-append "PATH=" #$lsof "/bin:" #$lsh "/bin"))))
|
||||
(stop #~(make-kill-destructor))
|
||||
(user-accounts (guix-build-accounts build-accounts
|
||||
#:group builder-group))
|
||||
|
@ -687,7 +665,7 @@ passed to @command{guix-daemon}."
|
|||
;; Use a fixed GID so that we can create the
|
||||
;; store with the right owner.
|
||||
(id 30000))))
|
||||
(activate activate)))))
|
||||
(activate activate)))
|
||||
|
||||
(define (udev-rules-union packages)
|
||||
"Return the union of the @code{lib/udev/rules.d} directories found in each
|
||||
|
@ -712,17 +690,16 @@ item of @var{packages}."
|
|||
(union-build (string-append #$output "/lib/udev/rules.d")
|
||||
(filter-map rules-sub-directory '#$packages))))
|
||||
|
||||
(gexp->derivation "udev-rules" build
|
||||
(computed-file "udev-rules" build
|
||||
#:modules '((guix build union)
|
||||
(guix build utils))
|
||||
#:local-build? #t))
|
||||
(guix build utils))))
|
||||
|
||||
(define* (kvm-udev-rule)
|
||||
"Return a directory with a udev rule that changes the group of
|
||||
@file{/dev/kvm} to \"kvm\" and makes it #o660."
|
||||
;; Apparently QEMU-KVM used to ship this rule, but now we have to add it by
|
||||
;; ourselves.
|
||||
(gexp->derivation "kvm-udev-rules"
|
||||
(computed-file "kvm-udev-rules"
|
||||
#~(begin
|
||||
(use-modules (guix build utils))
|
||||
|
||||
|
@ -743,16 +720,20 @@ KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n" port))))
|
|||
(define* (udev-service #:key (udev eudev) (rules '()))
|
||||
"Run @var{udev}, which populates the @file{/dev} directory dynamically. Get
|
||||
extra rules from the packages listed in @var{rules}."
|
||||
(mlet* %store-monad ((kvm (kvm-udev-rule))
|
||||
(rules (udev-rules-union (cons* udev kvm rules)))
|
||||
(udev.conf (text-file* "udev.conf"
|
||||
"udev_rules=\"" rules
|
||||
"/lib/udev/rules.d\"\n")))
|
||||
(return (service
|
||||
(let* ((rules (udev-rules-union (cons* udev
|
||||
(kvm-udev-rule)
|
||||
rules)))
|
||||
(udev.conf (computed-file "udev.conf"
|
||||
#~(call-with-output-file #$output
|
||||
(lambda (port)
|
||||
(format port
|
||||
"udev_rules=\"~a/lib/udev/rules.d\"\n"
|
||||
#$rules))))))
|
||||
(service
|
||||
(provision '(udev))
|
||||
|
||||
;; Udev needs /dev to be a 'devtmpfs' mount so that new device
|
||||
;; nodes can be added: see
|
||||
;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can
|
||||
;; be added: see
|
||||
;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>.
|
||||
(requirement '(root-file-system))
|
||||
|
||||
|
@ -815,21 +796,19 @@ extra rules from the packages listed in @var{rules}."
|
|||
;; When halting the system, 'udev' is actually killed by
|
||||
;; 'user-processes', i.e., before its own 'stop' method was
|
||||
;; called. Thus, make sure it is not respawned.
|
||||
(respawn? #f)))))
|
||||
(respawn? #f))))
|
||||
|
||||
(define (device-mapping-service target open close)
|
||||
"Return a service that maps device @var{target}, a string such as
|
||||
@code{\"home\"} (meaning @code{/dev/mapper/home}). Evaluate @var{open}, a
|
||||
gexp, to open it, and evaluate @var{close} to close it."
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(provision (list (symbol-append 'device-mapping-
|
||||
(string->symbol target))))
|
||||
(service
|
||||
(provision (list (symbol-append 'device-mapping- (string->symbol target))))
|
||||
(requirement '(udev))
|
||||
(documentation "Map a device node using Linux's device mapper.")
|
||||
(start #~(lambda () #$open))
|
||||
(stop #~(lambda _ (not #$close)))
|
||||
(respawn? #f)))))
|
||||
(respawn? #f)))
|
||||
|
||||
(define (swap-service device)
|
||||
"Return a service that uses @var{device} as a swap device."
|
||||
|
@ -839,8 +818,7 @@ gexp, to open it, and evaluate @var{close} to close it."
|
|||
(string->symbol (basename device))))
|
||||
'()))
|
||||
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(service
|
||||
(provision (list (symbol-append 'swap- (string->symbol device))))
|
||||
(requirement `(udev ,@requirement))
|
||||
(documentation "Enable the given swap device.")
|
||||
|
@ -850,7 +828,7 @@ gexp, to open it, and evaluate @var{close} to close it."
|
|||
(stop #~(lambda _
|
||||
(restart-on-EINTR (swapoff #$device))
|
||||
#f))
|
||||
(respawn? #f)))))
|
||||
(respawn? #f)))
|
||||
|
||||
(define %base-services
|
||||
;; Convenience variable holding the basic services.
|
||||
|
|
|
@ -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,8 +59,7 @@ 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"
|
||||
(program-file "start-postgres"
|
||||
#~(let ((user (getpwnam "postgres"))
|
||||
(postgres (string-append #$postgresql
|
||||
"/bin/postgres")))
|
||||
|
@ -71,7 +67,7 @@ and stores the database cluster in @var{data-directory}."
|
|||
(setuid (passwd:uid user))
|
||||
(system* postgres
|
||||
(string-append "--config-file=" #$config-file)
|
||||
"-D" #$data-directory)))))
|
||||
"-D" #$data-directory))))
|
||||
|
||||
(define activate
|
||||
#~(begin
|
||||
|
@ -99,8 +95,6 @@ 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.")
|
||||
|
@ -118,4 +112,4 @@ and stores the database cluster in @var{data-directory}."
|
|||
(comment "PostgreSQL server user")
|
||||
(home-directory "/var/empty")
|
||||
(shell
|
||||
#~(string-append #$shadow "/sbin/nologin")))))))))
|
||||
#~(string-append #$shadow "/sbin/nologin")))))))
|
||||
|
|
|
@ -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,8 +117,7 @@ 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
|
||||
(let ((conf (dbus-configuration-directory dbus services)))
|
||||
(service
|
||||
(documentation "Run the D-Bus system daemon.")
|
||||
(provision '(dbus-system))
|
||||
|
@ -161,7 +159,7 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
|
|||
(close-fdes 1)
|
||||
(dup2 (port->fdes port) 1)
|
||||
(execl prog)))
|
||||
(waitpid pid)))))))))))
|
||||
(waitpid pid))))))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -175,7 +173,7 @@ 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"
|
||||
(plain-file "UPower.conf"
|
||||
(string-append
|
||||
"[UPower]\n"
|
||||
"EnableWattsUpPro=" (bool watts-up-pro?)
|
||||
|
@ -210,7 +208,7 @@ 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
|
||||
(let ((config (upower-configuration-file
|
||||
#:watts-up-pro? watts-up-pro?
|
||||
#:poll-batteries? poll-batteries?
|
||||
#:ignore-lid? ignore-lid?
|
||||
|
@ -222,7 +220,6 @@ levels, with the given configuration settings. It implements the
|
|||
#: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))
|
||||
|
@ -250,7 +247,7 @@ levels, with the given configuration settings. It implements the
|
|||
(comment "UPower daemon user")
|
||||
(home-directory "/var/empty")
|
||||
(shell
|
||||
#~(string-append #$shadow "/sbin/nologin")))))))))
|
||||
#~(string-append #$shadow "/sbin/nologin"))))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -263,8 +260,6 @@ 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))
|
||||
|
@ -290,7 +285,7 @@ site} for more information."
|
|||
(comment "colord daemon user")
|
||||
(home-directory "/var/empty")
|
||||
(shell
|
||||
#~(string-append #$shadow "/sbin/nologin")))))))))
|
||||
#~(string-append #$shadow "/sbin/nologin")))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -321,7 +316,7 @@ users are allowed."
|
|||
wifi-submission-url submission-nick
|
||||
applications)
|
||||
"Return a geoclue configuration file."
|
||||
(text-file "geoclue.conf"
|
||||
(plain-file "geoclue.conf"
|
||||
(string-append
|
||||
"[agent]\n"
|
||||
"whitelist=" (string-join whitelist ";") "\n"
|
||||
|
@ -350,14 +345,13 @@ 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
|
||||
(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)))
|
||||
(return
|
||||
(service
|
||||
(documentation "Run the GeoClue location service.")
|
||||
(provision '(geoclue-daemon))
|
||||
|
@ -380,7 +374,7 @@ site} for more information."
|
|||
(comment "GeoClue daemon user")
|
||||
(home-directory "/var/empty")
|
||||
(shell
|
||||
"/run/current-system/profile/sbin/nologin"))))))))
|
||||
"/run/current-system/profile/sbin/nologin")))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -393,8 +387,6 @@ 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))
|
||||
|
@ -416,7 +408,7 @@ the system if the user is logged in locally."
|
|||
(shell
|
||||
"/run/current-system/profile/sbin/nologin"))))
|
||||
|
||||
(pam-services (list (unix-pam-service "polkit-1")))))))
|
||||
(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,8 +554,7 @@ 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
|
||||
(let ((config-file (elogind-configuration-file config)))
|
||||
(service
|
||||
(documentation "Run the elogind login and seat management service.")
|
||||
(provision '(elogind))
|
||||
|
@ -573,7 +564,7 @@ when they log out."
|
|||
(list (string-append #$elogind "/libexec/elogind/elogind"))
|
||||
#:environment-variables
|
||||
(list (string-append "ELOGIND_CONF_FILE=" #$config-file))))
|
||||
(stop #~(make-kill-destructor))))))
|
||||
(stop #~(make-kill-destructor)))))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -599,8 +590,7 @@ when they log out."
|
|||
|
||||
(ntp-service)
|
||||
|
||||
(map (lambda (mservice)
|
||||
(mlet %store-monad ((service mservice))
|
||||
(map (lambda (service)
|
||||
(cond
|
||||
;; Provide an nscd ready to use nss-mdns.
|
||||
((memq 'nscd (service-provision service))
|
||||
|
@ -617,7 +607,7 @@ when they log out."
|
|||
(list lvm2 fuse alsa-utils crda
|
||||
upower colord elogind)))
|
||||
|
||||
(else mservice))))
|
||||
(else service)))
|
||||
%base-services)))
|
||||
|
||||
;;; desktop.scm ends here
|
||||
|
|
|
@ -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,8 +40,6 @@ 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.")
|
||||
|
@ -63,6 +60,6 @@ passed to @command{lircd}."
|
|||
(stop #~(make-kill-destructor))
|
||||
(activate #~(begin
|
||||
(use-modules (guix build utils))
|
||||
(mkdir-p "/var/run/lirc")))))))
|
||||
(mkdir-p "/var/run/lirc")))))
|
||||
|
||||
;;; lirc.scm ends here
|
||||
|
|
|
@ -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,8 +92,6 @@ 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
|
||||
|
@ -140,7 +137,7 @@ gateway."
|
|||
"/sbin/route")
|
||||
"del" "-net" "default")
|
||||
#t))))
|
||||
(respawn? #f)))))
|
||||
(respawn? #f)))
|
||||
|
||||
(define* (dhcp-client-service #:key (dhcp isc-dhcp))
|
||||
"Return a service that runs @var{dhcp}, a Dynamic Host Configuration
|
||||
|
@ -152,31 +149,28 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
|
|||
(define pid-file
|
||||
"/var/run/dhclient.pid")
|
||||
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(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.
|
||||
;; 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.
|
||||
;; 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.
|
||||
;; 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))
|
||||
|
@ -189,15 +183,15 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
|
|||
(lambda ()
|
||||
(call-with-input-file #$pid-file read))
|
||||
(lambda args
|
||||
;; 'dhclient' returned before PID-FILE
|
||||
;; was created, so try again.
|
||||
;; '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))))))
|
||||
(stop #~(make-kill-destructor))))
|
||||
|
||||
(define %ntp-servers
|
||||
;; Default set of NTP servers.
|
||||
|
@ -227,8 +221,7 @@ 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
|
||||
(let ((ntpd.conf (plain-file "ntpd.conf" config)))
|
||||
(service
|
||||
(provision '(ntpd))
|
||||
(documentation "Run the Network Time Protocol (NTP) daemon.")
|
||||
|
@ -245,15 +238,14 @@ restrict -6 ::1\n"))
|
|||
(comment "NTP daemon user")
|
||||
(home-directory "/var/empty")
|
||||
(shell
|
||||
#~(string-append #$shadow "/sbin/nologin")))))))))
|
||||
#~(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
|
||||
(let ((torrc (plain-file "torrc" "User tor\n")))
|
||||
(service
|
||||
(provision '(tor))
|
||||
|
||||
|
@ -277,7 +269,7 @@ policy) as the @code{tor} unprivileged user."
|
|||
(shell
|
||||
#~(string-append #$shadow "/sbin/nologin")))))
|
||||
|
||||
(documentation "Run the Tor anonymous network overlay.")))))
|
||||
(documentation "Run the Tor anonymous network overlay."))))
|
||||
|
||||
(define* (bitlbee-service #:key (bitlbee bitlbee)
|
||||
(interface "127.0.0.1") (port 6667)
|
||||
|
@ -292,7 +284,7 @@ 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"
|
||||
(let ((conf (plain-file "bitlbee.conf"
|
||||
(string-append "
|
||||
[settings]
|
||||
User = bitlbee
|
||||
|
@ -300,7 +292,6 @@ configuration file."
|
|||
DaemonInterface = " interface "
|
||||
DaemonPort = " (number->string port) "
|
||||
" extra-settings))))
|
||||
(return
|
||||
(service
|
||||
(provision '(bitlbee))
|
||||
(requirement '(user-processes loopback))
|
||||
|
@ -324,13 +315,11 @@ configuration file."
|
|||
(comment "BitlBee daemon user")
|
||||
(home-directory "/var/empty")
|
||||
(shell #~(string-append #$shadow
|
||||
"/sbin/nologin")))))))))
|
||||
"/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))
|
||||
|
@ -346,6 +335,6 @@ manager that aims to simplify wired and wireless networking."
|
|||
(let ((file-name "/etc/wicd/dhclient.conf.template.default"))
|
||||
(unless (file-exists? file-name)
|
||||
(copy-file (string-append #$wicd file-name)
|
||||
file-name)))))))))
|
||||
file-name)))))))
|
||||
|
||||
;;; networking.scm ends here
|
||||
|
|
|
@ -19,7 +19,6 @@
|
|||
(define-module (gnu services ssh)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu system linux) ; 'pam-service'
|
||||
#:use-module (gnu packages lsh)
|
||||
|
@ -152,8 +151,7 @@ The other options should be self-descriptive."
|
|||
'(networking syslogd)
|
||||
'(networking)))
|
||||
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(service
|
||||
(documentation "GNU lsh SSH server")
|
||||
(provision '(ssh-daemon))
|
||||
(requirement requires)
|
||||
|
@ -168,6 +166,6 @@ The other options should be self-descriptive."
|
|||
(mkdir-p "/var/spool/lsh")
|
||||
#$(if initialize?
|
||||
(activation lsh host-key)
|
||||
#t)))))))
|
||||
#t)))))
|
||||
|
||||
;;; ssh.scm ends here
|
||||
|
|
|
@ -22,7 +22,6 @@
|
|||
#:use-module (gnu packages admin)
|
||||
#:use-module (gnu packages web)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix gexp)
|
||||
#:export (nginx-service))
|
||||
|
@ -76,8 +75,6 @@ files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY."
|
|||
(define nologin #~(string-append #$shadow "/sbin/nologin"))
|
||||
|
||||
;; TODO: Add 'reload' action.
|
||||
(mbegin %store-monad
|
||||
(return
|
||||
(service
|
||||
(provision '(nginx))
|
||||
(documentation "Run the nginx daemon.")
|
||||
|
@ -94,4 +91,4 @@ files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY."
|
|||
(system? #t)
|
||||
(comment "nginx server user")
|
||||
(home-directory "/var/empty")
|
||||
(shell nologin))))))))
|
||||
(shell nologin))))))
|
||||
|
|
|
@ -31,7 +31,6 @@
|
|||
#:use-module (gnu packages bash)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix records)
|
||||
#:use-module (srfi srfi-1)
|
||||
|
@ -63,8 +62,8 @@ appropriate screen resolution; otherwise, it must be a list of
|
|||
resolutions---e.g., @code{((1024 768) (640 480))}.
|
||||
|
||||
Last, @var{extra-config} is a list of strings or objects appended to the
|
||||
@code{text-file*} argument list. It is used to pass extra text to be added
|
||||
verbatim to the configuration file."
|
||||
@code{mixed-text-file} argument list. It is used to pass extra text to be
|
||||
added verbatim to the configuration file."
|
||||
(define (device-section driver)
|
||||
(string-append "
|
||||
Section \"Device\"
|
||||
|
@ -87,7 +86,7 @@ Section \"Screen\"
|
|||
EndSubSection
|
||||
EndSection"))
|
||||
|
||||
(apply text-file* "xserver.conf" "
|
||||
(apply mixed-text-file "xserver.conf" "
|
||||
Section \"Files\"
|
||||
FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\"
|
||||
ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
|
||||
|
@ -128,7 +127,7 @@ EndSection
|
|||
|
||||
(define* (xorg-start-command #:key
|
||||
(guile (canonical-package guile-2.0))
|
||||
configuration-file
|
||||
(configuration-file (xorg-configuration-file))
|
||||
(xorg-server 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
|
||||
|
@ -136,10 +135,7 @@ file or a derivation that builds it; when omitted, the result of
|
|||
@code{xorg-configuration-file} is used.
|
||||
|
||||
Usually the X server is started by a login manager."
|
||||
(mlet %store-monad ((config (if configuration-file
|
||||
(return configuration-file)
|
||||
(xorg-configuration-file))))
|
||||
(define script
|
||||
(define exp
|
||||
;; Write a small wrapper around the X server.
|
||||
#~(begin
|
||||
(setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri"))
|
||||
|
@ -149,14 +145,14 @@ Usually the X server is started by a login manager."
|
|||
(string-append #$xorg-server "/bin/X") ;argv[0]
|
||||
"-logverbose" "-verbose"
|
||||
"-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
|
||||
"-config" #$config
|
||||
"-config" #$configuration-file
|
||||
"-nolisten" "tcp" "-terminate"
|
||||
|
||||
;; Note: SLiM and other display managers add the
|
||||
;; '-auth' flag by themselves.
|
||||
(cdr (command-line)))))
|
||||
|
||||
(gexp->script "start-xorg" script)))
|
||||
(program-file "start-xorg" exp))
|
||||
|
||||
(define* (xinitrc #:key
|
||||
(guile (canonical-package guile-2.0))
|
||||
|
@ -200,7 +196,7 @@ which should be passed to this script as the first argument. If not, the
|
|||
(exec-from-login-shell xsession-file session)
|
||||
;; Otherwise, start the specified session.
|
||||
(exec-from-login-shell session)))))
|
||||
(gexp->script "xinitrc" builder))
|
||||
(program-file "xinitrc" builder))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -224,7 +220,7 @@ which should be passed to this script as the first argument. If not, the
|
|||
(xauth xauth) (dmd dmd) (bash bash)
|
||||
(auto-login-session #~(string-append #$windowmaker
|
||||
"/bin/wmaker"))
|
||||
startx)
|
||||
(startx (xorg-start-command)))
|
||||
"Return a service that spawns the SLiM graphical login manager, which in
|
||||
turn starts the X display server with @var{startx}, a command as returned by
|
||||
@code{xorg-start-command}.
|
||||
|
@ -251,13 +247,9 @@ If @var{theme} is @code{#f}, the use the default log-in theme; otherwise
|
|||
theme to use. In that case, @var{theme-name} specifies the name of the
|
||||
theme."
|
||||
|
||||
(define (slim.cfg)
|
||||
(mlet %store-monad ((startx (if startx
|
||||
(return startx)
|
||||
(xorg-start-command)))
|
||||
(xinitrc (xinitrc #:fallback-session
|
||||
auto-login-session)))
|
||||
(text-file* "slim.cfg" "
|
||||
(define slim.cfg
|
||||
(let ((xinitrc (xinitrc #:fallback-session auto-login-session)))
|
||||
(mixed-text-file "slim.cfg" "
|
||||
default_path /run/current-system/profile/bin
|
||||
default_xserver " startx "
|
||||
xserver_arguments :0 vt7
|
||||
|
@ -271,8 +263,7 @@ sessiondir /run/current-system/profile/share/xsessions
|
|||
session_msg session (F1 to change):
|
||||
|
||||
halt_cmd " dmd "/sbin/halt
|
||||
reboot_cmd " dmd "/sbin/reboot
|
||||
"
|
||||
reboot_cmd " dmd "/sbin/reboot\n"
|
||||
(if auto-login?
|
||||
(string-append "auto_login yes\ndefault_user " default-user "\n")
|
||||
"")
|
||||
|
@ -280,8 +271,6 @@ reboot_cmd " dmd "/sbin/reboot
|
|||
(string-append "current_theme " theme-name "\n")
|
||||
""))))
|
||||
|
||||
(mlet %store-monad ((slim.cfg (slim.cfg)))
|
||||
(return
|
||||
(service
|
||||
(documentation "Xorg display server")
|
||||
(provision '(xorg-server))
|
||||
|
@ -305,6 +294,6 @@ reboot_cmd " dmd "/sbin/reboot
|
|||
;; Tell PAM about 'slim'.
|
||||
(list (unix-pam-service
|
||||
"slim"
|
||||
#:allow-empty-passwords? allow-empty-passwords?)))))))
|
||||
#:allow-empty-passwords? allow-empty-passwords?)))))
|
||||
|
||||
;;; xorg.scm ends here
|
||||
|
|
|
@ -244,7 +244,6 @@ as 'needed-for-boot'."
|
|||
(string->symbol (mapped-device-target md))))
|
||||
(device-mappings fs))))
|
||||
|
||||
(sequence %store-monad
|
||||
(map (lambda (fs)
|
||||
(match fs
|
||||
(($ <file-system> device title target type flags opts
|
||||
|
@ -256,7 +255,7 @@ as 'needed-for-boot'."
|
|||
#:create-mount-point? create?
|
||||
#:options opts
|
||||
#:flags flags))))
|
||||
file-systems)))
|
||||
file-systems))
|
||||
|
||||
(define (mapped-device-user device file-systems)
|
||||
"Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
|
||||
|
@ -287,8 +286,7 @@ from the initrd."
|
|||
devices)))
|
||||
|
||||
(define (device-mapping-services os)
|
||||
"Return the list of device-mapping services for OS as a monadic list."
|
||||
(sequence %store-monad
|
||||
"Return the list of device-mapping services for OS as a list."
|
||||
(map (lambda (md)
|
||||
(let* ((source (mapped-device-source md))
|
||||
(target (mapped-device-target md))
|
||||
|
@ -298,12 +296,11 @@ from the initrd."
|
|||
(device-mapping-service target
|
||||
(open source target)
|
||||
(close source target))))
|
||||
(operating-system-user-mapped-devices os))))
|
||||
(operating-system-user-mapped-devices os)))
|
||||
|
||||
(define (swap-services os)
|
||||
"Return the list of swap services for OS as a monadic list."
|
||||
(sequence %store-monad
|
||||
(map swap-service (operating-system-swap-devices os))))
|
||||
"Return the list of swap services for OS."
|
||||
(map swap-service (operating-system-swap-devices os)))
|
||||
|
||||
(define (essential-services os)
|
||||
"Return the list of essential services for OS. These are special services
|
||||
|
@ -312,7 +309,7 @@ bookkeeping."
|
|||
(define known-fs
|
||||
(map file-system-mount-point (operating-system-file-systems os)))
|
||||
|
||||
(mlet* %store-monad ((mappings (device-mapping-services os))
|
||||
(let* ((mappings (device-mapping-services os))
|
||||
(root-fs (root-file-system-service))
|
||||
(other-fs (other-file-system-services os))
|
||||
(unmount (user-unmount-service known-fs))
|
||||
|
@ -320,18 +317,15 @@ bookkeeping."
|
|||
(procs (user-processes-service
|
||||
(map (compose first service-provision)
|
||||
other-fs)))
|
||||
(host-name (host-name-service
|
||||
(operating-system-host-name os))))
|
||||
(return (cons* host-name procs root-fs unmount
|
||||
(append other-fs mappings swaps)))))
|
||||
(host-name (host-name-service (operating-system-host-name os))))
|
||||
(cons* host-name procs root-fs unmount
|
||||
(append other-fs mappings swaps))))
|
||||
|
||||
(define (operating-system-services os)
|
||||
"Return all the services of OS, including \"internal\" services that do not
|
||||
explicitly appear in OS."
|
||||
(mlet %store-monad
|
||||
((user (sequence %store-monad (operating-system-user-services os)))
|
||||
(essential (essential-services os)))
|
||||
(return (append essential user))))
|
||||
(append (operating-system-user-services os)
|
||||
(essential-services os)))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -420,8 +414,7 @@ settings for 'guix.el' to work out-of-the-box."
|
|||
(define (user-shells os)
|
||||
"Return the list of all the shells used by the accounts of OS. These may be
|
||||
gexps or strings."
|
||||
(mlet %store-monad ((accounts (operating-system-accounts os)))
|
||||
(return (map user-account-shell accounts))))
|
||||
(map user-account-shell (operating-system-accounts os)))
|
||||
|
||||
(define (shells-file shells)
|
||||
"Return a derivation that builds a shell list for use as /etc/shells based
|
||||
|
@ -577,9 +570,9 @@ fi\n"))
|
|||
(operating-system-users os)
|
||||
(cons %root-account (operating-system-users os))))
|
||||
|
||||
(mlet %store-monad ((services (operating-system-services os)))
|
||||
(return (append users
|
||||
(append-map service-user-accounts services)))))
|
||||
(append users
|
||||
(append-map service-user-accounts
|
||||
(operating-system-services os))))
|
||||
|
||||
(define (maybe-string->file file-name thing)
|
||||
"If THING is a string, return a <plain-file> with THING as its content.
|
||||
|
@ -615,7 +608,7 @@ use 'plain-file' instead~%")
|
|||
(define (operating-system-etc-directory os)
|
||||
"Return that static part of the /etc directory of OS."
|
||||
(mlet* %store-monad
|
||||
((services (operating-system-services os))
|
||||
((services -> (operating-system-services os))
|
||||
(pam-services ->
|
||||
;; Services known to PAM.
|
||||
(append (operating-system-pam-services os)
|
||||
|
@ -626,7 +619,7 @@ use 'plain-file' instead~%")
|
|||
"hosts"
|
||||
(or (operating-system-hosts-file os)
|
||||
(default-/etc/hosts (operating-system-host-name os)))))
|
||||
(shells (user-shells os)))
|
||||
(shells -> (user-shells os)))
|
||||
(etc-directory #:pam-services pam-services
|
||||
#:skeletons skeletons
|
||||
#:issue (operating-system-issue os)
|
||||
|
@ -713,7 +706,7 @@ etc."
|
|||
(sequence %store-monad (map (cut gexp->file "activate-service.scm" <>)
|
||||
gexps))))
|
||||
|
||||
(mlet* %store-monad ((services (operating-system-services os))
|
||||
(mlet* %store-monad ((services -> (operating-system-services os))
|
||||
(actions (service-activations services))
|
||||
(etc (operating-system-etc-directory os))
|
||||
(modules (imported-modules %modules))
|
||||
|
@ -721,7 +714,7 @@ etc."
|
|||
(modprobe (modprobe-wrapper))
|
||||
(firmware (directory-union
|
||||
"firmware" (operating-system-firmware os)))
|
||||
(accounts (operating-system-accounts os)))
|
||||
(accounts -> (operating-system-accounts os)))
|
||||
(define setuid-progs
|
||||
(operating-system-setuid-programs os))
|
||||
|
||||
|
@ -789,9 +782,8 @@ etc."
|
|||
"Return the boot script for OS---i.e., the code started by the initrd once
|
||||
we're running in the final root. When CONTAINER? is true, skip all
|
||||
hardware-related operations as necessary when booting a Linux container."
|
||||
(mlet* %store-monad ((services (operating-system-services os))
|
||||
(activate (operating-system-activation-script
|
||||
os #:container? container?))
|
||||
(mlet* %store-monad ((services -> (operating-system-services os))
|
||||
(activate (operating-system-activation-script os))
|
||||
(dmd-conf (dmd-configuration-file services)))
|
||||
(gexp->file "boot"
|
||||
#~(begin
|
||||
|
|
|
@ -163,8 +163,7 @@ current store is on a RAM disk."
|
|||
"Return a service that makes the store copy-on-write, such that writes go to
|
||||
the user's target storage device rather than on the RAM disk."
|
||||
;; See <http://bugs.gnu.org/18061> for the initial report.
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(service
|
||||
(requirement '(root-file-system user-processes))
|
||||
(provision '(cow-store))
|
||||
(documentation
|
||||
|
@ -188,7 +187,7 @@ the given target.")
|
|||
;; 'user-unmount' service will unmount TARGET
|
||||
;; eventually.
|
||||
(delete-file-recursively
|
||||
(string-append target #$%backing-directory))))))))
|
||||
(string-append target #$%backing-directory))))))
|
||||
|
||||
(define (configuration-template-service)
|
||||
"Return a dummy service whose purpose is to install an operating system
|
||||
|
@ -204,8 +203,7 @@ configuration template file in the installation system."
|
|||
'(("gnu/system/examples/bare-bones.tmpl" -> "bare-bones.scm")
|
||||
("gnu/system/examples/desktop.tmpl" -> "desktop.scm"))))
|
||||
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(service
|
||||
(requirement '(root-file-system))
|
||||
(provision '(os-config-template))
|
||||
(documentation
|
||||
|
@ -222,7 +220,7 @@ configuration template file in the installation system."
|
|||
((file target)
|
||||
(unless (file-exists? target)
|
||||
(copy-file file target))))
|
||||
'#$templates)))))))
|
||||
'#$templates)))))
|
||||
|
||||
(define %nscd-minimal-caches
|
||||
;; Minimal in-memory caching policy for nscd.
|
||||
|
|
Reference in New Issue