diff options
-rw-r--r-- | gnu/build/linux-container.scm | 4 | ||||
-rw-r--r-- | guix/scripts/container/exec.scm | 10 | ||||
-rw-r--r-- | tests/containers.scm | 7 |
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*" |