Coverage report: /home/ellis/comp/ext/ironclad/src/ciphers/rc2.lisp

KindCoveredAll%
expression0166 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; rc2.lisp -- implementation of the RC2 cipher algorithm from RFC 2268
2
 (in-package :crypto)
3
 (in-ironclad-readtable)
4
 
5
 ;;; RC2 accepts a 1-byte to 128-byte key.  But it also lets you specify
6
 ;;; an "effective key length" in bits, which effectively lets you have a
7
 ;;; 1-bit to 1024-bit key.  The test vectors supplied in the RFC specify
8
 ;;; the effective key length as well as the bytes present in the key.
9
 ;;;
10
 ;;; This implementation does not support such generality: only effective
11
 ;;; key lengths from 8 bits to 1024 bits in multiples of eight are
12
 ;;; supported.  It would be nice to support the more general
13
 ;;; functionality from the RFC; an interface for such functionality
14
 ;;; (maybe an :EFFECTIVE-KEY-LENGTH argument to `MAKE-CIPHER',
15
 ;;; applicable only to RC2) would also support specifying the number of
16
 ;;; rounds for many ciphers.
17
 
18
 ;;; PITABLE from section 2.
19
 (defconst +rc2-pitable+
20
   #8@(#xd9 #x78 #xf9 #xc4 #x19 #xdd #xb5 #xed #x28 #xe9 #xfd #x79 #x4a #xa0 #xd8 #x9d
21
 #xc6 #x7e #x37 #x83 #x2b #x76 #x53 #x8e #x62 #x4c #x64 #x88 #x44 #x8b #xfb #xa2
22
 #x17 #x9a #x59 #xf5 #x87 #xb3 #x4f #x13 #x61 #x45 #x6d #x8d #x09 #x81 #x7d #x32
23
 #xbd #x8f #x40 #xeb #x86 #xb7 #x7b #x0b #xf0 #x95 #x21 #x22 #x5c #x6b #x4e #x82
24
 #x54 #xd6 #x65 #x93 #xce #x60 #xb2 #x1c #x73 #x56 #xc0 #x14 #xa7 #x8c #xf1 #xdc
25
 #x12 #x75 #xca #x1f #x3b #xbe #xe4 #xd1 #x42 #x3d #xd4 #x30 #xa3 #x3c #xb6 #x26
26
 #x6f #xbf #x0e #xda #x46 #x69 #x07 #x57 #x27 #xf2 #x1d #x9b #xbc #x94 #x43 #x03
27
 #xf8 #x11 #xc7 #xf6 #x90 #xef #x3e #xe7 #x06 #xc3 #xd5 #x2f #xc8 #x66 #x1e #xd7
28
 #x08 #xe8 #xea #xde #x80 #x52 #xee #xf7 #x84 #xaa #x72 #xac #x35 #x4d #x6a #x2a
29
 #x96 #x1a #xd2 #x71 #x5a #x15 #x49 #x74 #x4b #x9f #xd0 #x5e #x04 #x18 #xa4 #xec
30
 #xc2 #xe0 #x41 #x6e #x0f #x51 #xcb #xcc #x24 #x91 #xaf #x50 #xa1 #xf4 #x70 #x39
31
 #x99 #x7c #x3a #x85 #x23 #xb8 #xb4 #x7a #xfc #x02 #x36 #x5b #x25 #x55 #x97 #x31
32
 #x2d #x5d #xfa #x98 #xe3 #x8a #x92 #xae #x05 #xdf #x29 #x10 #x67 #x6c #xba #xc9
33
 #xd3 #x00 #xe6 #xcf #xe1 #x9e #xa8 #x2c #x63 #x16 #x01 #x3f #x58 #xe2 #x89 #xa9
34
 #x0d #x38 #x34 #x1b #xab #x33 #xff #xb0 #xbb #x48 #x0c #x5f #xb9 #xb1 #xcd #x2e
35
 #xc5 #xf3 #xdb #x47 #xe5 #xa5 #x9c #x77 #x0a #xa6 #x20 #x68 #xfe #x7f #xc1 #xad))
36
 
37
 (deftype rc2-round-keys () '(simple-array (unsigned-byte 16) (64)))
38
 
39
 (defclass rc2 (cipher 8-byte-block-mixin)
40
   ((round-keys :accessor round-keys :type rc2-round-keys)))
41
 
42
 (declaim (inline rol16)
43
          (ftype (function ((unsigned-byte 16) (integer 0 15)) (unsigned-byte 16))))
44
 (defun rol16 (x shift)
45
   (declare (type (unsigned-byte 16) x))
46
   (declare (type (integer 0 15) shift))
47
   (logior (ldb (byte 16 0) (ash x shift)) (ash x (- shift 16))))
48
 
49
 (defun rc2-schedule-key (key effective-key-length)
50
   (declare (type (simple-array (unsigned-byte 8) (*)) key))
51
   (let* ((length (length key))
52
          (lbuf (make-array 128 :element-type '(unsigned-byte 8)
53
                            :initial-element 0))
54
          (scheduled-key (make-array 64 :element-type '(unsigned-byte 16)
55
                                     :initial-element 0))
56
          (t8 (truncate (+ effective-key-length 7) 8))
57
          (tm (mod 255 (expt 2 (+ 8 effective-key-length (- (* t8 8)))))))
58
     (declare (type (integer 1 128) length))
59
     (declare (type (simple-array (unsigned-byte 8) (128)) lbuf))
60
     (declare (type rc2-round-keys scheduled-key))
61
     (declare (dynamic-extent lbuf))
62
     (replace lbuf key)
63
     (loop for j from length below 128 do
64
           (setf (aref lbuf j)
65
                 (aref +rc2-pitable+
66
                       (mod (+ (aref lbuf (1- j))
67
                               (aref lbuf (- j length)))
68
                            256))))
69
     (setf (aref lbuf (- 128 t8))
70
           (aref +rc2-pitable+ (logand (aref lbuf (- 128 t8)) tm)))
71
     (loop for j from (- 127 t8) downto 0 do
72
           (setf (aref lbuf j)
73
                 (aref +rc2-pitable+
74
                       (logxor (aref lbuf (1+ j))
75
                               (aref lbuf (+ j t8))))))
76
     ;; If we wanted to really be a speed demon, we'd specialize this.
77
     (dotimes (i 64 scheduled-key)
78
       (setf (aref scheduled-key i)
79
             (ub16ref/le lbuf (* i 2))))))
80
 
81
 (macrolet ((mix (index)
82
              (loop for i from 0 below 4
83
                    collect (let ((x0 (symbolicate '#:r i))
84
                                  (x1 (symbolicate '#:r (mod (- i 1) 4)))
85
                                  (x2 (symbolicate '#:r (mod (- i 2) 4)))
86
                                  (x3 (symbolicate '#:r (mod (- i 3) 4))))
87
                              `(progn
88
                                 (setf ,x0 (ldb (byte 16 0)
89
                                                (+ ,x0
90
                                                   (logand ,x1 ,x2)
91
                                                   (aref round-keys (+ (* 4 ,index) ,i))
92
                                                   (logandc1 ,x1 ,x3))))
93
                                 (setf ,x0 (rol16 ,x0 ,(case i
94
                                                         (0 1)
95
                                                         (1 2)
96
                                                         (2 3)
97
                                                         (3 5)))))) into forms
