summaryrefslogtreecommitdiff
path: root/gnu/build/shepherd.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-11-14 11:49:56 +0100
committerLudovic Courtès <ludo@gnu.org>2023-12-22 00:31:42 +0100
commitca813173894360edef35a5d98878a3135e99e62a (patch)
treef6d836820013700f4cf5ec01d63b13e0feab5550 /gnu/build/shepherd.scm
parent3d6583727ec90732ad7bd97808fd4fca8f6d8bdc (diff)
shepherd: Remove ‘make-forkexec-constructor/container’.
This was superseded by ‘least-authority-wrapper’. * gnu/build/shepherd.scm (read-pid-file/container) (make-forkexec-constructor/container): Remove. Change-Id: I6acccdff2609a35807608f865a4d381146113a88
Diffstat (limited to 'gnu/build/shepherd.scm')
-rw-r--r--gnu/build/shepherd.scm90
1 files changed, 0 insertions, 90 deletions
diff --git a/gnu/build/shepherd.scm b/gnu/build/shepherd.scm
index 9d9bfcfbc04..4ead27be0be 100644
--- a/gnu/build/shepherd.scm
+++ b/gnu/build/shepherd.scm
@@ -33,7 +33,6 @@
33 %precious-signals) 33 %precious-signals)
34 #:autoload (shepherd system) (unblock-signals) 34 #:autoload (shepherd system) (unblock-signals)
35 #:export (default-mounts 35 #:export (default-mounts
36 make-forkexec-constructor/container
37 fork+exec-command/container)) 36 fork+exec-command/container))
38 37
39;;; Commentary: 38;;; Commentary:
@@ -101,27 +100,6 @@
101 (file-exists? (file-system-mapping-source mapping))) 100 (file-exists? (file-system-mapping-source mapping)))
102 mappings))))) 101 mappings)))))
103 102
104(define* (read-pid-file/container pid pid-file #:key (max-delay 5))
105 "Read PID-FILE in the container namespaces of PID, which exists in a
106separate mount and PID name space. Return the \"outer\" PID. "
107 (match (container-excursion* pid
108 (lambda ()
109 ;; XXX: Trick for Shepherd 0.9: prevent 'read-pid-file' from
110 ;; using (@ (fibers) sleep), which would try to suspend the
111 ;; current task, which doesn't work in this extra process.
112 (with-continuation-barrier
113 (lambda ()
114 (read-pid-file pid-file
115 #:max-delay max-delay)))))
116 (#f
117 ;; Send SIGTERM to the whole process group.
118 (catch-system-error (kill (- pid) SIGTERM))
119 #f)
120 ((? integer? container-pid)
121 ;; XXX: When COMMAND is started in a separate PID namespace, its
122 ;; PID is always 1, but that's not what Shepherd needs to know.
123 pid)))
124
125(define* (exec-command* command #:key user group log-file pid-file 103(define* (exec-command* command #:key user group log-file pid-file
126 (supplementary-groups '()) 104 (supplementary-groups '())
127 (directory "/") (environment-variables (environ))) 105 (directory "/") (environment-variables (environ)))
@@ -144,74 +122,6 @@ shepherd (PID 1)."
144 #:directory directory 122 #:directory directory
145 #:environment-variables environment-variables)) 123 #:environment-variables environment-variables))
146 124
147(define* (make-forkexec-constructor/container command
148 #:key
149 (namespaces
150 (default-namespaces args))
151 (mappings '())
152 (user #f)
153 (group #f)
154 (supplementary-groups '())
155 (log-file #f)
156 pid-file
157 (pid-file-timeout 5)
158 (directory "/")
159 (environment-variables
160 (environ))
161 #:rest args)
162 "This is a variant of 'make-forkexec-constructor' that starts COMMAND in
163NAMESPACES, a list of Linux namespaces such as '(mnt ipc). MAPPINGS is the
164list of <file-system-mapping> to make in the case of a separate mount
165namespace, in addition to essential bind-mounts such /proc."
166 (define container-directory
167 (match command
168 ((program _ ...)
169 (string-append "/var/run/containers/" (basename program)))))
170
171 (define auto-mappings
172 `(,@(if log-file
173 (list (file-system-mapping
174 (source log-file)
175 (target source)
176 (writable? #t)))
177 '())))
178
179 (define mounts
180 (append (map file-system-mapping->bind-mount
181 (append auto-mappings mappings))
182 (default-mounts #:namespaces namespaces)))
183
184 (lambda args
185 (mkdir-p container-directory)
186
187 (when log-file
188 ;; Create LOG-FILE so we can map it in the container.
189 (unless (file-exists? log-file)
190 (close (open log-file (logior O_CREAT O_APPEND O_CLOEXEC) #o640))
191 (when user
192 (let ((pw (getpwnam user)))
193 (chown log-file (passwd:uid pw) (passwd:gid pw))))))
194
195 (let ((pid (run-container container-directory
196 mounts namespaces 1
197 (lambda ()
198 (exec-command* command
199 #:user user
200 #:group group
201 #:supplementary-groups
202 supplementary-groups
203 #:pid-file pid-file
204 #:log-file log-file
205 #:directory directory
206 #:environment-variables
207 environment-variables)))))
208 (if pid-file
209 (if (or (memq 'mnt namespaces) (memq 'pid namespaces))
210 (read-pid-file/container pid pid-file
211 #:max-delay pid-file-timeout)
212 (read-pid-file pid-file #:max-delay pid-file-timeout))
213 pid))))
214
215(define* (fork+exec-command/container command 125(define* (fork+exec-command/container command
216 #:key pid 126 #:key pid
217 #:allow-other-keys 127 #:allow-other-keys