From 715fc9d44d284a0c5e1ded45091eaf979aa5ecd4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 18 Sep 2014 20:19:56 +0200 Subject: [PATCH] syscalls: Add 'swapon' and 'swapoff'. * guix/build/syscalls.scm (swapon, swapoff): New procedures. * tests/syscalls.scm ("swapon, ENOENT/EPERM", "swapoff, EINVAL/EPERM"): New tests. --- guix/build/syscalls.scm | 26 ++++++++++++++++++++++++++ tests/syscalls.scm | 16 ++++++++++++++++ 2 files changed, 42 insertions(+) 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 ." (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)