1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00

linux-container: Add 'container-excursion*'.

* gnu/build/linux-container.scm (container-excursion*): New procedure.
* tests/containers.scm ("container-excursion*")
("container-excursion*, same namespaces"): New tests.
This commit is contained in:
Ludovic Courtès
2017-02-06 23:45:00 +01:00
parent b9a5efa596
commit c90db25f4c
2 changed files with 48 additions and 1 deletions

View File

@@ -180,4 +180,31 @@
(lambda ()
(primitive-exit 42))))
(skip-if-unsupported)
(test-assert "container-excursion*"
(call-with-temporary-directory
(lambda (root)
(define (namespaces pid)
(let ((pid (number->string pid)))
(map (lambda (ns)
(readlink (string-append "/proc/" pid "/ns/" ns)))
'("user" "ipc" "uts" "net" "pid" "mnt"))))
(let* ((pid (run-container root '()
%namespaces 1
(lambda ()
(sleep 100))))
(result (container-excursion* pid
(lambda ()
(namespaces 1)))))
(kill pid SIGKILL)
(equal? result (namespaces pid))))))
(skip-if-unsupported)
(test-equal "container-excursion*, same namespaces"
42
(container-excursion* (getpid)
(lambda ()
(* 6 7))))
(test-end)