[functional-tests] More work on the dm-ioctl bindings.
This commit is contained in:
Joe Thornber
parent
a0e709d370
commit
d74823fd53
@ -302,13 +302,14 @@ static int dev_cmd(struct dm_interface *dmi, const char *name, int request, unsi
|
||||
{
|
||||
int r;
|
||||
struct dm_ioctl *ctl = alloc_ctl(0);
|
||||
|
||||
ctl->flags = flags;
|
||||
r = copy_name(ctl, name);
|
||||
if (r) {
|
||||
free_ctl(ctl);
|
||||
return -ENOMEM;
|
||||
}
|
||||
r = ioctl(dmi->fd, request);
|
||||
r = ioctl(dmi->fd, request, ctl);
|
||||
free_ctl(ctl);
|
||||
|
||||
return r;
|
||||
@ -372,7 +373,16 @@ static int tb_append(struct target_builder *tb, uint64_t len, char *type, char *
|
||||
t->next = NULL;
|
||||
t->len = len;
|
||||
t->type = strdup(type);
|
||||
if (!t->type) {
|
||||
free(t);
|
||||
return -ENOMEM;
|
||||
}
|
||||
t->args = strdup(args);
|
||||
if (!t->args) {
|
||||
free(t->type);
|
||||
free(t);
|
||||
return -ENOMEM;
|
||||
}
|
||||
|
||||
if (tb->head) {
|
||||
tb->tail->next = t;
|
||||
@ -412,6 +422,7 @@ static int prep_load(struct dm_ioctl *ctl, size_t payload_size,
|
||||
uint64_t current_sector = 0;
|
||||
struct dm_target_spec *spec;
|
||||
|
||||
ctl->target_count = 0;
|
||||
spec = payload(ctl);
|
||||
|
||||
while (t) {
|
||||
@ -423,18 +434,20 @@ static int prep_load(struct dm_ioctl *ctl, size_t payload_size,
|
||||
if (r)
|
||||
return r;
|
||||
|
||||
r = copy_string((char *) spec + 1, t->args, payload_size);
|
||||
r = copy_string((char *) (spec + 1), t->args, payload_size);
|
||||
if (r)
|
||||
return r;
|
||||
|
||||
spec->next = sizeof(*spec) + round_up(strlen(t->args) + 1, 8);
|
||||
payload_size -= spec->next;
|
||||
|
||||
spec = (struct dm_target_spec *) (((char *) spec) + spec->next);
|
||||
|
||||
ctl->target_count++;
|
||||
t = t->next;
|
||||
}
|
||||
|
||||
return true;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int dm_load(struct dm_interface *dmi, const char *name,
|
||||
@ -495,11 +508,12 @@ static int unpack_status(struct dm_ioctl *ctl, struct target **result)
|
||||
unsigned i;
|
||||
struct target_builder tb;
|
||||
struct dm_target_spec *spec = payload(ctl);
|
||||
char *spec_start = (char *) spec;
|
||||
|
||||
tb_init(&tb);
|
||||
for (i = 0; i < ctl->target_count; i++) {
|
||||
tb_append(&tb, spec->length, spec->target_type, (char *) (spec + 1));
|
||||
spec = (struct dm_target_spec *) (((char *) spec) + spec->next);
|
||||
spec = (struct dm_target_spec *) (spec_start + spec->next);
|
||||
}
|
||||
|
||||
*result = tb_get(&tb);
|
||||
@ -527,6 +541,9 @@ retry:
|
||||
goto retry;
|
||||
}
|
||||
|
||||
if (r)
|
||||
return r;
|
||||
|
||||
r = unpack_status(ctl, targets);
|
||||
free_ctl(ctl);
|
||||
return r;
|
||||
|
||||
@ -1,22 +1,150 @@
|
||||
(library
|
||||
(device-mapper dm-tests)
|
||||
(export register-dm-tests)
|
||||
(export register-dm-tests make-allocator)
|
||||
(import (device-mapper ioctl)
|
||||
(chezscheme)
|
||||
(functional-tests)
|
||||
(fmt fmt)
|
||||
(list-utils)
|
||||
(process)
|
||||
(srfi s27 random-bits)
|
||||
(temp-file))
|
||||
|
||||
;; We have to export something that forces all the initialisation expressions
|
||||
;; to run.
|
||||
(define (register-dm-tests) #t)
|
||||
|
||||
;; Hard coded, get these from the command line
|
||||
(define test-dev "/dev/vda")
|
||||
(define test-dev-size 209715200)
|
||||
|
||||
(define (linear dev begin end)
|
||||
(make-target (- end begin)
|
||||
"linear"
|
||||
(fmt #f dev " " begin)))
|
||||
|
||||
(define (make-allocator dev dev-len)
|
||||
(let ((offset 0))
|
||||
(lambda (len)
|
||||
(let ((b offset)
|
||||
(e (+ offset len)))
|
||||
(if (> e dev-len)
|
||||
(fail "not enough space for allocation")
|
||||
(begin
|
||||
(set! offset e)
|
||||
(linear dev b e)))))))
|
||||
|
||||
(define-syntax with-test-allocator
|
||||
(syntax-rules ()
|
||||
((_ (var) b1 b2 ...)
|
||||
(let ((var (make-allocator test-dev test-dev-size)))
|
||||
b1 b2 ...))))
|
||||
|
||||
(define (linear-table allocator nr-targets)
|
||||
(let loop ((nr-targets nr-targets)
|
||||
(acc '()))
|
||||
(if (zero? nr-targets)
|
||||
(reverse acc)
|
||||
(loop (- nr-targets 1)
|
||||
(cons (allocator (* 8 (random-integer 1024)))
|
||||
acc)))))
|
||||
|
||||
(define (similar-targets t1 t2)
|
||||
(and (equal? (target-type t1)
|
||||
(target-type t2))
|
||||
(equal? (target-len t1)
|
||||
(target-len t2))))
|
||||
|
||||
;;;-----------------------------------------------------------
|
||||
;;; scenarios
|
||||
;;;-----------------------------------------------------------
|
||||
(define-scenario (dm create-interface)
|
||||
"create and destroy an ioctl interface object"
|
||||
(with-dm (dm) #t))
|
||||
(with-dm #t))
|
||||
|
||||
(define-scenario (dm create-device)
|
||||
"create and destroy a device"
|
||||
(with-dm
|
||||
(with-empty-device (dev "foo" "uuidd")
|
||||
#t)))
|
||||
|
||||
(define-scenario (dm duplicate-name-fails)
|
||||
"You can't create two devices with the same name"
|
||||
(with-dm
|
||||
(with-empty-device (dev1 "foo" "uuid1")
|
||||
(assert-raises
|
||||
(with-empty-device (dev2 "foo" "uuid2") #t)))))
|
||||
|
||||
(define-scenario (dm duplicate-uuid-fails)
|
||||
"You can't create two devices with the same uuid"
|
||||
(with-dm
|
||||
(with-empty-device (dev1 "foo" "uuid")
|
||||
(assert-raises
|
||||
(with-empty-device (dev2 "bar" "uuid") #t)))))
|
||||
|
||||
(define-scenario (dm load-single-target)
|
||||
"You can load a single target table"
|
||||
(with-dm
|
||||
(with-empty-device (dev "foo" "uuid")
|
||||
;; FIXME: export contructor for linear targets
|
||||
(load-table dev (list (linear test-dev 0 102400))))))
|
||||
|
||||
(define-scenario (dm load-many-targets)
|
||||
"You can load a large target table"
|
||||
(with-dm
|
||||
(with-test-allocator (pv)
|
||||
(with-empty-device (dev "foo" "uuid")
|
||||
(load-table dev (linear-table pv 32))))))
|
||||
|
||||
(define-scenario (dm resume-works)
|
||||
"You can resume a new target with a table"
|
||||
(with-dm
|
||||
(with-test-allocator (pv)
|
||||
(with-empty-device (dev "foo" "uuid")
|
||||
(load-table dev (linear-table pv 8))
|
||||
(resume-device dev)))))
|
||||
|
||||
(define-scenario (dm suspend-resume-cycle)
|
||||
"You can pause a device."
|
||||
(with-dm
|
||||
(with-test-allocator (pv)
|
||||
(with-device (dev "foo" "uuid" (linear-table pv 8))
|
||||
(suspend-device dev)
|
||||
(resume-device dev)))))
|
||||
|
||||
(define-scenario (dm reload-table)
|
||||
"You can reload a table"
|
||||
(with-dm
|
||||
(with-test-allocator (pv)
|
||||
(with-device (dev "foo" "uuid" (linear-table pv 16))
|
||||
(pause-device dev
|
||||
(load-table dev (linear-table pv 8)))))))
|
||||
|
||||
(define-scenario (dm list-devices)
|
||||
"list-devices works"
|
||||
(with-dm
|
||||
(with-test-allocator (pv)
|
||||
(with-devices ((dev1 "foo" "uuid" (linear-table pv 4))
|
||||
(dev2 "bar" "uuid2" (linear-table pv 4)))
|
||||
(let ((names (map device-details-name (list-devices))))
|
||||
(assert-member? "foo" names)
|
||||
(assert-member? "bar" names))))))
|
||||
|
||||
(define-scenario (dm get-status)
|
||||
"get-status works"
|
||||
(with-dm
|
||||
(with-test-allocator (pv)
|
||||
(let ((table (linear-table pv 4)))
|
||||
(with-device (dev "foo" "uuid" table)
|
||||
(let ((status (get-status dev)))
|
||||
(assert-every similar-targets table status)))))))
|
||||
|
||||
(define-scenario (dm get-table)
|
||||
"get-table works"
|
||||
(with-dm
|
||||
(with-test-allocator (pv)
|
||||
(let ((table (linear-table pv 4)))
|
||||
(with-device (dev "foo" "uuid" table)
|
||||
(let ((table-out (get-table dev)))
|
||||
(assert-every similar-targets table table-out)))))))
|
||||
)
|
||||
|
||||
@ -3,13 +3,41 @@
|
||||
|
||||
(export dm-open
|
||||
dm-close
|
||||
with-dm-thunk
|
||||
with-dm
|
||||
|
||||
dm-version
|
||||
get-version
|
||||
remove-all
|
||||
list-devices
|
||||
|
||||
create-device)
|
||||
create-device
|
||||
|
||||
target
|
||||
make-target
|
||||
target-len
|
||||
target-type
|
||||
target-args
|
||||
|
||||
load-table
|
||||
remove-device
|
||||
with-empty-device
|
||||
with-device
|
||||
with-devices
|
||||
suspend-device
|
||||
resume-device
|
||||
clear-device
|
||||
|
||||
pause-device
|
||||
pause-device-thunk
|
||||
|
||||
device-details
|
||||
device-details-name
|
||||
device-details-major
|
||||
device-details-minor
|
||||
|
||||
get-status
|
||||
get-table)
|
||||
|
||||
(import (chezscheme)
|
||||
(fmt fmt)
|
||||
@ -28,6 +56,8 @@
|
||||
(struct
|
||||
(fd int)))
|
||||
|
||||
(define-record-type dm-device (fields (mutable name)))
|
||||
|
||||
(define open% (foreign-procedure "dm_open" () (* DMIoctlInterface)))
|
||||
|
||||
(define (dm-open)
|
||||
@ -39,18 +69,27 @@
|
||||
(define dm-close
|
||||
(foreign-procedure "dm_close" ((* DMIoctlInterface)) void))
|
||||
|
||||
(define-syntax with-dm
|
||||
(syntax-rules ()
|
||||
((_ (name) b1 b2 ...)
|
||||
(let ((name (dm-open)))
|
||||
(define dm-interface #f)
|
||||
|
||||
(define (current-dm-interface)
|
||||
(if dm-interface
|
||||
dm-interface
|
||||
(fail "no dm interface")))
|
||||
|
||||
(define (with-dm-thunk thunk)
|
||||
(fluid-let ((dm-interface (dm-open)))
|
||||
(dynamic-wind
|
||||
(lambda () #f)
|
||||
(lambda () b1 b2 ...)
|
||||
(lambda () (dm-close name)))))))
|
||||
thunk
|
||||
(lambda () (dm-close dm-interface)))))
|
||||
|
||||
(define-syntax with-dm
|
||||
(syntax-rules ()
|
||||
((_ b1 b2 ...) (with-dm-thunk (lambda () b1 b2 ...)))))
|
||||
|
||||
(define-record-type dm-version (fields major minor patch))
|
||||
|
||||
(define (get-version dm)
|
||||
(define (get-version)
|
||||
(define get
|
||||
(foreign-procedure "dm_version" ((* DMIoctlInterface)
|
||||
(* unsigned-32)
|
||||
@ -67,7 +106,7 @@
|
||||
(let ((major (alloc-u32))
|
||||
(minor (alloc-u32))
|
||||
(patch (alloc-u32)))
|
||||
(if (zero? (get dm major minor patch))
|
||||
(if (zero? (get (current-dm-interface) major minor patch))
|
||||
(let ((r (make-dm-version (deref-u32 major)
|
||||
(deref-u32 minor)
|
||||
(deref-u32 patch))))
|
||||
@ -77,11 +116,11 @@
|
||||
r)
|
||||
(fail "couldn't get dm version"))))
|
||||
|
||||
(define (remove-all dm)
|
||||
(define (remove-all)
|
||||
(define do-it
|
||||
(foreign-procedure "dm_remove_all" ((* DMIoctlInterface)) int))
|
||||
|
||||
(let ((r (do-it dm)))
|
||||
(let ((r (do-it (current-dm-interface))))
|
||||
(unless (zero? r)
|
||||
(fail "remove-all failed"))))
|
||||
|
||||
@ -109,24 +148,26 @@
|
||||
(let* ((len (string-length str))
|
||||
(cstr (make-ftype-pointer unsigned-8
|
||||
(foreign-alloc (+ 1 len)))))
|
||||
;; FIXME: ugly; use for-each
|
||||
(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))))))
|
||||
(begin
|
||||
(ftype-set! unsigned-8 () cstr i (char->integer (string-ref str i)))
|
||||
(loop (+ i 1)))))))
|
||||
|
||||
;;; FIXME: put a dynamic wind in to ensure the dev list gets freed
|
||||
(define (list-devices dm)
|
||||
(define (list-devices)
|
||||
(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))
|
||||
(if (zero? (list-devs (current-dm-interface) 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)
|
||||
@ -137,21 +178,22 @@
|
||||
acc))))
|
||||
(fail "dm_list_devices ioctl failed"))))
|
||||
|
||||
(define (create-device dm name uuid)
|
||||
(define (create-device name uuid)
|
||||
(define create
|
||||
(foreign-procedure "dm_create_device" ((* DMIoctlInterface) string string) int))
|
||||
|
||||
(unless (zero? (create dm name uuid))
|
||||
(if (zero? (create (current-dm-interface) name uuid))
|
||||
(make-dm-device name)
|
||||
(fail "create-device failed")))
|
||||
|
||||
(define-syntax define-dev-cmd
|
||||
(syntax-rules ()
|
||||
((_ nm proc)
|
||||
(define (nm dm name)
|
||||
(define (nm dev)
|
||||
(define fn
|
||||
(foreign-procedure proc ((* DMIoctlInterface) string) int))
|
||||
|
||||
(unless (zero? (fn dm name))
|
||||
(unless (zero? (fn (current-dm-interface) (dm-device-name dev)))
|
||||
(fail (string-append proc " failed")))))))
|
||||
|
||||
(define-dev-cmd remove-device "dm_remove_device")
|
||||
@ -167,8 +209,12 @@
|
||||
(args (* unsigned-8))))
|
||||
|
||||
(define-ftype TargetPtr (* Target))
|
||||
(define-ftype TargetPtrPtr (* TargetPtr))
|
||||
|
||||
(define-record-type target
|
||||
(fields (mutable len) (mutable type) (mutable args)))
|
||||
(fields (mutable len)
|
||||
(mutable type)
|
||||
(mutable args)))
|
||||
|
||||
(define (build-c-target next len type args)
|
||||
(let ((t (make-ftype-pointer Target
|
||||
@ -177,34 +223,118 @@
|
||||
(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))))
|
||||
(ftype-set! Target (args) t (string->cstring args))
|
||||
t))
|
||||
|
||||
(define (build-c-targets targets)
|
||||
(let loop ((t targets)
|
||||
(let loop ((targets (reverse targets))
|
||||
(tail (make-ftype-pointer Target 0)))
|
||||
(if (null? t)
|
||||
(if (null? targets)
|
||||
tail
|
||||
(let ((t (car targets)))
|
||||
(loop (cdr targets)
|
||||
(build-c-target tail (target-len t) (target-type t) (target-args t))))))
|
||||
(build-c-target tail
|
||||
(target-len t)
|
||||
(target-type t)
|
||||
(target-args t)))))))
|
||||
|
||||
#|
|
||||
(define (free-c-target t)
|
||||
(foreign-free (ftype-ref Target (type) t))
|
||||
(foreign-free (ftype-ref Target (args) t))
|
||||
(foreign-free t))
|
||||
|#
|
||||
(define (free-c-target t)
|
||||
#f)
|
||||
|
||||
(define (free-c-targets t)
|
||||
(let loop ((t t)
|
||||
(acc '()))
|
||||
(if (ftype-pointer-null? t)
|
||||
(map foreign-free acc)
|
||||
(map free-c-target acc)
|
||||
(loop (ftype-ref Target (next) t) (cons t acc)))))
|
||||
|
||||
;; targets should be dlambdas with 'size, 'type and 'format methods
|
||||
(define (load-table dm name targets)
|
||||
(define-syntax ensure-free-ctargets
|
||||
(syntax-rules ()
|
||||
((_ ctargets b1 b2 ...)
|
||||
(dynamic-wind
|
||||
(lambda () #f)
|
||||
(lambda () b1 b2 ...)
|
||||
(lambda ()
|
||||
(free-c-targets ctargets))))))
|
||||
|
||||
(define (load-table dev targets)
|
||||
(define load
|
||||
(foreign-procedure "dm_load" ((* DMIoctlInterface) string (* Target)) int))
|
||||
|
||||
(define (dlambda->target t)
|
||||
(make-target (t 'size) (t 'type) (t 'format)))
|
||||
(let* ((ctargets (build-c-targets targets)))
|
||||
(ensure-free-ctargets ctargets
|
||||
(unless (zero? (load (current-dm-interface) (dm-device-name dev) ctargets))
|
||||
(fail "dm_load failed")))))
|
||||
|
||||
(let* ((ctargets (build-c-targets (map dlambda->target targets)))
|
||||
(r (load dm name ctargets)))
|
||||
(free-c-targets ctargets)
|
||||
(unless (zero? r)
|
||||
(fail "dm_load failed"))))
|
||||
(define-syntax with-empty-device
|
||||
(syntax-rules ()
|
||||
((_ (var name uuid) b1 b2 ...)
|
||||
(let ((var (create-device name uuid)))
|
||||
(dynamic-wind
|
||||
(lambda () #f)
|
||||
(lambda () b1 b2 ...)
|
||||
(lambda () (remove-device var)))))))
|
||||
|
||||
(define-syntax with-device
|
||||
(syntax-rules ()
|
||||
((_ (var name uuid table) b1 b2 ...)
|
||||
(with-empty-device (var name uuid)
|
||||
(load-table var table)
|
||||
(resume-device var)
|
||||
b1 b2 ...))))
|
||||
|
||||
(define-syntax with-devices
|
||||
(syntax-rules ()
|
||||
((_ (dev) b1 b2 ...)
|
||||
(with-device dev b1 b2 ...))
|
||||
|
||||
((_ (dev rest ...) b1 b2 ...)
|
||||
(with-device dev
|
||||
(with-devices (rest ...) b1 b2 ...)))))
|
||||
|
||||
(define (pause-device-thunk dev thunk)
|
||||
(suspend-device dev)
|
||||
(thunk)
|
||||
(resume-device dev))
|
||||
|
||||
(define-syntax pause-device
|
||||
(syntax-rules ()
|
||||
((_ dev b1 b2 ...)
|
||||
(pause-device-thunk dev (lambda () b1 b2 ...)))))
|
||||
|
||||
(define (do-status dev c-fn op-name)
|
||||
(let ((tpp (make-ftype-pointer TargetPtr
|
||||
(foreign-alloc (ftype-sizeof TargetPtrPtr)))))
|
||||
(if (zero? (c-fn (current-dm-interface) (dm-device-name dev) tpp))
|
||||
(let ((tp (ftype-ref TargetPtr () tpp)))
|
||||
(ensure-free-ctargets tp
|
||||
(let loop ((tp tp)
|
||||
(acc '()))
|
||||
(if (ftype-pointer-null? tp)
|
||||
(reverse acc)
|
||||
(loop (ftype-ref Target (next) tp)
|
||||
(cons (make-target
|
||||
(ftype-ref Target (len) tp)
|
||||
(cstring->string (ftype-ref Target (type) tp))
|
||||
(cstring->string (ftype-ref Target (args) tp)))
|
||||
acc))))))
|
||||
(fail (fmt #f op-name " ioctl failed")))))
|
||||
|
||||
(define (get-status dev)
|
||||
(define get-status
|
||||
(foreign-procedure "dm_status" ((* DMIoctlInterface) string (* TargetPtr)) int))
|
||||
|
||||
(do-status dev get-status "dm_status"))
|
||||
|
||||
(define (get-table dev)
|
||||
(define get-status
|
||||
(foreign-procedure "dm_table" ((* DMIoctlInterface) string (* TargetPtr)) int))
|
||||
|
||||
(do-status dev get-status "dm_table"))
|
||||
)
|
||||
|
||||
@ -21,7 +21,11 @@
|
||||
assert-eof
|
||||
assert-starts-with
|
||||
assert-matches
|
||||
assert-superblock-untouched)
|
||||
assert-superblock-untouched
|
||||
assert-member?
|
||||
assert-raises-thunk
|
||||
assert-raises
|
||||
assert-every)
|
||||
|
||||
(import
|
||||
(chezscheme)
|
||||
@ -33,6 +37,7 @@
|
||||
(regex)
|
||||
(temp-file)
|
||||
(utils)
|
||||
(only (srfi s1 lists) every)
|
||||
(srfi s8 receive))
|
||||
|
||||
;;;--------------------------------------------------------------------
|
||||
@ -251,5 +256,30 @@
|
||||
(unless (all-zeroes? (block-data b) 4096)
|
||||
(fail "superblock contains non-zero data")))))
|
||||
|
||||
(define (assert-member? x xs)
|
||||
(unless (member x xs)
|
||||
(fail (fmt #f "expected " (wrt x) "to be a member of " (wrt xs)))))
|
||||
|
||||
(define (assert-raises-thunk thunk)
|
||||
(call/cc
|
||||
(lambda (k)
|
||||
(with-exception-handler
|
||||
(lambda (x)
|
||||
(if (error? x)
|
||||
(k #f)
|
||||
(raise x)))
|
||||
thunk)
|
||||
(fail "expected an exception to be raised"))))
|
||||
|
||||
(define-syntax assert-raises
|
||||
(syntax-rules ()
|
||||
((_ b1 b2 ...)
|
||||
(assert-raises-thunk
|
||||
(lambda ()
|
||||
b1 b2 ...)))))
|
||||
|
||||
(define (assert-every pred . args)
|
||||
(unless (apply every pred args)
|
||||
(fail "assert-every failed")))
|
||||
)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user