ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

shepherd: Remove ‘make-forkexec-constructor/container’.

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

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

Change-Id: I6acccdff2609a35807608f865a4d381146113a88
This commit is contained in:
Ludovic Courtès 2023-11-14 11:49:56 +01:00
parent 3d6583727e
commit ca81317389
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 0 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

90
gnu/build/shepherd.scm
View file

@ -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 accounts
(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