emo/thin-provisioning-tools
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[functional tests] Break up check-superblock.scm into separate

Browse Source 
libraries
This commit is contained in:
Joe Thornber
2017-08-08 11:47:37 +01:00
parent 2f355f64ff
commit 57db3a2b99
5 changed files with 120 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files

41
functional-tests/binary-format.scm Normal file
View File

@@ -0,0 +1,41 @@
(library
(binary-format)
(export binary-format)
(import (rnrs))
(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-case t (le32 le64 bytes)
(le32 #'4)
(le64 #'8)
((bytes count) #'count)))
;;; FIXME: (bytes <count>) has to use a literal rather than a symbol.
(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 (+ (syntax->datum (size-type (car types))) acc) (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) ...)))))))))

53
functional-tests/block-io.scm Normal file
View File

@@ -0,0 +1,53 @@
(library
(block-io)
(export metadata-block-size
open-metadata
with-metadata
read-block)
(import (rnrs)
(fmt fmt))
;;;---------------------------------------------------
;;; TODO:
;;; - implement a little block cache.
;;; - writes
;;; - zero blocks
;;; - prefetching
;;;---------------------------------------------------
(define metadata-block-size 4096)
(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 boolean indicating success
(define (read-exact! port offset len bv start)
(set-port-position! port offset)
(let ((nr (get-bytevector-n! port bv start len)))
(and (not (eof-object? nr))
(= len nr))))
;;; Returns a 4k bytevector or #f
(define (read-exact port offset len)
(let ((bv (make-bytevector len)))
(if (read-exact! port offset len bv 0) bv #f)))
(define (read-block port b)
(or (read-exact port (* b metadata-block-size) metadata-block-size)
(io-error (fmt #f (dsp "Unable to read metadata block: ") (num b))))))

105
functional-tests/check-superblock.scm
View File

@@ -1,4 +1,5 @@
(import
(block-io)
(fmt fmt)
(matchable))
@@ -10,115 +11,11 @@
(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 boolean indicating success
(define (read-exact! port offset len bv start)
(set-port-position! port offset)
(let ((nr (get-bytevector-n! port bv start len)))
(and (not (eof-object? nr))
(= len nr))))
;;; Returns a 4k bytevector or #f
(define (read-exact port offset len)
(let ((bv (make-bytevector len)))
(if (read-exact! port offset len bv 0) bv #f)))
(define (read-block port b)
(or (read-exact port (* b metadata-block-size) metadata-block-size)
(io-error (fmt #f (dsp "Unable to read metadata block: ") (num b)))))
;;; FIXME: implement a little block cache.
;;;;---------------------------------------------------
;;;; 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-case t (le32 le64 bytes)
(le32 #'4)
(le64 #'8)
((bytes count) #'count)))
;;; FIXME: (bytes <count>) has to use a literal rather than a symbol.
(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 (+ (syntax->datum (size-type (car types))) acc) (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)

23
functional-tests/crc32.scm Normal file
View File

@@ -0,0 +1,23 @@
(library
(crc32)
(export crc32)
(import (chezscheme))
(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))))))