projects / BearSSL / blob
? search:


a31ab6aaeba94934dfa525ec48aac7441b5729ca
[BearSSL] / src / ssl / ssl_hs_server.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 \ Handshake processing code, for the server.
25 \ The common T0 code (ssl_hs_common.t0) shall be read first.
26
27 preamble {
28
29 /*
30 * This macro evaluates to a pointer to the server context, under that
31 * specific name. It must be noted that since the engine context is the
32 * first field of the br_ssl_server_context structure ('eng'), then
33 * pointers values of both types are interchangeable, modulo an
34 * appropriate cast. This also means that "adresses" computed as offsets
35 * within the structure work for both kinds of context.
36 */
37 #define CTX ((br_ssl_server_context *)ENG)
38
39 /*
40 * Decrypt the pre-master secret (RSA key exchange).
41 */
42 static void
43 do_rsa_decrypt(br_ssl_server_context *ctx, int prf_id,
44 unsigned char *epms, size_t len)
45 {
46 uint32_t x;
47 unsigned char rpms[48];
48
49 /*
50 * Decrypt the PMS.
51 */
52 x = (*ctx->policy_vtable)->do_keyx(ctx->policy_vtable, epms, len);
53
54 /*
55 * Set the first two bytes to the maximum supported client
56 * protocol version. These bytes are used for version rollback
57 * detection; forceing the two bytes will make the master secret
58 * wrong if the bytes are not correct. This process is
59 * recommended by RFC 5246 (section 7.4.7.1).
60 */
61 br_enc16be(epms, ctx->client_max_version);
62
63 /*
64 * Make a random PMS and copy it above the decrypted value if the
65 * decryption failed. Note that we use a constant-time conditional
66 * copy.
67 */
68 br_hmac_drbg_generate(&ctx->eng.rng, rpms, sizeof rpms);
69 br_ccopy(x ^ 1, epms, rpms, sizeof rpms);
70
71 /*
72 * Compute master secret.
73 */
74 br_ssl_engine_compute_master(&ctx->eng, prf_id, epms, 48);
75
76 /*
77 * Clear the pre-master secret from RAM: it is normally a buffer
78 * in the context, hence potentially long-lived.
79 */
80 memset(epms, 0, len);
81 }
82
83 /*
84 * Common part for ECDH and ECDHE.
85 */
86 static void
87 ecdh_common(br_ssl_server_context *ctx, int prf_id,
88 unsigned char *cpoint, size_t cpoint_len, uint32_t ctl)
89 {
90 unsigned char rpms[80];
91 size_t pms_len;
92
93 /*
94 * The point length is supposed to be 1+2*Xlen, where Xlen is
95 * the length (in bytes) of the X coordinate, i.e. the pre-master
96 * secret. If the provided point is too large, then it is
97 * obviously incorrect (i.e. everybody can see that it is
98 * incorrect), so leaking that fact is not a problem.
99 */
100 pms_len = cpoint_len >> 1;
101 if (pms_len > sizeof rpms) {
102 pms_len = sizeof rpms;
103 ctl = 0;
104 }
105
106 /*
107 * Make a random PMS and copy it above the decrypted value if the
108 * decryption failed. Note that we use a constant-time conditional
109 * copy.
110 */
111 br_hmac_drbg_generate(&ctx->eng.rng, rpms, pms_len);
112 br_ccopy(ctl ^ 1, cpoint + 1, rpms, pms_len);
113
114 /*
115 * Compute master secret.
116 */
117 br_ssl_engine_compute_master(&ctx->eng, prf_id, cpoint + 1, pms_len);
118
119 /*
120 * Clear the pre-master secret from RAM: it is normally a buffer
121 * in the context, hence potentially long-lived.
122 */
123 memset(cpoint, 0, cpoint_len);
124 }
125
126 /*
127 * Do the ECDH key exchange (not ECDHE).
128 */
129 static void
130 do_ecdh(br_ssl_server_context *ctx, int prf_id,
131 unsigned char *cpoint, size_t cpoint_len)
132 {
133 uint32_t x;
134
135 /*
136 * Finalise the key exchange.
137 */
138 x = (*ctx->policy_vtable)->do_keyx(ctx->policy_vtable,
139 cpoint, cpoint_len);
140 ecdh_common(ctx, prf_id, cpoint, cpoint_len, x);
141 }
142
143 /*
144 * Do the full static ECDH key exchange. When this function is called,
145 * it has already been verified that the cipher suite uses ECDH (not ECDHE),
146 * and the client's public key (from its certificate) has type EC and is
147 * apt for key exchange.
148 */
149 static void
150 do_static_ecdh(br_ssl_server_context *ctx, int prf_id)
151 {
152 unsigned char cpoint[133];
153 size_t cpoint_len;
154 const br_x509_class **xc;
155 const br_x509_pkey *pk;
156
157 xc = ctx->eng.x509ctx;
158 pk = (*xc)->get_pkey(xc, NULL);
159 cpoint_len = pk->key.ec.qlen;
160 if (cpoint_len > sizeof cpoint) {
161 /*
162 * If the point is larger than our buffer then we need to
163 * restrict it. Length 2 is not a valid point length, so
164 * the ECDH will fail.
165 */
166 cpoint_len = 2;
167 }
168 memcpy(cpoint, pk->key.ec.q, cpoint_len);
169 do_ecdh(ctx, prf_id, cpoint, cpoint_len);
170 }
171
172 /*
173 * Do the ECDHE key exchange (part 1: generation of transient key, and
174 * computing of the point to send to the client). Returned value is the
175 * signature length (in bytes), or -x on error (with x being an error
176 * code). The encoded point is written in the ecdhe_point[] context buffer
177 * (length in ecdhe_point_len).
178 */
179 static int
180 do_ecdhe_part1(br_ssl_server_context *ctx, int curve)
181 {
182 int hash;
183 unsigned mask;
184 const unsigned char *order;
185 size_t olen, glen;
186 br_multihash_context mhc;
187 unsigned char head[4];
188 size_t hv_len, sig_len;
189
190 if (!((ctx->eng.iec->supported_curves >> curve) & 1)) {
191 return -BR_ERR_INVALID_ALGORITHM;
192 }
193 ctx->eng.ecdhe_curve = curve;
194
195 /*
196 * Generate our private key. We need a non-zero random value
197 * which is lower than the curve order, in a "large enough"
198 * range. We force the top bit to 0 and bottom bit to 1, which
199 * does the trick. Note that contrary to what happens in ECDSA,
200 * this is not a problem if we do not cover the full range of
201 * possible values.
202 */
203 order = ctx->eng.iec->order(curve, &olen);
204 mask = 0xFF;
205 while (mask >= order[0]) {
206 mask >>= 1;
207 }
208 br_hmac_drbg_generate(&ctx->eng.rng, ctx->ecdhe_key, olen);
209 ctx->ecdhe_key[0] &= mask;
210 ctx->ecdhe_key[olen - 1] |= 0x01;
211 ctx->ecdhe_key_len = olen;
212
213 /*
214 * Compute our ECDH point.
215 */
216 #if 0
217 /* obsolete */
218 generator = ctx->eng.iec->generator(curve, &glen);
219 memcpy(ctx->eng.ecdhe_point, generator, glen);
220 ctx->eng.ecdhe_point_len = glen;
221 if (!ctx->eng.iec->mul(ctx->eng.ecdhe_point, glen,
222 ctx->ecdhe_key, olen, curve))
223 {
224 return -BR_ERR_INVALID_ALGORITHM;
225 }
226 #endif
227 glen = ctx->eng.iec->mulgen(ctx->eng.ecdhe_point,
228 ctx->ecdhe_key, olen, curve);
229 ctx->eng.ecdhe_point_len = glen;
230
231 /*
232 * Compute the signature.
233 */
234 br_multihash_zero(&mhc);
235 br_multihash_copyimpl(&mhc, &ctx->eng.mhash);
236 br_multihash_init(&mhc);
237 br_multihash_update(&mhc,
238 ctx->eng.client_random, sizeof ctx->eng.client_random);
239 br_multihash_update(&mhc,
240 ctx->eng.server_random, sizeof ctx->eng.server_random);
241 head[0] = 3;
242 head[1] = 0;
243 head[2] = curve;
244 head[3] = ctx->eng.ecdhe_point_len;
245 br_multihash_update(&mhc, head, sizeof head);
246 br_multihash_update(&mhc,
247 ctx->eng.ecdhe_point, ctx->eng.ecdhe_point_len);
248 hash = ctx->sign_hash_id;
249 if (hash) {
250 hv_len = br_multihash_out(&mhc, hash, ctx->eng.pad);
251 if (hv_len == 0) {
252 return -BR_ERR_INVALID_ALGORITHM;
253 }
254 } else {
255 if (!br_multihash_out(&mhc, br_md5_ID, ctx->eng.pad)
256 || !br_multihash_out(&mhc,
257 br_sha1_ID, ctx->eng.pad + 16))
258 {
259 return -BR_ERR_INVALID_ALGORITHM;
260 }
261 hv_len = 36;
262 }
263 sig_len = (*ctx->policy_vtable)->do_sign(ctx->policy_vtable,
264 hash, hv_len, ctx->eng.pad, sizeof ctx->eng.pad);
265 return sig_len ? (int)sig_len : -BR_ERR_INVALID_ALGORITHM;
266 }
267
268 /*
269 * Do the ECDHE key exchange (part 2: computation of the shared secret
270 * from the point sent by the client).
271 */
272 static void
273 do_ecdhe_part2(br_ssl_server_context *ctx, int prf_id,
274 unsigned char *cpoint, size_t cpoint_len)
275 {
276 int curve;
277 uint32_t x;
278
279 curve = ctx->eng.ecdhe_curve;
280
281 /*
282 * Finalise the key exchange.
283 */
284 x = ctx->eng.iec->mul(cpoint, cpoint_len,
285 ctx->ecdhe_key, ctx->ecdhe_key_len, curve);
286 ecdh_common(ctx, prf_id, cpoint, cpoint_len, x);
287
288 /*
289 * Clear the ECDHE private key. Forward Secrecy is achieved insofar
290 * as that key does not get stolen, so we'd better destroy it
291 * as soon as it ceases to be useful.
292 */
293 memset(ctx->ecdhe_key, 0, ctx->ecdhe_key_len);
294 }
295
296 /*
297 * Offset for hash value within the pad (when obtaining all hash values,
298 * in preparation for verification of the CertificateVerify message).
299 * Order is MD5, SHA-1, SHA-224, SHA-256, SHA-384, SHA-512; last value
300 * is used to get the total length.
301 */
302 static const unsigned char HASH_PAD_OFF[] = { 0, 16, 36, 64, 96, 144, 208 };
303
304 /*
305 * OID for hash functions in RSA signatures.
306 */
307 static const unsigned char HASH_OID_SHA1[] = {
308 0x05, 0x2B, 0x0E, 0x03, 0x02, 0x1A
309 };
310
311 static const unsigned char HASH_OID_SHA224[] = {
312 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x04
313 };
314
315 static const unsigned char HASH_OID_SHA256[] = {
316 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01
317 };
318
319 static const unsigned char HASH_OID_SHA384[] = {
320 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02
321 };
322
323 static const unsigned char HASH_OID_SHA512[] = {
324 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03
325 };
326
327 static const unsigned char *HASH_OID[] = {
328 HASH_OID_SHA1,
329 HASH_OID_SHA224,
330 HASH_OID_SHA256,
331 HASH_OID_SHA384,
332 HASH_OID_SHA512
333 };
334
335 /*
336 * Verify the signature in CertificateVerify. Returned value is 0 on
337 * success, or a non-zero error code. Lack of implementation of the
338 * designated signature algorithm is reported as a "bad signature"
339 * error (because it means that the peer did not honour our advertised
340 * set of supported signature algorithms).
341 */
342 static int
343 verify_CV_sig(br_ssl_server_context *ctx, size_t sig_len)
344 {
345 const br_x509_class **xc;
346 const br_x509_pkey *pk;
347 int id;
348
349 id = ctx->hash_CV_id;
350 xc = ctx->eng.x509ctx;
351 pk = (*xc)->get_pkey(xc, NULL);
352 if (pk->key_type == BR_KEYTYPE_RSA) {
353 unsigned char tmp[64];
354 const unsigned char *hash_oid;
355
356 if (id == 0) {
357 hash_oid = NULL;
358 } else {
359 hash_oid = HASH_OID[id - 2];
360 }
361 if (ctx->eng.irsavrfy == 0) {
362 return BR_ERR_BAD_SIGNATURE;
363 }
364 if (!ctx->eng.irsavrfy(ctx->eng.pad, sig_len,
365 hash_oid, ctx->hash_CV_len, &pk->key.rsa, tmp)
366 || memcmp(tmp, ctx->hash_CV, ctx->hash_CV_len) != 0)
367 {
368 return BR_ERR_BAD_SIGNATURE;
369 }
370 } else {
371 if (ctx->eng.iecdsa == 0) {
372 return BR_ERR_BAD_SIGNATURE;
373 }
374 if (!ctx->eng.iecdsa(ctx->eng.iec,
375 ctx->hash_CV, ctx->hash_CV_len,
376 &pk->key.ec, ctx->eng.pad, sig_len))
377 {
378 return BR_ERR_BAD_SIGNATURE;
379 }
380 }
381 return 0;
382 }
383
384 }
385
386 \ =======================================================================
387
388 : addr-ctx:
389 next-word { field }
390 "addr-" field + 0 1 define-word
391 0 8191 "offsetof(br_ssl_server_context, " field + ")" + make-CX
392 postpone literal postpone ; ;
393
394 addr-ctx: client_max_version
395 addr-ctx: client_suites
396 addr-ctx: client_suites_num
397 addr-ctx: hashes
398 addr-ctx: curves
399 addr-ctx: sign_hash_id
400
401 \ Get address and length of the client_suites[] buffer. Length is expressed
402 \ in bytes.
403 : addr-len-client_suites ( -- addr len )
404 addr-client_suites
405 CX 0 1023 { BR_MAX_CIPHER_SUITES * sizeof(br_suite_translated) } ;
406
407 \ Read the client SNI extension.
408 : read-client-sni ( lim -- lim )
409 \ Open extension value.
410 read16 open-elt
411
412 \ Open ServerNameList.
413 read16 open-elt
414
415 \ Find if there is a name of type 0 (host_name) with a length
416 \ that fits in our dedicated buffer.
417 begin dup while
418 read8 if
419 read-ignore-16
420 else
421 read16
422 dup 255 <= if
423 dup addr-server_name + 0 swap set8
424 addr-server_name swap read-blob
425 else
426 skip-blob
427 then
428 then
429 repeat
430
431 \ Close ServerNameList.
432 close-elt
433
434 \ Close extension value.
435 close-elt ;
436
437 \ Set the new maximum fragment length. BEWARE: this shall be called only
438 \ after reading the ClientHello and before writing the ServerHello.
439 cc: set-max-frag-len ( len -- ) {
440 size_t max_frag_len = T0_POP();
441
442 br_ssl_engine_new_max_frag_len(ENG, max_frag_len);
443
444 /*
445 * We must adjust our own output limit. Since we call this only
446 * after receiving a ClientHello and before beginning to send
447 * the ServerHello, the next output record should be empty at
448 * that point, so we can use max_frag_len as a limit.
449 */
450 if (ENG->hlen_out > max_frag_len) {
451 ENG->hlen_out = max_frag_len;
452 }
453 }
454
455 \ Read the client Max Frag Length extension.
456 : read-client-frag ( lim -- lim )
457 \ Extension value must have length exactly 1 byte.
458 read16 1 <> if ERR_BAD_FRAGLEN fail then
459 read8
460
461 \ The byte value must be 1, 2, 3 or 4.
462 dup dup 0= swap 5 >= or if ERR_BAD_FRAGLEN fail then
463
464 \ If our own maximum fragment length is greater, then we reduce
465 \ our length.
466 8 + dup addr-log_max_frag_len get8 < if
467 dup 1 swap << set-max-frag-len
468 dup addr-log_max_frag_len set8
469 addr-peer_log_max_frag_len set8
470 else
471 drop
472 then ;
473
474 \ Read the Secure Renegotiation extension from the client.
475 : read-client-reneg ( lim -- lim )
476 \ Get value length.
477 read16
478
479 \ The "reneg" value is one of:
480 \ 0 on first handshake, client support is unknown
481 \ 1 client does not support secure renegotiation
482 \ 2 client supports secure renegotiation
483 addr-reneg get8 case
484 0 of
485 \ First handshake, value length shall be 1.
486 1 = ifnot ERR_BAD_SECRENEG fail then
487 read8 if ERR_BAD_SECRENEG fail then
488 2 addr-reneg set8
489 endof
490 2 of
491 \ Renegotiation, value shall consist of 13 bytes
492 \ (header + copy of the saved client "Finished").
493 13 = ifnot ERR_BAD_SECRENEG fail then
494 read8 12 = ifnot ERR_BAD_SECRENEG fail then
495 addr-pad 12 read-blob
496 addr-saved_finished addr-pad 12 memcmp ifnot
497 ERR_BAD_SECRENEG fail
498 then
499 endof
500
501 \ If "reneg" is 1 then the client is not supposed to support
502 \ the extension, and it sends it nonetheless, which means
503 \ foul play.
504 ERR_BAD_SECRENEG fail
505 endcase ;
506
507 \ Read the Signature Algorithms extension.
508 : read-signatures ( lim -- lim )
509 \ Open extension value.
510 read16 open-elt
511
512 read-list-sign-algos addr-hashes set16
513
514 \ Close extension value.
515 close-elt ;
516
517 \ Read the Supported Curves extension.
518 : read-supported-curves ( lim -- lim )
519 \ Open extension value.
520 read16 open-elt
521
522 \ Open list of curve identifiers.
523 read16 open-elt
524
525 \ Get all supported curves.
526 0 addr-curves set32
527 begin dup while
528 read16 dup 32 < if
529 1 swap << addr-curves get32 or addr-curves set32
530 else
531 drop
532 then
533 repeat
534 close-elt
535 close-elt ;
536
537 \ Read the ALPN extension from client.
538 : read-ALPN-from-client ( lim -- lim )
539 \ If we do not have configured names, then we just ignore the
540 \ extension.
541 addr-protocol_names_num get16 ifnot read-ignore-16 ret then
542
543 \ Open extension value.
544 read16 open-elt
545
546 \ Open list of protocol names.
547 read16 open-elt
548
549 \ Get all names and test for their support. We keep the one with
550 \ the lowest index (because we apply server's preferences, as
551 \ recommended by RFC 7301, section 3.2. We set the 'found' variable
552 \ to -2 and use an unsigned comparison, making -2 a huge value.
553 -2 { found }
554 begin dup while
555 read8 dup { len } addr-pad swap read-blob
556 len test-protocol-name dup found u< if
557 >found
558 else
559 drop
560 then
561 repeat
562
563 \ End of extension.
564 close-elt
565 close-elt
566
567 \ Write back found name index (or not). If no match was found,
568 \ then we write -1 (0xFFFF) in the index value, not 0, so that
569 \ the caller knows that we tried to match, and failed.
570 found 1+ addr-selected_protocol set16 ;
571
572 \ Call policy handler to get cipher suite, hash function identifier and
573 \ certificate chain. Returned value is 0 (false) on failure.
574 cc: call-policy-handler ( -- bool ) {
575 int x;
576 br_ssl_server_choices choices;
577
578 x = (*CTX->policy_vtable)->choose(
579 CTX->policy_vtable, CTX, &choices);
580 ENG->session.cipher_suite = choices.cipher_suite;
581 CTX->sign_hash_id = choices.hash_id;
582 ENG->chain = choices.chain;
583 ENG->chain_len = choices.chain_len;
584 T0_PUSHi(-(x != 0));
585 }
586
587 \ Check for a remembered session.
588 cc: check-resume ( -- bool ) {
589 if (ENG->session.session_id_len == 32
590 && CTX->cache_vtable != NULL && (*CTX->cache_vtable)->load(
591 CTX->cache_vtable, CTX, &ENG->session))
592 {
593 T0_PUSHi(-1);
594 } else {
595 T0_PUSH(0);
596 }
597 }
598
599 \ Save the current session.
600 cc: save-session ( -- ) {
601 if (CTX->cache_vtable != NULL) {
602 (*CTX->cache_vtable)->save(
603 CTX->cache_vtable, CTX, &ENG->session);
604 }
605 }
606
607 \ Read ClientHello. If the session is resumed, then -1 is returned.
608 : read-ClientHello ( -- resume )
609 \ Get header, and check message type.
610 read-handshake-header 1 = ifnot ERR_UNEXPECTED fail then
611
612 \ Get maximum protocol version from client.
613 read16 dup { client-version-max } addr-client_max_version set16
614
615 \ Client random.
616 addr-client_random 32 read-blob
617
618 \ Client session ID.
619 read8 dup 32 > if ERR_OVERSIZED_ID fail then
620 dup addr-session_id_len set8
621 addr-session_id swap read-blob
622
623 \ Lookup session for resumption. We should do that here because
624 \ we need to verify that the remembered cipher suite is still
625 \ matched by this ClientHello.
626 check-resume { resume }
627
628 \ Cipher suites. We read all cipher suites from client, each time
629 \ matching against our own list. We accumulate suites in the
630 \ client_suites[] context buffer: we keep suites that are
631 \ supported by both the client and the server (so the list size
632 \ cannot exceed that of the server list), and we keep them in
633 \ either client or server preference order (depending on the
634 \ relevant flag).
635 \
636 \ We also need to identify the pseudo cipher suite for secure
637 \ renegotiation here.
638 read16 open-elt
639 0 { reneg-scsv }
640 0 { resume-suite }
641 addr-len-client_suites dup2 bzero
642 over + { css-off css-max }
643 begin
644 dup while
645 read16 dup { suite }
646
647 \ Check that when resuming a session, the requested
648 \ suite is still valid.
649 resume if
650 dup addr-cipher_suite get16 = if
651 -1 >resume-suite
652 then
653 then
654
655 \ Special handling for TLS_EMPTY_RENEGOTIATION_INFO_SCSV.
656 \ This fake cipher suite may occur only in the first
657 \ handshake.
658 dup 0x00FF = if
659 addr-reneg get8 if ERR_BAD_SECRENEG fail then
660 -1 >reneg-scsv
661 then
662
663 \ Special handling for TLS_FALLBACK_SCSV. If the client
664 \ maximum version is less than our own maximum version,
665 \ then this is an undue downgrade. We mark it by setting
666 \ the client max version to 0x10000.
667 dup 0x5600 = if
668 client-version-max addr-version_min get16 >=
669 client-version-max addr-version_max get16 < and if
670 -1 >client-version-max
671 then
672 then
673
674 \ Test whether the suite is supported by the server.
675 scan-suite dup 0< if
676 \ We do not support this cipher suite. Note
677 \ that this also covers the case of pseudo
678 \ cipher suites.
679 drop
680 else
681 \ If we use server order, then we place the
682 \ suite at the computed offset; otherwise, we
683 \ append it to the list at the current place.
684 0 flag? if
685 2 << addr-client_suites + suite swap set16
686 else
687 drop
688 \ We need to test for list length because
689 \ the client list may have duplicates,
690 \ that we do not filter. Duplicates are
691 \ invalid so this is not a problem if we
692 \ reject such clients.
693 css-off css-max >= if
694 ERR_BAD_HANDSHAKE fail
695 then
696 suite css-off set16
697 css-off 4 + >css-off
698 then
699 then
700 repeat
701 drop
702
703 \ Compression methods. We need method 0 (no compression).
704 0 { ok-compression }
705 read8 open-elt
706 begin dup while
707 read8 ifnot -1 >ok-compression then
708 repeat
709 close-elt
710
711 \ Set default values for parameters that may be affected by
712 \ extensions:
713 \ -- server name is empty
714 \ -- client is reputed to know RSA and ECDSA, both with SHA-1
715 \ -- the default elliptic curve is P-256 (secp256r1, id = 23)
716 0 addr-server_name set8
717 0x404 addr-hashes set16
718 0x800000 addr-curves set32
719
720 \ Process extensions, if any.
721 dup if
722 read16 open-elt
723 begin dup while
724 read16 case
725 \ Server Name Indication.
726 0x0000 of
727 read-client-sni
728 endof
729 \ Max Frag Length.
730 0x0001 of
731 read-client-frag
732 endof
733 \ Secure Renegotiation.
734 0xFF01 of
735 read-client-reneg
736 endof
737 \ Signature Algorithms.
738 0x000D of
739 read-signatures
740 endof
741 \ Supported Curves.
742 0x000A of
743 read-supported-curves
744 endof
745 \ Supported Point Formats.
746 \ We only support "uncompressed", that all
747 \ implementations are supposed to support,
748 \ so we can simply ignore that extension.
749 \ 0x000B of
750 \ read-ignore-16
751 \ endof
752
753 \ ALPN
754 0x0010 of
755 read-ALPN-from-client
756 endof
757
758 \ Other extensions are ignored.
759 drop read-ignore-16 0
760 endcase
761 repeat
762 close-elt
763 then
764
765 \ Close message.
766 close-elt
767
768 \ Cancel session resumption if the cipher suite was not found.
769 resume resume-suite and >resume
770
771 \ Now check the received data. Since the client is expecting an
772 \ answer, we can send an appropriate fatal alert on any error.
773
774 \ Compute protocol version as the minimum of our maximum version,
775 \ and the maximum version sent by the client. If that is less than
776 \ 0x0300 (SSL-3.0), then fail. Otherwise, we may at least send an
777 \ alert with that version. We still reject versions lower than our
778 \ configured minimum.
779 \ As a special case, in case of undue downgrade, we send a specific
780 \ alert (see RFC 7507). Note that this case may happen only if
781 \ we would otherwise accept the client's version.
782 client-version-max 0< if
783 addr-client_max_version get16 addr-version_out set16
784 86 fail-alert
785 then
786 addr-version_max get16
787 dup client-version-max > if drop client-version-max then
788 dup 0x0300 < if ERR_BAD_VERSION fail then
789 client-version-max addr-version_min get16 < if
790 70 fail-alert
791 then
792 \ If resuming the session, then enforce the previously negotiated
793 \ version (if still possible).
794 resume if
795 addr-version get16 client-version-max <= if
796 drop addr-version get16
797 else
798 0 >resume
799 then
800 then
801 dup addr-version set16
802 dup addr-version_in set16
803 dup addr-version_out set16
804 0x0303 >= { can-tls12 }
805
806 \ If the client sent TLS_EMPTY_RENEGOTIATION_INFO_SCSV, then
807 \ we should mark the client as "supporting secure renegotiation".
808 reneg-scsv if 2 addr-reneg set8 then
809
810 \ Check compression.
811 ok-compression ifnot 40 fail-alert then
812
813 \ Filter hash function support by what the server also supports.
814 \ If no common hash function remains with RSA and/or ECDSA, then
815 \ the corresponding ECDHE suites are not possible.
816 supported-hash-functions drop 257 *
817 addr-hashes get16 and dup addr-hashes set16
818 \ In 'can-ecdhe', bit 12 is set if ECDHE_RSA is possible, bit 13 is
819 \ set if ECDHE_ECDSA is possible.
820 dup 0xFF and 0<> neg
821 swap 8 >> 0<> 2 and or 12 << { can-ecdhe }
822
823 \ Filter supported curves. If there is no common curve between
824 \ client and us, then ECDHE suites cannot be used. Note that we
825 \ may still allow ECDH, depending on the EC key handler.
826 addr-curves get32 supported-curves and dup addr-curves set32
827 ifnot 0 >can-ecdhe then
828
829 \ If resuming a session, then the next steps are not necessary;
830 \ we won't invoke the policy handler.
831 resume if -1 ret then
832
833 \ We are not resuming, so a new session ID should be generated.
834 \ We don't check that the new ID is distinct from the one sent
835 \ by the client because probability of such an event is 2^(-256),
836 \ i.e. much (much) lower than that of an undetected transmission
837 \ error or hardware miscomputation, and with similar consequences
838 \ (handshake simply fails).
839 addr-session_id 32 mkrand
840 32 addr-session_id_len set8
841
842 \ Translate common cipher suites, then squeeze out holes: there
843 \ may be holes because of the way we fill the list when the
844 \ server preference order is enforced, and also in case some
845 \ suites are filtered out. In particular:
846 \ -- ECDHE suites are removed if there is no common hash function
847 \ (for the relevant signature algorithm) or no common curve.
848 \ -- TLS-1.2-only suites are removed if the negociated version is
849 \ TLS-1.1 or lower.
850 addr-client_suites dup >css-off
851 begin dup css-max < while
852 dup get16 dup cipher-suite-to-elements
853 dup 12 >> dup 1 = swap 2 = or if
854 dup can-ecdhe and ifnot
855 2drop 0 dup
856 then
857 then
858 can-tls12 ifnot
859 \ Suites compatible with TLS-1.0 and TLS-1.1 are
860 \ exactly the ones that use HMAC/SHA-1.
861 dup 0xF0 and 0x20 <> if
862 2drop 0 dup
863 then
864 then
865 dup if
866 css-off 2+ set16 css-off set16
867 css-off 4 + >css-off
868 else
869 2drop
870 then
871 4 +
872 repeat
873 drop
874 css-off addr-client_suites - 2 >>
875 dup ifnot
876 \ No common cipher suite: handshake failure.
877 40 fail-alert
878 then
879 addr-client_suites_num set8
880
881 \ Check ALPN.
882 addr-selected_protocol get16 0xFFFF = if
883 3 flag? if 120 fail-alert then
884 0 addr-selected_protocol set16
885 then
886
887 \ Call policy handler to obtain the cipher suite and other
888 \ parameters.
889 call-policy-handler ifnot 40 fail-alert then
890
891 \ We are not resuming a session.
892 0 ;
893
894 \ Write ServerHello.
895 : write-ServerHello ( initial -- )
896 { initial }
897 \ Compute ServerHello length.
898 2 write8 70
899
900 \ Compute length of Secure Renegotiation extension.
901 addr-reneg get8 2 = if
902 initial if 5 else 29 then
903 else
904 0
905 then
906 { ext-reneg-len }
907
908 \ Compute length of Max Fragment Length extension.
909 addr-peer_log_max_frag_len get8 if 5 else 0 then
910 { ext-max-frag-len }
911
912 \ Compute length of ALPN extension. This also copy the
913 \ selected protocol name into the pad.
914 addr-selected_protocol get16 dup if 1- copy-protocol-name 7 + then
915 { ext-ALPN-len }
916
917 \ Adjust ServerHello length to account for the extensions.
918 ext-reneg-len ext-max-frag-len + ext-ALPN-len + dup if 2 + then +
919 write24
920
921 \ Protocol version
922 addr-version get16 write16
923
924 \ Server random
925 addr-server_random 4 bzero
926 addr-server_random 4 + 28 mkrand
927 addr-server_random 32 write-blob
928
929 \ Session ID
930 \ TODO: if we have no session cache at all, we might send here
931 \ an empty session ID. This would save a bit of network
932 \ bandwidth.
933 32 write8
934 addr-session_id 32 write-blob
935
936 \ Cipher suite
937 addr-cipher_suite get16 write16
938
939 \ Compression method
940 0 write8
941
942 \ Extensions
943 ext-reneg-len ext-max-frag-len + ext-ALPN-len + dup if
944 write16
945 ext-reneg-len dup if
946 0xFF01 write16
947 4 - dup write16
948 1- addr-saved_finished swap write-blob-head8
949 else
950 drop
951 then
952 ext-max-frag-len if
953 0x0001 write16
954 1 write16 addr-peer_log_max_frag_len get8 8 - write8
955 then
956 ext-ALPN-len dup if
957 \ Note: the selected protocol name was previously
958 \ copied into the pad.
959 0x0010 write16
960 4 - dup write16
961 2- dup write16
962 1- addr-pad swap write-blob-head8
963 else
964 drop
965 then
966 else
967 drop
968 then ;
969
970 \ Do the first part of ECDHE. Returned value is the computed signature
971 \ length, or a negative error code on error.
972 cc: do-ecdhe-part1 ( curve -- len ) {
973 int curve = T0_POPi();
974 T0_PUSHi(do_ecdhe_part1(CTX, curve));
975 }
976
977 \ Write the Server Key Exchange message (if applicable).
978 : write-ServerKeyExchange ( -- )
979 addr-cipher_suite get16 use-ecdhe? ifnot ret then
980
981 \ We must select an appropriate curve among the curves that
982 \ are supported both by us and the peer. Right now we use
983 \ the one with the smallest ID, which in practice means P-256.
984 \ (TODO: add some option to make that behaviour configurable.)
985 \
986 \ This loop always terminates because previous processing made
987 \ sure that ECDHE suites are not selectable if there is no common
988 \ curve.
989 addr-curves get32 0
990 begin dup2 >> 1 and 0= while 1+ repeat
991 { curve-id } drop
992
993 \ Compute the signed curve point to send.
994 curve-id do-ecdhe-part1 dup 0< if neg fail then { sig-len }
995
996 \ If using TLS-1.2+, then the hash function and signature
997 \ algorithm are explicitly encoded in the message.
998 addr-version get16 0x0303 >= { tls1.2+ }
999
1000 12 write8
1001 sig-len addr-ecdhe_point_len get8 + tls1.2+ 2 and + 6 + write24
1002
1003 \ Curve parameters: named curve with 16-bit ID.
1004 3 write8 curve-id write16
1005
1006 \ Public point.
1007 addr-ecdhe_point addr-ecdhe_point_len get8 write-blob-head8
1008
1009 \ If TLS-1.2+, write hash and signature identifiers.
1010 tls1.2+ if
1011 \ Hash identifier is in the sign_hash_id field.
1012 addr-sign_hash_id get8 write8
1013 \ 'use-rsa-ecdhe?' returns -1 for RSA, 0 for ECDSA.
1014 \ The byte on the wire shall be 1 for RSA, 3 for ECDSA.
1015 addr-cipher_suite get16 use-rsa-ecdhe? 1 << 3 + write8
1016 then
1017
1018 \ Signature.
1019 sig-len write16
1020 addr-pad sig-len write-blob ;
1021
1022 \ Get length of the list of anchor names to send to the client. The length
1023 \ includes the per-name 2-byte header, but _not_ the 2-byte header for
1024 \ the list itself. If no client certificate is requested, then this
1025 \ returns 0.
1026 cc: ta-names-total-length ( -- len ) {
1027 size_t u, len;
1028
1029 len = 0;
1030 if (CTX->ta_names != NULL) {
1031 for (u = 0; u < CTX->num_tas; u ++) {
1032 len += CTX->ta_names[u].len + 2;
1033 }
1034 } else if (CTX->tas != NULL) {
1035 for (u = 0; u < CTX->num_tas; u ++) {
1036 len += CTX->tas[u].dn.len + 2;
1037 }
1038 }
1039 T0_PUSH(len);
1040 }
1041
1042 \ Compute length and optionally write the contents of the list of
1043 \ supported client authentication methods.
1044 : write-list-auth ( do_write -- len )
1045 0
1046 addr-cipher_suite get16 use-ecdh? if
1047 2+ over if 65 write8 66 write8 then
1048 then
1049 supports-rsa-sign? if 1+ over if 1 write8 then then
1050 supports-ecdsa? if 1+ over if 64 write8 then then
1051 swap drop ;
1052
1053 : write-signhash-inner2 ( dow algo hashes len id -- dow algo hashes len )
1054 { id }
1055 over 1 id << and ifnot ret then
1056 2+
1057 3 pick if id write8 2 pick write8 then ;
1058
1059 : write-signhash-inner1 ( dow algo hashes -- dow len )
1060 0
1061 4 write-signhash-inner2
1062 5 write-signhash-inner2
1063 6 write-signhash-inner2
1064 3 write-signhash-inner2
1065 2 write-signhash-inner2
1066 -rot 2drop ;
1067
1068 \ Compute length and optionally write the contents of the list of
1069 \ supported sign+hash algorithms.
1070 : write-list-signhash ( do_write -- len )
1071 0 { len }
1072 \ If supporting neither RSA nor ECDSA in the engine, then we
1073 \ will do only static ECDH, and thus we claim support for
1074 \ everything (for the X.509 validator).
1075 supports-rsa-sign? supports-ecdsa? or ifnot
1076 1 0x7C write-signhash-inner1 >len
1077 3 0x7C write-signhash-inner1 len +
1078 swap drop ret
1079 then
1080 supports-rsa-sign? if
1081 1 supported-hash-functions drop
1082 write-signhash-inner1 >len
1083 then
1084 supports-ecdsa? if
1085 3 supported-hash-functions drop
1086 write-signhash-inner1 len + >len
1087 then
1088 drop len ;
1089
1090 \ Initialise index for sending the list of anchor DN.
1091 cc: begin-ta-name-list ( -- ) {
1092 CTX->cur_dn_index = 0;
1093 }
1094
1095 \ Switch to next DN in the list. Returned value is the DN length, or -1
1096 \ if the end of the list was reached.
1097 cc: begin-ta-name ( -- len ) {
1098 const br_x500_name *dn;
1099 if (CTX->cur_dn_index >= CTX->num_tas) {
1100 T0_PUSHi(-1);
1101 } else {
1102 if (CTX->ta_names == NULL) {
1103 dn = &CTX->tas[CTX->cur_dn_index].dn;
1104 } else {
1105 dn = &CTX->ta_names[CTX->cur_dn_index];
1106 }
1107 CTX->cur_dn_index ++;
1108 CTX->cur_dn = dn->data;
1109 CTX->cur_dn_len = dn->len;
1110 T0_PUSH(CTX->cur_dn_len);
1111 }
1112 }
1113
1114 \ Copy a chunk of the current DN into the pad. Returned value is the
1115 \ chunk length; this is 0 when the end of the current DN is reached.
1116 cc: copy-dn-chunk ( -- len ) {
1117 size_t clen;
1118
1119 clen = CTX->cur_dn_len;
1120 if (clen > sizeof ENG->pad) {
1121 clen = sizeof ENG->pad;
1122 }
1123 memcpy(ENG->pad, CTX->cur_dn, clen);
1124 CTX->cur_dn += clen;
1125 CTX->cur_dn_len -= clen;
1126 T0_PUSH(clen);
1127 }
1128
1129 \ Write a CertificateRequest message.
1130 : write-CertificateRequest ( -- )
1131 \ The list of client authentication types includes:
1132 \ rsa_sign (1)
1133 \ ecdsa_sign (64)
1134 \ rsa_fixed_ecdh (65)
1135 \ ecdsa_fixed_ecdh (66)
1136 \ rsa_sign and ecdsa_sign require, respectively, RSA and ECDSA
1137 \ support. Static ECDH requires that the cipher suite is ECDH.
1138 \ When we ask for static ECDH, we always send both rsa_fixed_ecdh
1139 \ and ecdsa_fixed_ecdh because what matters there is what the
1140 \ X.509 engine may support, and we do not control that.
1141 \
1142 \ With TLS 1.2, we must also send a list of supported signature
1143 \ and hash algorithms. That list is supposed to qualify both
1144 \ the engine itself, and the X.509 validator, which are separate
1145 \ in BearSSL. There again, we use the engine capabilities in that
1146 \ list, and resort to a generic all-support list if only
1147 \ static ECDH is accepted.
1148 \
1149 \ (In practice, client implementations tend to have at most one
1150 \ or two certificates, and send the chain regardless of what
1151 \ algorithms are used in it.)
1152
1153 0 write-list-auth
1154 addr-version get16 0x0303 >= if
1155 2+ 0 write-list-signhash +
1156 then
1157 ta-names-total-length + 3 +
1158
1159 \ Message header
1160 13 write8 write24
1161
1162 \ List of authentication methods
1163 0 write-list-auth write8 1 write-list-auth drop
1164
1165 \ For TLS 1.2+, list of sign+hash
1166 addr-version get16 0x0303 >= if
1167 0 write-list-signhash write16 1 write-list-signhash drop
1168 then
1169
1170 \ Trust anchor names
1171 ta-names-total-length write16
1172 begin-ta-name-list
1173 begin
1174 begin-ta-name
1175 dup 0< if drop ret then write16
1176 begin copy-dn-chunk dup while
1177 addr-pad swap write-blob
1178 repeat
1179 drop
1180 again ;
1181
1182 \ Write the Server Hello Done message.
1183 : write-ServerHelloDone ( -- )
1184 14 write8 0 write24 ;
1185
1186 \ Perform RSA decryption of the client-sent pre-master secret. The value
1187 \ is in the pad, and its length is provided as parameter.
1188 cc: do-rsa-decrypt ( len prf_id -- ) {
1189 int prf_id = T0_POPi();
1190 size_t len = T0_POP();
1191 do_rsa_decrypt(CTX, prf_id, ENG->pad, len);
1192 }
1193
1194 \ Perform ECDH (not ECDHE). The point from the client is in the pad, and
1195 \ its length is provided as parameter.
1196 cc: do-ecdh ( len prf_id -- ) {
1197 int prf_id = T0_POPi();
1198 size_t len = T0_POP();
1199 do_ecdh(CTX, prf_id, ENG->pad, len);
1200 }
1201
1202 \ Do the second part of ECDHE.
1203 cc: do-ecdhe-part2 ( len prf_id -- ) {
1204 int prf_id = T0_POPi();
1205 size_t len = T0_POP();
1206 do_ecdhe_part2(CTX, prf_id, ENG->pad, len);
1207 }
1208
1209 \ Perform static ECDH. The point from the client is the public key
1210 \ extracted from its certificate.
1211 cc: do-static-ecdh ( prf_id -- ) {
1212 do_static_ecdh(CTX, T0_POP());
1213 }
1214
1215 \ Read a ClientKeyExchange header.
1216 : read-ClientKeyExchange-header ( -- len )
1217 read-handshake-header 16 = ifnot ERR_UNEXPECTED fail then ;
1218
1219 \ Read the Client Key Exchange contents (non-empty case).
1220 : read-ClientKeyExchange-contents ( lim -- )
1221 \ What we should get depends on the cipher suite.
1222 addr-cipher_suite get16 use-rsa-keyx? if
1223 \ RSA key exchange: we expect a RSA-encrypted value.
1224 read16
1225 dup 512 > if ERR_LIMIT_EXCEEDED fail then
1226 dup { enc-rsa-len }
1227 addr-pad swap read-blob
1228 enc-rsa-len addr-cipher_suite get16 prf-id do-rsa-decrypt
1229 then
1230 addr-cipher_suite get16 dup use-ecdhe? swap use-ecdh? { ecdhe ecdh }
1231 ecdh ecdhe or if
1232 \ ECDH or ECDHE key exchange: we expect an EC point.
1233 read8 dup { ec-point-len }
1234 addr-pad swap read-blob
1235 ec-point-len addr-cipher_suite get16 prf-id
1236 ecdhe if do-ecdhe-part2 else do-ecdh then
1237 then
1238 close-elt ;
1239
1240 \ Read the Client Key Exchange (normal case).
1241 : read-ClientKeyExchange ( -- )
1242 read-ClientKeyExchange-header
1243 read-ClientKeyExchange-contents ;
1244
1245 \ Obtain all possible hash values for handshake messages so far. This
1246 \ is done because we need the hash value for the CertificateVerify
1247 \ _before_ knowing which hash function will actually be used, as this
1248 \ information is obtained from decoding the message header itself.
1249 \ All hash values are stored in the pad (208 bytes in total).
1250 cc: compute-hash-CV ( -- ) {
1251 int i;
1252
1253 for (i = 1; i <= 6; i ++) {
1254 br_multihash_out(&ENG->mhash, i,
1255 ENG->pad + HASH_PAD_OFF[i - 1]);
1256 }
1257 }
1258
1259 \ Copy the proper hash value from the pad into the dedicated buffer.
1260 \ Returned value is true (-1) on success, false (0) on error (error
1261 \ being an unimplemented hash function). The id has already been verified
1262 \ to be either 0 (for MD5+SHA-1) or one of the SHA-* functions.
1263 cc: copy-hash-CV ( hash_id -- bool ) {
1264 int id = T0_POP();
1265 size_t off, len;
1266
1267 if (id == 0) {
1268 off = 0;
1269 len = 36;
1270 } else {
1271 if (br_multihash_getimpl(&ENG->mhash, id) == 0) {
1272 T0_PUSH(0);
1273 T0_RET();
1274 }
1275 off = HASH_PAD_OFF[id - 1];
1276 len = HASH_PAD_OFF[id] - off;
1277 }
1278 memcpy(CTX->hash_CV, ENG->pad + off, len);
1279 CTX->hash_CV_len = len;
1280 CTX->hash_CV_id = id;
1281 T0_PUSHi(-1);
1282 }
1283
1284 \ Verify signature in CertificateVerify. Output is 0 on success, or a
1285 \ non-zero error code.
1286 cc: verify-CV-sig ( sig-len -- err ) {
1287 int err;
1288
1289 err = verify_CV_sig(CTX, T0_POP());
1290 T0_PUSHi(err);
1291 }
1292
1293 \ Process static ECDH.
1294 : process-static-ECDH ( ktu -- )
1295 \ Static ECDH is allowed only if the cipher suite uses ECDH, and
1296 \ the client's public key has type EC and allows key exchange.
1297 \ BR_KEYTYPE_KEYX is 0x10, and BR_KEYTYPE_EC is 2.
1298 0x1F and 0x12 = ifnot ERR_WRONG_KEY_USAGE fail then
1299 addr-cipher_suite get16
1300 dup use-ecdh? ifnot ERR_UNEXPECTED fail then
1301 prf-id
1302 do-static-ecdh ;
1303
1304 \ Read CertificateVerify header.
1305 : read-CertificateVerify-header ( -- lim )
1306 compute-hash-CV
1307 read-handshake-header 15 = ifnot ERR_UNEXPECTED fail then ;
1308
1309 \ Read CertificateVerify. The client key type + usage is expected on the
1310 \ stack.
1311 : read-CertificateVerify ( ktu -- )
1312 \ Check that the key allows for signatures.
1313 dup 0x20 and ifnot ERR_WRONG_KEY_USAGE fail then
1314 0x0F and { key-type }
1315
1316 \ Get header.
1317 read-CertificateVerify-header
1318
1319 \ With TLS 1.2+, there is an explicit hash + signature indication,
1320 \ which must be compatible with the key type.
1321 addr-version get16 0x0303 >= if
1322 \ Get hash function, then signature algorithm. The
1323 \ signature algorithm is 1 (RSA) or 3 (ECDSA) while our
1324 \ symbolic constants for key types are 1 (RSA) or 2 (EC).
1325 read16
1326 dup 0xFF and 1+ 1 >> key-type = ifnot
1327 ERR_BAD_SIGNATURE fail
1328 then
1329 8 >>
1330
1331 \ We support only SHA-1, SHA-224, SHA-256, SHA-384
1332 \ and SHA-512. We explicitly reject MD5.
1333 dup 2 < over 6 > or if ERR_INVALID_ALGORITHM fail then
1334 else
1335 \ With TLS 1.0 and 1.1, hash is MD5+SHA-1 (0) for RSA,
1336 \ SHA-1 (2) for ECDSA.
1337 key-type 0x01 = if 0 else 2 then
1338 then
1339 copy-hash-CV ifnot ERR_INVALID_ALGORITHM fail then
1340
1341 \ Read signature.
1342 read16 dup { sig-len }
1343 dup 512 > if ERR_LIMIT_EXCEEDED fail then
1344 addr-pad swap read-blob
1345 sig-len verify-CV-sig
1346 dup if fail then drop
1347
1348 close-elt ;
1349
1350 \ Send a HelloRequest.
1351 : send-HelloRequest ( -- )
1352 flush-record
1353 begin can-output? not while wait-co drop repeat
1354 22 addr-record_type_out set8
1355 0 write8 0 write24 flush-record
1356 23 addr-record_type_out set8 ;
1357
1358 \ Make a handshake.
1359 : do-handshake ( initial -- )
1360 0 addr-application_data set8
1361 22 addr-record_type_out set8
1362 0 addr-selected_protocol set16
1363 multihash-init
1364 read-ClientHello
1365 more-incoming-bytes? if ERR_UNEXPECTED fail then
1366 if
1367 \ Session resumption
1368 write-ServerHello
1369 0 write-CCS-Finished
1370 0 read-CCS-Finished
1371 else
1372 \ Not a session resumption
1373 write-ServerHello
1374 write-Certificate drop
1375 write-ServerKeyExchange
1376 ta-names-total-length if
1377 write-CertificateRequest
1378 then
1379 write-ServerHelloDone
1380 flush-record
1381
1382 \ If we sent a CertificateRequest then we expect a
1383 \ Certificate message.
1384 ta-names-total-length if
1385 \ Read client certificate.
1386 0 read-Certificate
1387
1388 choice
1389 dup 0< uf
1390 \ Client certificate validation failed.
1391 2 flag? ifnot neg fail then
1392 drop
1393 read-ClientKeyExchange
1394 read-CertificateVerify-header
1395 dup skip-blob drop
1396 enduf
1397 dup 0= uf
1398 \ Client sent no certificate at all.
1399 drop
1400 2 flag? ifnot
1401 ERR_NO_CLIENT_AUTH fail
1402 then
1403 read-ClientKeyExchange
1404 enduf
1405
1406 \ Client certificate was validated.
1407 read-ClientKeyExchange-header
1408 dup ifnot
1409 \ Empty ClientKeyExchange.
1410 drop
1411 process-static-ECDH
1412 else
1413 read-ClientKeyExchange-contents
1414 read-CertificateVerify
1415 then
1416 endchoice
1417 else
1418 \ No client certificate request, we just expect
1419 \ a non-empty ClientKeyExchange.
1420 read-ClientKeyExchange
1421 then
1422 0 read-CCS-Finished
1423 0 write-CCS-Finished
1424 save-session
1425 then
1426 1 addr-application_data set8
1427 23 addr-record_type_out set8 ;
1428
1429 \ Entry point.
1430 : main ( -- ! )
1431 \ Perform initial handshake.
1432 -1 do-handshake
1433
1434 begin
1435 \ Wait for further invocation. At that point, we should
1436 \ get either an explicit call for renegotiation, or
1437 \ an incoming ClientHello handshake message.
1438 wait-co
1439 dup 0x07 and case
1440 0x00 of
1441 0x10 and if
1442 \ The best we can do is ask for a
1443 \ renegotiation, then wait for it
1444 \ to happen.
1445 send-HelloRequest
1446 then
1447 endof
1448 0x01 of
1449 \ Reject renegotiations if the peer does not
1450 \ support secure renegotiation, or if the
1451 \ "no renegotiation" flag is set.
1452 drop
1453 addr-reneg get8 1 = 1 flag? or if
1454 flush-record
1455 begin can-output? not while
1456 wait-co drop
1457 repeat
1458 100 send-warning
1459 else
1460 0 do-handshake
1461 then
1462 endof
1463 ERR_UNEXPECTED fail
1464 endcase
1465 again
1466 ;
The BearSSL library and tools.