Coverage report: /home/ellis/comp/ext/ironclad/src/public-key/pkcs1.lisp

Kind	Covered	All	%
expression	0	332	0.0
branch	0	18	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; pkcs1.lisp -- implementation of OAEP and PSS schemes

2

(in-package :crypto)

3

4

;;; Mask generation function

5

(defun mgf (digest-name seed num-bytes)

6

"Expand the SEED to a NUM-BYTES bytes vector using the DIGEST-NAME digest."

7

(loop

8

with result = #()

9

with digest-len = (digest-length digest-name)

10

for digest = (make-digest digest-name) then (reinitialize-instance digest)

11

for counter from 0 to (floor num-bytes digest-len)

12

for counter-bytes = (integer-to-octets counter :n-bits 32)

13

for tmp = (digest-sequence digest (concatenate '(vector (unsigned-byte 8))

14

seed

15

                                                     counter-bytes))

16

do (setf result (concatenate '(vector (unsigned-byte 8)) result tmp))

17

finally (return (subseq result 0 num-bytes))))

18

19

(declaim (notinline oaep-encode))

20

;; In the tests, this function is redefined to use a constant value

21

;; instead of a random one. Therefore it must not be inlined or the tests

22

;; will fail.

23

(defun oaep-encode (digest-name message num-bytes &optional label)

24

"Return a NUM-BYTES bytes vector containing the OAEP encoding of the MESSAGE

25

using the DIGEST-NAME digest (and the optional LABEL octet vector)."

26

(let* ((digest-name (if (eq digest-name t) :sha1 digest-name))

27

(digest-len (digest-length digest-name)))

28

(assert (<= (length message) (- num-bytes (* 2 digest-len) 2)))

29

(let* ((digest (make-digest digest-name))

30

(label (or label (coerce #() '(vector (unsigned-byte 8)))))

31

(padding-len (- num-bytes (length message) (* 2 digest-len) 2))

32

(padding (make-array padding-len :element-type '(unsigned-byte 8) :initial-element 0))

33

(l-hash (digest-sequence digest label))

34

(db (concatenate '(vector (unsigned-byte 8)) l-hash padding #(1) message))

35

(seed (random-data digest-len))

36

(db-mask (mgf digest-name seed (- num-bytes digest-len 1)))

37

(masked-db (map '(vector (unsigned-byte 8)) #'logxor db db-mask))

38

(seed-mask (mgf digest-name masked-db digest-len))

39

(masked-seed (map '(vector (unsigned-byte 8)) #'logxor seed seed-mask)))

40

(concatenate '(vector (unsigned-byte 8)) #(0) masked-seed masked-db))))

41

42

(defun oaep-decode (digest-name message &optional label)

43

"Return an octet vector containing the data that was encoded in the MESSAGE with OAEP

44

using the DIGEST-NAME digest (and the optional LABEL octet vector)."

45

(let* ((digest-name (if (eq digest-name t) :sha1 digest-name))

46

(digest-len (digest-length digest-name)))

47

(assert (>= (length message) (+ (* 2 digest-len) 2)))

48

(let* ((digest (make-digest digest-name))

49

(label (or label (coerce #() '(vector (unsigned-byte 8)))))

50

(zero-byte (elt message 0))

51

(masked-seed (subseq message 1 (1+ digest-len)))

52

(masked-db (subseq message (1+ digest-len)))

53

(seed-mask (mgf digest-name masked-db digest-len))

54

(seed (map '(vector (unsigned-byte 8)) #'logxor masked-seed seed-mask))

55

(db-mask (mgf digest-name seed (- (length message) digest-len 1)))

56

(db (map '(vector (unsigned-byte 8)) #'logxor masked-db db-mask))

57

(l-hash1 (digest-sequence digest label))

58

(l-hash2 (subseq db 0 digest-len))

59

(padding-len (loop

60

for i from digest-len below (length db)

61

while (zerop (elt db i))

62

finally (return (- i digest-len))))

63

(one-byte (elt db (+ digest-len padding-len))))

64

(unless (and (zerop zero-byte) (= 1 one-byte) (equalp l-hash1 l-hash2))

65

(error 'oaep-decoding-error))

66

(subseq db (+ digest-len padding-len 1)))))

67

68

(declaim (notinline pss-encode))

69

;; In the tests, this function is redefined to use a constant value

70

;; instead of a random one. Therefore it must not be inlined or the tests

71

;; will fail.

72

(defun pss-encode (digest-name message num-bytes)

73

(let* ((digest-name (if (eq digest-name t) :sha1 digest-name))

74

(digest-len (digest-length digest-name)))

75

(assert (>= num-bytes (+ (* 2 digest-len) 2)))

76

(let* ((m-hash (digest-sequence digest-name message))

77

(salt (random-data digest-len))

78

(m1 (concatenate '(vector (unsigned-byte 8)) #(0 0 0 0 0 0 0 0) m-hash salt))

79

(h (digest-sequence digest-name m1))

80

(ps (make-array (- num-bytes (* 2 digest-len) 2)

81

:element-type '(unsigned-byte 8)

82

:initial-element 0))

83

(db (concatenate '(vector (unsigned-byte 8)) ps #(1) salt))

84

(db-mask (mgf digest-name h (- num-bytes digest-len 1)))

85

(masked-db (map '(vector (unsigned-byte 8)) #'logxor db db-mask)))

86

(setf (ldb (byte 1 7) (elt masked-db 0)) 0)

87

(concatenate '(vector (unsigned-byte 8)) masked-db h #(188)))))

88

89

(defun pss-verify (digest-name message encoded-message)

90

(let* ((digest-name (if (eq digest-name t) :sha1 digest-name))

91

(digest-len (digest-length digest-name))

92

(em-len (length encoded-message)))

93

(assert (>= em-len (+ (* 2 digest-len) 2)))

94

(assert (= (elt encoded-message (- em-len 1)) 188))

95

(let* ((m-hash (digest-sequence digest-name message))

96

(masked-db (subseq encoded-message 0 (- em-len digest-len 1)))

97

(h (subseq encoded-message (- em-len digest-len 1) (- em-len 1)))

98

(db-mask (mgf digest-name h (- em-len digest-len 1)))

99

(db (map '(vector (unsigned-byte 8)) #'logxor masked-db db-mask)))

100

(setf (ldb (byte 1 7) (elt db 0)) 0)

101

(let* ((ps (subseq db 0 (- em-len (* 2 digest-len) 2)))

102

(one-byte (elt db (- em-len (* 2 digest-len) 2)))

103

(salt (subseq db (- (length db) digest-len)))

104

(m1 (concatenate '(vector (unsigned-byte 8)) #(0 0 0 0 0 0 0 0) m-hash salt))

105

(h1 (digest-sequence digest-name m1)))

106

(and (= 1 one-byte)

107

(loop for i across ps always (zerop i))

108

(equalp h h1))))))