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:
parent
ca465a9c84
commit
e6934c0429
@ -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))))
|
||||||
|
Loading…
Reference in New Issue
Block a user