thin-provisioning-tools/functional-tests/device-mapper/dm-tests.scm

391 lines
14 KiB
Scheme
Raw Normal View History

(library
(device-mapper dm-tests)
(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)
(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 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))))
2017-10-26 18:12:09 +05:30
(define-record-type segment (fields (mutable dev)
(mutable start)
(mutable end)))
(define (linear seg)
(make-target (- (segment-end seg) (segment-start seg))
"linear"
2017-10-26 18:12:09 +05:30
(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 (to-sectors len))))
(if (> e dev-len)
(fail "not enough space for allocation")
(begin
(set! offset e)
2017-10-26 18:12:09 +05:30
(linear (make-segment dev b e))))))))
(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 (sectors (* 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))))
(define-syntax define-dm-scenario
(syntax-rules ()
((_ path desc b1 b2 ...)
(define-scenario path desc
(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 ...)))))
;;;-----------------------------------------------------------
;;; Fundamental dm scenarios
;;;-----------------------------------------------------------
(define-scenario (dm create-interface)
"create and destroy an ioctl interface object"
(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 (make-segment fast-dev 0 102400)))))))
(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 (mk-fast-allocator) 32))))
(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 (mk-fast-allocator) 8))
(resume-device dev)))
(define-dm-scenario (dm suspend-resume-cycle)
"You can pause a device."
(with-device (dev "foo" "uuid" (linear-table (mk-fast-allocator) 8))
(suspend-device dev)
(resume-device dev)))
(define-dm-scenario (dm reload-table)
"You can reload a table"
(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)
"list-devices works"
(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)
"get-status works"
(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)
"get-table works"
(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))
;; )))
)