aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/linux-container.scm4
-rw-r--r--guix/scripts/container/exec.scm10
-rw-r--r--tests/containers.scm7
3 files changed, 15 insertions, 6 deletions
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 72e3a45422..d11c49c0d8 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -404,7 +404,7 @@ load path must be adjusted as needed."
(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 @@ return the exit status."
(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."
diff --git a/guix/scripts/container/exec.scm b/guix/scripts/container/exec.scm
index 51b616b384..3e70b1d3c2 100644
--- a/guix/scripts/container/exec.scm
+++ b/guix/scripts/container/exec.scm
@@ -102,4 +102,12 @@ and the other containing arguments for the command to be executed."
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)))))))))
diff --git a/tests/containers.scm b/tests/containers.scm
index 608902c41a..1378b10f22 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -203,9 +203,10 @@
42
;; The parent and child are in the same namespaces. 'container-excursion'
;; should notice that and avoid calling 'setns' since that would fail.
- (container-excursion (getpid)
- (lambda ()
- (primitive-exit 42))))
+ (status:exit-val
+ (container-excursion (getpid)
+ (lambda ()
+ (primitive-exit 42)))))
(skip-if-unsupported)
(test-assert "container-excursion*"