diff options
Diffstat (limited to 'src/eris-decode.lisp')
| -rw-r--r-- | src/eris-decode.lisp | 62 |
1 files changed, 31 insertions, 31 deletions
diff --git a/src/eris-decode.lisp b/src/eris-decode.lisp index b3629a2..df64913 100644 --- a/src/eris-decode.lisp +++ b/src/eris-decode.lisp @@ -20,19 +20,19 @@ fetched blocks are what they claim to be. Only disable this if the blocks are fetched from a trusted party.") -(defmacro hash-check (block hash) +(defmacro hash-check (block rk &optional key) `(when *decode-safety-checks* (let ((hash (ironclad:digest-sequence :blake2/256 ,block))) - (unless (equalp ,hash hash) - (error 'hash-mismatch :reference ,hash :hash hash ))))) + (unless (octet-vector= ,rk hash ,(if key :start1 :end1) 32) + (error 'hash-mismatch :reference ,rk :hash hash ))))) +;; This is quite pointless. (defmacro execute-fetch-function (fetch-function &rest args) - `(restart-case (funcall ,fetch-function ,@args) + `(restart-case (funcall ,fetch-function (subseq ,@args 0 32)) (use-value (value) value))) (defun key-reference-null? (kr) - (and (equalp (reference kr) null-secret) - (equalp (key kr) null-secret))) + (octet-vector= kr #.(make-array 64 :element-type 'octet :initial-element 0))) (defclass high-block () ((data :initarg :data :accessor data :type octet-vector) @@ -89,15 +89,16 @@ represents." ;; The standard states that: ;; "If 64 bytes of zeroes are encountered the rest of the node MUST be checked to be all zeroes" ;; This procedure processes the block from right to left so it's not really applicable here + ;; A maliciously crafted ERIS block which contains 0 ... kr ... 0 ... kr could fool this. (flet ((find-last-reference (block) (loop for i from (1- (/ block-size 64)) downto 0 - for key-reference = (octets-to-reference-pair block (* 64 i)) + for key-reference = (subseq block (* 64 i) (+ 64 (* 64 i))) unless (key-reference-null? key-reference) return (values key-reference i)))) (loop with position = 0 for local-level = level then (1- local-level) - for block = root then (funcall get-block (reference key-reference) (key key-reference) (make-nonce local-level)) + for block = root then (funcall get-block key-reference (make-nonce local-level)) for (key-reference block-pos) = (multiple-value-list (find-last-reference block)) if (eql 0 local-level) do (setf position (+ position (unpad-block block))) @@ -126,11 +127,11 @@ it is necessary and sets the position in the buffer to 0." (type fixnum next-pos)) (when (zerop next-pos) ;; if 1+ mod blocks results in a zero, then update the next block (process-block (cdr blocks) mod (1+ level))) - (let ((kr (octets-to-reference-pair - (data (cadr blocks)) - (the fixnum (* next-pos 64))))) + (let ((kr (let ((a (make-octet-vector 64))) + (replace a (data (cadr blocks)) :start2 (the fixnum (* next-pos 64))) + a))) (setf (data current) - (funcall get-block (reference kr) (key kr) (svref nonce-array level))))))) + (funcall get-block kr (svref nonce-array level))))))) (process-block (reverse root) (/ block-size 64) 0) ;; process the blocks from level 0 up ;; setf the buffer data to the level 0 block (setf (data buffer) (data (car (last root))) @@ -184,12 +185,12 @@ it is necessary and sets the position in the buffer to 0." do (error 'eof :eof new-pos :position (pos stream)) until (eq nil (cdr blocks)) when (or update-tree (not (eq block-position (pos lower-block)))) - do (let ((rk (octets-to-reference-pair - (data (car blocks)) - (* 64 block-position)))) + do (let ((rk (let ((a (make-octet-vector 64))) + (replace a (data (car blocks)) :start2 (* 64 block-position)) + a))) (when (key-reference-null? rk) (error 'eof :eof new-pos :position (pos stream))) - (setf (data lower-block) (funcall get-block (reference rk) (key rk) (svref nonce-array (1- level))) + (setf (data lower-block) (funcall get-block rk (svref nonce-array (1- level))) (pos lower-block) block-position update-tree t)) finally (when update-tree ;; if anything changed @@ -232,22 +233,22 @@ FETCH-FUNCTION is not handled." (cached-lambda (:cache-class 'lru-cache :capacity cache-capacity :table (make-hash-table :size (1+ cache-capacity) :test #'equalp)) - (reference key nonce) - (declare (type octet-vector reference key nonce)) - (let ((block (execute-fetch-function fetch-function reference))) + (rk nonce) + (declare (type octet-vector rk nonce)) + (let ((block (execute-fetch-function fetch-function rk))) (declare (type octet-vector block)) - (hash-check block reference) - (decrypt-block block key nonce))) - (lambda (reference key nonce) - (declare (type octet-vector reference key nonce)) - (let ((block (execute-fetch-function fetch-function reference))) + (hash-check block rk) + (decrypt-block block rk nonce))) + (lambda (rk nonce) + (declare (type octet-vector rk nonce)) + (let ((block (execute-fetch-function fetch-function rk))) (declare (type octet-vector block)) - (hash-check block reference) - (decrypt-block block key nonce))))) - (root (funcall get-block (reference root-reference-pair) (key root-reference-pair) (make-nonce level)))) + (hash-check block rk) + (decrypt-block block rk nonce))))) + (root (funcall get-block root-reference-pair (make-nonce level)))) ;; "Implementations MUST verify the key appearing in the read capability ;; if level of encoded content is larger than 0." - (when (> level 0) (hash-check root (key root-reference-pair))) + (when (> level 0) (hash-check root root-reference-pair :key)) (case level ;; Treat level 0 blocks specially, since those are just a single buffer. (0 (let ((stream @@ -256,9 +257,8 @@ FETCH-FUNCTION is not handled." :data (make-array block-size :element-type 'octet) :pos 0 :eof -1) - :get-block (lambda (reference key) - (declare (ignore key)) - (error 'missing-block :reference reference)) + :get-block (lambda (rk) + (error 'missing-block :reference rk)) :block-size block-size :root nil :eof (find-eof root get-block block-size level) |