syscalls: Add 'mount-points'.

* guix/build/syscalls.scm (mount-points): New procedure.
* tests/syscalls.scm ("mount-points"): New test.
This commit is contained in:
Ludovic Courtès 2014-11-10 18:14:20 +01:00
parent 7eda0c567b
commit ccea821bef
2 changed files with 16 additions and 0 deletions

View file

@ -31,6 +31,7 @@ (define-module (guix build syscalls)
MS_MOVE
mount
umount
mount-points
swapon
swapoff
processes
@ -166,6 +167,18 @@ (define umount
(when update-mtab?
(remove-from-mtab target))))))
(define (mount-points)
"Return the mounts points for currently mounted file systems."
(call-with-input-file "/proc/mounts"
(lambda (port)
(let loop ((result '()))
(let ((line (read-line port)))
(if (eof-object? line)
(reverse result)
(match (string-tokenize line)
((source mount-point _ ...)
(loop (cons mount-point result))))))))))
(define swapon
(let* ((ptr (dynamic-func "swapon" (dynamic-link)))
(proc (pointer->procedure int ptr (list '* int))))

View file

@ -44,6 +44,9 @@ (define-module (test-syscalls)
;; Both return values have been encountered in the wild.
(memv (system-error-errno args) (list EPERM ENOENT)))))
(test-assert "mount-points"
(member "/" (mount-points)))
(test-assert "swapon, ENOENT/EPERM"
(catch 'system-error
(lambda ()