This is the start of a tool that will analyse the block manager journal and spot any cases where we're not crash proof.
		
			
				
	
	
		
			59 lines
		
	
	
		
			1.4 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
			
		
		
	
	
			59 lines
		
	
	
		
			1.4 KiB
		
	
	
	
		
			Plaintext
		
	
	
	
	
	
(import (chezscheme)
 | 
						|
        (bcache block-manager)
 | 
						|
	(fmt fmt)
 | 
						|
	(loops)
 | 
						|
        (persistent-data btree)
 | 
						|
	(thin metadata))
 | 
						|
 | 
						|
(define (noop k v)
 | 
						|
  'nil)
 | 
						|
 | 
						|
(define (mapping-top-level root)
 | 
						|
  (btree-open le64-vt root))
 | 
						|
 | 
						|
(define (mapping-bottom-level root)
 | 
						|
  (btree-open le64-vt root))
 | 
						|
 | 
						|
(define (mk-incrementer counts)
 | 
						|
 (lambda (i)
 | 
						|
  (vector-set! counts i (+ (vector-ref counts i) 1))))
 | 
						|
 | 
						|
(define (bottom-level-walker cache inc-fn)
 | 
						|
 (lambda (key root)
 | 
						|
  (btree-each-and-count (mapping-bottom-level root) cache noop inc-fn)))
 | 
						|
 | 
						|
(define (walk-top-level cache root counts)
 | 
						|
  (let ((inc-fn (mk-incrementer counts)))
 | 
						|
   (btree-each-and-count (mapping-top-level root)
 | 
						|
    			 cache
 | 
						|
			 (bottom-level-walker cache inc-fn)
 | 
						|
			 inc-fn)))
 | 
						|
 | 
						|
(define (calc-ref-counts md-path)
 | 
						|
  (with-bcache (cache md-path (* 1 1024))
 | 
						|
    (let ((counts (make-vector (get-nr-blocks cache) 0)))
 | 
						|
     (with-block (b cache 0 (get-flags))
 | 
						|
      (let ((sb (block->superblock b)))
 | 
						|
	(walk-top-level cache
 | 
						|
	                (ftype-ref ThinSuperblock (data-mapping-root) sb)
 | 
						|
			counts)))
 | 
						|
 | 
						|
     counts)))
 | 
						|
 | 
						|
(define (print-counts counts)
 | 
						|
  (upto (i (vector-length counts))
 | 
						|
   (let ((rc (vector-ref counts i)))
 | 
						|
    (when (> rc 0)
 | 
						|
     (fmt #t i ": " (vector-ref counts i) nl)))))
 | 
						|
 | 
						|
(define (usage)
 | 
						|
 (fmt #t "Usage: thin-calc-ref-counts <binary metadata>" nl)
 | 
						|
 (exit 1))
 | 
						|
 | 
						|
(let ((args (cdr (command-line))))
 | 
						|
  (if (not (= (length args) 1))
 | 
						|
   (usage)
 | 
						|
   (let ((counts (calc-ref-counts (car args))))
 | 
						|
    (print-counts counts))))
 | 
						|
 |