shepherd: Remove dependency on (guix utils).

Since commit 8ce6f4dc2879919c12bc76a2f4b01200af97e019, importing this
module in a gexp would pull in (guix config) from the host, thereby
leading to non-reproducible derivations.  Users in (gnu services ...) do
not expect that so simply remove the (guix utils) dependency for now.

* gnu/build/shepherd.scm (fork+exec-command/container)[strip-pid]: New
procedure.
Use it instead of 'strip-keyword-arguments'.
This commit is contained in:
Ludovic Courtès 2020-11-05 15:26:57 +01:00
parent ca465a9c84
commit e6934c0429
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

@ -21,7 +21,6 @@
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu build linux-container) #:use-module (gnu build linux-container)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -199,11 +198,24 @@ namespace, in addition to essential bind-mounts such /proc."
"This is a variant of 'fork+exec-command' procedure, that joins the "This is a variant of 'fork+exec-command' procedure, that joins the
namespaces of process PID beforehand. If there is no support for containers, namespaces of process PID beforehand. If there is no support for containers,
on Hurd systems for instance, fallback to direct forking." on Hurd systems for instance, fallback to direct forking."
(define (strip-pid args)
;; TODO: Replace with 'strip-keyword-arguments' when that no longer pulls
;; in (guix config).
(let loop ((args args)
(result '()))
(match args
(()
(reverse result))
((#:pid _ . rest)
(loop rest result))
((head . rest)
(loop rest (cons head result))))))
(let ((container-support? (let ((container-support?
(file-exists? "/proc/self/ns")) (file-exists? "/proc/self/ns"))
(fork-proc (lambda () (fork-proc (lambda ()
(apply fork+exec-command command (apply fork+exec-command command
(strip-keyword-arguments '(#:pid) args))))) (strip-pid args)))))
(if container-support? (if container-support?
(container-excursion* pid fork-proc) (container-excursion* pid fork-proc)
(fork-proc)))) (fork-proc))))