diff --git a/functional-tests/cache-functional-tests.scm b/functional-tests/cache-functional-tests.scm index 856ea57..0e70b94 100644 --- a/functional-tests/cache-functional-tests.scm +++ b/functional-tests/cache-functional-tests.scm @@ -25,7 +25,7 @@ (define-syntax with-valid-metadata (syntax-rules () ((_ (md) b1 b2 ...) - (with-temp-file-sized ((md "cache.bin" (meg 4))) + (with-temp-file-sized ((md "cache.bin" (to-bytes (meg 4)))) (with-cache-xml (xml) (run-ok (cache-restore "-i" xml "-o" md)) b1 b2 ...))))) @@ -34,13 +34,13 @@ (define-syntax with-corrupt-metadata (syntax-rules () ((_ (md) b1 b2 ...) - (with-temp-file-sized ((md "cache.bin" (meg 4))) + (with-temp-file-sized ((md "cache.bin" (to-bytes (meg 4)))) b1 b2 ...)))) (define-syntax with-empty-metadata (syntax-rules () ((_ (md) b1 b2 ...) - (with-temp-file-sized ((md "cache.bin" (meg 4))) + (with-temp-file-sized ((md "cache.bin" (to-bytes (meg 4)))) b1 b2 ...)))) ;; We have to export something that forces all the initialisation expressions @@ -315,7 +315,7 @@ (define-scenario (cache-metadata-size device-size-only) "Just --device-size causes fail" - (run-fail-rcv (_ stderr) (cache-metadata-size "--device-size" (meg 100)) + (run-fail-rcv (_ stderr) (cache-metadata-size "--device-size" (to-bytes (meg 100))) (assert-equal "If you specify --device-size you must also give --block-size." stderr))) diff --git a/functional-tests/device-mapper/dm-tests.scm b/functional-tests/device-mapper/dm-tests.scm index 37cc26d..25e1acd 100644 --- a/functional-tests/device-mapper/dm-tests.scm +++ b/functional-tests/device-mapper/dm-tests.scm @@ -1,22 +1,40 @@ (library (device-mapper dm-tests) - (export register-dm-tests make-allocator) + (export register-dm-tests + get-dev-size) (import (device-mapper ioctl) + (disk-units) (chezscheme) (functional-tests) (fmt fmt) (list-utils) + (loops) (process) (srfi s27 random-bits) - (temp-file)) + (temp-file) + (utils)) ;; We have to export something that forces all the initialisation expressions ;; to run. (define (register-dm-tests) #t) + ;; FIXME: use memoisation to avoid running blockdev so much + (define (get-dev-size dev) + (run-ok-rcv (stdout stderr) (fmt #f "blockdev --getsz " dev) + (string->number (chomp stdout)))) + ;; Hard coded, get these from the command line - (define test-dev "/dev/vda") - (define test-dev-size 209715200) + (define fast-dev "/dev/vda") + (define mk-fast-allocator + (let ((size (get-dev-size fast-dev))) + (lambda () + (make-allocator fast-dev size)))) + + (define slow-dev "/dev/vdb") + (define mk-slow-allocator + (let ((size (get-dev-size slow-dev))) + (lambda () + (make-allocator slow-dev size)))) (define-record-type segment (fields (mutable dev) (mutable start) @@ -27,30 +45,25 @@ "linear" (fmt #f (segment-dev seg) " " (segment-start seg)))) + ;; FIXME: move above first use (define (make-allocator dev dev-len) (let ((offset 0)) (lambda (len) (let ((b offset) - (e (+ offset len))) + (e (+ offset (to-sectors len)))) (if (> e dev-len) (fail "not enough space for allocation") (begin (set! offset e) (linear (make-segment 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))) + (cons (allocator (sectors (* 8 (random-integer 1024)))) acc))))) (define (similar-targets t1 t2) @@ -61,14 +74,147 @@ (define-syntax define-dm-scenario (syntax-rules () - ((_ path (pv) desc b1 b2 ...) + ((_ path desc b1 b2 ...) (define-scenario path desc - (with-dm - (with-test-allocator (pv) - b1 b2 ...)))))) + (with-dm b1 b2 ...))))) + + ;;---------------- + ;; Thin utilities + ;;---------------- + (define-enumeration thin-pool-option + (skip-block-zeroing ignore-discard no-discard-passdown read-only error-if-no-space) + thin-pool-options) + + ;; Expands the above option set into a list of strings to be passed to the + ;; target. + (define (expand-thin-options opts) + (define (expand-opt o) + (case o + ((skip-block-zeroing) "skip_block_zeroing") + ((ignore-discard) "ignore_discard") + ((no-discard-passdown) "no_discard_passdown") + ((read-only) "read_only") + ((error-if-no-space) "error_if_no_space"))) + (map expand-opt (enum-set->list opts))) + + ;; Builds a string of space separated args + (define (build-args-string . args) + (fmt #f (fmt-join dsp args (dsp " ")))) + + (define (pool-table md-dev data-dev data-size block-size opts) + (let ((opts-str (expand-thin-options opts))) + (list + (make-target (to-sectors data-size) "thin-pool" + (apply build-args-string + (dm-device-path md-dev) + (dm-device-path data-dev) + (to-sectors block-size) + 80 ;; low water mark + (length opts-str) opts-str))))) + + ;; FIXME: move somewhere else, and do IO in bigger blocks + (define (zero-dev dev size) + (define (dd . args) + (build-command-line (cons "dd" args))) + + (run-ok (dd "if=/dev/zero" + (string-append "of=" (dm-device-path dev)) + "bs=512" (fmt #f "count=" (to-sectors size))))) + + ;; The contents should be + (define (with-ini-file-fn section contents fn) + (define (expand-elt pair) + (cat (car pair) "=" (cadr pair) nl)) + + (let ((expanded-contents + (fmt #f + (cat "[" section "]" nl) + (apply-cat (map expand-elt contents))))) + (with-temp-file-containing ((v "fio" expanded-contents)) + (fn v)))) + + (define-syntax with-ini-file + (syntax-rules () + ((_ (tmp section contents) b1 b2 ...) + (with-ini-file-fn section contents (lambda (tmp) b1 b2 ...))))) + + (define (rand-write-and-verify dev) + (with-ini-file (fio-input "write-and-verify" + `(("rw" "randwrite") + ("bs" "4k") + ("direct" 1) + ("ioengine" "libaio") + ("iodepth" 16) + ("verify" "crc32c") + ("filename" ,(dm-device-path dev)))) + (run-ok (fmt #f "fio " fio-input)))) + + (define (with-pool-fn fast-allocator slow-allocator size block-size fn) + (let ((metadata-table (list (fast-allocator (meg 32)))) + (data-table (list (slow-allocator size)))) + (with-devices ((md (generate-dev-name) "" metadata-table) + (data (generate-dev-name) "" data-table)) + (zero-dev md (kilo 4)) + (let ((ptable (pool-table md data size block-size (thin-pool-options)))) + (with-device (pool (generate-dev-name) "" ptable) + (fn pool)))))) + + (define-syntax with-pool + (syntax-rules () + ((_ (pool md-allocator data-allocator size block-size) b1 b2 ...) + (with-pool-fn md-allocator + data-allocator + size + block-size + (lambda (pool) b1 b2 ...))))) + + (define-syntax define-thin-scenario + (syntax-rules () + ((_ path (pool size) desc b1 b2 ...) + (define-dm-scenario path desc + (with-pool-fn (mk-fast-allocator) + (mk-slow-allocator) + size + (kilo 64) + (lambda (pool) b1 b2 ...)))))) + + (define generate-dev-name + (let ((nr 0)) + (lambda () + (let ((name (fmt #f "test-dev-" nr))) + (set! nr (+ nr 1)) + name)))) + + (define (thin-table pool id size) + (list + (make-target (to-sectors size) "thin" (build-args-string (dm-device-path pool) id)))) + + (define (create-thin pool id) + (message pool 0 (fmt #f "create_thin " id))) + + (define (create-snap pool new-id origin-id) + (message pool 0 (fmt #f "create_snap " new-id " " origin-id))) + + (define (with-thin-fn pool id size fn) + (with-device-fn (generate-dev-name) "" (thin-table pool id size) fn)) + + (define (with-new-thin-fn pool id size fn) + (create-thin pool id) + (with-thin-fn pool id size fn)) + + (define-syntax with-thin + (syntax-rules () + ((_ (thin pool id size) b1 b2 ...) + (with-thin-fn pool id size (lambda (thin) b1 b2 ...))))) + + (define-syntax with-new-thin + (syntax-rules () + ((_ (thin pool id size) b1 b2 ...) + (with-new-thin-fn pool id size (lambda (thin) + b1 b2 ...))))) ;;;----------------------------------------------------------- - ;;; scenarios + ;;; Fundamental dm scenarios ;;;----------------------------------------------------------- (define-scenario (dm create-interface) "create and destroy an ioctl interface object" @@ -99,50 +245,146 @@ (with-dm (with-empty-device (dev "foo" "uuid") ;; FIXME: export contructor for linear targets - (load-table dev (list (linear (make-segment test-dev 0 102400))))))) + (load-table dev (list (linear (make-segment fast-dev 0 102400))))))) - (define-dm-scenario (dm load-many-targets) (pv) + (define-dm-scenario (dm load-many-targets) "You can load a large target table" (with-empty-device (dev "foo" "uuid") - (load-table dev (linear-table pv 32)))) + (load-table dev (linear-table (mk-fast-allocator) 32)))) - (define-dm-scenario (dm resume-works) (pv) + (define-dm-scenario (dm resume-works) "You can resume a new target with a table" (with-empty-device (dev "foo" "uuid") - (load-table dev (linear-table pv 8)) + (load-table dev (linear-table (mk-fast-allocator) 8)) (resume-device dev))) - (define-dm-scenario (dm suspend-resume-cycle) (pv) + (define-dm-scenario (dm suspend-resume-cycle) "You can pause a device." - (with-device (dev "foo" "uuid" (linear-table pv 8)) + (with-device (dev "foo" "uuid" (linear-table (mk-fast-allocator) 8)) (suspend-device dev) (resume-device dev))) - (define-dm-scenario (dm reload-table) (pv) + (define-dm-scenario (dm reload-table) "You can reload a table" - (with-device (dev "foo" "uuid" (linear-table pv 16)) - (pause-device dev - (load-table dev (linear-table pv 8))))) + (let ((pv (mk-fast-allocator))) + (with-device (dev "foo" "uuid" (linear-table pv 16)) + (pause-device dev + (load-table dev (linear-table pv 8)))))) - (define-dm-scenario (dm list-devices) (pv) + (define-dm-scenario (dm list-devices) "list-devices works" - (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)))) + (let ((pv (mk-fast-allocator))) + (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-dm-scenario (dm get-status) (pv) + (define-dm-scenario (dm get-status) "get-status works" - (let ((table (linear-table pv 4))) + (let ((table (linear-table (mk-fast-allocator) 4))) (with-device (dev "foo" "uuid" table) (let ((status (get-status dev))) (assert-every similar-targets table status))))) - (define-dm-scenario (dm get-table) (pv) + (define-dm-scenario (dm get-table) "get-table works" - (let ((table (linear-table pv 4))) + (let ((table (linear-table (mk-fast-allocator) 4))) (with-device (dev "foo" "uuid" table) (let ((table-out (get-table dev))) (assert-every similar-targets table table-out))))) - ) + + ;;;----------------------------------------------------------- + ;;; Thin scenarios + ;;;----------------------------------------------------------- + (define-thin-scenario (thin create-pool) (pool (gig 10)) + "create a pool" + #t) + + (define-thin-scenario (thin create-thin) (pool (gig 10)) + "create a thin volume larger than the pool" + (with-new-thin (thin pool 0 (gig 100)) + #t)) + + (define-thin-scenario (thin zero-thin) (pool (gig 10)) + "zero a 1 gig thin device" + (let ((thin-size (gig 1))) + (with-new-thin (thin pool 0 thin-size) + (zero-dev thin thin-size)))) + + ;;;----------------------------------------------------------- + ;;; Thin creation scenarios + ;;;----------------------------------------------------------- + (define-thin-scenario (thin create lots-of-thins) (pool (gig 10)) + "create lots of empty thin volumes" + (upto (n 1000) (create-thin pool n))) + + (define-thin-scenario (thin create lots-of-snaps) (pool (gig 10)) + "create lots of snapshots of a single volume" + (create-thin pool 0) + (upto (n 999) + (create-snap pool (+ n 1) 0))) + + (define-thin-scenario (thin create lots-of-recursive-snaps) (pool (gig 10)) + "create lots of recursive snapshots" + (create-thin pool 0) + (upto (n 999) + (create-snap pool (+ n 1) n))) + + (define-thin-scenario (thin create activate-thin-while-pool-suspended-fails) (pool (gig 10)) + "you can't activate a thin device while the pool is suspended" + (create-thin pool 0) + (pause-device pool + (assert-raises + (with-thin (thin pool 0 (gig 1)) + (fail "activate shouldn't work"))))) + + (define-dm-scenario (thin create huge-block-size) + "huge block sizes are possible" + (let ((size (sectors 524288))) + (with-pool (pool (mk-fast-allocator) (mk-slow-allocator) (gig 10) size) + (with-new-thin (thin pool 0 size) + (rand-write-and-verify thin))))) + + ;; FIXME: I thought we supported this? + (define-dm-scenario (thin create non-power-2-block-size-fails) + "The block size must be a power of 2" + (assert-raises + (with-pool (pool (mk-fast-allocator) (mk-slow-allocator) (gig 10) (kilo 57)) + #t))) + + (define-dm-scenario (thin create tiny-block-size-fails) + "The block size must be at least 64k" + (assert-raises + (with-pool (pool (mk-fast-allocator) (mk-slow-allocator) (gig 10) (kilo 32)) + #t))) + + (define-dm-scenario (thin create too-large-block-size-fails) + "The block size must be less than 2^21 sectors" + (assert-raises + (with-pool (pool (mk-fast-allocator) (mk-slow-allocator) (gig 10) (sectors (expt 2 22))) + #t))) + + (define-dm-scenario (thin create largest-block-size-succeeds) + "The block size 2^21 sectors should work" + (with-pool (pool (mk-fast-allocator) (mk-slow-allocator) (gig 10) (sectors (expt 2 21))) + #t)) + + (define-dm-scenario (thin create too-large-thin-dev-fails) + "The thin-id must be less 2^24" + (with-pool (pool (mk-fast-allocator) (mk-slow-allocator) (gig 10) (kilo 64)) + (assert-raises + (create-thin pool (expt 2 24))))) + + (define-dm-scenario (thin create largest-thin-dev-succeeds) + "The thin-id must be less 2^24" + (with-pool (pool (mk-fast-allocator) (mk-slow-allocator) (gig 10) (kilo 64)) + (create-thin pool (- (expt 2 24) 1)))) + +;; (define-dm-scenario (thin create too-small-metadata-fails) +;; "16k metadata is way too small" +;; (assert-raises +;; (with-pool (pool (mk-fast-allocator) (mk-slow-allocator) (gig 10) (kilo 64)) +;; ))) +) + diff --git a/functional-tests/device-mapper/ioctl.scm b/functional-tests/device-mapper/ioctl.scm index eb8da08..3f0d6bf 100644 --- a/functional-tests/device-mapper/ioctl.scm +++ b/functional-tests/device-mapper/ioctl.scm @@ -6,6 +6,10 @@ with-dm-thunk with-dm + dm-device + dm-device-name + dm-device-path + dm-version get-version remove-all @@ -21,7 +25,9 @@ load-table remove-device + with-empty-device-fn with-empty-device + with-device-fn with-device with-devices suspend-device @@ -37,7 +43,9 @@ device-details-minor get-status - get-table) + get-table + + message) (import (chezscheme) (fmt fmt) @@ -58,6 +66,9 @@ (define-record-type dm-device (fields (mutable name))) + (define (dm-device-path d) + (fmt #f (dsp "/dev/mapper/") (dsp (dm-device-name d)))) + (define open% (foreign-procedure "dm_open" () (* DMIoctlInterface))) (define (dm-open) @@ -272,22 +283,29 @@ (unless (zero? (load (current-dm-interface) (dm-device-name dev) ctargets)) (fail "dm_load failed"))))) + (define (with-empty-device-fn name uuid fn) + (let ((v (create-device name uuid))) + (dynamic-wind + (lambda () #f) + (lambda () (fn v)) + (lambda () (remove-device v))))) + (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))))))) + (with-empty-device-fn name uuid (lambda (var) b1 b2 ...))))) + + (define (with-device-fn name uuid table fn) + (with-empty-device-fn name uuid + (lambda (v) + (load-table v table) + (resume-device v) + (fn v)))) (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 ...)))) + (with-device-fn name uuid table (lambda (var) b1 b2 ...))))) (define-syntax with-devices (syntax-rules () @@ -337,4 +355,11 @@ (foreign-procedure "dm_table" ((* DMIoctlInterface) string (* TargetPtr)) int)) (do-status dev get-status "dm_table")) + + (define (message dev sector msg) + (define c-message + (foreign-procedure "dm_message" ((* DMIoctlInterface) string unsigned-64 string) int)) + + (unless (zero? (c-message (current-dm-interface) (dm-device-name dev) sector msg)) + (fail (fmt #f "message ioctl failed")))) ) diff --git a/functional-tests/disk-units.scm b/functional-tests/disk-units.scm index fb75d32..9799d52 100644 --- a/functional-tests/disk-units.scm +++ b/functional-tests/disk-units.scm @@ -1,6 +1,25 @@ (library (disk-units) - (export meg) - (import (rnrs)) + (export bytes + sectors + kilo + meg + gig + tera + to-bytes + to-sectors) + (import (rnrs) + (math-utils)) - (define (meg n) (* 1024 1024 n))) + (define-record-type disk-size (fields (mutable sectors))) + + (define (bytes n) (make-disk-size (div-up n 512))) + (define (sectors n) (make-disk-size n)) + (define (kilo n) (make-disk-size (* n 2))) + (define (meg n) (make-disk-size (* n 2 1024))) + (define (gig n) (make-disk-size (* n 1024 1024))) + (define (tera n) (make-disk-size (* n 1024 104 1024))) + + (define (to-bytes ds) (* 512 (disk-size-sectors ds))) + (define (to-sectors ds) (disk-size-sectors ds)) + )