source: project/release/5/openssl/trunk/tests/cipher-test.scm @ 40289

Last change on this file since 40289 was 40289, checked in by Vasilij Schneidermann, 2 months ago

openssl: Disable CCM tests for OpenSSL<1.1.1

File size: 14.9 KB
Line 
1(define openssl-1.1.1 #x10101000)
2
3(define aes-128-ecb (cipher-by-name "aes-128-ecb"))
4(define aes-128-cbc (cipher-by-name "aes-128-cbc"))
5(define aes-128-ctr (cipher-by-name "aes-128-ctr"))
6(define aes-128-gcm (cipher-by-name "aes-128-gcm"))
7(define aes-128-ccm (cipher-by-name "aes-128-ccm"))
8(define aes-128-ocb (cipher-by-name "aes-128-ocb"))
9(define rc4 (cipher-by-name "rc4"))
10
11(define ciphers (cipher-list))
12(test-assert "Cipher list is not empty" (pair? ciphers))
13
14(for-each
15 (lambda (name)
16   (test-assert (format "~a cipher in list" name) (member name ciphers))
17   (test-assert (format "~a cipher available" name) (cipher-by-name name)))
18 '("aes-128-ecb" "aes-128-cbc" "aes-128-ctr" "aes-128-gcm" "rc4"))
19
20(test-assert "Bogus cipher" (not (cipher-by-name "aes-128-abc")))
21
22(let ((ctx (cipher-context-allocate!))
23      (key (string->blob "YELLOW SUBMARINE"))
24      (iv #f))
25  (cipher-context-init! ctx aes-128-ecb key iv)
26  (let* ((ciphertext (blob->string (cipher-context-update! ctx (string->blob "secret"))))
27         (ciphertext (string-append ciphertext (blob->string (cipher-context-final! ctx)))))
28    (cipher-context-reset! ctx)
29    (cipher-context-init! ctx aes-128-ecb key iv mode: 'decrypt)
30    (let* ((plaintext (blob->string (cipher-context-update! ctx (string->blob ciphertext))))
31           (plaintext (string-append (blob->string (cipher-context-final! ctx)))))
32      (test "Low level API roundtrip" plaintext "secret")))
33  (cipher-context-free! ctx)
34  (test-error "Error when accessing freed context" (cipher-context-init! ctx aes-128-ecb key iv)))
35
36(test "Port API roundtrip"
37      "secret"
38      (let* ((key (string->blob "YELLOW SUBMARINE"))
39             (iv #f)
40             (ciphertext
41              (call-with-output-string
42               (lambda (out)
43                 (let ((out (open-cipher-port aes-128-ecb out key iv mode: 'encrypt)))
44                   (display "secret" out)
45                   (close-output-port out))))))
46        (call-with-output-string
47         (lambda (out)
48           (let ((out (open-cipher-port aes-128-ecb out key iv mode: 'decrypt)))
49             (display ciphertext out)
50             (close-output-port out))))))
51
52(define (encrypt-string cipher plaintext key iv #!rest opts)
53  (apply string-cipher cipher plaintext key iv mode: 'encrypt opts))
54
55(define (decrypt-string cipher ciphertext key iv #!rest opts)
56  (apply string-cipher cipher ciphertext key iv mode: 'decrypt opts))
57
58(define (test-roundtrip cipher)
59  (let ((plaintexts (map (o blob->string random-bytes) '(0 10 20)))
60        (key (random-bytes (cipher-key-length cipher)))
61        (iv (random-bytes (cipher-iv-length cipher))))
62    (for-each
63     (lambda (plaintext)
64       (let ((label (format "Roundtrip ~a (~a bytes)"
65                            (cipher-name cipher)
66                            (string-length plaintext)))
67             (ciphertext (encrypt-string cipher plaintext key iv)))
68         (test label plaintext (decrypt-string cipher ciphertext key iv))))
69     plaintexts)))
70
71(test-roundtrip aes-128-cbc)
72(test-roundtrip aes-128-ctr)
73
74(let* ((cipher aes-128-cbc)
75       (key-length (cipher-key-length cipher))
76       (iv-length (cipher-iv-length cipher)))
77  (test-error "Encryption with bogus algorithm" (encrypt-string #f "" (random-bytes key-length) (random-bytes iv-length)))
78  (test-error "Encryption with too small key" (encrypt-string cipher "" (random-bytes 1) (random-bytes iv-length)))
79  (test-error "Encryption with too big key" (encrypt-string cipher "" (random-bytes (add1 max-key-length)) (random-bytes iv-length)))
80  (test-error "Encryption with too small IV" (encrypt-string cipher "" (random-bytes key-length) (random-bytes 1)))
81  (test-assert "Encryption with too big IV" (encrypt-string cipher "" (random-bytes key-length) (random-bytes (add1 max-iv-length))))
82  (test-assert "Encryption without IV in ECB mode" (encrypt-string cipher "" (random-bytes key-length) #f))
83  (test-assert "Encryption of unpadded empty input" (encrypt-string cipher "" (random-bytes key-length) (random-bytes iv-length) padding: #f))
84  (test-error "Encryption of unpadded input" (encrypt-string cipher "abc" (random-bytes key-length) (random-bytes iv-length) padding: #f))
85  (test-assert "Encryption of manually padded input" (encrypt-string cipher (string-append "abc" (make-string 13 (integer->char 13))) (random-bytes key-length) (random-bytes iv-length) padding: #f)))
86
87;; https://nvlpubs.nist.gov/nistpubs/Legacy/SP/nistspecialpublication800-38a.pdf
88(let ((key (string->blob "\x2b\x7e\x15\x16\x28\xae\xd2\xa6\xab\xf7\x15\x88\x09\xcf\x4f\x3c"))
89      (plaintext "\x6b\xc1\xbe\xe2\x2e\x40\x9f\x96\xe9\x3d\x7e\x11\x73\x93\x17\x2a"))
90  (let ((ciphertext "\x3a\xd7\x7b\xb4\x0d\x7a\x36\x60\xa8\x9e\xca\xf3\x24\x66\xef\x97"))
91    (test "AES-128-ECB test vector (encryption)" ciphertext (encrypt-string aes-128-ecb plaintext key #f padding: #f))
92    (test "AES-128-ECB test vector (decryption)" plaintext (decrypt-string aes-128-ecb ciphertext key #f padding: #f)))
93  (let ((iv (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"))
94        (ciphertext "\x76\x49\xab\xac\x81\x19\xb2\x46\xce\xe9\x8e\x9b\x12\xe9\x19\x7d"))
95    (test "AES-128-CBC test vector (encryption)" ciphertext (encrypt-string aes-128-cbc plaintext key iv padding: #f))
96    (test "AES-128-CBC test vector (decryption)" plaintext (decrypt-string aes-128-cbc ciphertext key iv padding: #f)))
97  (let ((iv (string->blob "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"))
98        (ciphertext "\x87\x4d\x61\x91\xb6\x20\xe3\x26\x1b\xef\x68\x64\x99\x0d\xb6\xce"))
99    (test "AES-128-CTR test vector (encryption)" ciphertext (encrypt-string aes-128-ctr plaintext key iv))
100    (test "AES-128-CTR test vector (decryption)" plaintext (decrypt-string aes-128-ctr ciphertext key iv))))
101
102(when aes-128-gcm
103  (let ((key (string->blob "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"))
104        (iv (string->blob "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00")))
105    (let ((plaintext ""))
106      (receive (ciphertext tag)
107          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16)
108        (test "AES-GCM test vector (encryption)" "" ciphertext)
109        (test "AES-GCM test vector (tag)" "\x58\xe2\xfc\xce\xfa\x7e\x30\x61\x36\x7f\x1d\x57\xa4\xe7\x45\x5a" tag)
110        (test "AES-GCM test vector (decryption)" plaintext
111              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv))))
112    (let ((plaintext "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"))
113      (receive (ciphertext tag)
114          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16)
115        (test "AES-GCM test vector (encryption)" "\x03\x88\xda\xce\x60\xb6\xa3\x92\xf3\x28\xc2\xb9\x71\xb2\xfe\x78" ciphertext)
116        (test "AES-GCM test vector (tag)" "\xab\x6e\x47\xd4\x2c\xec\x13\xbd\xf5\x3a\x67\xb2\x12\x57\xbd\xdf" tag)
117        (test "AES-GCM test vector (decryption)" plaintext
118              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv))))
119    (let ((key (string->blob "\xfe\xff\xe9\x92\x86\x65\x73\x1c\x6d\x6a\x8f\x94\x67\x30\x83\x08"))
120          (iv (string->blob "\xca\xfe\xba\xbe\xfa\xce\xdb\xad\xde\xca\xf8\x88"))
121          (plaintext "\xd9\x31\x32\x25\xf8\x84\x06\xe5\xa5\x59\x09\xc5\xaf\xf5\x26\x9a\x86\xa7\xa9\x53\x15\x34\xf7\xda\x2e\x4c\x30\x3d\x8a\x31\x8a\x72\x1c\x3c\x0c\x95\x95\x68\x09\x53\x2f\xcf\x0e\x24\x49\xa6\xb5\x25\xb1\x6a\xed\xf5\xaa\x0d\xe6\x57\xba\x63\x7b\x39")
122          (auth-data (string->blob "\xfe\xed\xfa\xce\xde\xad\xbe\xef\xfe\xed\xfa\xce\xde\xad\xbe\xef\xab\xad\xda\xd2")))
123      (receive (ciphertext tag)
124          (string-encrypt-and-digest aes-128-gcm plaintext key iv tag-length: 16 auth-data: auth-data)
125        (test "AES-GCM test vector (encryption)" "\x42\x83\x1e\xc2\x21\x77\x74\x24\x4b\x72\x21\xb7\x84\xd0\xd4\x9c\xe3\xaa\x21\x2f\x2c\x02\xa4\xe0\x35\xc1\x7e\x23\x29\xac\xa1\x2e\x21\xd5\x14\xb2\x54\x66\x93\x1c\x7d\x8f\x6a\x5a\xac\x84\xaa\x05\x1b\xa3\x0b\x39\x6a\x0a\xac\x97\x3d\x58\xe0\x91" ciphertext)
126        (test "AES-GCM test vector (tag)" "\x5b\xc9\x4f\xbc\x32\x21\xa5\xdb\x94\xfa\xe9\x5a\xe7\x12\x1a\x47" tag)
127        (test "AES-GCM test vector (decryption)" plaintext
128              (string-decrypt-and-verify aes-128-gcm ciphertext tag key iv auth-data: auth-data))))))
129
130;; https://github.com/openssl/openssl/pull/2550#discussion_r99657275
131(when (and aes-128-ccm (>= (openssl-version-number) openssl-1.1.1))
132  (let ((key (string->blob "\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f")))
133    (let* ((plaintext "\x20\x21\x22\x23")
134           (message-length (string-length plaintext))
135           (iv-length 7)
136           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16"))
137           (tag-length 4)
138           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07")))
139      (receive (ciphertext tag)
140          (string-encrypt-and-digest aes-128-ccm plaintext key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data)
141        (test "AES-CCM test vector (encryption)" "\x71\x62\x01\x5b" ciphertext)
142        (test "AES-CCM test vector (tag)" "\x4d\xac\x25\x5d" tag)
143        (test "AES-CCM test vector (decryption)" plaintext
144              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data))))
145    (let* ((plaintext "\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f")
146           (message-length (string-length plaintext))
147           (iv-length 8)
148           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16\x17"))
149           (tag-length 6)
150           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f")))
151      (receive (ciphertext tag)
152          (string-encrypt-and-digest aes-128-ccm plaintext key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data)
153        (test "AES-CCM test vector (encryption)" "\xd2\xa1\xf0\xe0\x51\xea\x5f\x62\x08\x1a\x77\x92\x07\x3d\x59\x3d" ciphertext)
154        (test "AES-CCM test vector (tag)" "\x1f\xc6\x4f\xbf\xac\xcd" tag)
155        (test "AES-CCM test vector (decryption)" plaintext
156              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data))))
157    (let* ((plaintext "\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37")
158           (message-length (string-length plaintext))
159           (iv-length 12)
160           (iv (string->blob "\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b"))
161           (tag-length 8)
162           (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13")))
163      (receive (ciphertext tag)
164          (string-encrypt-and-digest aes-128-ccm plaintext key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data)
165        (test "AES-CCM test vector (encryption)" "\xe3\xb2\x01\xa9\xf5\xb7\x1a\x7a\x9b\x1c\xea\xec\xcd\x97\xe7\x0b\x61\x76\xaa\xd9\xa4\x42\x8a\xa5" ciphertext)
166        (test "AES-CCM test vector (tag)" "\x48\x43\x92\xfb\xc1\xb0\x99\x51" tag)
167        (test "AES-CCM test vector (decryption)" plaintext
168              (string-decrypt-and-verify aes-128-ccm ciphertext tag key iv effective-iv-length: iv-length message-length: message-length tag-length: tag-length auth-data: auth-data))))))
169
170(when aes-128-ocb
171  (let ((key (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"))
172        (auth-data (string->blob "\x00\x01\x02\x03\x04\x05\x06\x07")))
173    (let ((plaintext "")
174          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x00")))
175      (receive (ciphertext tag)
176          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16)
177        (test "AES-OCB test vector (encryption)" "" ciphertext)
178        (test "AES-OCB test vector (tag)" "\x78\x54\x07\xbf\xff\xc8\xad\x9e\xdc\xc5\x52\x0a\xc9\x11\x1e\xe6" tag)
179        (test "AES-OCB test vector (decryption)" plaintext
180              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv))))
181    (let ((plaintext "\x00\x01\x02\x03\x04\x05\x06\x07")
182          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x01")))
183      (receive (ciphertext tag)
184          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16 auth-data: auth-data)
185        (test "AES-OCB test vector (encryption)" "\x68\x20\xb3\x65\x7b\x6f\x61\x5a" ciphertext)
186        (test "AES-OCB test vector (tag)" "\x57\x25\xbd\xa0\xd3\xb4\xeb\x3a\x25\x7c\x9a\xf1\xf8\xf0\x30\x09" tag)
187        (test "AES-OCB test vector (decryption)" plaintext
188              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv auth-data: auth-data))))
189    (let ((plaintext "")
190          (iv (string->blob "\xbb\xaa\x99\x88\x77\x66\x55\x44\x33\x22\x11\x02")))
191      (receive (ciphertext tag)
192          (string-encrypt-and-digest aes-128-ocb plaintext key iv tag-length: 16 auth-data: auth-data)
193        (test "AES-OCB test vector (encryption)" "" ciphertext)
194        (test "AES-OCB test vector (tag)" "\x81\x01\x7f\x82\x03\xf0\x81\x27\x71\x52\xfa\xde\x69\x4a\x0a\x00" tag)
195        (test "AES-OCB test vector (decryption)" plaintext
196              (string-decrypt-and-verify aes-128-ocb ciphertext tag key iv auth-data: auth-data))))))
197
198;; https://www.rfc-editor.org/rfc/rfc6229.txt
199(let* ((cipher rc4)
200       (key (string->blob "\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20"))
201       (plaintext "\x00\x00\x00\x00\x00\x00\x00\x00")
202       (iv #f))
203  (test-error "RC4-40 with invalid key length"
204        (encrypt-string cipher plaintext (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 10))
205  (test "RC4-40 test vector (encryption)" "\xb2\x39\x63\x05\xf0\x3d\xc0\x27"
206        (encrypt-string cipher plaintext (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
207  (test "RC4-40 test vector (decryption)" plaintext
208        (decrypt-string cipher "\xb2\x39\x63\x05\xf0\x3d\xc0\x27" (string->blob "\x01\x02\x03\x04\x05") #f effective-key-length: 5))
209  (test "RC4-80 test vector (encryption)" "\xed\xe3\xb0\x46\x43\xe5\x86\xcc"
210        (encrypt-string cipher plaintext key #f effective-key-length: 10))
211  (test "RC4-80 test vector (decryption)" plaintext
212        (decrypt-string cipher "\xed\xe3\xb0\x46\x43\xe5\x86\xcc" key #f effective-key-length: 10))
213  (test "RC4-128 test vector (encryption)" "\x9a\xc7\xcc\x9a\x60\x9d\x1e\xf7"
214        (encrypt-string cipher plaintext key #f effective-key-length: 16))
215  (test "RC4-128 test vector (decryption)" plaintext
216        (decrypt-string cipher "\x9a\xc7\xcc\x9a\x60\x9d\x1e\xf7" key #f effective-key-length: 16))
217  (test "RC4-256 test vector (encryption)" "\xea\xa6\xbd\x25\x88\x0b\xf9\x3d"
218        (encrypt-string cipher plaintext key #f effective-key-length: 32))
219  (test "RC4-256 test vector (decryption)" plaintext
220        (encrypt-string cipher "\xea\xa6\xbd\x25\x88\x0b\xf9\x3d" key #f effective-key-length: 32)))
Note: See TracBrowser for help on using the repository browser.