[functional-tests] More work on the dm-ioctl bindings.

ft-lib/dm-ioctl.c

@@ -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,22 +434,24 @@ 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,
-	    struct target *targets)
+		struct target *targets)
 {
 	int r;
 	size_t payload_size = calc_load_payload(targets);
@@ -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;

functional-tests/device-mapper/dm-tests.scm

@@ -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"
+    "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)))))))
   )

functional-tests/device-mapper/ioctl.scm

@@ -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 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)
+        thunk
+        (lambda () (dm-close dm-interface)))))
+
   (define-syntax with-dm
     (syntax-rules ()
-      ((_ (name) b1 b2 ...)
+      ((_ b1 b2 ...) (with-dm-thunk (lambda () b1 b2 ...)))))
-       (let ((name (dm-open)))
-        (dynamic-wind
-          (lambda () #f)
-          (lambda () b1 b2 ...)
-          (lambda () (dm-close name)))))))
 
   (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))
-      (fail "create-device failed")))
+        (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
-          (loop (cdr targets)
+          (let ((t (car targets)))
-                (build-c-target tail (target-len t) (target-type t) (target-args t))))))
+           (loop (cdr targets)
+                 (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-syntax ensure-free-ctargets
-  (define (load-table dm name targets)
+    (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)
+    (let* ((ctargets (build-c-targets targets)))
-      (make-target (t 'size) (t 'type) (t 'format)))
+     (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)))
+  (define-syntax with-empty-device
-           (r (load dm name ctargets)))
+    (syntax-rules ()
-      (free-c-targets ctargets)
+      ((_ (var name uuid) b1 b2 ...)
-      (unless (zero? r)
+       (let ((var (create-device name uuid)))
-          (fail "dm_load failed"))))
+        (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"))
 )

functional-tests/functional-tests.scm

@@ -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")))
   )