98
                    finally (return `(progn ,@forms))))
99
            (mash ()
100
              (loop for i from 0 below 4
101
                    collect (let ((x0 (symbolicate '#:r i))
102
                                  (x1 (symbolicate '#:r (mod (- i 1) 4))))
103
                              `(setf ,x0 (ldb (byte 16 0)
104
                                              (+ ,x0 (aref round-keys (ldb (byte 6 0) ,x1)))))) into forms
105
                    finally (return `(progn ,@forms))))
106
            (rmix (index)
107
              (loop for i from 0 below 4
108
                    collect (let ((x0 (symbolicate '#:r i))
109
                                  (x1 (symbolicate '#:r (mod (- i 1) 4)))
110
                                  (x2 (symbolicate '#:r (mod (- i 2) 4)))
111
                                  (x3 (symbolicate '#:r (mod (- i 3) 4))))
112
                              `(progn
113
                                 (setf ,x0 (rol16 ,x0 ,(case i
114
                                                         (0 15)
115
                                                         (1 14)
116
                                                         (2 13)
117
                                                         (3 11))))
118
                                 (setf ,x0 (ldb (byte 16 0)
119
                                                (- ,x0
120
                                                   (aref round-keys (+ (* 4 ,index) ,i))
121
                                                   (logand ,x1 ,x2)
122
                                                   (logandc1 ,x1 ,x3)))))) into forms
