dd9abcb53552ea93b9fb85621043ff5645ba702e
[BearSSL] / src / ssl / ssl_hs_common.t0
1 \ Copyright (c) 2016 Thomas Pornin <pornin@bolet.org>
2 \
3 \ Permission is hereby granted, free of charge, to any person obtaining
4 \ a copy of this software and associated documentation files (the
5 \ "Software"), to deal in the Software without restriction, including
6 \ without limitation the rights to use, copy, modify, merge, publish,
7 \ distribute, sublicense, and/or sell copies of the Software, and to
8 \ permit persons to whom the Software is furnished to do so, subject to
9 \ the following conditions:
10 \
11 \ The above copyright notice and this permission notice shall be
12 \ included in all copies or substantial portions of the Software.
13 \
14 \ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15 \ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16 \ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
17 \ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
18 \ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
19 \ ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20 \ CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 \ SOFTWARE.
22
23 \ ----------------------------------------------------------------------
24 \ This is the common T0 code for processing handshake messages (code that
25 \ is used by both client and server).
26
27 preamble {
28
29 #include <stddef.h>
30 #include <string.h>
31
32 #include "inner.h"
33
34 /*
35 * This macro evaluates to a pointer to the current engine context.
36 */
37 #define ENG ((br_ssl_engine_context *)(void *)((unsigned char *)t0ctx - offsetof(br_ssl_engine_context, cpu)))
38
39 }
40
41 \ IMPLEMENTATION NOTES
42 \ ====================
43 \
44 \ This code handles all records except application data records.
45 \ Application data is accepted (incoming records, outgoing payload data)
46 \ only when the application_data flag is set, which is done at the end
47 \ of the handshake; and it is cleared whenever a renegotiation or a
48 \ closure takes place.
49 \
50 \ Incoming alerts are processed on the fly; fatal alerts terminate the
51 \ context, while warnings are ignored, except for close_notify, which
52 \ triggers the closure procedure. That procedure never returns (it ends
53 \ with an 'ERR_OK fail' call). We can thus make this processing right
54 \ into the read functions.
55 \
56 \ Specific actions from the caller (closure or renegotiation) may happen
57 \ only when jumping back into the T0 code, i.e. just after a 'co' call.
58 \ Similarly, incoming record type may change only while the caller has
59 \ control, so we need to check that type only when returning from a 'co'.
60 \
61 \ The handshake processor needs to defer back to the caller ('co') only
62 \ in one of the following situations:
63 \
64 \ -- Some handshake data is expected.
65 \
66 \ -- The handshake is finished, and application data may flow. There may
67 \ be some incoming handshake data (HelloRequest from the server). This
68 \ is the only situation where a renegotiation call won't be ignored.
69 \
70 \ -- Some change-cipher-spec data is expected.
71 \
72 \ -- An alert record is expected. Other types of incoming records will be
73 \ skipped.
74 \
75 \ -- Waiting for the currently accumulated record to be sent and the
76 \ output buffer to become free again for another record.
77
78 \ Placeholder for handling not yet implemented functionalities.
79 : NYI ( -- ! )
80 "NOT YET IMPLEMENTED!" puts cr -1 fail ;
81
82 \ Debug function that prints a string (and a newline) on stderr.
83 cc: DBG ( addr -- ) {
84 extern void *stderr;
85 extern int fprintf(void *, const char *, ...);
86 fprintf(stderr, "%s\n", &t0_datablock[T0_POPi()]);
87 }
88
89 \ Debug function that prints a string and an integer value (followed
90 \ by a newline) on stderr.
91 cc: DBG2 ( addr x -- ) {
92 extern void *stderr;
93 extern int fprintf(void *, const char *, ...);
94 int32_t x = T0_POPi();
95 fprintf(stderr, "%s: %ld (0x%08lX)\n",
96 &t0_datablock[T0_POPi()], (long)x, (unsigned long)(uint32_t)x);
97 }
98
99 \ Mark the context as failed with a specific error code. This also
100 \ returns control to the caller.
101 cc: fail ( err -- ! ) {
102 br_ssl_engine_fail(ENG, (int)T0_POPi());
103 T0_CO();
104 }
105
106 \ Read a byte from the context (address is offset in context).
107 cc: get8 ( addr -- val ) {
108 size_t addr = (size_t)T0_POP();
109 T0_PUSH(*((unsigned char *)ENG + addr));
110 }
111
112 \ Read a 16-bit word from the context (address is offset in context).
113 cc: get16 ( addr -- val ) {
114 size_t addr = (size_t)T0_POP();
115 T0_PUSH(*(uint16_t *)(void *)((unsigned char *)ENG + addr));
116 }
117
118 \ Read a 32-bit word from the context (address is offset in context).
119 cc: get32 ( addr -- val ) {
120 size_t addr = (size_t)T0_POP();
121 T0_PUSH(*(uint32_t *)(void *)((unsigned char *)ENG + addr));
122 }
123
124 \ Set a byte in the context (address is offset in context).
125 cc: set8 ( val addr -- ) {
126 size_t addr = (size_t)T0_POP();
127 *((unsigned char *)ENG + addr) = (unsigned char)T0_POP();
128 }
129
130 \ Set a 16-bit word in the context (address is offset in context).
131 cc: set16 ( val addr -- ) {
132 size_t addr = (size_t)T0_POP();
133 *(uint16_t *)(void *)((unsigned char *)ENG + addr) = (uint16_t)T0_POP();
134 }
135
136 \ Set a 32-bit word in the context (address is offset in context).
137 cc: set32 ( val addr -- ) {
138 size_t addr = (size_t)T0_POP();
139 *(uint32_t *)(void *)((unsigned char *)ENG + addr) = (uint32_t)T0_POP();
140 }
141
142 \ Define a word that evaluates as an address of a field within the
143 \ engine context. The field name (C identifier) must follow in the
144 \ source. For field 'foo', the defined word is 'addr-foo'.
145 : addr-eng:
146 next-word { field }
147 "addr-" field + 0 1 define-word
148 0 8191 "offsetof(br_ssl_engine_context, " field + ")" + make-CX
149 postpone literal postpone ; ;
150
151 addr-eng: max_frag_len
152 addr-eng: log_max_frag_len
153 addr-eng: peer_log_max_frag_len
154 addr-eng: shutdown_recv
155 addr-eng: record_type_in
156 addr-eng: record_type_out
157 addr-eng: version_in
158 addr-eng: version_out
159 addr-eng: application_data
160 addr-eng: version_min
161 addr-eng: version_max
162 addr-eng: suites_buf
163 addr-eng: suites_num
164 addr-eng: server_name
165 addr-eng: client_random
166 addr-eng: server_random
167 addr-eng: ecdhe_curve
168 addr-eng: ecdhe_point
169 addr-eng: ecdhe_point_len
170 addr-eng: reneg
171 addr-eng: saved_finished
172 addr-eng: flags
173 addr-eng: pad
174 addr-eng: action
175 addr-eng: alert
176 addr-eng: close_received
177 addr-eng: protocol_names_num
178 addr-eng: selected_protocol
179
180 \ Similar to 'addr-eng:', for fields in the 'session' substructure.
181 : addr-session-field:
182 next-word { field }
183 "addr-" field + 0 1 define-word
184 0 8191 "offsetof(br_ssl_engine_context, session) + offsetof(br_ssl_session_parameters, " field + ")" + make-CX
185 postpone literal postpone ; ;
186
187 addr-session-field: session_id
188 addr-session-field: session_id_len
189 addr-session-field: version
190 addr-session-field: cipher_suite
191 addr-session-field: master_secret
192
193 \ Check a server flag by index.
194 : flag? ( index -- bool )
195 addr-flags get32 swap >> 1 and neg ;
196
197 \ Define a word that evaluates to an error constant. This assumes that
198 \ all relevant error codes are in the 0..63 range.
199 : err:
200 next-word { name }
201 name 0 1 define-word
202 0 63 "BR_" name + make-CX postpone literal postpone ; ;
203
204 err: ERR_OK
205 err: ERR_BAD_PARAM
206 err: ERR_BAD_STATE
207 err: ERR_UNSUPPORTED_VERSION
208 err: ERR_BAD_VERSION
209 err: ERR_BAD_LENGTH
210 err: ERR_TOO_LARGE
211 err: ERR_BAD_MAC
212 err: ERR_NO_RANDOM
213 err: ERR_UNKNOWN_TYPE
214 err: ERR_UNEXPECTED
215 err: ERR_BAD_CCS
216 err: ERR_BAD_ALERT
217 err: ERR_BAD_HANDSHAKE
218 err: ERR_OVERSIZED_ID
219 err: ERR_BAD_CIPHER_SUITE
220 err: ERR_BAD_COMPRESSION
221 err: ERR_BAD_FRAGLEN
222 err: ERR_BAD_SECRENEG
223 err: ERR_EXTRA_EXTENSION
224 err: ERR_BAD_SNI
225 err: ERR_BAD_HELLO_DONE
226 err: ERR_LIMIT_EXCEEDED
227 err: ERR_BAD_FINISHED
228 err: ERR_RESUME_MISMATCH
229 err: ERR_INVALID_ALGORITHM
230 err: ERR_BAD_SIGNATURE
231 err: ERR_WRONG_KEY_USAGE
232 err: ERR_NO_CLIENT_AUTH
233
234 \ Get supported curves (bit mask).
235 cc: supported-curves ( -- x ) {
236 uint32_t x = ENG->iec == NULL ? 0 : ENG->iec->supported_curves;
237 T0_PUSH(x);
238 }
239
240 \ Get supported hash functions (bit mask and number).
241 \ Note: this (on purpose) skips MD5.
242 cc: supported-hash-functions ( -- x num ) {
243 int i;
244 unsigned x, num;
245
246 x = 0;
247 num = 0;
248 for (i = br_sha1_ID; i <= br_sha512_ID; i ++) {
249 if (br_multihash_getimpl(&ENG->mhash, i)) {
250 x |= 1U << i;
251 num ++;
252 }
253 }
254 T0_PUSH(x);
255 T0_PUSH(num);
256 }
257
258 \ Test support for RSA signatures.
259 cc: supports-rsa-sign? ( -- bool ) {
260 T0_PUSHi(-(ENG->irsavrfy != 0));
261 }
262
263 \ Test support for ECDSA signatures.
264 cc: supports-ecdsa? ( -- bool ) {
265 T0_PUSHi(-(ENG->iecdsa != 0));
266 }
267
268 \ (Re)initialise the multihasher.
269 cc: multihash-init ( -- ) {
270 br_multihash_init(&ENG->mhash);
271 }
272
273 \ Flush the current record: if some payload data has been accumulated,
274 \ close the record and schedule it for sending. If there is no such data,
275 \ this function does nothing.
276 cc: flush-record ( -- ) {
277 br_ssl_engine_flush_record(ENG);
278 }
279
280 \ Yield control to the caller.
281 \ When the control is returned to us, react to the new context. Returned
282 \ value is a bitwise combination of the following:
283 \ 0x01 handshake data is available
284 \ 0x02 change-cipher-spec data is available
285 \ 0x04 some data other than handshake or change-cipher-spec is available
286 \ 0x08 output buffer is ready for a new outgoing record
287 \ 0x10 renegotiation is requested and not to be ignored
288 \ Flags 0x01, 0x02 and 0x04 are mutually exclusive.
289 : wait-co ( -- state )
290 co
291 0
292 addr-action get8 dup if
293 case
294 1 of 0 do-close endof
295 2 of addr-application_data get8 1 = if
296 0x10 or
297 then endof
298 endcase
299 else
300 drop
301 then
302 addr-close_received get8 ifnot
303 has-input? if
304 addr-record_type_in get8 case
305
306 \ ChangeCipherSpec
307 20 of 0x02 or endof
308
309 \ Alert -- if close_notify received, trigger
310 \ the closure sequence.
311 21 of process-alerts if -1 do-close then endof
312
313 \ Handshake
314 22 of 0x01 or endof
315
316 \ Not CCS, Alert or Handshake.
317 drop 0x04 or 0
318 endcase
319 then
320 then
321 can-output? if 0x08 or then ;
322
323 \ Send an alert message. This shall be called only when there is room for
324 \ an outgoing record.
325 : send-alert ( level alert -- )
326 21 addr-record_type_out set8
327 swap write8-native drop write8-native drop
328 flush-record ;
329
330 \ Send an alert message of level "warning". This shall be called only when
331 \ there is room for an outgoing record.
332 : send-warning ( alert -- )
333 1 swap send-alert ;
334
335 \ Fail by sending a fatal alert.
336 : fail-alert ( alert -- ! )
337 { alert }
338 flush-record
339 begin can-output? not while wait-co drop repeat
340 2 alert send-alert
341 begin can-output? not while wait-co drop repeat
342 alert 512 + fail ;
343
344 \ Perform the close operation:
345 \ -- Prevent new application data from the caller.
346 \ -- Incoming data is discarded (except alerts).
347 \ -- Outgoing data is flushed.
348 \ -- A close_notify alert is sent.
349 \ -- If 'cnr' is zero, then incoming data is discarded until a close_notify
350 \ is received.
351 \ -- At the end, the context is terminated.
352 \
353 \ cnr shall be either 0 or -1.
354 : do-close ( cnr -- ! )
355 \ 'cnr' is set to non-zero when a close_notify is received from
356 \ the peer.
357 { cnr }
358
359 \ Get out of application data state. If we were accepting
360 \ application data (flag is 1), and we still expect a close_notify
361 \ from the peer (cnr is 0), then we should set the flag to 2.
362 \ In all other cases, flag should be set to 0.
363 addr-application_data get8 cnr not and 1 << addr-application_data set8
364
365 \ Flush existing payload if any.
366 flush-record
367
368 \ Wait for room to send the close_notify. Since individual records
369 \ can always hold at least 512 bytes, we know that when there is
370 \ room, then there is room for a complete close_notify (two bytes).
371 begin can-output? not while cnr wait-for-close >cnr repeat
372
373 \ Write the close_notify and flush it.
374 \ 21 addr-record_type_out set8
375 \ 1 write8-native 0 write8-native 2drop
376 \ flush-record
377 0 send-warning
378
379 \ Loop until our record has been sent (we know it's gone when
380 \ writing is again possible) and a close_notify has been received.
381 cnr
382 begin
383 dup can-output? and if ERR_OK fail then
384 wait-for-close
385 again ;
386
387 \ Yield control to the engine, with a possible flush. If 'cnr' is 0,
388 \ then input is analysed: all input is discarded, until a close_notify
389 \ is received.
390 : wait-for-close ( cnr -- cnr )
391 co
392 dup ifnot
393 has-input? if
394 addr-record_type_in get8 21 = if
395 drop process-alerts
396 \ If we received a close_notify then we
397 \ no longer accept incoming application
398 \ data records.
399 0 addr-application_data set8
400 else
401 discard-input
402 then
403 then
404 then ;
405
406 \ Test whether there is some accumulated payload that still needs to be
407 \ sent.
408 cc: payload-to-send? ( -- bool ) {
409 T0_PUSHi(-br_ssl_engine_has_pld_to_send(ENG));
410 }
411
412 \ Test whether there is some available input data.
413 cc: has-input? ( -- bool ) {
414 T0_PUSHi(-(ENG->hlen_in != 0));
415 }
416
417 \ Test whether some payload bytes may be written.
418 cc: can-output? ( -- bool ) {
419 T0_PUSHi(-(ENG->hlen_out > 0));
420 }
421
422 \ Discard current input entirely.
423 cc: discard-input ( -- ) {
424 ENG->hlen_in = 0;
425 }
426
427 \ Low-level read for one byte. If there is no available byte right
428 \ away, then -1 is returned. Otherwise, the byte value is returned.
429 \ If the current record type is "handshake" then the read byte is also
430 \ injected in the multi-hasher.
431 cc: read8-native ( -- x ) {
432 if (ENG->hlen_in > 0) {
433 unsigned char x;
434
435 x = *ENG->hbuf_in ++;
436 if (ENG->record_type_in == BR_SSL_HANDSHAKE) {
437 br_multihash_update(&ENG->mhash, &x, 1);
438 }
439 T0_PUSH(x);
440 ENG->hlen_in --;
441 } else {
442 T0_PUSHi(-1);
443 }
444 }
445
446 \ Low-level read for several bytes. On entry, this expects an address
447 \ (offset in the engine context) and a length; these values designate
448 \ where the chunk should go. Upon exit, the new address and length
449 \ are pushed; that output length contains how many bytes could not be
450 \ read. If there is no available byte for reading, the address and
451 \ length are unchanged.
452 \ If the current record type is "handshake" then the read bytes are
453 \ injected in the multi-hasher.
454 cc: read-chunk-native ( addr len -- addr len ) {
455 size_t clen = ENG->hlen_in;
456 if (clen > 0) {
457 uint32_t addr, len;
458
459 len = T0_POP();
460 addr = T0_POP();
461 if ((size_t)len < clen) {
462 clen = (size_t)len;
463 }
464 memcpy((unsigned char *)ENG + addr, ENG->hbuf_in, clen);
465 if (ENG->record_type_in == BR_SSL_HANDSHAKE) {
466 br_multihash_update(&ENG->mhash, ENG->hbuf_in, clen);
467 }
468 T0_PUSH(addr + (uint32_t)clen);
469 T0_PUSH(len - (uint32_t)clen);
470 ENG->hbuf_in += clen;
471 ENG->hlen_in -= clen;
472 }
473 }
474
475 \ Process available alert bytes. If a fatal alert is received, then the
476 \ context is terminated; otherwise, this returns either true (-1) if a
477 \ close_notify was received, false (0) otherwise.
478 : process-alerts ( -- bool )
479 0
480 begin has-input? while read8-native process-alert-byte or repeat
481 dup if 1 addr-shutdown_recv set8 then ;
482
483 \ Process an alert byte. Returned value is non-zero if this is a close_notify,
484 \ zero otherwise.
485 : process-alert-byte ( x -- bool )
486 addr-alert get8 case
487 0 of
488 \ 'alert' field is 0, so this byte shall be a level.
489 \ Levels shall be 1 (warning) or 2 (fatal); we convert
490 \ all other values to "fatal".
491 dup 1 <> if drop 2 then
492 addr-alert set8 0
493 endof
494 1 of
495 0 addr-alert set8
496 \ close_notify has value 0.
497 \ no_renegotiation has value 100, and we treat it
498 \ as a fatal alert.
499 dup 100 = if 256 + fail then
500 0=
501 endof
502 \ Fatal alert implies context termination.
503 drop 256 + fail
504 endcase ;
505
506 \ In general we only deal with handshake data here. Alerts are processed
507 \ in specific code right when they are received, and ChangeCipherSpec has
508 \ its own handling code. So we need to check that the data is "handshake"
509 \ only when returning from a coroutine call.
510
511 \ Yield control to the engine. Alerts are processed; if incoming data is
512 \ neither handshake or alert, then an error is triggered.
513 : wait-for-handshake ( -- )
514 wait-co 0x07 and 0x01 > if ERR_UNEXPECTED fail then ;
515
516 \ Flush outgoing data (if any), then wait for the output buffer to be
517 \ clear; when this is done, set the output record type to the specified
518 \ value.
519 : wait-rectype-out ( rectype -- )
520 { rectype }
521 flush-record
522 begin
523 can-output? if rectype addr-record_type_out set8 ret then
524 wait-co drop
525 again ;
526
527 \ Read one byte of handshake data. Block until that byte is available.
528 \ This does not check any length.
529 : read8-nc ( -- x )
530 begin
531 read8-native dup 0< ifnot ret then
532 drop wait-for-handshake
533 again ;
534
535 \ Test whether there are some more bytes in the current record. These
536 \ bytes have not necessarily been received yet (processing of unencrypted
537 \ records may begin before all bytes are received).
538 cc: more-incoming-bytes? ( -- bool ) {
539 T0_PUSHi(ENG->hlen_in != 0 || !br_ssl_engine_recvrec_finished(ENG));
540 }
541
542 \ For reading functions, the TOS is supposed to contain the number of bytes
543 \ that can still be read (from encapsulating structure header), and it is
544 \ updated.
545
546 : check-len ( lim len -- lim )
547 - dup 0< if ERR_BAD_PARAM fail then ;
548
549 \ Read one byte of handshake data. This pushes an integer in the 0..255 range.
550 : read8 ( lim -- lim x )
551 1 check-len read8-nc ;
552
553 \ Read a 16-bit value (in the 0..65535 range)
554 : read16 ( lim -- lim n )
555 2 check-len read8-nc 8 << read8-nc + ;
556
557 \ Read a 24-bit value (in the 0..16777215 range)
558 : read24 ( lim -- lim n )
559 3 check-len read8-nc 8 << read8-nc + 8 << read8-nc + ;
560
561 \ Read some bytes. The "address" is an offset within the context
562 \ structure.
563 : read-blob ( lim addr len -- lim )
564 { addr len }
565 len check-len
566 addr len
567 begin
568 read-chunk-native
569 dup 0 = if 2drop ret then
570 wait-for-handshake
571 again ;
572
573 \ Read some bytes and drop them.
574 : skip-blob ( lim len -- lim )
575 swap over check-len swap
576 begin dup while read8-nc drop 1- repeat
577 drop ;
578
579 \ Read a 16-bit length, then skip exactly that many bytes.
580 : read-ignore-16 ( lim -- lim )
581 read16 skip-blob ;
582
583 \ Open a substructure: the inner structure length is checked against,
584 \ and substracted, from the output structure current limit.
585 : open-elt ( lim len -- lim-outer lim-inner )
586 dup { len }
587 - dup 0< if ERR_BAD_PARAM fail then
588 len ;
589
590 \ Close the current structure. This checks that the limit is 0.
591 : close-elt ( lim -- )
592 if ERR_BAD_PARAM fail then ;
593
594 \ Write one byte of handshake data.
595 : write8 ( n -- )
596 begin
597 dup write8-native if drop ret then
598 wait-co drop
599 again ;
600
601 \ Low-level write for one byte. On exit, it pushes either -1 (byte was
602 \ written) or 0 (no room in output buffer).
603 cc: write8-native ( x -- bool ) {
604 unsigned char x;
605
606 x = (unsigned char)T0_POP();
607 if (ENG->hlen_out > 0) {
608 if (ENG->record_type_out == BR_SSL_HANDSHAKE) {
609 br_multihash_update(&ENG->mhash, &x, 1);
610 }
611 *ENG->hbuf_out ++ = x;
612 ENG->hlen_out --;
613 T0_PUSHi(-1);
614 } else {
615 T0_PUSHi(0);
616 }
617 }
618
619 \ Write a 16-bit value.
620 : write16 ( n -- )
621 dup 8 u>> write8 write8 ;
622
623 \ Write a 24-bit value.
624 : write24 ( n -- )
625 dup 16 u>> write8 write16 ;
626
627 \ Write some bytes. The "address" is an offset within the context
628 \ structure.
629 : write-blob ( addr len -- )
630 begin
631 write-blob-chunk
632 dup 0 = if 2drop ret then
633 wait-co drop
634 again ;
635
636 cc: write-blob-chunk ( addr len -- addr len ) {
637 size_t clen = ENG->hlen_out;
638 if (clen > 0) {
639 uint32_t addr, len;
640
641 len = T0_POP();
642 addr = T0_POP();
643 if ((size_t)len < clen) {
644 clen = (size_t)len;
645 }
646 memcpy(ENG->hbuf_out, (unsigned char *)ENG + addr, clen);
647 if (ENG->record_type_out == BR_SSL_HANDSHAKE) {
648 br_multihash_update(&ENG->mhash, ENG->hbuf_out, clen);
649 }
650 T0_PUSH(addr + (uint32_t)clen);
651 T0_PUSH(len - (uint32_t)clen);
652 ENG->hbuf_out += clen;
653 ENG->hlen_out -= clen;
654 }
655 }
656
657 \ Write a blob with the length as header (over one byte)
658 : write-blob-head8 ( addr len -- )
659 dup write8 write-blob ;
660
661 \ Write a blob with the length as header (over two bytes)
662 : write-blob-head16 ( addr len -- )
663 dup write16 write-blob ;
664
665 \ Perform a byte-to-byte comparison between two blobs. Each blob is
666 \ provided as an "address" (offset in the context structure); the
667 \ length is common. Returned value is true (-1) if the two blobs are
668 \ equal, false (0) otherwise.
669 cc: memcmp ( addr1 addr2 len -- bool ) {
670 size_t len = (size_t)T0_POP();
671 void *addr2 = (unsigned char *)ENG + (size_t)T0_POP();
672 void *addr1 = (unsigned char *)ENG + (size_t)T0_POP();
673 int x = memcmp(addr1, addr2, len);
674 T0_PUSH((uint32_t)-(x == 0));
675 }
676
677 \ Copy bytes between two areas, whose addresses are provided as
678 \ offsets in the context structure.
679 cc: memcpy ( dst src len -- ) {
680 size_t len = (size_t)T0_POP();
681 void *src = (unsigned char *)ENG + (size_t)T0_POP();
682 void *dst = (unsigned char *)ENG + (size_t)T0_POP();
683 memcpy(dst, src, len);
684 }
685
686 \ Get string length (zero-terminated). The string address is provided as
687 \ an offset relative to the context start. Returned length does not include
688 \ the terminated 0.
689 cc: strlen ( str -- len ) {
690 void *str = (unsigned char *)ENG + (size_t)T0_POP();
691 T0_PUSH((uint32_t)strlen(str));
692 }
693
694 \ Fill a buffer with zeros. The buffer address is an offset in the context.
695 cc: bzero ( addr len -- ) {
696 size_t len = (size_t)T0_POP();
697 void *addr = (unsigned char *)ENG + (size_t)T0_POP();
698 memset(addr, 0, len);
699 }
700
701 \ Scan the list of supported cipher suites for a given value. If found,
702 \ then the list index at which it was found is returned; otherwise, -1
703 \ is returned.
704 : scan-suite ( suite -- index )
705 { suite }
706 addr-suites_num get8 { num }
707 0
708 begin dup num < while
709 dup 1 << addr-suites_buf + get16 suite = if ret then
710 1+
711 repeat
712 drop -1 ;
713
714 \ =======================================================================
715
716 \ Generate random bytes into buffer (address is offset in context).
717 cc: mkrand ( addr len -- ) {
718 size_t len = (size_t)T0_POP();
719 void *addr = (unsigned char *)ENG + (size_t)T0_POP();
720 br_hmac_drbg_generate(&ENG->rng, addr, len);
721 }
722
723 \ Read a handshake message header: type and length. These are returned
724 \ in reverse order (type is TOS, length is below it).
725 : read-handshake-header-core ( -- lim type )
726 read8-nc 3 read24 swap drop swap ;
727
728 \ Read a handshake message header: type and length. If the header is for
729 \ a HelloRequest message, then it is discarded and a new header is read
730 \ (repeatedly if necessary).
731 : read-handshake-header ( -- lim type )
732 begin
733 read-handshake-header-core dup 0= while
734 drop if ERR_BAD_HANDSHAKE fail then
735 repeat ;
736
737 \ =======================================================================
738
739 \ Cipher suite processing.
740 \
741 \ Unfortunately, cipher suite identifiers are attributed mostly arbitrary,
742 \ so we have to map the cipher suite numbers we support into aggregate
743 \ words that encode the information we need. Table below is organized
744 \ as a sequence of pairs of 16-bit words, the first being the cipher suite
745 \ identifier, the second encoding the algorithm elements. The suites are
746 \ ordered by increasing cipher suite ID, so that fast lookups may be
747 \ performed with a binary search (not implemented for the moment, since it
748 \ does not appear to matter much in practice).
749 \
750 \ Algorithm elements are encoded over 4 bits each, in the following order
751 \ (most significant to least significant):
752 \
753 \ -- Server key type:
754 \ 0 RSA (RSA key exchange)
755 \ 1 ECDHE-RSA (ECDHE key exchange, RSA signature)
756 \ 2 ECDHE-ECDSA (ECDHE key exchange, ECDSA signature)
757 \ 3 ECDH-RSA (ECDH key exchange, certificate is RSA-signed)
758 \ 4 ECDH-ECDSA (ECDH key exchange, certificate is ECDSA-signed)
759 \ -- Encryption algorithm:
760 \ 0 3DES/CBC
761 \ 1 AES-128/CBC
762 \ 2 AES-256/CBC
763 \ 3 AES-128/GCM
764 \ 4 AES-256/GCM
765 \ 5 ChaCha20/Poly1305
766 \ -- MAC algorithm:
767 \ 0 none (for suites with AEAD encryption)
768 \ 2 HMAC/SHA-1
769 \ 4 HMAC/SHA-256
770 \ 5 HMAC/SHA-384
771 \ -- PRF for TLS-1.2:
772 \ 4 with SHA-256
773 \ 5 with SHA-384
774 \
775 \ WARNING: if adding a new cipher suite that does not use SHA-256 for the
776 \ PRF (with TLS 1.2), be sure to check the suites_sha384[] array defined
777 \ in ssl/ssl_keyexport.c
778
779 data: cipher-suite-def
780
781 hexb| 000A 0024 | \ TLS_RSA_WITH_3DES_EDE_CBC_SHA
782 hexb| 002F 0124 | \ TLS_RSA_WITH_AES_128_CBC_SHA
783 hexb| 0035 0224 | \ TLS_RSA_WITH_AES_256_CBC_SHA
784 hexb| 003C 0144 | \ TLS_RSA_WITH_AES_128_CBC_SHA256
785 hexb| 003D 0244 | \ TLS_RSA_WITH_AES_256_CBC_SHA256
786
787 hexb| 009C 0304 | \ TLS_RSA_WITH_AES_128_GCM_SHA256
788 hexb| 009D 0405 | \ TLS_RSA_WITH_AES_256_GCM_SHA384
789
790 hexb| C003 4024 | \ TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA
791 hexb| C004 4124 | \ TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA
792 hexb| C005 4224 | \ TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA
793 hexb| C008 2024 | \ TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA
794 hexb| C009 2124 | \ TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA
795 hexb| C00A 2224 | \ TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA
796 hexb| C00D 3024 | \ TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA
797 hexb| C00E 3124 | \ TLS_ECDH_RSA_WITH_AES_128_CBC_SHA
798 hexb| C00F 3224 | \ TLS_ECDH_RSA_WITH_AES_256_CBC_SHA
799 hexb| C012 1024 | \ TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA
800 hexb| C013 1124 | \ TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA
801 hexb| C014 1224 | \ TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA
802
803 hexb| C023 2144 | \ TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256
804 hexb| C024 2255 | \ TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384
805 hexb| C025 4144 | \ TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256
806 hexb| C026 4255 | \ TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384
807 hexb| C027 1144 | \ TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256
808 hexb| C028 1255 | \ TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384
809 hexb| C029 3144 | \ TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256
810 hexb| C02A 3255 | \ TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384
811 hexb| C02B 2304 | \ TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256
812 hexb| C02C 2405 | \ TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384
813 hexb| C02D 4304 | \ TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256
814 hexb| C02E 4405 | \ TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384
815 hexb| C02F 1304 | \ TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256
816 hexb| C030 1405 | \ TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384
817 hexb| C031 3304 | \ TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256
818 hexb| C032 3405 | \ TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384
819
820 hexb| CCA8 1504 | \ TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256
821 hexb| CCA9 2504 | \ TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256
822
823 hexb| 0000 | \ List terminator.
824
825 \ Convert cipher suite identifier to element words. This returns 0 if
826 \ the cipher suite is not known.
827 : cipher-suite-to-elements ( suite -- elts )
828 { id }
829 cipher-suite-def
830 begin
831 dup 2+ swap data-get16
832 dup ifnot 2drop 0 ret then
833 id = if data-get16 ret then
834 2+
835 again ;
836
837 \ Check that a given cipher suite is supported. Note that this also
838 \ returns true (-1) for the TLS_FALLBACK_SCSV pseudo-ciphersuite.
839 : suite-supported? ( suite -- bool )
840 dup 0x5600 = if drop -1 ret then
841 cipher-suite-to-elements 0<> ;
842
843 \ Get expected key type for cipher suite. The key type is one of
844 \ BR_KEYTYPE_RSA or BR_KEYTYPE_EC, combined with either BR_KEYTYPE_KEYX
845 \ (RSA encryption or static ECDH) or BR_KEYTYPE_SIGN (RSA or ECDSA
846 \ signature, for ECDHE cipher suites).
847 : expected-key-type ( suite -- key-type )
848 cipher-suite-to-elements 12 >>
849 case
850 0 of CX 0 63 { BR_KEYTYPE_RSA | BR_KEYTYPE_KEYX } endof
851 1 of CX 0 63 { BR_KEYTYPE_RSA | BR_KEYTYPE_SIGN } endof
852 2 of CX 0 63 { BR_KEYTYPE_EC | BR_KEYTYPE_SIGN } endof
853 3 of CX 0 63 { BR_KEYTYPE_EC | BR_KEYTYPE_KEYX } endof
854 4 of CX 0 63 { BR_KEYTYPE_EC | BR_KEYTYPE_KEYX } endof
855 0 swap
856 endcase ;
857
858 \ Test whether the cipher suite uses RSA key exchange.
859 : use-rsa-keyx? ( suite -- bool )
860 cipher-suite-to-elements 12 >> 0= ;
861
862 \ Test whether the cipher suite uses ECDHE key exchange, signed with RSA.
863 : use-rsa-ecdhe? ( suite -- bool )
864 cipher-suite-to-elements 12 >> 1 = ;
865
866 \ Test whether the cipher suite uses ECDHE key exchange, signed with ECDSA.
867 : use-ecdsa-ecdhe? ( suite -- bool )
868 cipher-suite-to-elements 12 >> 2 = ;
869
870 \ Test whether the cipher suite uses ECDHE key exchange (with RSA or ECDSA).
871 : use-ecdhe? ( suite -- bool )
872 cipher-suite-to-elements 12 >> dup 0> swap 3 < and ;
873
874 \ Test whether the cipher suite uses ECDH (static) key exchange.
875 : use-ecdh? ( suite -- bool )
876 cipher-suite-to-elements 12 >> 2 > ;
877
878 \ Get identifier for the PRF (TLS 1.2).
879 : prf-id ( suite -- id )
880 cipher-suite-to-elements 15 and ;
881
882 \ Test whether a cipher suite is only for TLS-1.2. Cipher suites that
883 \ can be used with TLS-1.0 or 1.1 use HMAC/SHA-1. RFC do not formally
884 \ forbid using a CBC-based TLS-1.2 cipher suite, e.g. based on HMAC/SHA-256,
885 \ with older protocol versions; however, servers should not do that, since
886 \ it may confuse clients. Since the server code does not try such games,
887 \ for consistency, the client should reject it as well (normal servers
888 \ don't do that, so any attempt is a sign of foul play).
889 : use-tls12? ( suite -- bool )
890 cipher-suite-to-elements 0xF0 and 0x20 <> ;
891
892 \ Switch to negotiated security parameters for input or output.
893 : switch-encryption ( is-client for-input -- )
894 { for-input }
895 addr-cipher_suite get16 cipher-suite-to-elements { elts }
896
897 \ prf_id
898 elts 15 and
899
900 \ mac_id
901 elts 4 >> 15 and
902
903 \ cipher type and key length
904 elts 8 >> 15 and case
905 \ 3DES/CBC
906 0 of 0 24
907 for-input if
908 switch-cbc-in
909 else
910 switch-cbc-out
911 then
912 endof
913
914 \ AES-128/CBC
915 1 of 1 16
916 for-input if
917 switch-cbc-in
918 else
919 switch-cbc-out
920 then
921 endof
922
923 \ AES-256/CBC
924 2 of 1 32
925 for-input if
926 switch-cbc-in
927 else
928 switch-cbc-out
929 then
930 endof
931
932 \ AES-128/GCM
933 3 of drop 16
934 for-input if
935 switch-aesgcm-in
936 else
937 switch-aesgcm-out
938 then
939 endof
940
941 \ AES-256/GCM
942 4 of drop 32
943 for-input if
944 switch-aesgcm-in
945 else
946 switch-aesgcm-out
947 then
948 endof
949
950 \ ChaCha20+Poly1305
951 5 of drop
952 for-input if
953 switch-chapol-in
954 else
955 switch-chapol-out
956 then
957 endof
958
959 ERR_BAD_PARAM fail
960 endcase
961 ;
962
963 cc: switch-cbc-out ( is_client prf_id mac_id aes cipher_key_len -- ) {
964 int is_client, prf_id, mac_id, aes;
965 unsigned cipher_key_len;
966
967 cipher_key_len = T0_POP();
968 aes = T0_POP();
969 mac_id = T0_POP();
970 prf_id = T0_POP();
971 is_client = T0_POP();
972 br_ssl_engine_switch_cbc_out(ENG, is_client, prf_id, mac_id,
973 aes ? ENG->iaes_cbcenc : ENG->ides_cbcenc, cipher_key_len);
974 }
975
976 cc: switch-cbc-in ( is_client prf_id mac_id aes cipher_key_len -- ) {
977 int is_client, prf_id, mac_id, aes;
978 unsigned cipher_key_len;
979
980 cipher_key_len = T0_POP();
981 aes = T0_POP();
982 mac_id = T0_POP();
983 prf_id = T0_POP();
984 is_client = T0_POP();
985 br_ssl_engine_switch_cbc_in(ENG, is_client, prf_id, mac_id,
986 aes ? ENG->iaes_cbcdec : ENG->ides_cbcdec, cipher_key_len);
987 }
988
989 cc: switch-aesgcm-out ( is_client prf_id cipher_key_len -- ) {
990 int is_client, prf_id;
991 unsigned cipher_key_len;
992
993 cipher_key_len = T0_POP();
994 prf_id = T0_POP();
995 is_client = T0_POP();
996 br_ssl_engine_switch_gcm_out(ENG, is_client, prf_id,
997 ENG->iaes_ctr, cipher_key_len);
998 }
999
1000 cc: switch-aesgcm-in ( is_client prf_id cipher_key_len -- ) {
1001 int is_client, prf_id;
1002 unsigned cipher_key_len;
1003
1004 cipher_key_len = T0_POP();
1005 prf_id = T0_POP();
1006 is_client = T0_POP();
1007 br_ssl_engine_switch_gcm_in(ENG, is_client, prf_id,
1008 ENG->iaes_ctr, cipher_key_len);
1009 }
1010
1011 cc: switch-chapol-out ( is_client prf_id -- ) {
1012 int is_client, prf_id;
1013
1014 prf_id = T0_POP();
1015 is_client = T0_POP();
1016 br_ssl_engine_switch_chapol_out(ENG, is_client, prf_id);
1017 }
1018
1019 cc: switch-chapol-in ( is_client prf_id -- ) {
1020 int is_client, prf_id;
1021
1022 prf_id = T0_POP();
1023 is_client = T0_POP();
1024 br_ssl_engine_switch_chapol_in(ENG, is_client, prf_id);
1025 }
1026
1027 \ Write Finished message.
1028 : write-Finished ( from_client -- )
1029 compute-Finished
1030 20 write8 12 write24 addr-pad 12 write-blob ;
1031
1032 \ Read Finished message.
1033 : read-Finished ( from_client -- )
1034 compute-Finished
1035 read-handshake-header 20 <> if ERR_UNEXPECTED fail then
1036 addr-pad 12 + 12 read-blob
1037 close-elt
1038 addr-pad dup 12 + 12 memcmp ifnot ERR_BAD_FINISHED fail then ;
1039
1040 \ Compute the "Finished" contents (either the value to send, or the
1041 \ expected value). The 12-byte string is written in the pad. The
1042 \ "from_client" value is non-zero for the Finished sent by the client.
1043 \ The computed value is also saved in the relevant buffer for handling
1044 \ secure renegotiation.
1045 : compute-Finished ( from_client -- )
1046 dup addr-saved_finished swap ifnot 12 + then swap
1047 addr-cipher_suite get16 prf-id compute-Finished-inner
1048 addr-pad 12 memcpy ;
1049
1050 cc: compute-Finished-inner ( from_client prf_id -- ) {
1051 int prf_id = T0_POP();
1052 int from_client = T0_POPi();
1053 unsigned char tmp[48];
1054 br_tls_prf_seed_chunk seed;
1055
1056 br_tls_prf_impl prf = br_ssl_engine_get_PRF(ENG, prf_id);
1057 seed.data = tmp;
1058 if (ENG->session.version >= BR_TLS12) {
1059 seed.len = br_multihash_out(&ENG->mhash, prf_id, tmp);
1060 } else {
1061 br_multihash_out(&ENG->mhash, br_md5_ID, tmp);
1062 br_multihash_out(&ENG->mhash, br_sha1_ID, tmp + 16);
1063 seed.len = 36;
1064 }
1065 prf(ENG->pad, 12, ENG->session.master_secret,
1066 sizeof ENG->session.master_secret,
1067 from_client ? "client finished" : "server finished",
1068 1, &seed);
1069 }
1070
1071 \ Receive ChangeCipherSpec and Finished from the peer.
1072 : read-CCS-Finished ( is-client -- )
1073 has-input? if
1074 addr-record_type_in get8 20 <> if ERR_UNEXPECTED fail then
1075 else
1076 begin
1077 wait-co 0x07 and dup 0x02 <> while
1078 if ERR_UNEXPECTED fail then
1079 repeat
1080 drop
1081 then
1082 read8-nc 1 <> more-incoming-bytes? or if ERR_BAD_CCS fail then
1083 dup 1 switch-encryption
1084
1085 \ Read and verify Finished from peer.
1086 not read-Finished ;
1087
1088 \ Send ChangeCipherSpec and Finished to the peer.
1089 : write-CCS-Finished ( is-client -- )
1090 \ Flush and wait for output buffer to be clear, so that we may
1091 \ write our ChangeCipherSpec. We must switch immediately after
1092 \ triggering the flush.
1093 20 wait-rectype-out
1094 1 write8
1095 flush-record
1096 dup 0 switch-encryption
1097 22 wait-rectype-out
1098 write-Finished
1099 flush-record ;
1100
1101 \ Read and parse a list of supported signature algorithms (with hash
1102 \ functions). The resulting bit field is returned.
1103 : read-list-sign-algos ( lim -- lim value )
1104 0 { hashes }
1105 read16 open-elt
1106 begin dup while
1107 read8 { hash } read8 { sign }
1108
1109 \ If hash is 0x08 then this is a "new algorithm" identifier,
1110 \ and we set the corresponding bit if it is in the 0..15
1111 \ range. Otherwise, we keep the value only if the signature
1112 \ is either 1 (RSA) or 3 (ECDSA), and the hash is one of the
1113 \ SHA-* functions (2 to 6). Note that we reject MD5.
1114 hash 8 = if
1115 sign 15 <= if
1116 1 sign 16 + << hashes or >hashes
1117 then
1118 else
1119 hash 2 >= hash 6 <= and
1120 sign 1 = sign 3 = or
1121 and if
1122 hashes 1 sign 1- 2 << hash + << or >hashes
1123 then
1124 then
1125 repeat
1126 close-elt
1127 hashes ;
1128
1129 \ =======================================================================
1130
1131 \ Compute total chain length. This includes the individual certificate
1132 \ headers, but not the total chain header. This also sets the cert_cur,
1133 \ cert_len and chain_len context fields.
1134 cc: total-chain-length ( -- len ) {
1135 size_t u;
1136 uint32_t total;
1137
1138 total = 0;
1139 for (u = 0; u < ENG->chain_len; u ++) {
1140 total += 3 + (uint32_t)ENG->chain[u].data_len;
1141 }
1142 T0_PUSH(total);
1143 }
1144
1145 \ Get length for current certificate in the chain; if the chain end was
1146 \ reached, then this returns -1.
1147 cc: begin-cert ( -- len ) {
1148 if (ENG->chain_len == 0) {
1149 T0_PUSHi(-1);
1150 } else {
1151 ENG->cert_cur = ENG->chain->data;
1152 ENG->cert_len = ENG->chain->data_len;
1153 ENG->chain ++;
1154 ENG->chain_len --;
1155 T0_PUSH(ENG->cert_len);
1156 }
1157 }
1158
1159 \ Copy a chunk of certificate data into the pad. Returned value is the
1160 \ chunk length, or 0 if the certificate end is reached.
1161 cc: copy-cert-chunk ( -- len ) {
1162 size_t clen;
1163
1164 clen = ENG->cert_len;
1165 if (clen > sizeof ENG->pad) {
1166 clen = sizeof ENG->pad;
1167 }
1168 memcpy(ENG->pad, ENG->cert_cur, clen);
1169 ENG->cert_cur += clen;
1170 ENG->cert_len -= clen;
1171 T0_PUSH(clen);
1172 }
1173
1174 \ Write a Certificate message. Total chain length (excluding the 3-byte
1175 \ header) is returned; it is 0 if the chain is empty.
1176 : write-Certificate ( -- total_chain_len )
1177 11 write8
1178 total-chain-length dup
1179 dup 3 + write24 write24
1180 begin
1181 begin-cert
1182 dup 0< if drop ret then write24
1183 begin copy-cert-chunk dup while
1184 addr-pad swap write-blob
1185 repeat
1186 drop
1187 again ;
1188
1189 cc: x509-start-chain ( by_client -- ) {
1190 const br_x509_class *xc;
1191 uint32_t bc;
1192
1193 bc = T0_POP();
1194 xc = *(ENG->x509ctx);
1195 xc->start_chain(ENG->x509ctx, bc ? ENG->server_name : NULL);
1196 }
1197
1198 cc: x509-start-cert ( length -- ) {
1199 const br_x509_class *xc;
1200
1201 xc = *(ENG->x509ctx);
1202 xc->start_cert(ENG->x509ctx, T0_POP());
1203 }
1204
1205 cc: x509-append ( length -- ) {
1206 const br_x509_class *xc;
1207 size_t len;
1208
1209 xc = *(ENG->x509ctx);
1210 len = T0_POP();
1211 xc->append(ENG->x509ctx, ENG->pad, len);
1212 }
1213
1214 cc: x509-end-cert ( -- ) {
1215 const br_x509_class *xc;
1216
1217 xc = *(ENG->x509ctx);
1218 xc->end_cert(ENG->x509ctx);
1219 }
1220
1221 cc: x509-end-chain ( -- err ) {
1222 const br_x509_class *xc;
1223
1224 xc = *(ENG->x509ctx);
1225 T0_PUSH(xc->end_chain(ENG->x509ctx));
1226 }
1227
1228 cc: get-key-type-usages ( -- key-type-usages ) {
1229 const br_x509_class *xc;
1230 const br_x509_pkey *pk;
1231 unsigned usages;
1232
1233 xc = *(ENG->x509ctx);
1234 pk = xc->get_pkey(ENG->x509ctx, &usages);
1235 if (pk == NULL) {
1236 T0_PUSH(0);
1237 } else {
1238 T0_PUSH(pk->key_type | usages);
1239 }
1240 }
1241
1242 \ Read a Certificate message.
1243 \ Parameter: non-zero if this is a read by the client of a certificate
1244 \ sent by the server; zero otherwise.
1245 \ Returned value:
1246 \ - Empty: 0
1247 \ - Valid: combination of key type and allowed key usages.
1248 \ - Invalid: negative (-x for error code x)
1249 : read-Certificate ( by_client -- key-type-usages )
1250 \ Get header, and check message type.
1251 read-handshake-header 11 = ifnot ERR_UNEXPECTED fail then
1252
1253 \ If the chain is empty, do some special processing.
1254 dup 3 = if
1255 read24 if ERR_BAD_PARAM fail then
1256 swap drop ret
1257 then
1258
1259 \ Start processing the chain through the X.509 engine.
1260 swap x509-start-chain
1261
1262 \ Total chain length is a 24-bit integer.
1263 read24 open-elt
1264 begin
1265 dup while
1266 read24 open-elt
1267 dup x509-start-cert
1268
1269 \ We read the certificate by chunks through the pad, so
1270 \ as to use the existing reading function (read-blob)
1271 \ that also ensures proper hashing.
1272 begin
1273 dup while
1274 dup 256 > if 256 else dup then { len }
1275 addr-pad len read-blob
1276 len x509-append
1277 repeat
1278 close-elt
1279 x509-end-cert
1280 repeat
1281
1282 \ We must close the chain AND the handshake message.
1283 close-elt
1284 close-elt
1285
1286 \ Chain processing is finished; get the error code.
1287 x509-end-chain
1288 dup if neg ret then drop
1289
1290 \ Return key type and usages.
1291 get-key-type-usages ;
1292
1293 \ =======================================================================
1294
1295 \ Copy a specific protocol name from the list to the pad. The byte
1296 \ length is returned.
1297 cc: copy-protocol-name ( idx -- len ) {
1298 size_t idx = T0_POP();
1299 size_t len = strlen(ENG->protocol_names[idx]);
1300 memcpy(ENG->pad, ENG->protocol_names[idx], len);
1301 T0_PUSH(len);
1302 }
1303
1304 \ Compare name in pad with the configured list of protocol names.
1305 \ If a match is found, then the index is returned; otherwise, -1
1306 \ is returned.
1307 cc: test-protocol-name ( len -- n ) {
1308 size_t len = T0_POP();
1309 size_t u;
1310
1311 for (u = 0; u < ENG->protocol_names_num; u ++) {
1312 const char *name;
1313
1314 name = ENG->protocol_names[u];
1315 if (len == strlen(name) && memcmp(ENG->pad, name, len) == 0) {
1316 T0_PUSH(u);
1317 T0_RET();
1318 }
1319 }
1320 T0_PUSHi(-1);
1321 }