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