123
                    finally (return `(progn ,@(nreverse forms)))))
124
            (rmash ()
125
              (loop for i from 0 below 4
126
                    collect (let ((x0 (symbolicate '#:r i))
127
                                  (x1 (symbolicate '#:r (mod (- i 1) 4))))
128
                              `(setf ,x0 (ldb (byte 16 0)
129
                                              (- ,x0 (aref round-keys (ldb (byte 6 0) ,x1)))))) into forms
130
                    finally (return `(progn ,@(nreverse forms))))))
131
   (define-block-encryptor rc2 8
132
     (let ((round-keys (round-keys context)))
133
       (declare (type rc2-round-keys round-keys))
134
       (with-words ((r0 r1 r2 r3) plaintext plaintext-start
135
                    :size 2 :big-endian nil)
136
         #.(loop for i from 0 below 18
137
                 collect (ecase i
138
                           ((0 1 2 3 4
139
                               6 7 8 9 10 11
140
                               13 14 15 16 17)
141
                            ;; mixing round
142
                            `(mix ,(cond
143
                                     ((<= i 4) i)
144
                                     ((<= 6 i 11) (- i 1))
145
                                     ((<= 13 i 17) (- i 2)))))
146
                           ((5 12)
147
                            ;; mashing round
148
                            `(mash))) into forms
149
                 finally (return `(progn ,@forms)))
150
         (store-words ciphertext ciphertext-start r0 r1 r2 r3))))
151
 
152
   (define-block-decryptor rc2 8
153
     (let ((round-keys (round-keys context)))
154
       (declare (type rc2-round-keys round-keys))
155
       (with-words ((r0 r1 r2 r3) ciphertext ciphertext-start
156
                    :size 2 :big-endian nil)
157
         #.(loop for i from 0 below 18
158
                 collect (ecase i
159
                           ((0 1 2 3 4
160
                               6 7 8 9 10 11
161
                               13 14 15 16 17)
162
                            ;; mixing round
163
                            `(rmix ,(cond
164
                                      ((<= i 4) i)
165
                                      ((<= 6 i 11) (- i 1))
166
                                      ((<= 13 i 17) (- i 2)))))
167
                           ((5 12)
168
                            ;; mashing round
169
                            `(rmash))) into forms
170
                 finally (return `(progn ,@(nreverse forms))))
171
         (store-words plaintext plaintext-start r0 r1 r2 r3))))
172
   ) ; MACROLET
173
 
174
 (defmethod schedule-key ((cipher rc2) key)
175
   (let* ((effective-key-length (* (length key) 8))
176
          (round-keys (rc2-schedule-key key effective-key-length)))
177
     (setf (round-keys cipher) round-keys)
178
     cipher))
179
 
180
 (defcipher rc2
181
   (:encrypt-function rc2-encrypt-block)
182
   (:decrypt-function rc2-decrypt-block)
183
   (:block-length 8)
184
   (:key-length (:variable 1 128 1)))