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

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit d236cd16a7173278ca69578d3e7ce4d1ce55e04c
Author: Ludovic Courtès <address@hidden>
Date:   Thu Sep 12 23:06:12 2019 +0200

    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'.
---
 gnu/build/linux-container.scm  |  7 +++++--
 gnu/system/linux-container.scm | 19 +++++++++++++++++--
 2 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 6ccb924..87695c9 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -299,8 +299,10 @@ delete it when leaving the dynamic extent of this call."
         (false-if-exception (delete-file-recursively tmp-dir))))))
 
 (define* (call-with-container mounts thunk #:key (namespaces %namespaces)
-                              (host-uids 1) (guest-uid 0) (guest-gid 0))
-  "Run THUNK in a new container process and return its exit status.
+                              (host-uids 1) (guest-uid 0) (guest-gid 0)
+                              (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
 inside the container.  NAMESPACES is a list of symbols corresponding to
 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
             (kill pid SIGKILL))))
 
+       (process-spawned-hook pid)
        (match (waitpid pid)
          ((_ . status) status))))))
 
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index cca626b..c6124cd 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -171,11 +171,15 @@ that will be shared with the host system."
     (define script
       (with-imported-modules (source-module-closure
                               '((guix build utils)
-                                (gnu build linux-container)))
+                                (gnu build linux-container)
+                                (guix i18n)
+                                (guix diagnostics)))
         #~(begin
             (use-modules (gnu build linux-container)
                          (gnu system file-systems) ;spec->file-system
                          (guix build utils)
+                         (guix i18n)
+                         (guix diagnostics)
                          (srfi srfi-1))
 
             (define file-systems
@@ -187,6 +191,16 @@ that will be shared with the host system."
                                    fs)))
                           '#$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
               (lambda ()
                 (setenv "HOME" "/root")
@@ -201,7 +215,8 @@ that will be shared with the host system."
               #:host-uids 65536
               #:namespaces (if #$shared-network?
                                (delq 'net %namespaces)
-                               %namespaces)))))
+                               %namespaces)
+              #:process-spawned-hook explain))))
 
     (gexp->script "run-container" script)))