build: syscalls: Add setns.

* guix/build/syscalls.scm (setns): New procedure.
* tests/syscalls.scm ("setns"): New test.

squash: setns
This commit is contained in:
David Thompson 2015-06-08 08:43:05 -04:00 committed by David Thompson
parent 8950ed11c6
commit 43ace6ea76
2 changed files with 42 additions and 0 deletions

View file

@ -54,6 +54,7 @@ (define-module (guix build syscalls)
CLONE_NEWPID
CLONE_NEWNET
clone
setns
IFF_UP
IFF_BROADCAST
@ -313,6 +314,21 @@ (define clone
are shared between the parent and child processes."
(proc syscall-id flags %null-pointer))))
(define setns
(let* ((ptr (dynamic-func "setns" (dynamic-link)))
(proc (pointer->procedure int ptr (list int int))))
(lambda (fdes nstype)
"Reassociate the current process with the namespace specified by FDES, a
file descriptor obtained by opening a /proc/PID/ns/* file. NSTYPE specifies
which type of namespace the current process may be reassociated with, or 0 if
there is no such limitation."
(let ((ret (proc fdes nstype))
(err (errno)))
(unless (zero? ret)
(throw 'system-error "setns" "~d ~d: ~A"
(list fdes nstype (strerror err))
(list err)))))))
;;;
;;; Packed structures.

View file

@ -90,6 +90,32 @@ (define (user-namespace pid)
((_ . status)
(= 42 (status:exit-val status))))))))
(test-assert "setns"
(match (clone (logior CLONE_NEWUSER SIGCHLD))
(0 (primitive-exit 0))
(clone-pid
(match (pipe)
((in . out)
(match (primitive-fork)
(0
(close in)
;; Join the user namespace.
(call-with-input-file (user-namespace clone-pid)
(lambda (port)
(setns (port->fdes port) 0)))
(write 'done out)
(close out)
(primitive-exit 0))
(fork-pid
(close out)
;; Wait for the child process to join the namespace.
(read in)
(let ((result (and (equal? (readlink (user-namespace clone-pid))
(readlink (user-namespace fork-pid))))))
;; Clean up.
(waitpid clone-pid)
(waitpid fork-pid)
result))))))))
(test-assert "all-network-interfaces"
(match (all-network-interfaces)