diff options
| -rw-r--r-- | src/base32.lisp | 4 | ||||
| -rw-r--r-- | src/conditions.lisp | 6 | ||||
| -rw-r--r-- | src/eris-decode.lisp | 43 | ||||
| -rw-r--r-- | src/eris.lisp | 65 |
4 files changed, 78 insertions, 40 deletions
diff --git a/src/base32.lisp b/src/base32.lisp index 0ed4624..ec0340b 100644 --- a/src/base32.lisp +++ b/src/base32.lisp @@ -183,9 +183,13 @@ base32-bytes)) (defun base32-to-bytes-unpadded (base32-string) + "Return the bytes decoded from the supplied base32 string that was produced with +padding removed." (let ((padding (make-array (- 8 (mod (length base32-string) 8)) :element-type 'character :initial-element #\=))) (base32-to-bytes (concatenate 'string base32-string padding)))) (defun bytes-to-base32-unpadded (bytes) + "Return a base32 string encoding of the provided vector of bytes, without any +padding." (let ((string (bytes-to-base32 bytes))) (subseq string 0 (position #\= string)))) diff --git a/src/conditions.lisp b/src/conditions.lisp index 290d999..99b56f2 100644 --- a/src/conditions.lisp +++ b/src/conditions.lisp @@ -15,7 +15,11 @@ (in-package :eris) -(define-constant +eris-revision+ "1.0" :test #'equalp) +(define-constant +eris-revision+ "1.0" + :test #'equalp + :documentation + "String constant indicating the ERIS standard revision supported by this +implementation.") (define-condition eris-condition () ()) diff --git a/src/eris-decode.lisp b/src/eris-decode.lisp index b660cae..fe2dcbe 100644 --- a/src/eris-decode.lisp +++ b/src/eris-decode.lisp @@ -49,7 +49,8 @@ fetched from a trusted party.") (root :accessor root :type high-block :initarg :root :documentation "A list of blocks, starting from the root to the level 1 block.") (buffer :accessor buffer :initarg :buffer :type buffer) (eof :accessor eof :initarg :eof :type integer) - (nonce-array :accessor nonce-array :initarg :nonce-array :type simple-array))) + (nonce-array :accessor nonce-array :initarg :nonce-array :type simple-array)) + (:documentation "Class representing the stream object that decodes an ERIS read capability.")) (defun initialize-nonce-array (level) (let ((array (make-array (1+ level)))) @@ -68,11 +69,12 @@ fetched from a trusted party.") (defun unpad-buffer (buffer) (with-slots (eof data) buffer - (setf eof - (unpad-block data)))) + (setf eof (unpad-block data)))) -(defun ls (level block-size) - (declare ;; (type (unsigned-byte 8) level) +(defun local-range (level block-size) + "Given a level and a block-size, determine the range of bytes that it +represents." + (declare (type fixnum level) (type block-size block-size)) (ecase block-size (1024 (expt 2 (+ 10 (* level 4)))) @@ -81,7 +83,7 @@ fetched from a trusted party.") (defun find-eof (root get-block block-size level) "Find the end of file in a given tree." ;; The standard states that: - ;; If 64 bytes of zeroes are encountered the rest of the node MUST be checked to be all zeroes + ;; "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 (flet ((find-last-reference (block) @@ -97,10 +99,14 @@ fetched from a trusted party.") do (setf position (+ position (unpad-block block))) and return position else - do (setf position (+ position (* block-pos (ls (1- local-level) block-size))))))) + do (setf position (+ position (* block-pos (local-range (1- local-level) block-size))))))) (defun advance-next-block (stream) - "Advance to the next block. This function is called by update-buffer." + "Advance to the next block. + +This function walks the tree in order to get the next block, which is then put +in the buffer object of the STREAM. It sets the EOF indicator of the buffer if +it is necessary and sets the position in the buffer to 0." (declare (optimize (speed 3) (debug 0))) (with-slots (buffer position eof block-size root get-block nonce-array) stream (declare (type integer position eof) @@ -122,8 +128,8 @@ fetched from a trusted party.") (funcall get-block (reference kr) (key 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)))) + (setf (data buffer) (data (car (last root))) + (pos buffer) 0) ;; if the EOF block is reached, unpad it. (when (= (- eof (mod eof block-size)) position) (unpad-buffer buffer))))) @@ -148,8 +154,7 @@ fetched from a trusted party.") (+ start seq-bytes)) ((eql eof (length data)) ;; seq is larger or equal than buffer case (replace sequence data :start1 start :end1 end :start2 pos) - (setf pos 0 - (pos stream) (+ (pos stream) buffer-bytes)) + (setf (pos stream) (+ (pos stream) buffer-bytes)) (advance-next-block stream) (read-to-seq sequence buf :start (+ start buffer-bytes) :end end :stream stream)) (t ;; if there is an eof in the buffer @@ -167,8 +172,8 @@ fetched from a trusted party.") (loop with update-tree = nil for blocks = root then (cdr blocks) for level = (level (car blocks)) ;; then (decf level) - for position = new-pos then (mod position (ls (1- level) block-size)) ;; local position - for block-position = (floor (/ position (ls (1- level) block-size))) ;; the position of the block + for position = new-pos then (mod position (local-range (1- level) block-size)) ;; local position + for block-position = (floor (/ position (local-range (1- level) block-size))) ;; the position of the block for lower-block = (second blocks) when (> block-position (/ block-size 64)) do (error 'eof :eof new-pos :position (pos stream)) @@ -209,11 +214,14 @@ gethash. The keyword argument CACHE-CAPACITY indicates the amount of blocks stored in the cache." + (declare (type read-capability read-capability) + (type function fetch-function) + (type integer cache-capacity)) (with-slots (level block-size root-reference-pair) read-capability (let* ((get-block (cached-lambda (:cache-class 'lru-cache - :capacity cache-capacity - :table (make-hash-table :size (1+ cache-capacity) :test #'equalp)) - (reference key &optional nonce) + :capacity cache-capacity + :table (make-hash-table :size (1+ cache-capacity) :test #'equalp)) + (reference key &optional nonce) (let* ((block (funcall fetch-function reference))) (unless block (error 'missing-block :reference reference)) (hash-check block reference) @@ -291,7 +299,6 @@ the new position is beyond the end of file.." (with-slots (pos eof data) buffer (cond ((eql pos block-size) - (setf pos 0) (advance-next-block stream) (stream-read-byte stream)) ((eql pos eof) diff --git a/src/eris.lisp b/src/eris.lisp index b30c6a4..5e3ed2a 100644 --- a/src/eris.lisp +++ b/src/eris.lisp @@ -15,15 +15,6 @@ (in-package :eris) -(defun pad (input block-size) - (declare (type (simple-array (unsigned-byte 8)) input) - (type integer block-size)) - (let* ((pad-size (- block-size (mod (length input) block-size))) - (padded-input (adjust-array input (+ pad-size (length input)) :initial-element 0))) - (replace padded-input input) - (setf (aref padded-input (length input)) #x80) - padded-input)) - (deftype block-size () `(member 1024 32768)) @@ -36,14 +27,22 @@ ((reference :initarg :reference :accessor reference :type (simple-array (unsigned-byte 8) 32)) (key :initarg :key :accessor key :type (simple-array (unsigned-byte 8) 32))))) -(define-constant null-secret (make-array 32 :element-type '(unsigned-byte 8) :initial-element 0) :test #'equalp) +(define-constant null-secret (make-array 32 :element-type '(unsigned-byte 8) :initial-element 0) + :test #'equalp + :documentation + "32-byte null vector.") (defun reference-pair-to-octets (pair buf &optional (start 0)) - (replace buf (reference pair) :start1 start) + "Convert a reference-pair object PAIR into the standard binary representation by +filling the buffer BUF from the START keyword argument. " + (declare (type vector buf)) + (replace buf (reference pair) :start1 start) (replace buf (key pair) :start1 (+ 32 start))) (defun octets-to-reference-pair (octets &optional (start 0)) - (declare (type (simple-array (unsigned-byte 8)) octets)) + "Convert the standard reference-pair binary representation into a reference-pair +object, using the bytes from the OCTETS vector from at START." + (declare (type vector octets)) (make-instance 'reference-pair :key (subseq octets (+ 32 start) (+ 64 start)) :reference (subseq octets start (+ 32 start)))) @@ -54,8 +53,6 @@ (ironclad:digest-sequence :blake2/256 block :digest reference) reference)) -(declaim (inline make-nonce)) - (defun make-nonce (level) (let ((nonce (make-array 12 :element-type '(unsigned-byte 8) :initial-element 0))) (setf (aref nonce 0) level) @@ -98,20 +95,31 @@ :type block-size :documentation "A value of either 1024 or 1kb blocks.") (level :initarg :level :accessor level :type (unsigned-byte 8)) - (root-reference-pair :initarg :reference-pair :accessor reference-pair))) - + (root-reference-pair :initarg :reference-pair :accessor reference-pair)) + (:documentation "Class representing the concept of an ERIS read capability.")) +(declaim + (ftype (function (read-capability) (values (simple-array (unsigned-byte 8) (66)) &optional)) read-capability-to-octets) + (ftype (function ((simple-array (unsigned-byte 8) (66))) read-capability) octets-to-read-capability) + (ftype (function (read-capability) string) read-capability-to-urn) + (ftype (function (string) read-capability) urn-to-read-capability) + (ftype (function ((simple-array (unsigned-byte 8) (32))) string) reference-to-block-urn) + (ftype (function (string) (values (simple-array (unsigned-byte 8) (32)) &optional)) block-urn-to-reference)) (defun read-capability-to-octets (read-capability) + "Convert a read-capability object to its standard binary representation. Returns +a (simple-array (unsigned-byte 8)) object." (declare (type read-capability read-capability)) (let ((cap (make-array 66 :element-type '(unsigned-byte 8)))) (case (block-size read-capability) ;; This depends on the version of the standard - (1024 (setf (aref cap 0) #x0a)) - (32768 (setf (aref cap 0) #x0f))) + (1024 (setf (aref cap 0) #x0a)) + (32768 (setf (aref cap 0) #x0f))) (setf (aref cap 1) (level read-capability)) (reference-pair-to-octets (reference-pair read-capability) cap 2))) (defun octets-to-read-capability (octets) + "Convert the standard binary representation for ERIS read capabilities into a +read-capability object. Returns the read-capability." (declare (type (simple-array (unsigned-byte 8) (66)) octets)) (let ((capability (make-instance 'read-capability))) (setf (block-size capability) @@ -126,21 +134,36 @@ capability)) (defun read-capability-to-urn (capability) + "Convert a read-capability object into a URN string." + (declare (type read-capability capability)) (concatenate 'string "urn:eris:" (bytes-to-base32-unpadded (read-capability-to-octets capability)))) (defun urn-to-read-capability (urn) + "Convert a urn:eris URN string into a read-capability object." + (declare (type string urn)) (octets-to-read-capability (base32-to-bytes-unpadded (subseq urn (1+ (position #\: urn :from-end t)))))) (defun reference-to-block-urn (reference) + "Convert a 32-byte block reference into a URN string." (declare (type (simple-array (unsigned-byte 8) (32)) reference)) (concatenate 'string "urn:blake2b:" (bytes-to-base32-unpadded reference))) (defun block-urn-to-reference (urn) + "Convert a urn:blake2b URN string into a 32-byte block reference vector." (declare (type string urn)) (base32-to-bytes-unpadded (subseq urn (1+ (position #\: urn :from-end t))))) +(defun pad (input block-size) + (declare (type (simple-array (unsigned-byte 8)) input) + (type integer block-size)) + (let* ((pad-size (- block-size (mod (length input) block-size))) + (padded-input (adjust-array input (+ pad-size (length input)) :initial-element 0))) + (replace padded-input input) + (setf (aref padded-input (length input)) #x80) + padded-input)) + (defvar *output-hashmap* nil) (defmacro output-block (ref-vector &rest expr) @@ -230,9 +253,9 @@ An optional 32-byte secret can be passed for additional encryption using the for rk across reference-vector with i = 0 when (eql i block-keys) - do (output-internal-block reference-vector-l nonce - (setf block (make-array block-size :element-type '(unsigned-byte 8) :initial-element 0) - i 0)) + do (output-internal-block reference-vector-l nonce + (setf block (make-array block-size :element-type '(unsigned-byte 8) :initial-element 0) + i 0)) do (progn (reference-pair-to-octets rk block (* 64 i)) (incf i)) finally (unless (zerop i) |