1;;;; -*- mode: lisp; indent-tabs-mode: nil -*- 2;;;; pkcs1.lisp -- implementation of OAEP and PSS schemes 3 4(in-package :crypto) 5 6 7;;; Mask generation function 8(defun mgf (digest-name seed num-bytes) 9 "Expand the SEED to a NUM-BYTES bytes vector using the DIGEST-NAME digest." 10 (loop 11 with result = #() 12 with digest-len = (digest-length digest-name) 13 for digest = (make-digest digest-name) then (reinitialize-instance digest) 14 for counter from 0 to (floor num-bytes digest-len) 15 for counter-bytes = (integer-to-octets counter :n-bits 32) 16 for tmp = (digest-sequence digest (concatenate '(vector (unsigned-byte 8)) 17 seed 18 counter-bytes)) 19 do (setf result (concatenate '(vector (unsigned-byte 8)) result tmp)) 20 finally (return (subseq result 0 num-bytes)))) 21 22(declaim (notinline oaep-encode)) 23;; In the tests, this function is redefined to use a constant value 24;; instead of a random one. Therefore it must not be inlined or the tests 25;; will fail. 26(defun oaep-encode (digest-name message num-bytes &optional label) 27 "Return a NUM-BYTES bytes vector containing the OAEP encoding of the MESSAGE 28using the DIGEST-NAME digest (and the optional LABEL octet vector)." 29 (let* ((digest-name (if (eq digest-name t) :sha1 digest-name)) 30 (digest-len (digest-length digest-name))) 31 (assert (<= (length message) (- num-bytes (* 2 digest-len) 2))) 32 (let* ((digest (make-digest digest-name)) 33 (label (or label (coerce #() '(vector (unsigned-byte 8))))) 34 (padding-len (- num-bytes (length message) (* 2 digest-len) 2)) 35 (padding (make-array padding-len :element-type '(unsigned-byte 8) :initial-element 0)) 36 (l-hash (digest-sequence digest label)) 37 (db (concatenate '(vector (unsigned-byte 8)) l-hash padding #(1) message)) 38 (seed (random-data digest-len)) 39 (db-mask (mgf digest-name seed (- num-bytes digest-len 1))) 40 (masked-db (map '(vector (unsigned-byte 8)) #'logxor db db-mask)) 41 (seed-mask (mgf digest-name masked-db digest-len)) 42 (masked-seed (map '(vector (unsigned-byte 8)) #'logxor seed seed-mask))) 43 (concatenate '(vector (unsigned-byte 8)) #(0) masked-seed masked-db)))) 44 45(defun oaep-decode (digest-name message &optional label) 46 "Return an octet vector containing the data that was encoded in the MESSAGE with OAEP 47using the DIGEST-NAME digest (and the optional LABEL octet vector)." 48 (let* ((digest-name (if (eq digest-name t) :sha1 digest-name)) 49 (digest-len (digest-length digest-name))) 50 (assert (>= (length message) (+ (* 2 digest-len) 2))) 51 (let* ((digest (make-digest digest-name)) 52 (label (or label (coerce #() '(vector (unsigned-byte 8))))) 53 (zero-byte (elt message 0)) 54 (masked-seed (subseq message 1 (1+ digest-len))) 55 (masked-db (subseq message (1+ digest-len))) 56 (seed-mask (mgf digest-name masked-db digest-len)) 57 (seed (map '(vector (unsigned-byte 8)) #'logxor masked-seed seed-mask)) 58 (db-mask (mgf digest-name seed (- (length message) digest-len 1))) 59 (db (map '(vector (unsigned-byte 8)) #'logxor masked-db db-mask)) 60 (l-hash1 (digest-sequence digest label)) 61 (l-hash2 (subseq db 0 digest-len)) 62 (padding-len (loop 63 for i from digest-len below (length db) 64 while (zerop (elt db i)) 65 finally (return (- i digest-len)))) 66 (one-byte (elt db (+ digest-len padding-len)))) 67 (unless (and (zerop zero-byte) (= 1 one-byte) (equalp l-hash1 l-hash2)) 68 (error 'oaep-decoding-error)) 69 (subseq db (+ digest-len padding-len 1))))) 70 71(declaim (notinline pss-encode)) 72;; In the tests, this function is redefined to use a constant value 73;; instead of a random one. Therefore it must not be inlined or the tests 74;; will fail. 75(defun pss-encode (digest-name message num-bytes) 76 (let* ((digest-name (if (eq digest-name t) :sha1 digest-name)) 77 (digest-len (digest-length digest-name))) 78 (assert (>= num-bytes (+ (* 2 digest-len) 2))) 79 (let* ((m-hash (digest-sequence digest-name message)) 80 (salt (random-data digest-len)) 81 (m1 (concatenate '(vector (unsigned-byte 8)) #(0 0 0 0 0 0 0 0) m-hash salt)) 82 (h (digest-sequence digest-name m1)) 83 (ps (make-array (- num-bytes (* 2 digest-len) 2) 84 :element-type '(unsigned-byte 8) 85 :initial-element 0)) 86 (db (concatenate '(vector (unsigned-byte 8)) ps #(1) salt)) 87 (db-mask (mgf digest-name h (- num-bytes digest-len 1))) 88 (masked-db (map '(vector (unsigned-byte 8)) #'logxor db db-mask))) 89 (setf (ldb (byte 1 7) (elt masked-db 0)) 0) 90 (concatenate '(vector (unsigned-byte 8)) masked-db h #(188))))) 91 92(defun pss-verify (digest-name message encoded-message) 93 (let* ((digest-name (if (eq digest-name t) :sha1 digest-name)) 94 (digest-len (digest-length digest-name)) 95 (em-len (length encoded-message))) 96 (assert (>= em-len (+ (* 2 digest-len) 2))) 97 (assert (= (elt encoded-message (- em-len 1)) 188)) 98 (let* ((m-hash (digest-sequence digest-name message)) 99 (masked-db (subseq encoded-message 0 (- em-len digest-len 1))) 100 (h (subseq encoded-message (- em-len digest-len 1) (- em-len 1))) 101 (db-mask (mgf digest-name h (- em-len digest-len 1))) 102 (db (map '(vector (unsigned-byte 8)) #'logxor masked-db db-mask))) 103 (setf (ldb (byte 1 7) (elt db 0)) 0) 104 (let* ((ps (subseq db 0 (- em-len (* 2 digest-len) 2))) 105 (one-byte (elt db (- em-len (* 2 digest-len) 2))) 106 (salt (subseq db (- (length db) digest-len))) 107 (m1 (concatenate '(vector (unsigned-byte 8)) #(0 0 0 0 0 0 0 0) m-hash salt)) 108 (h1 (digest-sequence digest-name m1))) 109 (and (= 1 one-byte) 110 (loop for i across ps always (zerop i)) 111 (equalp h h1)))))) 112