syscalls: Add 'mount-points'.
* guix/build/syscalls.scm (mount-points): New procedure. * tests/syscalls.scm ("mount-points"): New test.master
parent
7eda0c567b
commit
ccea821bef
|
@ -31,6 +31,7 @@
|
||||||
MS_MOVE
|
MS_MOVE
|
||||||
mount
|
mount
|
||||||
umount
|
umount
|
||||||
|
mount-points
|
||||||
swapon
|
swapon
|
||||||
swapoff
|
swapoff
|
||||||
processes
|
processes
|
||||||
|
@ -166,6 +167,18 @@ constants from <sys/mount.h>."
|
||||||
(when update-mtab?
|
(when update-mtab?
|
||||||
(remove-from-mtab target))))))
|
(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
|
(define swapon
|
||||||
(let* ((ptr (dynamic-func "swapon" (dynamic-link)))
|
(let* ((ptr (dynamic-func "swapon" (dynamic-link)))
|
||||||
(proc (pointer->procedure int ptr (list '* int))))
|
(proc (pointer->procedure int ptr (list '* int))))
|
||||||
|
|
|
@ -44,6 +44,9 @@
|
||||||
;; Both return values have been encountered in the wild.
|
;; Both return values have been encountered in the wild.
|
||||||
(memv (system-error-errno args) (list EPERM ENOENT)))))
|
(memv (system-error-errno args) (list EPERM ENOENT)))))
|
||||||
|
|
||||||
|
(test-assert "mount-points"
|
||||||
|
(member "/" (mount-points)))
|
||||||
|
|
||||||
(test-assert "swapon, ENOENT/EPERM"
|
(test-assert "swapon, ENOENT/EPERM"
|
||||||
(catch 'system-error
|
(catch 'system-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
|
Loading…
Reference in New Issue