syscalls: Add 'swapon' and 'swapoff'.

* guix/build/syscalls.scm (swapon, swapoff): New procedures.
* tests/syscalls.scm ("swapon, ENOENT/EPERM", "swapoff, EINVAL/EPERM"):
  New tests.

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)