summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/base32.lisp4
-rw-r--r--src/conditions.lisp6
-rw-r--r--src/eris-decode.lisp43
-rw-r--r--src/eris.lisp65
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)