me/guix
Archived
1
0
Fork 0
Code Activity

syscalls: Add 'swapon' and 'swapoff'.

Browse source 
* guix/build/syscalls.scm (swapon, swapoff): New procedures.
* tests/syscalls.scm ("swapon, ENOENT/EPERM", "swapoff, EINVAL/EPERM"):
  New tests.
This commit is contained in:
Ludovic Courtès 2014-09-18 20:19:56 +02:00
parent 510f9d8624
commit 715fc9d44d
2 changed files with 42 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
guix/build/syscalls.scm
View file

@ -31,6 +31,8 @@
MS_MOVE MS_MOVE
mount mount
umount umount
swapon
swapoff
processes processes
IFF_UP IFF_UP
@ -164,6 +166,30 @@ constants from <sys/mount.h>."
(when update-mtab? (when update-mtab?
(remove-from-mtab target)))))) (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) (define (kernel? pid)
"Return #t if PID designates a \"kernel thread\" rather than a normal "Return #t if PID designates a \"kernel thread\" rather than a normal
user-land process." user-land process."

16
tests/syscalls.scm
View file

@ -44,6 +44,22 @@
;; Both return values have been encountered in the wild. ;; Both return values have been encountered in the wild.
(memv (system-error-errno args) (list EPERM ENOENT))))) (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" (test-assert "all-network-interfaces"
(match (all-network-interfaces) (match (all-network-interfaces)
(((? string? names) ..1) (((? string? names) ..1)