[functional-tests] more work on the dm-ioctl bindings
This commit is contained in:
parent
742629fb8d
commit
5e2cd1e9f2
@ -144,6 +144,7 @@ static int dlb_append(struct dev_list_builder *dlb,
|
||||
if (!dl)
|
||||
return -ENOMEM;
|
||||
|
||||
dl->next = NULL;
|
||||
dl->major = major;
|
||||
dl->minor = minor;
|
||||
dl->name = strdup(name);
|
||||
@ -266,8 +267,8 @@ int dm_list_devices(struct dm_interface *dmi, struct dev_list **devs)
|
||||
if (!ctl)
|
||||
return -ENOMEM;
|
||||
}
|
||||
free_ctl(ctl);
|
||||
|
||||
free_ctl(ctl);
|
||||
return r;
|
||||
}
|
||||
|
||||
|
@ -5,7 +5,11 @@
|
||||
dm-close
|
||||
with-dm
|
||||
|
||||
get-version)
|
||||
get-version
|
||||
remove-all
|
||||
list-devices
|
||||
|
||||
create-device)
|
||||
|
||||
(import (chezscheme)
|
||||
(fmt fmt)
|
||||
@ -46,8 +50,6 @@
|
||||
|
||||
(define-record-type dm-version (fields major minor patch))
|
||||
|
||||
(define-ftype PtrU32 (* unsigned-32))
|
||||
|
||||
(define (get-version dm)
|
||||
(define get
|
||||
(foreign-procedure "dm_version" ((* DMIoctlInterface)
|
||||
@ -65,14 +67,140 @@
|
||||
(let ((major (alloc-u32))
|
||||
(minor (alloc-u32))
|
||||
(patch (alloc-u32)))
|
||||
(get dm major minor patch)
|
||||
(let ((r (make-dm-version (deref-u32 major)
|
||||
(deref-u32 minor)
|
||||
(deref-u32 patch))))
|
||||
(foreign-free (ftype-pointer-address major))
|
||||
(foreign-free (ftype-pointer-address minor))
|
||||
(foreign-free (ftype-pointer-address patch))
|
||||
r)))
|
||||
(if (zero? (get dm major minor patch))
|
||||
(let ((r (make-dm-version (deref-u32 major)
|
||||
(deref-u32 minor)
|
||||
(deref-u32 patch))))
|
||||
(foreign-free (ftype-pointer-address major))
|
||||
(foreign-free (ftype-pointer-address minor))
|
||||
(foreign-free (ftype-pointer-address patch))
|
||||
r)
|
||||
(fail "couldn't get dm version"))))
|
||||
|
||||
(define (remove-all dm)
|
||||
(define do-it
|
||||
(foreign-procedure "dm_remove_all" ((* DMIoctlInterface)) int))
|
||||
|
||||
(let ((r (do-it dm)))
|
||||
(unless (zero? r)
|
||||
(fail "remove-all failed"))))
|
||||
|
||||
(define-ftype DevList
|
||||
(struct
|
||||
(next (* DevList))
|
||||
(major unsigned)
|
||||
(minor unsigned)
|
||||
(name (* unsigned-8))))
|
||||
|
||||
(define-ftype DevListPtr (* DevList))
|
||||
|
||||
(define-record-type device-details
|
||||
(fields name major minor))
|
||||
|
||||
(define (cstring->string str)
|
||||
(let loop ((i 0)
|
||||
(acc '()))
|
||||
(let ((c (ftype-ref unsigned-8 () str i)))
|
||||
(if (zero? c)
|
||||
(list->string (reverse acc))
|
||||
(loop (+ i 1) (cons (integer->char c) acc))))))
|
||||
|
||||
(define (string->cstring str)
|
||||
(let* ((len (string-length str))
|
||||
(cstr (make-ftype-pointer unsigned-8
|
||||
(foreign-alloc (+ 1 len)))))
|
||||
(let loop ((i 0))
|
||||
(if (= i len)
|
||||
(begin
|
||||
(ftype-set! unsigned-8 () cstr i 0)
|
||||
cstr)
|
||||
(ftype-set! unsigned-8 () cstr i (string-ref str i))))))
|
||||
|
||||
;;; FIXME: put a dynamic wind in to ensure the dev list gets freed
|
||||
(define (list-devices dm)
|
||||
(define list-devs
|
||||
(foreign-procedure "dm_list_devices" ((* DMIoctlInterface) (* DevListPtr)) int))
|
||||
|
||||
(let ((pp (make-ftype-pointer DevListPtr
|
||||
(foreign-alloc (ftype-sizeof DevListPtr)))))
|
||||
(if (zero? (list-devs dm pp))
|
||||
(let loop ((dl (ftype-ref DevListPtr () pp))
|
||||
(acc '()))
|
||||
;(fmt #t "dl: " dl ", acc: " acc)
|
||||
(if (ftype-pointer-null? dl)
|
||||
acc
|
||||
(loop (ftype-ref DevList (next) dl)
|
||||
(cons (make-device-details
|
||||
(cstring->string (ftype-ref DevList (name) dl))
|
||||
(ftype-ref DevList (major) dl)
|
||||
(ftype-ref DevList (minor) dl))
|
||||
acc))))
|
||||
(fail "dm_list_devices ioctl failed"))))
|
||||
|
||||
(define (create-device dm name uuid)
|
||||
(define create
|
||||
(foreign-procedure "dm_create_device" ((* DMIoctlInterface) string string) int))
|
||||
|
||||
(unless (zero? (create dm name uuid))
|
||||
(fail "create-device failed")))
|
||||
|
||||
(define-syntax define-dev-cmd
|
||||
(syntax-rules ()
|
||||
((_ nm proc)
|
||||
(define (nm dm name)
|
||||
(define fn
|
||||
(foreign-procedure proc ((* DMIoctlInterface) string) int))
|
||||
|
||||
(unless (zero? (fn dm name))
|
||||
(fail (string-append proc " failed")))))))
|
||||
|
||||
(define-dev-cmd remove-device "dm_remove_device")
|
||||
(define-dev-cmd suspend-device "dm_suspend_device")
|
||||
(define-dev-cmd resume-device "dm_resume_device")
|
||||
(define-dev-cmd clear-device "dm_clear_device")
|
||||
|
||||
(define-ftype Target
|
||||
(struct
|
||||
(next (* Target))
|
||||
(len unsigned-64)
|
||||
(type (* unsigned-8))
|
||||
(args (* unsigned-8))))
|
||||
|
||||
(define-ftype TargetPtr (* Target))
|
||||
(define-record-type target
|
||||
(fields (mutable len) (mutable type) (mutable args)))
|
||||
|
||||
(define (build-c-target next len type args)
|
||||
(let ((t (make-ftype-pointer Target
|
||||
(foreign-alloc
|
||||
(ftype-sizeof Target)))))
|
||||
(ftype-set! Target (next) t next)
|
||||
(ftype-set! Target (len) t len)
|
||||
(ftype-set! Target (type) t (string->cstring type))
|
||||
(ftype-set! Target (args) t (string->cstring args))))
|
||||
|
||||
(define (build-c-targets targets)
|
||||
(let loop ((t targets)
|
||||
(tail (make-ftype-pointer Target 0)))
|
||||
(if (null? t)
|
||||
tail
|
||||
(loop (cdr targets)
|
||||
(build-c-target tail (target-len t) (target-type t) (target-args t))))))
|
||||
|
||||
(define (free-c-targets t)
|
||||
(let loop ((t t)
|
||||
(acc '()))
|
||||
(if (ftype-pointer-null? t)
|
||||
(map foreign-free acc)
|
||||
(loop (ftype-ref Target (next) t) (cons t acc)))))
|
||||
|
||||
(define (load-table dm name targets)
|
||||
(define load
|
||||
(foreign-procedure "dm_load" ((* DMIoctlInterface) string (* Target)) int))
|
||||
|
||||
(let* ((ctargets (build-c-targets targets))
|
||||
(r (load dm name ctargets)))
|
||||
(free-c-targets ctargets)
|
||||
(unless (zero? r)
|
||||
(fail "dm_load failed"))))
|
||||
)
|
||||
|
Loading…
Reference in New Issue
Block a user