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 <[email protected]>

3 files changed, 31 insertions, 42 deletions

diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index e8a4acc996..6530c6f0a1 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <[email protected]>
-;;; Copyright © 2015-2016, 2022-2023 Ludovic Courtès <[email protected]>
+;;; Copyright © 2015-2016, 2022-2023, 2025 Ludovic Courtès <[email protected]>
 ;;; Copyright © 2016 Leo Famulari <[email protected]>
 ;;; Copyright © 2017 Christopher Baines <[email protected]>
 ;;; Copyright © 2018 Clément Lassieur <[email protected]>
@@ -448,12 +448,14 @@ rolname = '" ,name "')) as not_exists;\n"
            (one-shot? #t)
            (start
             #~(lambda args
-                (let ((pid (fork+exec-command
-                            #$(postgresql-create-roles config)
-                            #:user "postgres"
-                            #:group "postgres"
-                            #:log-file #$log)))
-                  (zero? (cdr (waitpid pid))))))
+                (zero? (spawn-command
+                        #$(postgresql-create-roles config)
+                        #:user "postgres"
+                        #:group "postgres"
+                        ;; XXX: As of Shepherd 1.0.2, #:log-file is not
+                        ;; supported.
+                        ;; #:log-file #$log
+                        ))))
            (documentation "Create PostgreSQL roles.")))))
 
 (define postgresql-role-service-type
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index b9a5bef5d8..f7c2471535 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2024 Ludovic Courtès <[email protected]>
+;;; Copyright © 2013-2025 Ludovic Courtès <[email protected]>
 ;;; Copyright © 2015 Mark H Weaver <[email protected]>
 ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <[email protected]>
 ;;; Copyright © 2016 John Darrington <[email protected]>
@@ -390,18 +390,18 @@
                                  '()))
 
                            (false-if-exception (delete-file #$pid-file))
-                           (let ((pid (fork+exec-command
-                                       ;; By default dhclient uses a
-                                       ;; pre-standardization implementation of
-                                       ;; DDNS, which is incompatable with
-                                       ;; non-ISC DHCP servers; thus, pass '-I'.
-                                       ;; <https://kb.isc.org/docs/aa-01091>.
-                                       `(,dhclient "-nw" "-I"
-                                                   #$(string-append "-" version)
-                                                   "-pf" ,#$pid-file
-                                                   ,@config-file-args
-                                                   ,@ifaces))))
-                             (and (zero? (cdr (waitpid pid)))
+                           (let ((status (spawn-command
+                                          ;; By default dhclient uses a
+                                          ;; pre-standardization implementation of
+                                          ;; DDNS, which is incompatable with
+                                          ;; non-ISC DHCP servers; thus, pass '-I'.
+                                          ;; <https://kb.isc.org/docs/aa-01091>.
+                                          `(,dhclient "-nw" "-I"
+                                                      #$(string-append "-" version)
+                                                      "-pf" ,#$pid-file
+                                                      ,@config-file-args
+                                                      ,@ifaces))))
+                             (and (zero? status)
                                   (read-pid-file #$pid-file)))))
                 (stop #~(make-kill-destructor)))))))
     (package
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index f5de5997ac..d42ef09c3c 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <[email protected]>
-;;; Copyright © 2015-2023 Ludovic Courtès <[email protected]>
+;;; Copyright © 2015-2023, 2025 Ludovic Courtès <[email protected]>
 ;;; Copyright © 2016 Nikita <[email protected]>
 ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <[email protected]>
 ;;; Copyright © 2017, 2018, 2019 Christopher Baines <[email protected]>
@@ -1902,27 +1902,14 @@ WSGIPassAuthorization On
 
 (define (patchwork-django-admin-gexp patchwork settings-module)
   #~(lambda command
-      (let ((pid (primitive-fork))
-            (user (getpwnam "httpd")))
-        (if (eq? pid 0)
-            (dynamic-wind
-              (const #t)
-              (lambda ()
-                (setgid (passwd:gid user))
-                (setuid (passwd:uid user))
-
-                (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)))))))
+      (zero? (spawn-command
+              `(#$(file-append patchwork "/bin/patchwork-admin")
+                ,command)
+              #:user "httpd"
+              #:group "httpd"
+              #:environment-variables
+              `("DJANGO_SETTINGS_MODULE=guix.patchwork.settings"
+                ,(string-append "PYTHONPATH=" #$settings-module))))))
 
 (define (patchwork-django-admin-action patchwork settings-module)
   (shepherd-action