From dcb0fe114806dc5d054f51d3ce5c41e8136f0938 Mon Sep 17 00:00:00 2001 From: Joe Thornber Date: Wed, 4 Oct 2017 10:45:39 +0100 Subject: [PATCH] [functional-tests] add a useful script for investigating corrupt thin metadata --- functional-tests/find-working-roots.scm | 171 ++++++++++++++++++++++++ 1 file changed, 171 insertions(+) create mode 100644 functional-tests/find-working-roots.scm diff --git a/functional-tests/find-working-roots.scm b/functional-tests/find-working-roots.scm new file mode 100644 index 0000000..8ee4830 --- /dev/null +++ b/functional-tests/find-working-roots.scm @@ -0,0 +1,171 @@ +(import (chezscheme) + (bcache block-manager) + (fmt fmt) + (loops) + (persistent-data btree) + (process) + (srfi s8 receive) + (thin metadata) + (utils)) + +;;;;--------------------------------------------------------------------- +;;;; Constraints +;;;; 1) No thin device has a data block mapped in more than once. +;;;; 2) Only root nodes may have fewer than max_entries/3 +;;;; 3) tl-leaf values are all in-metadata-bounds? +;;;; 4) bl-leaf values are all in-data-bounds? +;;;; 5) internal values are all in-metadata-bounds? (true of every internal +;;; node though, can't be used to differentiate). +(define (thin-check metadata root) + (let ((exit-code (system + (fmt #f "../bin/thin_check --skip-mappings --override-mapping-root " + root " " metadata " > /dev/null 2>&1")))) + (fmt #t "exit-code: " (wrt exit-code) ", ") + (zero? exit-code))) + +(define metadata "../customer-metadata-full.bin") + +(define (read-superblock cache) + (with-block (b cache 0 (get-flags)) + (block->superblock b))) + +(define nr-metadata-blocks 8192) + +(define (in-metadata-bounds? i) + (< i nr-metadata-blocks)) + +(define nr-data-blocks (* 183 32 1024)) + +(define (in-data-bounds? i) + (< i nr-data-blocks)) + +(define superblock-salt 160774) + +(define (checksum-superblock cache) + (with-block (b cache 0 (get-flags)) + (checksum-block b (ftype-sizeof unsigned-32) superblock-salt))) + +(define (mk-conser v) + (lambda (xs) + (cons v xs))) + +(define (add-rmap! rmap parent child) + (hashtable-update! rmap child (mk-conser parent) '())) + +(define (get-nr-entries hdr) + (ftype-ref BTreeNodeHeader (nr-entries) hdr)) + +(define (all-values? pred b hdr vt) + (let ((vals (block->values b vt))) + (all? (lambda (i) (pred (value-at vt vals i))) + (iota (get-nr-entries hdr))))) + +(define (unpack-block bt) + (receive (block time) (unpack-block-time bt) + block)) + +(define (internal? b hdr) + (internal-node? hdr)) + +(define (top-level-leaf? b hdr) + (and (leaf-node? hdr) + (= (ftype-sizeof unsigned-64) (ftype-ref BTreeNodeHeader (value-size) hdr)) + (all-values? in-metadata-bounds? b hdr le64-vt))) + +(define (bottom-level-leaf? b hdr) + (and (leaf-node? hdr) + (= (ftype-sizeof unsigned-64) (ftype-ref BTreeNodeHeader (value-size) hdr)) + (let ((vals (block->values b le64-vt))) + (all? in-data-bounds? + (map (lambda (i) + (unpack-block (value-at le64-vt vals i))) + (iota (get-nr-entries hdr))))))) + +(define (top-level-root? b hdr) + (and (leaf-node? hdr) + (< (ftype-ref BTreeNodeHeader (nr-entries) hdr) + (/ (ftype-ref BTreeNodeHeader (max-entries) hdr) 3)))) + +(define (classify-node b hdr) + (fold-left append '() + (map (lambda (pair) + (if ((car pair) b hdr) + (cdr pair) + '())) + `((,internal? internal) + (,bottom-level-leaf? bottom-level-leaf) + (,top-level-leaf? top-level-leaf))))) + +(define (checksum-btree-node b) + (checksum-block b (ftype-sizeof unsigned-32) btree-node-salt)) + +(define (classify-nodes cache) + (map (lambda (n) + (with-block (b cache n (get-flags)) + (let ((hdr (block->header b)) + (csum (checksum-btree-node b))) + (cons n + (if (= csum (ftype-ref BTreeNodeHeader (csum) hdr)) + (classify-node b hdr) + '()))))) + (iota (get-nr-blocks cache)))) + +;;; The rmap depends on which class we're assuming + +(define-syntax detail-ref + (syntax-rules () + ((_ ptr field) + (ftype-ref ThinDeviceDetails (field) ptr)))) + +(define (dump-device-details cache) + (let ((sb (read-superblock cache))) + (device-tree-each cache (ftype-ref ThinSuperblock (device-details-root) sb) + (lambda (dev-id dd) + (fmt #t "dev-id: " dev-id "\n" + "mapped-blocks: " (detail-ref dd mapped-blocks) "\n" + "transaction-id: " (detail-ref dd transaction-id) "\n" + "creation-time: " (detail-ref dd creation-time) "\n" + "snappshotted-time: " (detail-ref dd snapshotted-time) "\n"))))) + +(define (dump-rmap rmap) + (receive (keys values) (hashtable-entries rmap) + (vector-for-each + (lambda (k v) + (fmt #t k ": " (dsp v) "\n")) + keys + values))) + +;; An interesting node has more than one class. +(define (filter-interesting-blocks classes) + (filter (lambda (xs) + (> (length xs) 1)) + classes)) + +(with-bcache (cache metadata (* 16 1024)) + (dump-device-details cache) + (let ((classes (classify-nodes cache)) + (rmap (make-eq-hashtable))) + (fmt #t (filter-interesting-blocks classes)))) + +#| +(with-bcache (cache metadata (* 16 1024)) + (let ((sb (read-superblock cache))) + (let ((actual-cs (checksum-superblock cache)) + (disk-cs (ftype-ref ThinSuperblock (csum) sb))) + (fmt #t "actual checksum: " actual-cs ", disk checksum: " disk-cs "\n")))) +|# + +#| +(let loop ((i 0) + (successes '())) + (if (> i 8192) + (fmt #t "successes: " (wrt successes) "\n") + ;; add --ignore-non-fatal-errors flag + (if (thin-check "../customer-metadata-full.bin" i) + (begin + (fmt #t "success: " i "\n") + (loop (+ i 1) (cons i successes))) + (begin + (fmt #t "fail: " i "\n") + (loop (+ i 1) successes))))) +|#