diff options
| -rw-r--r-- | guix/build/syscalls.scm | 26 | ||||
| -rw-r--r-- | tests/syscalls.scm | 16 |
2 files changed, 42 insertions, 0 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index c8ec13983b..f910ebd152 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -31,6 +31,8 @@ MS_MOVE mount umount + swapon + swapoff processes IFF_UP @@ -164,6 +166,30 @@ constants from <sys/mount.h>." (when update-mtab? (remove-from-mtab target)))))) +(define swapon + (let* ((ptr (dynamic-func "swapon" (dynamic-link))) + (proc (pointer->procedure int ptr (list '* int)))) + (lambda* (device #:optional (flags 0)) + "Use the block special device at DEVICE for swapping." + (let ((ret (proc (string->pointer device) flags)) + (err (errno))) + (unless (zero? ret) + (throw 'system-error "swapon" "~S: ~A" + (list device (strerror err)) + (list err))))))) + +(define swapoff + (let* ((ptr (dynamic-func "swapoff" (dynamic-link))) + (proc (pointer->procedure int ptr '(*)))) + (lambda (device) + "Stop using block special device DEVICE for swapping." + (let ((ret (proc (string->pointer device))) + (err (errno))) + (unless (zero? ret) + (throw 'system-error "swapff" "~S: ~A" + (list device (strerror err)) + (list err))))))) + (define (kernel? pid) "Return #t if PID designates a \"kernel thread\" rather than a normal user-land process." diff --git a/tests/syscalls.scm b/tests/syscalls.scm index b1dc298a14..51846d3c36 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -44,6 +44,22 @@ ;; Both return values have been encountered in the wild. (memv (system-error-errno args) (list EPERM ENOENT))))) +(test-assert "swapon, ENOENT/EPERM" + (catch 'system-error + (lambda () + (swapon "/does-not-exist") + #f) + (lambda args + (memv (system-error-errno args) (list EPERM ENOENT))))) + +(test-assert "swapoff, EINVAL/EPERM" + (catch 'system-error + (lambda () + (swapoff "/does-not-exist") + #f) + (lambda args + (memv (system-error-errno args) (list EPERM EINVAL))))) + (test-assert "all-network-interfaces" (match (all-network-interfaces) (((? string? names) ..1) |