diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-11-10 18:14:20 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-11-10 22:42:14 +0100 |
| commit | ccea821befc96a2c5e0c64b1a18eef0f31abe0a7 (patch) | |
| tree | 96eb82811452b7762690ef6fa90cbc393a4e2348 | |
| parent | 7eda0c567baf1505ba918539d2095e08f328b466 (diff) | |
syscalls: Add 'mount-points'.
* guix/build/syscalls.scm (mount-points): New procedure.
* tests/syscalls.scm ("mount-points"): New test.
| -rw-r--r-- | guix/build/syscalls.scm | 13 | ||||
| -rw-r--r-- | tests/syscalls.scm | 3 |
2 files changed, 16 insertions, 0 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 7e5245fcc6..9765820836 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -31,6 +31,7 @@ MS_MOVE mount umount + mount-points swapon swapoff processes @@ -166,6 +167,18 @@ constants from <sys/mount.h>." (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)))) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 161e036e19..d65ec82740 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -44,6 +44,9 @@ ;; 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 () |