linux-container: "run-container" scripts shows the container's PID.

* gnu/build/linux-container.scm (call-with-container): Add
 #:process-spawned-hook and honor it.
* gnu/system/linux-container.scm (container-script)[script]:
Define 'explain' and pass it as #:process-spawned-hook'.
This commit is contained in:
Ludovic Courtès 2019-09-12 23:06:12 +02:00
parent 3d8424a5ad
commit d236cd16a7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 4 deletions

View File

@ -299,8 +299,10 @@ delete it when leaving the dynamic extent of this call."
(false-if-exception (delete-file-recursively tmp-dir)))))) (false-if-exception (delete-file-recursively tmp-dir))))))
(define* (call-with-container mounts thunk #:key (namespaces %namespaces) (define* (call-with-container mounts thunk #:key (namespaces %namespaces)
(host-uids 1) (guest-uid 0) (guest-gid 0)) (host-uids 1) (guest-uid 0) (guest-gid 0)
"Run THUNK in a new container process and return its exit status. (process-spawned-hook (const #t)))
"Run THUNK in a new container process and return its exit status; call
PROCESS-SPAWNED-HOOK with the PID of the new process that has been spawned.
MOUNTS is a list of <file-system> objects that specify file systems to mount MOUNTS is a list of <file-system> objects that specify file systems to mount
inside the container. NAMESPACES is a list of symbols corresponding to inside the container. NAMESPACES is a list of symbols corresponding to
the identifiers for Linux namespaces: mnt, ipc, uts, pid, user, and net. By the identifiers for Linux namespaces: mnt, ipc, uts, pid, user, and net. By
@ -329,6 +331,7 @@ load path must be adjusted as needed."
(false-if-exception (false-if-exception
(kill pid SIGKILL)))) (kill pid SIGKILL))))
(process-spawned-hook pid)
(match (waitpid pid) (match (waitpid pid)
((_ . status) status)))))) ((_ . status) status))))))

View File

@ -171,11 +171,15 @@ that will be shared with the host system."
(define script (define script
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((guix build utils) '((guix build utils)
(gnu build linux-container))) (gnu build linux-container)
(guix i18n)
(guix diagnostics)))
#~(begin #~(begin
(use-modules (gnu build linux-container) (use-modules (gnu build linux-container)
(gnu system file-systems) ;spec->file-system (gnu system file-systems) ;spec->file-system
(guix build utils) (guix build utils)
(guix i18n)
(guix diagnostics)
(srfi srfi-1)) (srfi srfi-1))
(define file-systems (define file-systems
@ -187,6 +191,16 @@ that will be shared with the host system."
fs))) fs)))
'#$specs)) '#$specs))
(define (explain pid)
;; XXX: We can't quite call 'bindtextdomain' so there's actually
;; no i18n.
(info (G_ "system container is running as PID ~a~%") pid)
;; XXX: Should we recommend 'guix container exec'? It's more
;; verbose and doesn't bring much.
(info (G_ "Run 'sudo nsenter -a -t ~a' to get a shell into it.~%")
pid)
(newline (guix-warning-port)))
(call-with-container file-systems (call-with-container file-systems
(lambda () (lambda ()
(setenv "HOME" "/root") (setenv "HOME" "/root")
@ -201,7 +215,8 @@ that will be shared with the host system."
#:host-uids 65536 #:host-uids 65536
#:namespaces (if #$shared-network? #:namespaces (if #$shared-network?
(delq 'net %namespaces) (delq 'net %namespaces)
%namespaces))))) %namespaces)
#:process-spawned-hook explain))))
(gexp->script "run-container" script))) (gexp->script "run-container" script)))