services: Use ‘spawn-command’ instead of ‘fork’ + ‘waitpid’.

Fixes <https://issues.guix.gnu.org/76315>.

This is more concise and more robust: these ‘waitpid’ calls would
compete with those made by shepherd’s event loop upon SIGCHLD, and they
could hang forever, as illustrated with ‘dhcp-client-service-type’
in <https://issues.guix.gnu.org/76315>.

* gnu/services/databases.scm (postgresql-role-shepherd-service): Use
‘spawn-command’ instead of ‘fork+exec-command’ followed by ‘waitpid’.
* gnu/services/networking.scm (dhcp-client-shepherd-service): Change
‘start’ to use ‘spawn-command’ instead of ‘fork+exec-command’ and
* gnu/services/web.scm (patchwork-django-admin-gexp): Use
‘spawn-command’ instead of ‘primitive-fork’ + ‘waitpid’.

Change-Id: I449290bfa46f8600e6ccdb5a6da990ad0cb7948c
Reported-by: Tomas Volf <~@wolfsden.cz>
This commit is contained in:
Ludovic Courtès 2025-02-13 11:12:13 +01:00
parent 9f77db78e6
commit e36d6ab24b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 31 additions and 42 deletions

View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015-2016, 2022-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015-2016, 2022-2023, 2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
@ -448,12 +448,14 @@ rolname = '" ,name "')) as not_exists;\n"
(one-shot? #t) (one-shot? #t)
(start (start
#~(lambda args #~(lambda args
(let ((pid (fork+exec-command (zero? (spawn-command
#$(postgresql-create-roles config) #$(postgresql-create-roles config)
#:user "postgres" #:user "postgres"
#:group "postgres" #:group "postgres"
#:log-file #$log))) ;; XXX: As of Shepherd 1.0.2, #:log-file is not
(zero? (cdr (waitpid pid)))))) ;; supported.
;; #:log-file #$log
))))
(documentation "Create PostgreSQL roles."))))) (documentation "Create PostgreSQL roles.")))))
(define postgresql-role-service-type (define postgresql-role-service-type

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013-2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 John Darrington <jmd@gnu.org> ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
@ -390,18 +390,18 @@
'())) '()))
(false-if-exception (delete-file #$pid-file)) (false-if-exception (delete-file #$pid-file))
(let ((pid (fork+exec-command (let ((status (spawn-command
;; By default dhclient uses a ;; By default dhclient uses a
;; pre-standardization implementation of ;; pre-standardization implementation of
;; DDNS, which is incompatable with ;; DDNS, which is incompatable with
;; non-ISC DHCP servers; thus, pass '-I'. ;; non-ISC DHCP servers; thus, pass '-I'.
;; <https://kb.isc.org/docs/aa-01091>. ;; <https://kb.isc.org/docs/aa-01091>.
`(,dhclient "-nw" "-I" `(,dhclient "-nw" "-I"
#$(string-append "-" version) #$(string-append "-" version)
"-pf" ,#$pid-file "-pf" ,#$pid-file
,@config-file-args ,@config-file-args
,@ifaces)))) ,@ifaces))))
(and (zero? (cdr (waitpid pid))) (and (zero? status)
(read-pid-file #$pid-file))))) (read-pid-file #$pid-file)))))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor)))))))
(package (package

View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015-2023, 2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Nikita <nikita@n0.is> ;;; Copyright © 2016 Nikita <nikita@n0.is>
;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017, 2018, 2019 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2017, 2018, 2019 Christopher Baines <mail@cbaines.net>
@ -1902,27 +1902,14 @@ WSGIPassAuthorization On
(define (patchwork-django-admin-gexp patchwork settings-module) (define (patchwork-django-admin-gexp patchwork settings-module)
#~(lambda command #~(lambda command
(let ((pid (primitive-fork)) (zero? (spawn-command
(user (getpwnam "httpd"))) `(#$(file-append patchwork "/bin/patchwork-admin")
(if (eq? pid 0) ,command)
(dynamic-wind #:user "httpd"
(const #t) #:group "httpd"
(lambda () #:environment-variables
(setgid (passwd:gid user)) `("DJANGO_SETTINGS_MODULE=guix.patchwork.settings"
(setuid (passwd:uid user)) ,(string-append "PYTHONPATH=" #$settings-module))))))
(setenv "DJANGO_SETTINGS_MODULE" "guix.patchwork.settings")
(setenv "PYTHONPATH" #$settings-module)
(primitive-exit
(if (zero?
(apply system*
#$(file-append patchwork "/bin/patchwork-admin")
command))
0
1)))
(lambda ()
(primitive-exit 1)))
(zero? (cdr (waitpid pid)))))))
(define (patchwork-django-admin-action patchwork settings-module) (define (patchwork-django-admin-action patchwork settings-module)
(shepherd-action (shepherd-action