thin-provisioning-tools/functional-tests/thin/check.scm

92 lines
2.8 KiB
Scheme

(library
(thin check)
(export thin-check
thin-check-flags)
(import
(bcache block-manager)
(persistent-data btree)
(fmt fmt)
(list-utils)
(matchable)
(parser-combinators)
(srfi s8 receive)
(thin metadata)
(thin mapping-tree)
(chezscheme))
;;;;---------------------------------------------------
;;;; Constants
;;;;---------------------------------------------------
;; FIXME: duplicate with main.scm
(define (current-metadata) "./metadata.bin")
(define $superblock-magic 27022010)
(define $superblock-salt 160774)
(define $uuid-size 16)
(define $space-map-root-size 128)
(define-compound-value-type device-details-vt ThinDeviceDetails)
(define (block->superblock b)
(make-ftype-pointer ThinSuperblock (block-data b)))
;;;------------------------------------------------
;;; Fluid vars for the switches
(define quiet #f)
(define clear-needs-check-flag #f)
(define ignore-non-fatal-errors #f)
(define skip-mappings #f)
(define super-block-only #f)
(define (dump-dev-tree cache root)
(btree-each (btree-open device-details-vt cache root)
(lambda (k v)
(fmt #t
"dev-id: " k "\n"
" mapped blocks: " (ftype-ref ThinDeviceDetails (mapped-blocks) v) "\n"
" transaction id: " (ftype-ref ThinDeviceDetails (transaction-id) v) "\n"
" creation time: " (ftype-ref ThinDeviceDetails (creation-time) v) "\n"
" snapshotted time: " (ftype-ref ThinDeviceDetails (snapshotted-time) v) "\n"))))
(define-enumeration thin-check-element
(quiet
clear-needs-check-flag
ignore-non-fatal-errors
skip-mappings
super-block-only)
thin-check-flags)
(define (thin-check metadata-path flags)
(define (member? s)
(enum-set-member? s flags))
(fluid-let ((quiet (member? 'quiet))
(clear-needs-check-flag (member? 'clear-needs-check-flag))
(ignore-non-fatal-errors (member? 'ignore-non-fatal-errors))
(skip-mappings (member? 'skip-mappings))
(super-block-only (member? 'super-block-only)))
(fmt (current-output-port)
"quiet: " quiet "\n"
"clear-needs-check-flag: " clear-needs-check-flag "\n"
"ignore-non-fatal-errors: " ignore-non-fatal-errors "\n"
"skip-mappings: " skip-mappings "\n"
"super-block-only: " super-block-only "\n"
"input-file: " metadata-path "\n")
(with-bcache (cache metadata-path 1024)
(with-block (b cache 0 (get-flags))
(let ((sb (block->superblock b)))
(fmt (current-output-port)
"block-nr: " (ftype-ref ThinSuperblock (block-nr) sb) "\n"
"magic: " (ftype-ref ThinSuperblock (magic) sb) "\n"
"data-mapping-root: " (ftype-ref ThinSuperblock (data-mapping-root) sb) "\n"
"device-details-root: " (ftype-ref ThinSuperblock (device-details-root) sb) "\n")
(dump-dev-tree cache (ftype-ref ThinSuperblock (device-details-root) sb)))))))
)