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