aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/avahi.scm108
-rw-r--r--gnu/services/base.scm219
-rw-r--r--gnu/services/dbus.scm120
-rw-r--r--gnu/services/dmd.scm76
-rw-r--r--gnu/services/networking.scm58
-rw-r--r--gnu/services/xorg.scm118
6 files changed, 513 insertions, 186 deletions
diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm
new file mode 100644
index 0000000000..4b52fd7840
--- /dev/null
+++ b/gnu/services/avahi.scm
@@ -0,0 +1,108 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services avahi)
+ #:use-module (gnu services)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu packages avahi)
+ #:use-module (guix monads)
+ #:use-module (guix gexp)
+ #:export (avahi-service))
+
+;;; Commentary:
+;;;
+;;; This module provides service definitions for the Avahi
+;;; "zero-configuration" tool set.
+;;;
+;;; Code:
+
+(define* (configuration-file #:key host-name publish?
+ ipv4? ipv6? wide-area? domains-to-browse)
+ "Return an avahi-daemon configuration file."
+ (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")
+ "")
+
+ "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
+ (publish? #t)
+ (ipv4? #t) (ipv6? #t)
+ wide-area?
+ (domains-to-browse '()))
+ "Return a service that runs @command{avahi-daemon}, a system-wide
+mDNS/DNS-SD responder that allows for service discovery and
+\"zero-configuration\" host name lookups.
+
+If @var{host-name} is different from @code{#f}, use that as the host name to
+publish for this machine; otherwise, use the machine's actual host name.
+
+When @var{publish?} is true, publishing of host names and services is allowed;
+in particular, avahi-daemon will publish the machine's host name and IP
+address via mDNS on the local network.
+
+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))
+
+ (start #~(make-forkexec-constructor
+ (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"))))
+ (user-accounts (list (user-account
+ (name "avahi")
+ (group "avahi")
+ (comment "Avahi daemon user")
+ (home-directory "/var/empty")
+ (shell
+ "/run/current-system/profile/sbin/nologin"))))))))
+
+;;; avahi.scm ends here
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d6c1707c6a..dc0161408b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -24,11 +24,15 @@
#:use-module ((gnu packages base)
#:select (glibc-final))
#:use-module (gnu packages package-management)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 format)
- #:export (host-name-service
+ #:export (root-file-system-service
+ file-system-service
+ user-processes-service
+ host-name-service
mingetty-service
nscd-service
syslog-service
@@ -42,14 +46,148 @@
;;;
;;; Code:
+(define (root-file-system-service)
+ "Return a service whose sole purpose is to re-mount read-only the root file
+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))
+ (start #~(const #t))
+ (stop #~(lambda _
+ ;; Return #f if successfully stopped.
+ (sync)
+
+ (call-with-blocked-asyncs
+ (lambda ()
+ (let ((null (%make-void-port "w")))
+ ;; Close 'dmd.log'.
+ (display "closing log\n")
+ ;; XXX: Ideally we'd use 'stop-logging', but that one
+ ;; doesn't actually close the port as of dmd 0.1.
+ (close-port (@@ (dmd comm) log-output-port))
+ (set! (@@ (dmd comm) log-output-port) null)
+
+ ;; Redirect the default output ports..
+ (set-current-output-port null)
+ (set-current-error-port null)
+
+ ;; Close /dev/console.
+ (for-each close-fdes '(0 1 2))
+
+ ;; At this point, there are no open files left, so the
+ ;; root file system can be re-mounted read-only.
+ (mount #f "/" #f
+ (logior MS_REMOUNT MS_RDONLY)
+ #:update-mtab? #f)
+
+ #f)))))
+ (respawn? #f)))))
+
+(define* (file-system-service device target type
+ #:key (check? #t) options)
+ "Return a service that mounts DEVICE on TARGET as a file system TYPE with
+OPTIONS. When CHECK? is true, check the file system before mounting it."
+ (with-monad %store-monad
+ (return
+ (service
+ (provision (list (symbol-append 'file-system- (string->symbol target))))
+ (requirement '(root-file-system))
+ (documentation "Check, mount, and unmount the given file system.")
+ (start #~(lambda args
+ #$(if check?
+ #~(check-file-system #$device #$type)
+ #~#t)
+ (mount #$device #$target #$type 0 #$options)
+ #t))
+ (stop #~(lambda args
+ ;; Normally there are no processes left at this point, so
+ ;; TARGET can be safely unmounted.
+ (umount #$target)
+ #f))))))
+
+(define %do-not-kill-file
+ ;; Name of the file listing PIDs of processes that must survive when halting
+ ;; the system. Typical example is user-space file systems.
+ "/etc/dmd/do-not-kill")
+
+(define* (user-processes-service requirements #:key (grace-delay 2))
+ "Return the service that is responsible for terminating all the processes so
+that the root file system can be re-mounted read-only, just before
+rebooting/halting. Processes still running GRACE-DELAY seconds after SIGTERM
+has been sent are terminated with SIGKILL.
+
+The returned service will depend on 'root-file-system' and on all the services
+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
+ (documentation "When stopped, terminate all user processes.")
+ (provision '(user-processes))
+ (requirement (cons 'root-file-system requirements))
+ (start #~(const #t))
+ (stop #~(lambda _
+ (define (kill-except omit signal)
+ ;; Kill all the processes with SIGNAL except those
+ ;; listed in OMIT and the current process.
+ (let ((omit (cons (getpid) omit)))
+ (for-each (lambda (pid)
+ (unless (memv pid omit)
+ (false-if-exception
+ (kill pid signal))))
+ (processes))))
+
+ (define omitted-pids
+ ;; List of PIDs that must not be killed.
+ (if (file-exists? #$%do-not-kill-file)
+ (map string->number
+ (call-with-input-file #$%do-not-kill-file
+ (compose string-tokenize
+ (@ (ice-9 rdelim) read-string))))
+ '()))
+
+ ;; When this happens, all the processes have been
+ ;; killed, including 'deco', so DMD-OUTPUT-PORT and
+ ;; thus CURRENT-OUTPUT-PORT are dangling.
+ (call-with-output-file "/dev/console"
+ (lambda (port)
+ (display "sending all processes the TERM signal\n"
+ port)))
+
+ (if (null? omitted-pids)
+ (begin
+ ;; Easy: terminate all of them.
+ (kill -1 SIGTERM)
+ (sleep #$grace-delay)
+ (kill -1 SIGKILL))
+ (begin
+ ;; Kill them all except OMITTED-PIDS. XXX: We
+ ;; would like to (kill -1 SIGSTOP) to get a fixed
+ ;; list of processes, like 'killall5' does, but
+ ;; that seems unreliable.
+ (kill-except omitted-pids SIGTERM)
+ (sleep #$grace-delay)
+ (kill-except omitted-pids SIGKILL)
+ (delete-file #$%do-not-kill-file)))
+
+ (display "all processes have been terminated\n")
+ #f))
+ (respawn? #f)))))
+
(define (host-name-service name)
"Return a service that sets the host name to NAME."
(with-monad %store-monad
(return (service
(documentation "Initialize the machine's host name.")
(provision '(host-name))
- (start `(lambda _
- (sethostname ,name)))
+ (start #~(lambda _
+ (sethostname #$name)))
(respawn? #f)))))
(define* (mingetty-service tty
@@ -57,8 +195,7 @@
(motd (text-file "motd" "Welcome.\n"))
(allow-empty-passwords? #t))
"Return a service to run mingetty on TTY."
- (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty"))
- (motd motd))
+ (mlet %store-monad ((motd motd))
(return
(service
(documentation (string-append "Run mingetty on " tty "."))
@@ -66,12 +203,12 @@
;; Since the login prompt shows the host name, wait for the 'host-name'
;; service to be done.
- (requirement '(host-name))
+ (requirement '(user-processes host-name))
- (start `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty))
- (stop `(make-kill-destructor))
- (inputs `(("mingetty" ,mingetty)
- ("motd" ,motd)))
+ (start #~(make-forkexec-constructor
+ (string-append #$mingetty "/sbin/mingetty")
+ "--noclear" #$tty))
+ (stop #~(make-kill-destructor))
(pam-services
;; Let 'login' be known to PAM. All the mingetty services will have
@@ -83,16 +220,23 @@
(define* (nscd-service #:key (glibc glibc-final))
"Return a service that runs libc's name service cache daemon (nscd)."
- (mlet %store-monad ((nscd (package-file glibc "sbin/nscd")))
+ (with-monad %store-monad
(return (service
(documentation "Run libc's name service cache daemon (nscd).")
(provision '(nscd))
- (start `(make-forkexec-constructor ,nscd "-f" "/dev/null"
- "--foreground"))
- (stop `(make-kill-destructor))
+ (requirement '(user-processes))
- (respawn? #f)
- (inputs `(("glibc" ,glibc)))))))
+ (activate #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p "/var/run/nscd")))
+
+ (start
+ #~(make-forkexec-constructor (string-append #$glibc "/sbin/nscd")
+ "-f" "/dev/null"
+ "--foreground"))
+ (stop #~(make-kill-destructor))
+
+ (respawn? #f)))))
(define (syslog-service)
"Return a service that runs 'syslogd' with reasonable default settings."
@@ -120,21 +264,22 @@
")
(mlet %store-monad
- ((syslog.conf (text-file "syslog.conf" contents))
- (syslogd (package-file inetutils "libexec/syslogd")))
+ ((syslog.conf (text-file "syslog.conf" contents)))
(return
(service
(documentation "Run the syslog daemon (syslogd).")
(provision '(syslogd))
- (start `(make-forkexec-constructor ,syslogd "--no-detach"
- "--rcfile" ,syslog.conf))
- (stop `(make-kill-destructor))
- (inputs `(("inetutils" ,inetutils)
- ("syslog.conf" ,syslog.conf)))))))
+ (requirement '(user-processes))
+ (start
+ #~(make-forkexec-constructor (string-append #$inetutils
+ "/libexec/syslogd")
+ "--no-detach"
+ "--rcfile" #$syslog.conf))
+ (stop #~(make-kill-destructor))))))
(define* (guix-build-accounts count #:key
+ (group "guixbuild")
(first-uid 30001)
- (gid 30000)
(shadow shadow))
"Return a list of COUNT user accounts for Guix build users, with UIDs
starting at FIRST-UID, and under GID."
@@ -143,34 +288,32 @@ starting at FIRST-UID, and under GID."
(lambda (n)
(user-account
(name (format #f "guixbuilder~2,'0d" n))
- (password "!")
(uid (+ first-uid n -1))
- (gid gid)
+ (group group)
(comment (format #f "Guix Build User ~2d" n))
(home-directory "/var/empty")
- (shell (package-file shadow "sbin/nologin"))
- (inputs `(("shadow" ,shadow)))))
+ (shell #~(string-append #$shadow "/sbin/nologin"))))
1+
1))))
(define* (guix-service #:key (guix guix) (builder-group "guixbuild")
- (build-user-gid 30000) (build-accounts 10))
+ (build-accounts 10))
"Return a service that runs the build daemon from GUIX, and has
BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
- (mlet %store-monad ((daemon (package-file guix "bin/guix-daemon"))
- (accounts (guix-build-accounts build-accounts
- #:gid build-user-gid)))
+ (mlet %store-monad ((accounts (guix-build-accounts build-accounts
+ #:group builder-group)))
(return (service
(provision '(guix-daemon))
- (start `(make-forkexec-constructor ,daemon
- "--build-users-group"
- ,builder-group))
- (stop `(make-kill-destructor))
- (inputs `(("guix" ,guix)))
+ (requirement '(user-processes))
+ (start
+ #~(make-forkexec-constructor (string-append #$guix
+ "/bin/guix-daemon")
+ "--build-users-group"
+ #$builder-group))
+ (stop #~(make-kill-destructor))
(user-accounts accounts)
(user-groups (list (user-group
(name builder-group)
- (id build-user-gid)
(members (map user-account-name
user-accounts)))))))))
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
new file mode 100644
index 0000000000..3fbbfde09b
--- /dev/null
+++ b/gnu/services/dbus.scm
@@ -0,0 +1,120 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services dbus)
+ #:use-module (gnu services)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu packages glib)
+ #:use-module (guix monads)
+ #:use-module (guix gexp)
+ #:export (dbus-service))
+
+;;; Commentary:
+;;;
+;;; This module supports the configuration of the D-Bus message bus
+;;; (http://dbus.freedesktop.org/). D-Bus is an inter-process communication
+;;; facility. Its "system bus" is used to allow system services to
+;;; communicate and be notified of system-wide events.
+;;;
+;;; Code:
+
+(define (dbus-configuration-directory dbus services)
+ "Return a configuration directory for @var{dbus} that includes the
+@code{etc/dbus-1/system.d} directories of each package listed in
+@var{services}."
+ (define build
+ #~(begin
+ (use-modules (sxml simple))
+
+ (define (services->sxml services)
+ ;; Return the SXML 'includedir' clauses for DIRS.
+ `(busconfig
+ ,@(map (lambda (dir)
+ `(includedir ,(string-append dir
+ "/etc/dbus-1/system.d")))
+ services)))
+
+ (mkdir #$output)
+ (copy-file (string-append #$dbus "/etc/dbus-1/system.conf")
+ (string-append #$output "/system.conf"))
+
+ ;; The default 'system.conf' has an <includedir> clause for
+ ;; 'system.d', so create it.
+ (mkdir (string-append #$output "/system.d"))
+
+ ;; 'system-local.conf' is automatically included by the default
+ ;; 'system.conf', so this is where we stuff our own things.
+ (call-with-output-file (string-append #$output "/system-local.conf")
+ (lambda (port)
+ (sxml->xml (services->sxml (list #$@services))
+ port)))))
+
+ (gexp->derivation "dbus-configuration" build))
+
+(define* (dbus-service services #:key (dbus dbus))
+ "Return a service that runs the system bus, using @var{dbus}, with support
+for @var{services}.
+
+@var{services} must be a list of packages that provide an
+@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
+ (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"))))
+ (user-accounts (list (user-account
+ (name "messagebus")
+ (group "messagebus")
+ (comment "D-Bus system bus user")
+ (home-directory "/var/run/dbus")
+ (shell
+ "/run/current-system/profile/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)))))))))))
+
+;;; dbus.scm ends here
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index 54fb5cbfd6..982c196fe4 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -17,6 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services dmd)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (gnu services)
#:use-module (ice-9 match)
@@ -29,52 +30,45 @@
;;;
;;; Code:
-(define (dmd-configuration-file services etc)
- "Return the dmd configuration file for SERVICES, that initializes /etc from
-ETC (the name of a directory in the store) on startup."
- (define config
- `(begin
- (use-modules (ice-9 ftw))
+(define (dmd-configuration-file services)
+ "Return the dmd configuration file for SERVICES."
+ (define modules
+ ;; Extra modules visible to dmd.conf.
+ '((guix build syscalls)
+ (guix build linux-initrd)
+ (guix build utils)))
- (register-services
- ,@(map (lambda (service)
- `(make <service>
- #:docstring ',(service-documentation service)
- #:provides ',(service-provision service)
- #:requires ',(service-requirement service)
- #:respawn? ',(service-respawn? service)
- #:start ,(service-start service)
- #:stop ,(service-stop service)))
- services))
+ (mlet %store-monad ((modules (imported-modules modules))
+ (compiled (compiled-modules modules)))
+ (define config
+ #~(begin
+ (eval-when (expand load eval)
+ (set! %load-path (cons #$modules %load-path))
+ (set! %load-compiled-path
+ (cons #$compiled %load-compiled-path)))
- ;; /etc is a mixture of static and dynamic settings. Here is where we
- ;; initialize it from the static part.
- (format #t "populating /etc from ~a...~%" ,etc)
- (let ((rm-f (lambda (f)
- (false-if-exception (delete-file f)))))
- (rm-f "/etc/static")
- (symlink ,etc "/etc/static")
- (for-each (lambda (file)
- ;; TODO: Handle 'shadow' specially so that changed
- ;; password aren't lost.
- (let ((target (string-append "/etc/" file))
- (source (string-append "/etc/static/" file)))
- (rm-f target)
- (symlink source target)))
- (scandir ,etc
- (lambda (file)
- (not (member file '("." ".."))))))
+ (use-modules (ice-9 ftw)
+ (guix build syscalls)
+ ((guix build linux-initrd)
+ #:select (check-file-system)))
- ;; Prevent ETC from being GC'd.
- (rm-f "/var/guix/gcroots/etc-directory")
- (symlink ,etc "/var/guix/gcroots/etc-directory"))
+ (register-services
+ #$@(map (lambda (service)
+ #~(make <service>
+ #:docstring '#$(service-documentation service)
+ #:provides '#$(service-provision service)
+ #:requires '#$(service-requirement service)
+ #:respawn? '#$(service-respawn? service)
+ #:start #$(service-start service)
+ #:stop #$(service-stop service)))
+ services))
- ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
- (setenv "PATH" "/run/current-system/bin")
+ ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
+ (setenv "PATH" "/run/current-system/profile/bin")
- (format #t "starting services...~%")
- (for-each start ',(append-map service-provision services))))
+ (format #t "starting services...~%")
+ (for-each start '#$(append-map service-provision services))))
- (text-file "dmd.conf" (object->string config)))
+ (gexp->file "dmd.conf" config)))
;;; dmd.scm ends here
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 317800db50..8bb05850e3 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -20,6 +20,7 @@
#:use-module (gnu services)
#:use-module (gnu packages admin)
#:use-module (gnu packages linux)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:export (static-networking-service))
@@ -41,40 +42,41 @@ true, it must be a string specifying the default network gateway."
;; TODO: Eventually we should do this using Guile's networking procedures,
;; like 'configure-qemu-networking' does, but the patch that does this is
;; not yet in stock Guile.
- (mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig"))
- (route (package-file net-tools "sbin/route")))
+ (with-monad %store-monad
(return
(service
(documentation
(string-append "Set up networking on the '" interface
"' interface using a static IP address."))
(provision '(networking))
- (start `(lambda _
- ;; Return #t if successfully started.
- (and (zero? (system* ,ifconfig ,interface ,ip "up"))
- ,(if gateway
- `(zero? (system* ,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 _
+ (start #~(lambda _
+ ;; Return #t if successfully started.
+ (and (zero? (system* (string-append #$inetutils
+ "/bin/ifconfig")
+ #$interface #$ip "up"))
+ #$(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.
- (not (and (system* ,ifconfig ,interface "down")
- (system* ,route "del" "-net" "default")))))
- (respawn? #f)
- (inputs `(("inetutils" ,inetutils)
- ,@(if gateway
- `(("net-tools" ,net-tools))
- '())))))))
+ (not (and (system* (string-append #$inetutils "/bin/ifconfig")
+ #$interface "down")
+ (system* (string-append #$net-tools "/sbin/route")
+ "del" "-net" "default")))))
+ (respawn? #f)))))
;;; networking.scm ends here
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 086150a658..7215297f69 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -27,6 +27,7 @@
#:use-module (gnu packages gnustep)
#:use-module (gnu packages admin)
#:use-module (gnu packages bash)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix derivations)
#:export (xorg-start-command
@@ -86,77 +87,42 @@ Section \"Screen\"
Device \"Device-vesa\"
EndSection"))
- (mlet %store-monad ((guile-bin (package-file guile "bin/guile"))
- (xorg-bin (package-file xorg-server "bin/X"))
- (dri (package-file mesa "lib/dri"))
- (xkbcomp-bin (package-file xkbcomp "bin"))
- (xkb-dir (package-file xkeyboard-config
- "share/X11/xkb"))
- (config (xserver.conf)))
- (define builder
+ (mlet %store-monad ((config (xserver.conf)))
+ (define script
;; Write a small wrapper around the X server.
- `(let ((out (assoc-ref %outputs "out")))
- (call-with-output-file out
- (lambda (port)
- (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
- (write '(begin
- (setenv "XORG_DRI_DRIVER_PATH" ,dri)
- (setenv "XKB_BINDIR" ,xkbcomp-bin)
-
- (apply execl
-
- ,xorg-bin "-ac" "-logverbose" "-verbose"
- "-xkbdir" ,xkb-dir
- "-config" ,(derivation->output-path config)
- "-nolisten" "tcp" "-terminate"
-
- ;; Note: SLiM and other display managers add the
- ;; '-auth' flag by themselves.
- (cdr (command-line))))
- port)))
- (chmod out #o555)
- #t))
-
- (mlet %store-monad ((inputs (lower-inputs
- `(("xorg" ,xorg-server)
- ("xkbcomp" ,xkbcomp)
- ("xkeyboard-config" ,xkeyboard-config)
- ("mesa" ,mesa)
- ("guile" ,guile)
- ("xorg.conf" ,config)))))
- (derivation-expression "start-xorg" builder
- #:inputs inputs))))
+ #~(begin
+ (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri"))
+ (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin"))
+
+ (apply execl (string-append #$xorg-server "/bin/X")
+ "-ac" "-logverbose" "-verbose"
+ "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
+ "-config" #$config
+ "-nolisten" "tcp" "-terminate"
+
+ ;; Note: SLiM and other display managers add the
+ ;; '-auth' flag by themselves.
+ (cdr (command-line)))))
+
+ (gexp->script "start-xorg" script)))
(define* (xinitrc #:key
(guile guile-final)
(ratpoison ratpoison)
(windowmaker windowmaker))
"Return a system-wide xinitrc script that starts the specified X session."
- (mlet %store-monad ((guile-bin (package-file guile "bin/guile"))
- (ratpoison-bin (package-file ratpoison "bin/ratpoison"))
- (wmaker-bin (package-file windowmaker "bin/wmaker"))
- (inputs (lower-inputs
- `(("raptoison" ,ratpoison)
- ("wmaker" ,windowmaker)))))
- (define builder
- `(let ((out (assoc-ref %outputs "out")))
- (call-with-output-file out
- (lambda (port)
- (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
- (write '(begin
- (use-modules (ice-9 match))
-
- ;; TODO: Check for ~/.xsession.
- (match (command-line)
- ((_ "ratpoison")
- (execl ,ratpoison-bin))
- (_
- (execl ,wmaker-bin))))
- port)))
- (chmod out #o555)
- #t))
-
- (derivation-expression "xinitrc" builder #:inputs inputs)))
+ (define builder
+ #~(begin
+ (use-modules (ice-9 match))
+
+ ;; TODO: Check for ~/.xsession.
+ (match (command-line)
+ ((_ "ratpoison")
+ (execl (string-append #$ratpoison "/bin/ratpoison")))
+ (_
+ (execl (string-append #$windowmaker "/bin/wmaker"))))))
+
+ (gexp->script "xinitrc" builder))
(define* (slim-service #:key (slim slim)
(allow-empty-passwords? #t) auto-login?
@@ -173,7 +139,7 @@ When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER."
(mlet %store-monad ((startx (or startx (xorg-start-command)))
(xinitrc (xinitrc)))
(text-file* "slim.cfg" "
-default_path /run/current-system/bin
+default_path /run/current-system/profile/bin
default_xserver " startx "
xserver_arguments :0 vt7
xauth_path " xauth "/bin/xauth
@@ -181,7 +147,7 @@ authfile /var/run/slim.auth
# The login command. '%session' is replaced by the chosen session name, one
# of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
-login_cmd exec " xinitrc "%session
+login_cmd exec " xinitrc " %session
sessions wmaker,ratpoison
halt_cmd " dmd "/sbin/halt
@@ -190,25 +156,19 @@ reboot_cmd " dmd "/sbin/reboot
(string-append "auto_login yes\ndefault_user " default-user)
""))))
- (mlet %store-monad ((slim-bin (package-file slim "bin/slim"))
- (bash-bin (package-file bash "bin/bash"))
- (slim.cfg (slim.cfg)))
+ (mlet %store-monad ((slim.cfg (slim.cfg)))
(return
(service
(documentation "Xorg display server")
(provision '(xorg-server))
- (requirement '(host-name))
+ (requirement '(user-processes host-name))
(start
;; XXX: Work around the inability to specify env. vars. directly.
- `(make-forkexec-constructor
- ,bash-bin "-c"
- ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg)
- " " slim-bin
- " -nodaemon")))
- (stop `(make-kill-destructor))
- (inputs `(("slim" ,slim)
- ("slim.cfg" ,slim.cfg)
- ("bash" ,bash)))
+ #~(make-forkexec-constructor
+ (string-append #$bash "/bin/sh") "-c"
+ (string-append "SLIM_CFGFILE=" #$slim.cfg
+ " " #$slim "/bin/slim" " -nodaemon")))
+ (stop #~(make-kill-destructor))
(respawn? #t)
(pam-services
;; Tell PAM about 'slim'.
generated by cgit v1.2.3 (git 2.45.0) at 2025-02-27 09:14:52 +0000