diff options
Diffstat (limited to 'src/eris-decode.lisp')
| -rw-r--r-- | src/eris-decode.lisp | 55 |
1 files changed, 31 insertions, 24 deletions
diff --git a/src/eris-decode.lisp b/src/eris-decode.lisp index fe2dcbe..351da72 100644 --- a/src/eris-decode.lisp +++ b/src/eris-decode.lisp @@ -26,6 +26,10 @@ fetched from a trusted party.") (unless (equalp ,hash hash) (error 'hash-mismatch :reference ,hash :hash hash ))))) +(defmacro execute-fetch-function (fetch-function &rest args) + `(restart-case (funcall ,fetch-function ,@args) + (use-value (value) value))) + (defun key-reference-null? (kr) (and (equalp (reference kr) null-secret) (equalp (key kr) null-secret))) @@ -222,7 +226,7 @@ cache." :capacity cache-capacity :table (make-hash-table :size (1+ cache-capacity) :test #'equalp)) (reference key &optional nonce) - (let* ((block (funcall fetch-function reference))) + (let* ((block (execute-fetch-function fetch-function reference))) (unless block (error 'missing-block :reference reference)) (hash-check block reference) (decrypt-block block key nonce)))) @@ -262,34 +266,17 @@ cache." :eof (find-eof root get-block block-size level) :nonce-array (initialize-nonce-array level))))))) -(defmethod stream-file-position ((stream eris-decode-stream) &optional (set-position nil)) - "Provides the file position of the stream. If the optional second argument is -set, try to move the stream to that position. It may signal an EOF condition if -the new position is beyond the end of file.." - ;; NOTE: this should accept a "file-spec", which I believe is either an int, a - ;; :start or an :end. This only accepts a number. - (with-slots (position block-size buffer eof) stream - (when set-position - (let ((buffer-pos (mod set-position block-size))) - (if (< set-position eof) - (cond - ;; If the pos is within the buffer (and initialized): - ((and (<= 0 (- set-position (- position (pos buffer))) (1- block-size)) - (not (minusp (pos buffer)))) - (setf (pos buffer) buffer-pos - position set-position)) - - (t (reupdate-block stream set-position) - (setf (pos buffer) buffer-pos))) - (error 'eof :eof eof :position position)))) - position)) +(defmethod stream-file-position ((stream eris-decode-stream)) + "Provides the file position of the stream. This method is setf-able in order to +change the position." + (pos stream)) -(defmethod stream-read-sequence ((stream eris-decode-stream) seq &optional (start 0) (end (length seq))) +(defmethod stream-read-sequence ((stream eris-decode-stream) seq start end &key) (when (minusp (pos (buffer stream))) ;; initializes the buffer (reupdate-block stream (pos stream))) (with-slots (buffer position) stream - (read-to-seq seq buffer :start start :end (if end end (length seq)) :stream stream))) + (read-to-seq seq buffer :start start :end end :stream stream))) (defmethod stream-read-byte ((stream eris-decode-stream)) (when (minusp (pos (buffer stream))) @@ -313,3 +300,23 @@ the new position is beyond the end of file.." (defun eris-file-length (stream) "This is the equivalent of \"file-length\" for eris-decode-stream." (eof stream)) + +(defmethod (setf stream-file-position) (set-position (stream eris-decode-stream)) + (with-slots (position block-size buffer eof) stream + (when set-position + (case set-position + (:end (setf set-position eof)) + (:start (setf set-position 0))) + (let ((buffer-pos (mod set-position block-size))) + (if (< set-position eof) + (cond + ;; If the pos is within the buffer (and initialized): + ((and (<= 0 (- set-position (- position (pos buffer))) (1- block-size)) + (not (minusp (pos buffer)))) + (setf (pos buffer) buffer-pos + position set-position)) + + (t (reupdate-block stream set-position) + (setf (pos buffer) buffer-pos))) + (error 'eof :eof eof :position position)))) + set-position)) |