[bug#67175] [PATCH 9/9] shepherd: Remove ‘make-forkexec-constructor/container’.

["Ludovic Courtès" <ludo@gnu.org>]

This was superseded by ‘least-authority-wrapper’.

* gnu/build/shepherd.scm (read-pid-file/container)
(make-forkexec-constructor/container): Remove.

Change-Id: I6acccdff2609a35807608f865a4d381146113a88
---
 gnu/build/shepherd.scm | 90 ------------------------------------------
 1 file changed, 90 deletions(-)

diff --git a/gnu/build/shepherd.scm b/gnu/build/shepherd.scm
index 9d9bfcfbc0..4ead27be0b 100644
--- a/gnu/build/shepherd.scm
+++ b/gnu/build/shepherd.scm
@@ -33,7 +33,6 @@ (define-module (gnu build shepherd)
                                  %precious-signals)
   #:autoload (shepherd system) (unblock-signals)
   #:export (default-mounts
-            make-forkexec-constructor/container
             fork+exec-command/container))
 
 ;;; Commentary:
@@ -101,27 +100,6 @@ (define* (default-mounts #:key (namespaces (default-namespaces '())))
                            (file-exists? (file-system-mapping-source mapping)))
                          mappings)))))
 
-(define* (read-pid-file/container pid pid-file #:key (max-delay 5))
-  "Read PID-FILE in the container namespaces of PID, which exists in a
-separate mount and PID name space.  Return the \"outer\" PID. "
-  (match (container-excursion* pid
-           (lambda ()
-             ;; XXX: Trick for Shepherd 0.9: prevent 'read-pid-file' from
-             ;; using (@ (fibers) sleep), which would try to suspend the
-             ;; current task, which doesn't work in this extra process.
-             (with-continuation-barrier
-              (lambda ()
-                (read-pid-file pid-file
-                               #:max-delay max-delay)))))
-    (#f
-     ;; Send SIGTERM to the whole process group.
-     (catch-system-error (kill (- pid) SIGTERM))
-     #f)
-    ((? integer? container-pid)
-     ;; XXX: When COMMAND is started in a separate PID namespace, its
-     ;; PID is always 1, but that's not what Shepherd needs to know.
-     pid)))
-
 (define* (exec-command* command #:key user group log-file pid-file
                         (supplementary-groups '())
                         (directory "/") (environment-variables (environ)))
@@ -144,74 +122,6 @@ (define* (exec-command* command #:key user group log-file pid-file
                 #:directory directory
                 #:environment-variables environment-variables))
 
-(define* (make-forkexec-constructor/container command
-                                              #:key
-                                              (namespaces
-                                               (default-namespaces args))
-                                              (mappings '())
-                                              (user #f)
-                                              (group #f)
-                                              (supplementary-groups '())
-                                              (log-file #f)
-                                              pid-file
-                                              (pid-file-timeout 5)
-                                              (directory "/")
-                                              (environment-variables
-                                               (environ))
-                                              #:rest args)
-  "This is a variant of 'make-forkexec-constructor' that starts COMMAND in
-NAMESPACES, a list of Linux namespaces such as '(mnt ipc).  MAPPINGS is the
-list of <file-system-mapping> to make in the case of a separate mount
-namespace, in addition to essential bind-mounts such /proc."
-  (define container-directory
-    (match command
-      ((program _  ...)
-       (string-append "/var/run/containers/" (basename program)))))
-
-  (define auto-mappings
-    `(,@(if log-file
-            (list (file-system-mapping
-                   (source log-file)
-                   (target source)
-                   (writable? #t)))
-            '())))
-
-  (define mounts
-    (append (map file-system-mapping->bind-mount
-                 (append auto-mappings mappings))
-            (default-mounts #:namespaces namespaces)))
-
-  (lambda args
-    (mkdir-p container-directory)
-
-    (when log-file
-      ;; Create LOG-FILE so we can map it in the container.
-      (unless (file-exists? log-file)
-        (close (open log-file (logior O_CREAT O_APPEND O_CLOEXEC) #o640))
-        (when user
-          (let ((pw (getpwnam user)))
-            (chown log-file (passwd:uid pw) (passwd:gid pw))))))
-
-    (let ((pid (run-container container-directory
-                              mounts namespaces 1
-                              (lambda ()
-                                (exec-command* command
-                                               #:user user
-                                               #:group group
-                                               #:supplementary-groups
-                                               supplementary-groups
-                                               #:pid-file pid-file
-                                               #:log-file log-file
-                                               #:directory directory
-                                               #:environment-variables
-                                               environment-variables)))))
-      (if pid-file
-          (if (or (memq 'mnt namespaces) (memq 'pid namespaces))
-              (read-pid-file/container pid pid-file
-                                       #:max-delay pid-file-timeout)
-              (read-pid-file pid-file #:max-delay pid-file-timeout))
-          pid))))
-
 (define* (fork+exec-command/container command
                                       #:key pid
                                       #:allow-other-keys
-- 
2.41.0