diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/backend.lisp | 3 | ||||
| -rw-r--r-- | src/eris-decode.lisp | 62 | ||||
| -rw-r--r-- | src/eris.lisp | 128 |
3 files changed, 74 insertions, 119 deletions
diff --git a/src/backend.lisp b/src/backend.lisp index 5568132..8d1405b 100644 --- a/src/backend.lisp +++ b/src/backend.lisp @@ -41,7 +41,7 @@ protect the data from attacks against convergent encryption.")) (with-slots (fetch-function) backend (eris-decode read-capability fetch-function))) -(defmethod store-data (input (backend encoding-backend) &key (secret null-secret) (hash-output nil) &allow-other-keys) +(defmethod store-data (input (backend encoding-backend) &key (secret null-secret) &allow-other-keys) (declare (type octet-vector secret)) (with-slots (output-function) backend (eris-encode input ;; According to ERIS spec recommendation. @@ -52,5 +52,4 @@ protect the data from attacks against convergent encryption.")) 32kib 1kib) output-function - :hash-output hash-output :secret secret))) 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) diff --git a/src/eris.lisp b/src/eris.lisp index 8f836f8..7efdc73 100644 --- a/src/eris.lisp +++ b/src/eris.lisp @@ -21,69 +21,44 @@ (defconstant 32kib 32768) (defconstant 1kib 1024) -(defclass reference-pair () - ((reference :initarg :reference :accessor reference :type (octet-vector 32)) - (key :initarg :key :accessor key :type (octet-vector 32)))) - (define-constant null-secret (make-array 32 :element-type 'octet :initial-element 0) :test #'equalp :documentation "32-byte null vector.") -(defun reference-pair-to-octets (pair buf &optional (start 0)) - "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)) - "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)))) - - -(defun compute-reference (block) - (declare (type octet-vector block)) - (let ((reference (make-array 32 :element-type 'octet))) - (ironclad:digest-sequence :blake2/256 block :digest reference) - reference)) - (defun make-nonce (level) (let ((nonce (make-array 12 :element-type 'octet :initial-element 0))) (setf (aref nonce 0) level) nonce)) -(defun encrypt-block (input secret reference) - (declare (type octet-vector input secret reference)) + +(defun encrypt-block (input secret) + (declare (type octet-vector input secret)) (let ((mac (ironclad:make-mac :blake2-mac secret :digest-length 32)) - (key (make-array 32 :element-type 'octet))) + (rk (make-array 64 :element-type 'octet))) ;; reference-key pair (ironclad:update-mac mac input) - (ironclad:produce-mac mac :digest key) - ;; NOT the IETF chacha. Need to fix this by patching ironclad. Maybe. - (ironclad:encrypt-in-place (ironclad:make-cipher :chacha :mode :stream :key key + (ironclad:produce-mac mac :digest rk :digest-start 32) ;; get key + (ironclad:encrypt-in-place (ironclad:make-cipher :chacha :mode :stream :key (subseq rk 32 64) :initialization-vector null-secret) - input) - (ironclad:digest-sequence :blake2/256 input :digest reference) - (make-instance 'reference-pair :key key :reference reference))) - -(defun encrypt-internal-block (input reference nonce) - (declare (type octet-vector input reference)) - (let ((key (make-array 32 :element-type 'octet))) - (ironclad:digest-sequence :blake2/256 input :digest key) - ;; NOT the IETF chacha. Need to fix this by patching ironclad. Maybe. - (ironclad:encrypt-in-place (ironclad:make-cipher :chacha :mode :stream :key key + input) ;; encrypt block + (ironclad:digest-sequence :blake2/256 input :digest rk) ;; get reference + rk)) + + +(defun encrypt-internal-block (input nonce) + (declare (type octet-vector input)) + (let ((rk (make-array 64 :element-type 'octet))) ;; reference-key pair + (ironclad:digest-sequence :blake2/256 input :digest rk :digest-start 32);; get key + (ironclad:encrypt-in-place (ironclad:make-cipher :chacha :mode :stream :key (subseq rk 32 64) :initialization-vector nonce) - input) - (ironclad:digest-sequence :blake2/256 input :digest reference) - (make-instance 'reference-pair :key key :reference reference))) + input) ;; encrypt block + (ironclad:digest-sequence :blake2/256 input :digest rk) ;; get reference + rk)) -(defun decrypt-block (input key &optional (nonce null-secret)) - (declare (type octet-vector input key nonce)) +(defun decrypt-block (input rk &optional (nonce null-secret)) + (declare (type octet-vector input rk nonce)) (ironclad:decrypt-in-place - (ironclad:make-cipher :chacha :mode :stream :key key :initialization-vector nonce) + (ironclad:make-cipher :chacha :mode :stream :key (subseq rk 32 64) :initialization-vector nonce) input) input) @@ -107,7 +82,8 @@ a (simple-array (unsigned-byte 8)) object." (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))) + (replace cap (reference-pair read-capability) :start1 2) + cap)) (-> octets-to-read-capability ((octet-vector 66)) (values read-capability &optional)) (defun octets-to-read-capability (octets) @@ -126,7 +102,9 @@ versioning bytes are not supported by eris-cl." (setf (level capability) (aref octets 1)) (setf (reference-pair capability) - (octets-to-reference-pair octets 2)) + (let ((kr (make-array 64 :element-type 'octet))) + (replace kr octets :start2 2) + kr)) ;; TODO CHECK CORRECTNESS capability)) (-> read-capability-to-urn (read-capability) string) @@ -165,34 +143,17 @@ versioning bytes are not supported by eris-cl." (setf (aref padded-input (length input)) #x80) padded-input)) -(defvar *output-hashmap* nil) - (defmacro output-block (ref-vector) - `(let ((reference (compute-reference block))) - (if hash-output - (if (gethash reference *output-hashmap*) - block - (let ((rk (encrypt-block block secret reference))) - (vector-push-extend rk ,ref-vector) - (setf (gethash reference *output-hashmap*) t) - (funcall output-function block (reference rk)))) - (let ((rk (encrypt-block block secret reference))) - (vector-push-extend rk ,ref-vector) - (funcall output-function block (reference rk)))))) + `(let ((rk (encrypt-block block secret))) + (vector-push-extend rk ,ref-vector) + (funcall output-function block (subseq rk 0 32)))) (defmacro output-internal-block (ref-vector nonce) - `(let ((reference (compute-reference block))) - (if hash-output - (unless (gethash reference *output-hashmap*) - (let ((rk (encrypt-internal-block block reference ,nonce))) - (vector-push-extend rk ,ref-vector) - (setf (gethash reference *output-hashmap*) t) - (funcall output-function block (reference rk)))) - (let ((rk (encrypt-internal-block block reference ,nonce))) - (vector-push-extend rk ,ref-vector) - (funcall output-function block (reference rk)))))) - -(defgeneric eris-encode (input block-size output-function &key secret hash-output) + `(let ((rk (encrypt-internal-block block ,nonce))) + (vector-push-extend rk ,ref-vector) + (funcall output-function block (subseq rk 0 32)))) + +(defgeneric eris-encode (input block-size output-function &key secret) (:documentation "Encode an INPUT into BLOCK-SIZE (32kib or 1kib) blocks, that are output using the function OUTPUT-FUNCTION. This function wil be called with two arguments: an @@ -201,12 +162,9 @@ a (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) of equal size to the one given, which will be destructively modified. Returns a read-capability object. An optional 32-byte secret can be passed for additional encryption using the -SECRET keyword argument. - -The HASH-OUTPUT keyword argument controls whether a hash-table is used to -guarantee that a reference is only output once.")) +SECRET keyword argument.")) -(defmethod eris-encode ((input vector) block-size output-function &key (secret null-secret) (hash-output t)) +(defmethod eris-encode ((input vector) block-size output-function &key (secret null-secret)) (declare (type block-size block-size) (type function output-function) (type (octet-vector 32) secret)) @@ -214,7 +172,6 @@ guarantee that a reference is only output once.")) (setf input (pad input block-size)) (let ((reference-vector (make-array 16 :adjustable t :fill-pointer 0)) - (*output-hashmap* (if hash-output (make-hash-table :test #'equalp) nil)) (block (make-array block-size :element-type 'octet :initial-element 0))) (declare (type octet-vector block)) (loop for i = 0 then (incf i) @@ -224,15 +181,14 @@ guarantee that a reference is only output once.")) (fill block 0))) ;; always bzero the buffer; this is unoptimal (it only needs to be zeroed out to eliminate trailing junk) ;; TODO: consider removing this entire function and replacing it with an octet stream - (eris-create-tree reference-vector block-size output-function :hash-output hash-output))) + (eris-create-tree reference-vector block-size output-function))) -(defmethod eris-encode ((input stream) block-size output-function &key (secret null-secret) hash-output) +(defmethod eris-encode ((input stream) block-size output-function &key (secret null-secret)) "This method does not handle any IO related conditions." (declare (type block-size block-size) (type function output-function) (type (octet-vector 32) secret)) (let ((reference-vector (make-array 16 :adjustable t :fill-pointer 0)) - (*output-hashmap* (if hash-output (make-hash-table :test #'equalp) nil)) (block (make-array block-size :element-type 'octet :initial-element 0))) (declare (type octet-vector block)) (loop for bytes-read = (read-sequence block input) @@ -242,9 +198,9 @@ guarantee that a reference is only output once.")) (fill block 0 :start (1+ bytes-read))) ;; bzero the buffer here to eliminate trailing junk do (progn (setf block (output-block reference-vector))) until (< bytes-read block-size)) - (eris-create-tree reference-vector block-size output-function :hash-output hash-output))) + (eris-create-tree reference-vector block-size output-function))) -(defun eris-create-tree (reference-vector block-size output-function &key hash-output) +(defun eris-create-tree (reference-vector block-size output-function) (declare (type block-size block-size) (type function output-function)) (loop with block-keys = (/ block-size 64) @@ -266,7 +222,7 @@ guarantee that a reference is only output once.")) do (progn (setf block (output-internal-block reference-vector-l nonce)) (setf i 0) (fill block 0)) - do (progn (reference-pair-to-octets rk block (* 64 i)) + do (progn (replace block rk :start1 (* 64 i)) (incf i)) finally (unless (zerop i) ;; If i is zero, then the amount of blocks is just |