summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/build/syscalls.scm26
-rw-r--r--tests/syscalls.scm16
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)