diff --git a/functional-tests/check-superblock.scm b/functional-tests/check-superblock.scm new file mode 100644 index 0000000..e4033f6 --- /dev/null +++ b/functional-tests/check-superblock.scm @@ -0,0 +1,151 @@ +(import + (fmt fmt) + (matchable)) + +;;;;--------------------------------------------------- +;;;; Constants +;;;;--------------------------------------------------- + +;; FIXME: duplicate with main.scm +(define (current-metadata) + "./metadata.bin") + +(define metadata-block-size 4096) +(define superblock-magic 27022010) +(define superblock-salt 160774) +(define uuid-size 16) +(define space-map-root-size 128) + +;;;;--------------------------------------------------- +;;;; Metadata IO +;;;;--------------------------------------------------- + +(define (open-metadata path) + (open-file-input-port path (file-options) (buffer-mode none))) + +(define-syntax with-metadata + (syntax-rules () + ((_ (port path) body ...) (let ((port (open-metadata path))) + (dynamic-wind + (lambda () #f) + (lambda () body ...) + (lambda () (close-port port))))))) + +;; FIXME: return our own condition? +(define (io-error msg) + (raise (condition + (make-error) + (make-message-condition msg)))) + +;;; Returns a 4k bytevector +(define (read-block port b) + (set-port-position! port (* b metadata-block-size)) + (let ((data (get-bytevector-n port metadata-block-size))) + (unless (and (not (eof-object? data)) + (= metadata-block-size (bytevector-length data))) + (io-error (fmt #f (dsp "unable to read metadata block: ") (num b)))) + data)) + +;;;;--------------------------------------------------- +;;;; CRC32 +;;;;--------------------------------------------------- + +;; FIXME: move to own library +(load-shared-object "libz.so") +(define crc32 + (foreign-procedure "crc32" (unsigned-long u8* unsigned-int) unsigned-long)) + +(define crc32-combine + (foreign-procedure "crc32_combine" (unsigned-long unsigned-long unsigned-long) unsigned-long)) + +;; FIXME: stop copying the bytevector. I'm not sure how to pass an offset into +;; the bv. +(define (crc32-region salt bv start end) + (assert (< start end)) + (let ((len (- end start))) + (let ((copy (make-bytevector len))) + (bytevector-copy! bv start copy 0 len) + (let ((crc (crc32 salt copy 0))) + (crc32 crc copy len))))) + +;;;;--------------------------------------------------- +;;;; Decoding +;;;;--------------------------------------------------- + +(define-syntax unpack-type + (syntax-rules (le32 le64 bytes) + ((_ bv offset le32) + (bytevector-u32-ref bv offset (endianness little))) + + ((_ bv offset le64) + (bytevector-u64-ref bv offset (endianness little))) + + ((_ bv offset (bytes count)) + (let ((copy (make-bytevector count))) + (bytevector-copy! bv offset copy 0 count) + copy)))) + +(define (size-type t) + (syntax->datum + (syntax-case t (le32 le64 bytes) + (le32 #'4) + (le64 #'8) + ((bytes count) #'count)))) + +(define-syntax binary-format + (lambda (x) + (syntax-case x () + ((_ (name pack-name unpack-name) (field type) ...) + (with-syntax ((((t o) ...) + (let f ((acc 0) (types #'(type ...))) + (if (null? types) + '() + (cons (list (car types) acc) + (f (+ acc (size-type (car types))) (cdr types))))))) + #'(begin + (define-record-type name (fields field ...)) + + (define (unpack-name bv offset) + ((record-constructor (record-type-descriptor name)) + (unpack-type bv (+ offset o) t) ...)))))))) + +(binary-format (superblock pack-superblock unpack-superblock) + (csum le32) + (flags le32) + (block-nr le64) + (uuid (bytes 16)) + (magic le64) + (version le32) + (time le32) + (trans-id le64) + (metadata-snap le64) + (data-space-map-root (bytes 128)) + (metadata-space-map-root (bytes 128)) + (data-mapping-root le64) + (device-details-root le64) + (data-block-size le32) + (metadata-block-size le32) + (metadata-nr-blocks le64) + (compat-flags le32) + (compat-ro-flags le32) + (incompat-flags le32)) + +;;;;--------------------------------------------------- +;;;; Top level +;;;;--------------------------------------------------- + +(define (check-magic sb) + ((let ((m (bytevector-u32-ref sb 32 (endianness little)))) + (fmt #t (dsp "on disk magic: ") (num m) nl) + ))) + +(define (read-superblock) + (with-metadata (md (current-metadata)) + (unpack-superblock (read-block md 0) 0))) + +(define (check-superblock) + (with-metadata (md (current-metadata)) + (let ((superblock (read-block md 0))) + (fmt #t (dsp "checksum on disk: ") (dsp (bytevector-u32-ref superblock 0 (endianness little))) nl) + (fmt #t (dsp "calculated checksum: ") (dsp (crc32-region superblock-salt superblock 4 4092)) nl) + (check-magic superblock))))