container: Correctly report exit status.

* gnu/build/linux-container.scm (container-excursion): Return the raw
status value.
* tests/containers.scm ("container-excursion, same namespaces"): Add
'status:exit-val' call.
* guix/scripts/container/exec.scm (guix-container-exec): Correctly
handle the different cases.

gnu/build/linux-container.scm

@@ -404,7 +404,7 @@ (define (relay-signal signal)
 
 (define (container-excursion pid thunk)
   "Run THUNK as a child process within the namespaces of process PID and
-return the exit status."
+return the exit status, an integer as returned by 'waitpid'."
   (define (namespace-file pid namespace)
     (string-append "/proc/" (number->string pid) "/ns/" namespace))
 
@@ -436,7 +436,7 @@ (define (namespace-file pid namespace)
     (pid
      (match (waitpid pid)
        ((_ . status)
-        (status:exit-val status))))))
+        status)))))
 
 (define (container-excursion* pid thunk)
   "Like 'container-excursion', but return the return value of THUNK."

guix/scripts/container/exec.scm

@@ -102,4 +102,12 @@ (define (handle-argument arg result)
                                        environment)
                              (apply execlp program program program-args)))))))
           (unless (zero? result)
-            (leave (G_ "exec failed with status ~d~%") result)))))))
+            (match (status:exit-val result)
+              (#f
+               (if (status:term-sig result)
+                   (leave (G_ "process terminated with signal ~a~%")
+                          (status:term-sig result))
+                   (leave (G_ "process stopped with signal ~a~%")
+                          (status:stop-sig result))))
+              (code
+               (leave (G_ "process exited with status ~d~%") code)))))))))

tests/containers.scm

@@ -203,9 +203,10 @@ (define (namespaces pid)
   42
   ;; The parent and child are in the same namespaces.  'container-excursion'
   ;; should notice that and avoid calling 'setns' since that would fail.
+  (status:exit-val
    (container-excursion (getpid)
      (lambda ()
-      (primitive-exit 42))))
+       (primitive-exit 42)))))
 
 (skip-if-unsupported)
 (test-assert "container-excursion*"