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

Last change on this file since 40254 was 40254, checked in by Vasilij Schneidermann, 3 months ago

openssl: Reorder port arguments for consistency

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