aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm4
-rw-r--r--gnu/services/messaging.scm53
-rw-r--r--gnu/services/shepherd.scm51
-rw-r--r--gnu/services/ssh.scm7
-rw-r--r--gnu/services/xorg.scm15
5 files changed, 53 insertions, 77 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 6539bfd6ce..60388a22dd 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1798,9 +1798,9 @@ archive' public keys, with GUIX."
(chroot-directories guix-configuration-chroot-directories ;list of file-like/strings
(default '()))
(max-silent-time guix-configuration-max-silent-time ;integer
- (default 0))
+ (default 3600))
(timeout guix-configuration-timeout ;integer
- (default 0))
+ (default (* 3600 24)))
(log-compression guix-configuration-log-compression
(default 'gzip))
(discover? guix-configuration-discover?
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 7505810e7c..9702170b3e 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2015, 2017-2020, 2022, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017-2020, 2022-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Pierre-Antoine Rouby <contact@parouby.fr>
;;;
;;; This file is part of GNU Guix.
@@ -857,39 +857,24 @@ string, you could instantiate a prosody service like this:
;; on 'networking'.
(requirement '(user-processes networking))
- (start #~(if (defined? 'make-inetd-constructor)
-
- (make-inetd-constructor
- (list #$bitlbee* "-I" "-c" #$conf)
- (list (endpoint
- (addrinfo:addr
- (car (getaddrinfo #$interface
- #$(number->string port)
- (logior AI_NUMERICHOST
- AI_NUMERICSERV))))))
- #:requirements '#$requirement
- #:service-name-stem "bitlbee"
- #:user "bitlbee" #:group "bitlbee"
-
- ;; Allow 'bitlbee-purple' to use libpurple plugins.
- #:environment-variables
- (list (string-append "PURPLE_PLUGIN_PATH="
- #$plugins "/lib/purple-2")
- "GUIX_LOCPATH=/run/current-system/locale"))
-
- (make-forkexec-constructor
- (list #$(file-append bitlbee "/sbin/bitlbee")
- "-n" "-F" "-u" "bitlbee" "-c" #$conf)
-
- ;; Allow 'bitlbee-purple' to use libpurple plugins.
- #:environment-variables
- (list (string-append "PURPLE_PLUGIN_PATH="
- #$plugins "/lib/purple-2"))
-
- #:pid-file "/var/run/bitlbee.pid")))
- (stop #~(if (defined? 'make-inetd-destructor)
- (make-inetd-destructor)
- (make-kill-destructor)))))))))
+ (start #~(make-inetd-constructor
+ (list #$bitlbee* "-I" "-c" #$conf)
+ (list (endpoint
+ (addrinfo:addr
+ (car (getaddrinfo #$interface
+ #$(number->string port)
+ (logior AI_NUMERICHOST
+ AI_NUMERICSERV))))))
+ #:requirements '#$requirement
+ #:service-name-stem "bitlbee"
+ #:user "bitlbee" #:group "bitlbee"
+
+ ;; Allow 'bitlbee-purple' to use libpurple plugins.
+ #:environment-variables
+ (list (string-append "PURPLE_PLUGIN_PATH="
+ #$plugins "/lib/purple-2")
+ "GUIX_LOCPATH=/run/current-system/locale")))
+ (stop #~(make-inetd-destructor))))))))
(define %bitlbee-accounts
;; User group and account to run BitlBee.
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index e9d3a631c2..5ebac129ce 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2016, 2018-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2016, 2018-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
@@ -183,7 +183,6 @@ DEFAULT is given, use it as the service's default value."
(define %default-modules
;; Default set of modules visible in a service's file.
`((shepherd service)
- (oop goops)
((guix build utils) #:hide (delete))
(guix build syscalls)))
@@ -300,10 +299,10 @@ stored."
#~(begin
(use-modules #$@(shepherd-service-modules service))
- (make <service>
- #:docstring '#$(shepherd-service-documentation service)
- #:provides '#$(shepherd-service-provision service)
- #:requires '#$(shepherd-service-requirement service)
+ (service
+ '#$(shepherd-service-provision service)
+ #:documentation '#$(shepherd-service-documentation service)
+ #:requirement '#$(shepherd-service-requirement service)
;; The 'one-shot?' slot is new in Shepherd 0.6.0.
;; Older versions ignore it.
@@ -313,7 +312,7 @@ stored."
#:start #$(shepherd-service-start service)
#:stop #$(shepherd-service-stop service)
#:actions
- (make-actions
+ (actions
#$@(map (match-lambda
(($ <shepherd-action> name proc doc)
#~(#$name #$doc #$proc)))
@@ -338,7 +337,6 @@ and return the resulting '.go' file. SHEPHERD is used as shepherd package."
;; Do the same as the Shepherd's 'load-in-user-module'.
(let ((env (make-fresh-user-module)))
- (module-use! env (resolve-interface '(oop goops)))
(module-use! env (resolve-interface '(shepherd service)))
(with-target #$(or target #~%host-type)
(lambda _
@@ -371,17 +369,6 @@ as shepherd package."
(use-modules (srfi srfi-34)
(system repl error-handling))
- (define (call-with-file file flags proc)
- (let ((port #f))
- (dynamic-wind
- (lambda ()
- (set! port (open file flags)))
- (lambda ()
- (proc port))
- (lambda ()
- (close-port port)
- (set! port #f)))))
-
;; There's code run from shepherd that uses 'call-with-input-file' &
;; co.--e.g., the 'urandom-seed' service. Starting from Shepherd
;; 0.9.2, users need to make sure not to leak non-close-on-exec file
@@ -389,12 +376,12 @@ as shepherd package."
;; standard bindings with O_CLOEXEC variants.
(set! call-with-input-file
(lambda (file proc)
- (call-with-file file (logior O_RDONLY O_CLOEXEC)
- proc)))
+ (call-with-port (open file (logior O_RDONLY O_CLOEXEC))
+ proc)))
(set! call-with-output-file
(lambda (file proc)
- (call-with-file file (logior O_WRONLY O_CREAT O_CLOEXEC)
- proc)))
+ (call-with-port (open file (logior O_WRONLY O_CREAT O_CLOEXEC))
+ proc)))
;; Specify the default environment visible to all the services.
;; Without this statement, all the environment variables of PID 1
@@ -412,25 +399,17 @@ as shepherd package."
;; than a kernel panic.
(call-with-error-handling
(lambda ()
- (apply register-services
- (parameterize ((current-warning-port
- (%make-void-port "w")))
- (map load-compiled '#$(map scm->go files))))))
+ (register-services
+ (parameterize ((current-warning-port
+ (%make-void-port "w")))
+ (map load-compiled '#$(map scm->go files))))))
(format #t "starting services...~%")
(let ((services-to-start
'#$(append-map shepherd-service-provision
(filter shepherd-service-auto-start?
services))))
- (if (defined? 'start-in-the-background)
- (start-in-the-background services-to-start)
- (for-each (lambda (service) ;pre-0.9.0 compatibility
- (guard (c ((service-error? c)
- (format (current-error-port)
- "failed to start service '~a'~%"
- service)))
- (start service)))
- services-to-start))
+ (start-in-the-background services-to-start)
;; Hang up stdin. At this point, we assume that 'start' methods
;; that required user interaction on the console (e.g.,
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 0abecd6b42..f759c5cf6e 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2019, 2022, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2019, 2022-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
@@ -592,7 +592,10 @@ of user-name/file-like tuples."
(list (shepherd-service
(documentation "OpenSSH server.")
- (requirement '(pam syslogd loopback))
+
+ ;; On the Hurd, this can only be started after pfinet is up, hence
+ ;; the dependency on 'networking'.
+ (requirement '(pam syslogd loopback networking))
(provision '(ssh-daemon ssh sshd))
(start #~(if #$inetd-style?
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index f8cf9f25b6..1ee15ea90c 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -981,6 +981,11 @@ argument.")))
(lambda (pw)
(string-append (passwd:dir pw) "/.guix-profile"))))
+ (define home-profile
+ (and=> (getpw (getuid))
+ (lambda (pw)
+ (string-append (passwd:dir pw) "/.guix-home/profile"))))
+
;; If we are able to find the user's profile, we can add it to
;; the search paths set below. We need to do this so that D-Bus
;; can start services installed by the user. This allows
@@ -988,9 +993,13 @@ argument.")))
;; 'evolution') to work even if those services are only available
;; in the user's profile. See <https://bugs.gnu.org/35267>.
(define profiles
- (if user-profile
- (list user-profile system-profile)
- (list system-profile)))
+ (append (if home-profile
+ (list home-profile)
+ '())
+ (if user-profile
+ (list user-profile)
+ '())
+ (list system-profile)))
(setenv "XDG_CONFIG_DIRS"
(string-join (map (cut string-append <> "/etc/xdg") profiles)