thin-provisioning-tools/functional-tests/block-io.scm

(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))))))