817642901a957ba335c1f9099ba33b092f33d016
[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 ECDHE key exchange (part 1: generation of transient key, and
145 * computing of the point to send to the client). Returned value is the
146 * signature length (in bytes), or -x on error (with x being an error
147 * code). The encoded point is written in the ecdhe_point[] context buffer
148 * (length in ecdhe_point_len).
149 */
150 static int
151 do_ecdhe_part1(br_ssl_server_context *ctx, int curve)
152 {
153 int hash;
154 unsigned mask;
155 const unsigned char *order, *generator;
156 size_t olen, glen;
157 br_multihash_context mhc;
158 unsigned char head[4];
159 size_t hv_len, sig_len;
160
161 if (!((ctx->eng.iec->supported_curves >> curve) & 1)) {
162 return -BR_ERR_INVALID_ALGORITHM;
163 }
164 ctx->eng.ecdhe_curve = curve;
165
166 /*
167 * Generate our private key. We need a non-zero random value
168 * which is lower than the curve order, in a "large enough"
169 * range. We force the top bit to 0 and bottom bit to 1, which
170 * does the trick. Note that contrary to what happens in ECDSA,
171 * this is not a problem if we do not cover the full range of
172 * possible values.
173 */
174 order = ctx->eng.iec->order(curve, &olen);
175 mask = 0xFF;
176 while (mask >= order[0]) {
177 mask >>= 1;
178 }
179 br_hmac_drbg_generate(&ctx->eng.rng, ctx->ecdhe_key, olen);
180 ctx->ecdhe_key[0] &= mask;
181 ctx->ecdhe_key[olen - 1] |= 0x01;
182 ctx->ecdhe_key_len = olen;
183
184 /*
185 * Compute our ECDH point.
186 */
187 generator = ctx->eng.iec->generator(curve, &glen);
188 memcpy(ctx->eng.ecdhe_point, generator, glen);
189 ctx->eng.ecdhe_point_len = glen;
190 if (!ctx->eng.iec->mul(ctx->eng.ecdhe_point, glen,
191 ctx->ecdhe_key, olen, curve))
192 {
193 return -BR_ERR_INVALID_ALGORITHM;
194 }
195
196 /*
197 * Compute the signature.
198 */
199 br_multihash_zero(&mhc);
200 br_multihash_copyimpl(&mhc, &ctx->eng.mhash);
201 br_multihash_init(&mhc);
202 br_multihash_update(&mhc,
203 ctx->eng.client_random, sizeof ctx->eng.client_random);
204 br_multihash_update(&mhc,
205 ctx->eng.server_random, sizeof ctx->eng.server_random);
206 head[0] = 3;
207 head[1] = 0;
208 head[2] = curve;
209 head[3] = ctx->eng.ecdhe_point_len;
210 br_multihash_update(&mhc, head, sizeof head);
211 br_multihash_update(&mhc,
212 ctx->eng.ecdhe_point, ctx->eng.ecdhe_point_len);
213 hash = ctx->sign_hash_id;
214 if (hash) {
215 hv_len = br_multihash_out(&mhc, hash, ctx->eng.pad);
216 if (hv_len == 0) {
217 return -BR_ERR_INVALID_ALGORITHM;
218 }
219 } else {
220 if (!br_multihash_out(&mhc, br_md5_ID, ctx->eng.pad)
221 || !br_multihash_out(&mhc,
222 br_sha1_ID, ctx->eng.pad + 16))
223 {
224 return -BR_ERR_INVALID_ALGORITHM;
225 }
226 hv_len = 36;
227 }
228 sig_len = (*ctx->policy_vtable)->do_sign(ctx->policy_vtable,
229 hash, hv_len, ctx->eng.pad, sizeof ctx->eng.pad);
230 return sig_len ? (int)sig_len : -BR_ERR_INVALID_ALGORITHM;
231 }
232
233 /*
234 * Do the ECDHE key exchange (part 2: computation of the shared secret
235 * from the point sent by the client).
236 */
237 static void
238 do_ecdhe_part2(br_ssl_server_context *ctx, int prf_id,
239 unsigned char *cpoint, size_t cpoint_len)
240 {
241 int curve;
242 uint32_t x;
243
244 curve = ctx->eng.ecdhe_curve;
245
246 /*
247 * Finalise the key exchange.
248 */
249 x = ctx->eng.iec->mul(cpoint, cpoint_len,
250 ctx->ecdhe_key, ctx->ecdhe_key_len, curve);
251 ecdh_common(ctx, prf_id, cpoint, cpoint_len, x);
252
253 /*
254 * Clear the ECDHE private key. Forward Secrecy is achieved insofar
255 * as that key does not get stolen, so we'd better destroy it
256 * as soon as it ceases to be useful.
257 */
258 memset(ctx->ecdhe_key, 0, ctx->ecdhe_key_len);
259 }
260
261 }
262
263 \ =======================================================================
264
265 : addr-ctx:
266 next-word { field }
267 "addr-" field + 0 1 define-word
268 0 8191 "offsetof(br_ssl_server_context, " field + ")" + make-CX
269 postpone literal postpone ; ;
270
271 addr-ctx: client_max_version
272 addr-ctx: client_suites
273 addr-ctx: client_suites_num
274 addr-ctx: hashes
275 addr-ctx: curves
276 addr-ctx: sign_hash_id
277
278 \ Get address and length of the client_suites[] buffer. Length is expressed
279 \ in bytes.
280 : addr-len-client_suites ( -- addr len )
281 addr-client_suites
282 CX 0 1023 { BR_MAX_CIPHER_SUITES * sizeof(br_suite_translated) } ;
283
284 \ Read the client SNI extension.
285 : read-client-sni ( lim -- lim )
286 \ Open extension value.
287 read16 open-elt
288
289 \ Open ServerNameList.
290 read16 open-elt
291
292 \ Find if there is a name of type 0 (host_name) with a length
293 \ that fits in our dedicated buffer.
294 begin dup while
295 read8 if
296 read-ignore-16
297 else
298 read16
299 dup 255 <= if
300 dup addr-server_name + 0 swap set8
301 addr-server_name swap read-blob
302 else
303 skip-blob
304 then
305 then
306 repeat
307
308 \ Close ServerNameList.
309 close-elt
310
311 \ Close extension value.
312 close-elt ;
313
314 \ Set the new maximum fragment length. BEWARE: this shall be called only
315 \ after reading the ClientHello and before writing the ServerHello.
316 cc: set-max-frag-len ( len -- ) {
317 size_t max_frag_len = T0_POP();
318
319 br_ssl_engine_new_max_frag_len(ENG, max_frag_len);
320
321 /*
322 * We must adjust our own output limit. Since we call this only
323 * after receiving a ClientHello and before beginning to send
324 * the ServerHello, the next output record should be empty at
325 * that point, so we can use max_frag_len as a limit.
326 */
327 if (ENG->hlen_out > max_frag_len) {
328 ENG->hlen_out = max_frag_len;
329 }
330 }
331
332 \ Read the client Max Frag Length extension.
333 : read-client-frag ( lim -- lim )
334 \ Extension value must have length exactly 1 byte.
335 read16 1 <> if ERR_BAD_FRAGLEN fail then
336 read8
337
338 \ The byte value must be 1, 2, 3 or 4.
339 dup dup 0= swap 5 >= or if ERR_BAD_FRAGLEN fail then
340
341 \ If our own maximum fragment length is greater, then we reduce
342 \ our length.
343 8 + dup addr-log_max_frag_len get8 < if
344 dup 1 swap << set-max-frag-len
345 dup addr-log_max_frag_len set8
346 addr-peer_log_max_frag_len set8
347 else
348 drop
349 then ;
350
351 \ Read the Secure Renegotiation extension from the client.
352 : read-client-reneg ( lim -- lim )
353 \ Get value length.
354 read16
355
356 \ The "reneg" value is one of:
357 \ 0 on first handshake, client support is unknown
358 \ 1 client does not support secure renegotiation
359 \ 2 client supports secure renegotiation
360 addr-reneg get8 case
361 0 of
362 \ First handshake, value length shall be 1.
363 1 = ifnot ERR_BAD_SECRENEG fail then
364 read8 if ERR_BAD_SECRENEG fail then
365 2 addr-reneg set8
366 endof
367 2 of
368 \ Renegotiation, value shall consist of 13 bytes
369 \ (header + copy of the saved client "Finished").
370 13 = ifnot ERR_BAD_SECRENEG fail then
371 read8 12 = ifnot ERR_BAD_SECRENEG fail then
372 addr-pad 12 read-blob
373 addr-saved_finished addr-pad 12 memcmp ifnot
374 ERR_BAD_SECRENEG fail
375 then
376 endof
377
378 \ If "reneg" is 1 then the client is not supposed to support
379 \ the extension, and it sends it nonetheless, which means
380 \ foul play.
381 ERR_BAD_SECRENEG fail
382 endcase ;
383
384 \ Read the Signature Algorithms extension.
385 : read-signatures ( lim -- lim )
386 \ Open extension value.
387 read16 open-elt
388
389 \ Clear list of supported signature algorithms.
390 0 addr-hashes set16
391
392 \ Get list of algorithms length.
393 read16 open-elt
394 begin dup while
395 read8 { hash } read8 { sign }
396 \ We keep the value if the signature is either 1 (RSA) or
397 \ 3 (ECDSA), and the hash is one of the SHA-* functions
398 \ (2 to 6, from SHA-1 to SHA-512). Note that we reject
399 \ any use of MD5. Also, we do not keep track of the client
400 \ preferences.
401 hash 2 >= hash 6 <= and
402 sign 1 = sign 3 = or
403 and if
404 addr-hashes get16
405 1 sign 1- 2 << hash + << or addr-hashes set16
406 then
407 repeat
408 close-elt
409
410 \ Close extension value.
411 close-elt ;
412
413 \ Read the Supported Curves extension.
414 : read-supported-curves ( lim -- lim )
415 \ Open extension value.
416 read16 open-elt
417
418 \ Open list of curve identifiers.
419 read16 open-elt
420
421 \ Get all supported curves.
422 0 addr-curves set32
423 begin dup while
424 read16 dup 32 < if
425 1 swap << addr-curves get32 or addr-curves set32
426 else
427 drop
428 then
429 repeat
430 close-elt
431 close-elt ;
432
433 \ Call policy handler to get cipher suite, hash function identifier and
434 \ certificate chain. Returned value is 0 (false) on failure.
435 cc: call-policy-handler ( -- bool ) {
436 int x;
437 br_ssl_server_choices choices;
438
439 x = (*CTX->policy_vtable)->choose(
440 CTX->policy_vtable, CTX, &choices);
441 ENG->session.cipher_suite = choices.cipher_suite;
442 CTX->sign_hash_id = choices.hash_id;
443 CTX->chain = choices.chain;
444 CTX->chain_len = choices.chain_len;
445 T0_PUSHi(-(x != 0));
446 }
447
448 \ Check for a remembered session.
449 cc: check-resume ( -- bool ) {
450 if (ENG->session.session_id_len == 32
451 && CTX->cache_vtable != NULL && (*CTX->cache_vtable)->load(
452 CTX->cache_vtable, CTX, &ENG->session))
453 {
454 T0_PUSHi(-1);
455 } else {
456 T0_PUSH(0);
457 }
458 }
459
460 \ Save the current session.
461 cc: save-session ( -- ) {
462 if (CTX->cache_vtable != NULL) {
463 (*CTX->cache_vtable)->save(
464 CTX->cache_vtable, CTX, &ENG->session);
465 }
466 }
467
468 \ Read ClientHello. If the session is resumed, then -1 is returned.
469 : read-ClientHello ( -- resume )
470 \ Get header, and check message type.
471 read-handshake-header 1 = ifnot ERR_UNEXPECTED fail then
472
473 \ Get maximum protocol version from client.
474 read16 dup { client-version-max } addr-client_max_version set16
475
476 \ Client random.
477 addr-client_random 32 read-blob
478
479 \ Client session ID.
480 read8 dup 32 > if ERR_OVERSIZED_ID fail then
481 dup addr-session_id_len set8
482 addr-session_id swap read-blob
483
484 \ Lookup session for resumption. We should do that here because
485 \ we need to verify that the remembered cipher suite is still
486 \ matched by this ClientHello.
487 check-resume { resume }
488
489 \ Cipher suites. We read all cipher suites from client, each time
490 \ matching against our own list. We accumulare suites in the
491 \ client_suites[] context buffer: we keep suites that are
492 \ supported by both the client and the server (so the list size
493 \ cannot exceed that of the server list), and we keep them in
494 \ either client or server preference order (depending on the
495 \ relevant flag).
496 \
497 \ We also need to identify the pseudo cipher suite for secure
498 \ renegotiation here.
499 read16 open-elt
500 0 { reneg-scsv }
501 0 { resume-suite }
502 addr-len-client_suites dup2 bzero
503 over + { css-off css-max }
504 begin
505 dup while
506 read16 dup { suite }
507
508 \ Check that when resuming a session, the requested
509 \ suite is still valid.
510 resume if
511 dup addr-cipher_suite get16 = if
512 -1 >resume-suite
513 then
514 then
515
516 \ Special handling for TLS_EMPTY_RENEGOTIATION_INFO_SCSV.
517 \ This fake cipher suite may occur only in the first
518 \ handshake.
519 dup 0x00FF = if
520 addr-reneg get8 if ERR_BAD_SECRENEG fail then
521 -1 >reneg-scsv
522 then
523
524 \ Special handling for TLS_FALLBACK_SCSV. If the client
525 \ maximum version is less than our own maximum version,
526 \ then this is an undue downgrade. We mark it by setting
527 \ the client max version to 0x10000.
528 dup 0x5600 = if
529 client-version-max addr-version_min get16 >=
530 client-version-max addr-version_max get16 < and if
531 -1 >client-version-max
532 then
533 then
534
535 \ Test whether the suite is supported by the server.
536 scan-suite dup 0< if
537 \ We do not support this cipher suite. Note
538 \ that this also covers the case of pseudo
539 \ cipher suites.
540 drop
541 else
542 \ If we use server order, then we place the
543 \ suite at the computed offset; otherwise, we
544 \ append it to the list at the current place.
545 0 flag? if
546 2 << addr-client_suites + suite swap set16
547 else
548 drop
549 \ We need to test for list length because
550 \ the client list may have duplicates,
551 \ that we do not filter. Duplicates are
552 \ invalid so this is not a problem if we
553 \ reject such clients.
554 css-off css-max >= if
555 ERR_BAD_HANDSHAKE fail
556 then
557 suite css-off set16
558 css-off 4 + >css-off
559 then
560 then
561 repeat
562 drop
563
564 \ Compression methods. We need method 0 (no compression).
565 0 { ok-compression }
566 read8 open-elt
567 begin dup while
568 read8 ifnot -1 >ok-compression then
569 repeat
570 close-elt
571
572 \ Set default values for parameters that may be affected by
573 \ extensions:
574 \ -- server name is empty
575 \ -- client is reputed to know RSA and ECDSA, both with SHA-1
576 \ -- the default elliptic curve is P-256 (secp256r1, id = 23)
577 0 addr-server_name set8
578 0x404 addr-hashes set16
579 0x800000 addr-curves set32
580
581 \ Process extensions, if any.
582 dup if
583 read16 open-elt
584 begin dup while
585 read16 case
586 \ Server Name Indication.
587 0x0000 of
588 read-client-sni
589 endof
590 \ Max Frag Length.
591 0x0001 of
592 read-client-frag
593 endof
594 \ Secure Renegotiation.
595 0xFF01 of
596 read-client-reneg
597 endof
598 \ Signature Algorithms.
599 0x000D of
600 read-signatures
601 endof
602 \ Supported Curves.
603 0x000A of
604 read-supported-curves
605 endof
606 \ Supported Point Formats.
607 \ We only support "uncompressed", that all
608 \ implementations are supposed to support,
609 \ so we can simply ignore that extension.
610 \ 0x000B of
611 \ read-ignore-16
612 \ endof
613
614 \ Other extensions are ignored.
615 drop read-ignore-16 0
616 endcase
617 repeat
618 close-elt
619 then
620
621 \ Close message.
622 close-elt
623
624 \ Cancel session resumption if the cipher suite was not found.
625 resume resume-suite and >resume
626
627 \ Now check the received data. Since the client is expecting an
628 \ answer, we can send an appropriate fatal alert on any error.
629
630 \ Compute protocol version as the minimum of our maximum version,
631 \ and the maximum version sent by the client. If that is less than
632 \ 0x0300 (SSL-3.0), then fail. Otherwise, we may at least send an
633 \ alert with that version. We still reject versions lower than our
634 \ configured minimum.
635 \ As a special case, in case of undue downgrade, we send a specific
636 \ alert (see RFC 7507). Note that this case may happen only if
637 \ we would otherwise accept the client's version.
638 client-version-max 0< if
639 addr-client_max_version get16 addr-version_out set16
640 86 fail-alert
641 then
642 addr-version_max get16
643 dup client-version-max > if drop client-version-max then
644 dup 0x0300 < if ERR_BAD_VERSION fail then
645 client-version-max addr-version_min get16 < if
646 70 fail-alert
647 then
648 \ If resuming the session, then enforce the previously negotiated
649 \ version (if still possible).
650 resume if
651 addr-version get16 client-version-max <= if
652 drop addr-version get16
653 else
654 0 >resume
655 then
656 then
657 dup addr-version set16
658 dup addr-version_in set16
659 dup addr-version_out set16
660 0x0303 >= { can-tls12 }
661
662 \ If the client sent TLS_EMPTY_RENEGOTIATION_INFO_SCSV, then
663 \ we should mark the client as "supporting secure renegotiation".
664 reneg-scsv if 2 addr-reneg set8 then
665
666 \ Check compression.
667 ok-compression ifnot 40 fail-alert then
668
669 \ Filter hash function support by what the server also supports.
670 \ If no common hash function remains, then ECDHE suites are not
671 \ possible.
672 supported-hash-functions drop 257 *
673 addr-hashes get16 and dup addr-hashes set16
674 0<> { can-ecdhe }
675
676 \ Filter supported curves. If there is no common curve between
677 \ client and us, then ECDHE suites cannot be used. Note that we
678 \ may still allow ECDH, depending on the EC key handler.
679 addr-curves get32 supported-curves and dup addr-curves set32
680 ifnot 0 >can-ecdhe then
681
682 \ If resuming a session, then the next steps are not necessary;
683 \ we won't invoke the policy handler.
684 resume if -1 ret then
685
686 \ We are not resuming, so a new session ID should be generated.
687 addr-session_id 32 mkrand
688 32 addr-session_id_len set8
689
690 \ Translate common cipher suites, then squeeze out holes: there
691 \ may be holes because of the way we fill the list when the
692 \ server preference order is enforced, and also in case some
693 \ suites are filtered out. In particular:
694 \ -- ECDHE suites are removed if there is no common hash function
695 \ (for signatures) or no common curve.
696 \ -- TLS-1.2-only suites are removed if the negociated version is
697 \ TLS-1.1 or lower.
698 addr-client_suites dup >css-off
699 begin dup css-max < while
700 dup get16 dup cipher-suite-to-elements
701 can-ecdhe ifnot
702 dup 12 >> dup 1 = swap 2 = or if
703 2drop 0 dup
704 then
705 then
706 can-tls12 ifnot
707 \ Suites compatible with TLS-1.0 and TLS-1.1 are
708 \ exactly the ones that use HMAC/SHA-1.
709 dup 0xF0 and 0x20 <> if
710 2drop 0 dup
711 then
712 then
713 dup if
714 css-off 2+ set16 css-off set16
715 css-off 4 + >css-off
716 else
717 2drop
718 then
719 4 +
720 repeat
721 drop
722 css-off addr-client_suites - 2 >>
723 dup ifnot
724 \ No common cipher suite: handshake failure.
725 40 fail-alert
726 then
727 addr-client_suites_num set8
728
729 \ Call policy handler to obtain the cipher suite and other
730 \ parameters.
731 call-policy-handler ifnot 40 fail-alert then
732
733 \ We are not resuming a session.
734 0 ;
735
736 \ Write ServerHello.
737 : write-ServerHello ( initial -- )
738 { initial }
739 \ Compute ServerHello length. Right now we only send the
740 \ "secure renegotiation" extension.
741 2 write8 70
742
743 addr-reneg get8 2 = if
744 initial if 5 else 29 then
745 else
746 0
747 then
748 { ext-reneg-len }
749 addr-peer_log_max_frag_len get8 if 5 else 0 then
750 { ext-max-frag-len }
751
752 ext-reneg-len ext-max-frag-len + dup if 2 + then +
753 write24
754
755 \ Protocol version
756 addr-version get16 write16
757
758 \ Server random
759 addr-server_random 4 bzero
760 addr-server_random 4 + 28 mkrand
761 addr-server_random 32 write-blob
762
763 \ Session ID
764 \ TODO: if we have no session cache at all, we might send here
765 \ an empty session ID. This would save a bit of network
766 \ bandwidth.
767 32 write8
768 addr-session_id 32 write-blob
769
770 \ Cipher suite
771 addr-cipher_suite get16 write16
772
773 \ Compression method
774 0 write8
775
776 \ Extensions
777 ext-reneg-len ext-max-frag-len + dup if
778 write16
779 ext-reneg-len dup if
780 0xFF01 write16
781 4 - dup write16
782 1- addr-saved_finished swap write-blob-head8
783 else
784 drop
785 then
786 ext-max-frag-len if
787 0x0001 write16
788 1 write16 addr-peer_log_max_frag_len get8 8 - write8
789 then
790 else
791 drop
792 then ;
793
794 \ Compute total chain length. This includes the individual certificate
795 \ headers, but not the total chain header. This also sets the cert_cur,
796 \ cert_len and chain_len context fields.
797 cc: total-chain-length ( -- len ) {
798 size_t u;
799 uint32_t total;
800
801 total = 0;
802 for (u = 0; u < CTX->chain_len; u ++) {
803 total += 3 + (uint32_t)CTX->chain[u].data_len;
804 }
805 T0_PUSH(total);
806 }
807
808 \ Get length for current certificate in the chain; if the chain end was
809 \ reached, then this returns -1.
810 cc: begin-cert ( -- len ) {
811 if (CTX->chain_len == 0) {
812 T0_PUSHi(-1);
813 } else {
814 CTX->cert_cur = CTX->chain->data;
815 CTX->cert_len = CTX->chain->data_len;
816 CTX->chain ++;
817 CTX->chain_len --;
818 T0_PUSH(CTX->cert_len);
819 }
820 }
821
822 \ Copy a chunk of certificate data into the pad. Returned value is the
823 \ chunk length, or 0 if the certificate end is reached.
824 cc: copy-cert-chunk ( -- len ) {
825 size_t clen;
826
827 clen = CTX->cert_len;
828 if (clen > sizeof ENG->pad) {
829 clen = sizeof ENG->pad;
830 }
831 memcpy(ENG->pad, CTX->cert_cur, clen);
832 CTX->cert_cur += clen;
833 CTX->cert_len -= clen;
834 T0_PUSH(clen);
835 }
836
837 \ Write the server Certificate.
838 : write-Certificate ( -- )
839 11 write8
840 total-chain-length
841 dup 3 + write24 write24
842 begin
843 begin-cert
844 dup 0< if drop ret then write24
845 begin copy-cert-chunk dup while
846 addr-pad swap write-blob
847 repeat
848 drop
849 again ;
850
851 \ Do the first part of ECDHE. Returned value is the computed signature
852 \ length, or a negative error code on error.
853 cc: do-ecdhe-part1 ( curve -- len ) {
854 int curve = T0_POPi();
855 T0_PUSHi(do_ecdhe_part1(CTX, curve));
856 }
857
858 \ Write the Server Key Exchange message (if applicable).
859 : write-ServerKeyExchange ( -- )
860 addr-cipher_suite get16 use-ecdhe? ifnot ret then
861
862 \ We must select an appropriate curve among the curves that
863 \ are supported both by us and the peer. Right now we use
864 \ the one with the smallest ID, which in practice means P-256.
865 \ (TODO: add some option to make that behaviour configurable.)
866 \
867 \ This loop always terminates because previous processing made
868 \ sure that ECDHE suites are not selectable if there is no common
869 \ curve.
870 addr-curves get32 0
871 begin dup2 >> 1 and 0= while 1+ repeat
872 { curve-id } drop
873
874 \ Compute the signed curve point to send.
875 curve-id do-ecdhe-part1 dup 0< if neg fail then { sig-len }
876
877 \ If using TLS-1.2+, then the hash function and signature
878 \ algorithm are explicitly encoded in the message.
879 addr-version get16 0x0303 >= { tls1.2+ }
880
881 12 write8
882 sig-len addr-ecdhe_point_len get8 + tls1.2+ 2 and + 6 + write24
883
884 \ Curve parameters: named curve with 16-bit ID.
885 3 write8 curve-id write16
886
887 \ Public point.
888 addr-ecdhe_point addr-ecdhe_point_len get8 write-blob-head8
889
890 \ If TLS-1.2+, write hash and signature identifiers.
891 tls1.2+ if
892 \ Hash identifier is in the sign_hash_id field.
893 addr-sign_hash_id get8 write8
894 \ 'use-rsa-ecdhe?' returns -1 for RSA, 0 for ECDSA.
895 \ The byte on the wire shall be 1 for RSA, 3 for ECDSA.
896 addr-cipher_suite get16 use-rsa-ecdhe? 1 << 3 + write8
897 then
898
899 \ Signature.
900 sig-len write16
901 addr-pad sig-len write-blob ;
902
903 \ Write the Server Hello Done message.
904 : write-ServerHelloDone ( -- )
905 14 write8 0 write24 ;
906
907 \ Perform RSA decryption of the client-sent pre-master secret. The value
908 \ is in the pad, and its length is provided as parameter.
909 cc: do-rsa-decrypt ( len prf_id -- ) {
910 int prf_id = T0_POPi();
911 size_t len = T0_POP();
912 do_rsa_decrypt(CTX, prf_id, ENG->pad, len);
913 }
914
915 \ Perform ECDH (not ECDHE). The point from the client is in the pad, and
916 \ its length is provided as parameter.
917 cc: do-ecdh ( len prf_id -- ) {
918 int prf_id = T0_POPi();
919 size_t len = T0_POP();
920 do_ecdh(CTX, prf_id, ENG->pad, len);
921 }
922
923 \ Do the second part of ECDHE.
924 cc: do-ecdhe-part2 ( len prf_id -- ) {
925 int prf_id = T0_POPi();
926 size_t len = T0_POP();
927 do_ecdhe_part2(CTX, prf_id, ENG->pad, len);
928 }
929
930 \ Read the Client Key Exchange.
931 : read-ClientKeyExchange ( -- )
932 \ Get header, and check message type.
933 read-handshake-header 16 = ifnot ERR_UNEXPECTED fail then
934
935 \ What we should get depends on the cipher suite.
936 addr-cipher_suite get16 use-rsa-keyx? if
937 \ RSA key exchange: we expect a RSA-encrypted value.
938 read16
939 dup 512 > if ERR_LIMIT_EXCEEDED fail then
940 dup { enc-rsa-len }
941 addr-pad swap read-blob
942 enc-rsa-len addr-cipher_suite get16 prf-id do-rsa-decrypt
943 then
944 addr-cipher_suite get16 dup use-ecdhe? swap use-ecdh? { ecdhe ecdh }
945 ecdh ecdhe or if
946 \ ECDH or ECDHE key exchange: we expect an EC point.
947 read8 dup { ec-point-len }
948 addr-pad swap read-blob
949 ec-point-len addr-cipher_suite get16 prf-id
950 ecdhe if do-ecdhe-part2 else do-ecdh then
951 then
952 close-elt ;
953
954 \ Send a HelloRequest.
955 : send-HelloRequest ( -- )
956 flush-record
957 begin can-output? not while wait-co drop repeat
958 22 addr-record_type_out set8
959 0 write8 0 write24 flush-record
960 23 addr-record_type_out set8 ;
961
962 \ Make a handshake.
963 : do-handshake ( initial -- )
964 0 addr-application_data set8
965 22 addr-record_type_out set8
966 multihash-init
967 read-ClientHello
968 more-incoming-bytes? if ERR_UNEXPECTED fail then
969 if
970 \ Session resumption
971 write-ServerHello
972 0 write-CCS-Finished
973 0 read-CCS-Finished
974 else
975 \ Not a session resumption
976 write-ServerHello
977 write-Certificate
978 write-ServerKeyExchange
979 write-ServerHelloDone
980 flush-record
981 read-ClientKeyExchange
982 0 read-CCS-Finished
983 0 write-CCS-Finished
984 save-session
985 then
986 1 addr-application_data set8
987 23 addr-record_type_out set8 ;
988
989 \ Entry point.
990 : main ( -- ! )
991 \ Perform initial handshake.
992 -1 do-handshake
993
994 begin
995 \ Wait for further invocation. At that point, we should
996 \ get either an explicit call for renegotiation, or
997 \ an incoming ClientHello handshake message.
998 wait-co
999 dup 0x07 and case
1000 0x00 of
1001 0x10 and if
1002 \ The best we can do is ask for a
1003 \ renegotiation, then wait for it
1004 \ to happen.
1005 send-HelloRequest
1006 then
1007 endof
1008 0x01 of
1009 \ Reject renegotiations if the peer does not
1010 \ support secure renegotiation, or if the
1011 \ "no renegotiation" flag is set.
1012 drop
1013 addr-reneg get8 1 = 1 flag? or if
1014 flush-record
1015 begin can-output? not while
1016 wait-co drop
1017 repeat
1018 100 send-warning
1019 else
1020 0 do-handshake
1021 then
1022 endof
1023 ERR_UNEXPECTED fail
1024 endcase
1025 again
1026 ;