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

KindCoveredAll%
expression0168 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; sm4.lisp -- implementation of SM4 (GB/T 32907-2016)
2
 (in-package :crypto)
3
 (in-ironclad-readtable)
4
 
5
 ;;; Parameters
6
 (eval-when (:compile-toplevel :load-toplevel :execute)
7
   (defconst +sm4-s+
8
     #8@(#xd6 #x90 #xe9 #xfe #xcc #xe1 #x3d #xb7
9
         #x16 #xb6 #x14 #xc2 #x28 #xfb #x2c #x05
10
         #x2b #x67 #x9a #x76 #x2a #xbe #x04 #xc3
11
         #xaa #x44 #x13 #x26 #x49 #x86 #x06 #x99
12
         #x9c #x42 #x50 #xf4 #x91 #xef #x98 #x7a
13
         #x33 #x54 #x0b #x43 #xed #xcf #xac #x62
14
         #xe4 #xb3 #x1c #xa9 #xc9 #x08 #xe8 #x95
15
         #x80 #xdf #x94 #xfa #x75 #x8f #x3f #xa6
16
         #x47 #x07 #xa7 #xfc #xf3 #x73 #x17 #xba
17
         #x83 #x59 #x3c #x19 #xe6 #x85 #x4f #xa8
18
         #x68 #x6b #x81 #xb2 #x71 #x64 #xda #x8b
19
         #xf8 #xeb #x0f #x4b #x70 #x56 #x9d #x35
20
         #x1e #x24 #x0e #x5e #x63 #x58 #xd1 #xa2
21
         #x25 #x22 #x7c #x3b #x01 #x21 #x78 #x87
22
         #xd4 #x00 #x46 #x57 #x9f #xd3 #x27 #x52
23
         #x4c #x36 #x02 #xe7 #xa0 #xc4 #xc8 #x9e
24
         #xea #xbf #x8a #xd2 #x40 #xc7 #x38 #xb5
25
         #xa3 #xf7 #xf2 #xce #xf9 #x61 #x15 #xa1
26
         #xe0 #xae #x5d #xa4 #x9b #x34 #x1a #x55
27
         #xad #x93 #x32 #x30 #xf5 #x8c #xb1 #xe3
28
         #x1d #xf6 #xe2 #x2e #x82 #x66 #xca #x60
29
         #xc0 #x29 #x23 #xab #x0d #x53 #x4e #x6f
30
         #xd5 #xdb #x37 #x45 #xde #xfd #x8e #x2f
31
         #x03 #xff #x6a #x72 #x6d #x6c #x5b #x51
32
         #x8d #x1b #xaf #x92 #xbb #xdd #xbc #x7f
33
         #x11 #xd9 #x5c #x41 #x1f #x10 #x5a #xd8
34
         #x0a #xc1 #x31 #x88 #xa5 #xcd #x7b #xbd
35
         #x2d #x74 #xd0 #x12 #xb8 #xe5 #xb4 #xb0
36
         #x89 #x69 #x97 #x4a #x0c #x96 #x77 #x7e
37
         #x65 #xb9 #xf1 #x09 #xc5 #x6e #xc6 #x84
38
         #x18 #xf0 #x7d #xec #x3a #xdc #x4d #x20
39
         #x79 #xee #x5f #x3e #xd7 #xcb #x39 #x48))
40
 
41
   (defconst +sm4-ck+
42
     #32@(#x00070e15 #x1c232a31 #x383f464d #x545b6269
43
          #x70777e85 #x8c939aa1 #xa8afb6bd #xc4cbd2d9
44
          #xe0e7eef5 #xfc030a11 #x181f262d #x343b4249
45
          #x50575e65 #x6c737a81 #x888f969d #xa4abb2b9
46
          #xc0c7ced5 #xdce3eaf1 #xf8ff060d #x141b2229
47
          #x30373e45 #x4c535a61 #x686f767d #x848b9299
48
          #xa0a7aeb5 #xbcc3cad1 #xd8dfe6ed #xf4fb0209
49
          #x10171e25 #x2c333a41 #x484f565d #x646b7279)))
50
 
51
 
52
 ;;;
53
 ;;; SM4 round
54
 ;;;
55
 
56
 (defmacro sm4-h (x)
57
   `(logior (mod32ash (aref +sm4-s+ (logand (mod32ash ,x -24) #xff)) 24)
58
            (mod32ash (aref +sm4-s+ (logand (mod32ash ,x -16) #xff)) 16)
59
            (mod32ash (aref +sm4-s+ (logand (mod32ash ,x -8) #xff)) 8)
60
            (aref +sm4-s+ (logand ,x #xff))))
61
 
62
 (defmacro sm4-g (x)
63
   (let ((y (gensym)))
64
     `(let ((,y (sm4-h ,x)))
65
        (declare (type (unsigned-byte 32) ,y))
66
        (logxor ,y (rol32 ,y 13) (rol32 ,y 23)))))
67
 
68
 (defmacro sm4-f (x)
69
   (let ((y (gensym)))
70
     `(let ((,y (sm4-h ,x)))
71
        (declare (type (unsigned-byte 32) ,y))
72
        (logxor ,y (rol32 ,y 2) (rol32 ,y 10) (rol32 ,y 18) (rol32 ,y 24)))))
73
 
74
 (defmacro sm4-round (w0 w1 w2 w3 round-keys r encrypt-p)
75
   `(setf ,w0 (logxor ,w0 (sm4-f (logxor ,w1 ,w2 ,w3
76
                                         (aref ,round-keys ,r))))
77
          ,w1 (logxor ,w1 (sm4-f (logxor ,w0 ,w2 ,w3
78
                                         (aref ,round-keys ,(if encrypt-p
79
                                                                (+ r 1)
80
                                                                (- r 1))))))
81
          ,w2 (logxor ,w2 (sm4-f (logxor ,w0 ,w1 ,w3
82
                                         (aref ,round-keys ,(if encrypt-p
83
                                                                (+ r 2)
84
                                                                (- r 2))))))
85
          ,w3 (logxor ,w3 (sm4-f (logxor ,w0 ,w1 ,w2
86
                                         (aref ,round-keys ,(if encrypt-p
87
                                                                (+ r 3)
88
                                                                (- r 3))))))))
89
 
90
 
91
 ;;;
92
 ;;; Key schedule
93
 ;;;
94
 
95
 (defclass sm4 (cipher 16-byte-block-mixin)
96
   ((round-keys :accessor sm4-round-keys
97
                :initform (make-array 32 :element-type '(unsigned-byte 32))
98
                :type (simple-array (unsigned-byte 32) (32)))))
99
 
100
 (defmethod schedule-key ((cipher sm4) key)
101
   (let ((round-keys (sm4-round-keys cipher))
102
         (k0 (logxor (ub32ref/be key 0) #xa3b1bac6))
103
         (k1 (logxor (ub32ref/be key 4) #x56aa3350))
104
         (k2 (logxor (ub32ref/be key 8) #x677d9197))
105
         (k3 (logxor (ub32ref/be key 12) #xb27022dc)))
106
     (declare (type (simple-array (unsigned-byte 32) (32)) round-keys)
107
              (type (unsigned-byte 32) k0 k1 k2 k3))
108
     (dotimes (i 8)
109
       (setf k0 (logxor k0 (sm4-g (logxor k1 k2 k3 (aref +sm4-ck+ (* 4 i)))))
110
             (aref round-keys (* 4 i)) k0
111
             k1 (logxor k1 (sm4-g (logxor k2 k3 k0 (aref +sm4-ck+ (+ (* 4 i) 1)))))
112
             (aref round-keys (+ (* 4 i) 1)) k1
113
             k2 (logxor k2 (sm4-g (logxor k3 k0 k1 (aref +sm4-ck+ (+ (* 4 i) 2)))))
114
             (aref round-keys (+ (* 4 i) 2)) k2
115
             k3 (logxor k3 (sm4-g (logxor k0 k1 k2 (aref +sm4-ck+ (+ (* 4 i) 3)))))
116
             (aref round-keys (+ (* 4 i) 3)) k3))
117
     cipher))
118
 
119
 ;;; Rounds
120
 (define-block-encryptor sm4 16
121
   (let ((round-keys (sm4-round-keys context)))
122
     (declare (type (simple-array (unsigned-byte 32) (32)) round-keys))
123
     (with-words ((w0 w1 w2 w3) plaintext plaintext-start :size 4)
124
       (sm4-round w0 w1 w2 w3 round-keys 0 t)
125
       (sm4-round w0 w1 w2 w3 round-keys 4 t)
126
       (sm4-round w0 w1 w2 w3 round-keys 8 t)
127
       (sm4-round w0 w1 w2 w3 round-keys 12 t)
128
       (sm4-round w0 w1 w2 w3 round-keys 16 t)
129
       (sm4-round w0 w1 w2 w3 round-keys 20 t)
130
       (sm4-round w0 w1 w2 w3 round-keys 24 t)
131
       (sm4-round w0 w1 w2 w3 round-keys 28 t)
132
       (store-words ciphertext ciphertext-start w3 w2 w1 w0)))
133
   (values))
134
 
135
 (define-block-decryptor sm4 16
136
   (let ((round-keys (sm4-round-keys context)))
137
     (declare (type (simple-array (unsigned-byte 32) (32)) round-keys))
138
     (with-words ((w0 w1 w2 w3) ciphertext ciphertext-start :size 4)
139
       (sm4-round w0 w1 w2 w3 round-keys 31 nil)
140
       (sm4-round w0 w1 w2 w3 round-keys 27 nil)
141
       (sm4-round w0 w1 w2 w3 round-keys 23 nil)
142
       (sm4-round w0 w1 w2 w3 round-keys 19 nil)
143
       (sm4-round w0 w1 w2 w3 round-keys 15 nil)
144
       (sm4-round w0 w1 w2 w3 round-keys 11 nil)
145
       (sm4-round w0 w1 w2 w3 round-keys 7 nil)
146
       (sm4-round w0 w1 w2 w3 round-keys 3 nil)
147
       (store-words plaintext plaintext-start w3 w2 w1 w0)))
148
   (values))
149
 
150
 (defcipher sm4
151
   (:encrypt-function sm4-encrypt-block)
152
   (:decrypt-function sm4-decrypt-block)
153
   (:block-length 16)
154
   (:key-length (:fixed 16)))