xref: /freebsd/contrib/bearssl/src/ssl/ssl_hs_server.t0 (revision faf25f48d601ae39f5752602f3020e2e92605625)
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
27preamble {
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 "addresses" 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 */
42static void
43do_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 */
86static void
87ecdh_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 */
120static void
121do_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 */
140static void
141do_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
163static size_t
164hash_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 */
208static int
209do_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 */
277static void
278do_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 */
309static const unsigned char HASH_PAD_OFF[] = { 0, 16, 36, 64, 96, 144, 208 };
310
311/*
312 * OID for hash functions in RSA signatures.
313 */
314static const unsigned char HASH_OID_SHA1[] = {
315	0x05, 0x2B, 0x0E, 0x03, 0x02, 0x1A
316};
317
318static const unsigned char HASH_OID_SHA224[] = {
319	0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x04
320};
321
322static const unsigned char HASH_OID_SHA256[] = {
323	0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01
324};
325
326static const unsigned char HASH_OID_SHA384[] = {
327	0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02
328};
329
330static const unsigned char HASH_OID_SHA512[] = {
331	0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03
332};
333
334static 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 */
349static int
350verify_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
401addr-ctx: client_max_version
402addr-ctx: client_suites
403addr-ctx: client_suites_num
404addr-ctx: hashes
405addr-ctx: curves
406addr-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.
446cc: 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.
581cc: 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.
595cc: 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.
607cc: 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 and drop ClientHello. This is used when a client-triggered
615\ renegotiation attempt is rejected.
616: skip-ClientHello ( -- )
617	read-handshake-header-core
618	1 = ifnot ERR_UNEXPECTED fail then
619	dup skip-blob drop ;
620
621\ Read ClientHello. If the session is resumed, then -1 is returned.
622: read-ClientHello ( -- resume )
623	\ Get header, and check message type.
624	read-handshake-header 1 = ifnot ERR_UNEXPECTED fail then
625
626	\ Get maximum protocol version from client.
627	read16 dup { client-version-max } addr-client_max_version set16
628
629	\ Client random.
630	addr-client_random 32 read-blob
631
632	\ Client session ID.
633	read8 dup 32 > if ERR_OVERSIZED_ID fail then
634	dup addr-session_id_len set8
635	addr-session_id swap read-blob
636
637	\ Lookup session for resumption. We should do that here because
638	\ we need to verify that the remembered cipher suite is still
639	\ matched by this ClientHello.
640	check-resume { resume }
641
642	\ Cipher suites. We read all cipher suites from client, each time
643	\ matching against our own list. We accumulate suites in the
644	\ client_suites[] context buffer: we keep suites that are
645	\ supported by both the client and the server (so the list size
646	\ cannot exceed that of the server list), and we keep them in
647	\ either client or server preference order (depending on the
648	\ relevant flag).
649	\
650	\ We also need to identify the pseudo cipher suite for secure
651	\ renegotiation here.
652	read16 open-elt
653	0 { reneg-scsv }
654	0 { resume-suite }
655	addr-len-client_suites dup2 bzero
656	over + { css-off css-max }
657	begin
658		dup while
659		read16 dup { suite }
660
661		\ Check that when resuming a session, the requested
662		\ suite is still valid.
663		resume if
664			dup addr-cipher_suite get16 = if
665				-1 >resume-suite
666			then
667		then
668
669		\ Special handling for TLS_EMPTY_RENEGOTIATION_INFO_SCSV.
670		\ This fake cipher suite may occur only in the first
671		\ handshake.
672		dup 0x00FF = if
673			addr-reneg get8 if ERR_BAD_SECRENEG fail then
674			-1 >reneg-scsv
675		then
676
677		\ Special handling for TLS_FALLBACK_SCSV. If the client
678		\ maximum version is less than our own maximum version,
679		\ then this is an undue downgrade. We mark it by setting
680		\ the client max version to 0x10000.
681		dup 0x5600 = if
682			client-version-max addr-version_min get16 >=
683			client-version-max addr-version_max get16 < and if
684				-1 >client-version-max
685			then
686		then
687
688		\ Test whether the suite is supported by the server.
689		scan-suite dup 0< if
690			\ We do not support this cipher suite. Note
691			\ that this also covers the case of pseudo
692			\ cipher suites.
693			drop
694		else
695			\ If we use server order, then we place the
696			\ suite at the computed offset; otherwise, we
697			\ append it to the list at the current place.
698			0 flag? if
699				2 << addr-client_suites + suite swap set16
700			else
701				drop
702				\ We need to test for list length because
703				\ the client list may have duplicates,
704				\ that we do not filter. Duplicates are
705				\ invalid so this is not a problem if we
706				\ reject such clients.
707				css-off css-max >= if
708					ERR_BAD_HANDSHAKE fail
709				then
710				suite css-off set16
711				css-off 4 + >css-off
712			then
713		then
714	repeat
715	drop
716
717	\ Compression methods. We need method 0 (no compression).
718	0 { ok-compression }
719	read8 open-elt
720	begin dup while
721		read8 ifnot -1 >ok-compression then
722	repeat
723	close-elt
724
725	\ Set default values for parameters that may be affected by
726	\ extensions:
727	\ -- server name is empty
728	\ -- client is reputed to know RSA and ECDSA, both with SHA-1
729	\ -- the default elliptic curve is P-256 (secp256r1, id = 23)
730	0 addr-server_name set8
731	0x0404 addr-hashes set32
732	0x800000 addr-curves set32
733
734	\ Process extensions, if any.
735	dup if
736		read16 open-elt
737		begin dup while
738			read16 case
739				\ Server Name Indication.
740				0x0000 of
741					read-client-sni
742				endof
743				\ Max Frag Length.
744				0x0001 of
745					read-client-frag
746				endof
747				\ Secure Renegotiation.
748				0xFF01 of
749					read-client-reneg
750				endof
751				\ Signature Algorithms.
752				0x000D of
753					read-signatures
754				endof
755				\ Supported Curves.
756				0x000A of
757					read-supported-curves
758				endof
759				\ Supported Point Formats.
760				\ We only support "uncompressed", that all
761				\ implementations are supposed to support,
762				\ so we can simply ignore that extension.
763				\ 0x000B of
764				\ 	read-ignore-16
765				\ endof
766
767				\ ALPN
768				0x0010 of
769					read-ALPN-from-client
770				endof
771
772				\ Other extensions are ignored.
773				drop read-ignore-16 0
774			endcase
775		repeat
776		close-elt
777	then
778
779	\ Close message.
780	close-elt
781
782	\ Cancel session resumption if the cipher suite was not found.
783	resume resume-suite and >resume
784
785	\ Now check the received data. Since the client is expecting an
786	\ answer, we can send an appropriate fatal alert on any error.
787
788	\ Compute protocol version as the minimum of our maximum version,
789	\ and the maximum version sent by the client. If that is less than
790	\ 0x0300 (SSL-3.0), then fail. Otherwise, we may at least send an
791	\ alert with that version. We still reject versions lower than our
792	\ configured minimum.
793	\ As a special case, in case of undue downgrade, we send a specific
794	\ alert (see RFC 7507). Note that this case may happen only if
795	\ we would otherwise accept the client's version.
796	client-version-max 0< if
797		addr-client_max_version get16 addr-version_out set16
798		86 fail-alert
799	then
800	addr-version_max get16
801	dup client-version-max > if drop client-version-max then
802	dup 0x0300 < if ERR_BAD_VERSION fail then
803	client-version-max addr-version_min get16 < if
804		70 fail-alert
805	then
806	\ If resuming the session, then enforce the previously negotiated
807	\ version (if still possible).
808	resume if
809		addr-version get16 client-version-max <= if
810			drop addr-version get16
811		else
812			0 >resume
813		then
814	then
815	dup addr-version set16
816	dup addr-version_in set16
817	dup addr-version_out set16
818	0x0303 >= { can-tls12 }
819
820	\ If the client sent TLS_EMPTY_RENEGOTIATION_INFO_SCSV, then
821	\ we should mark the client as "supporting secure renegotiation".
822	reneg-scsv if 2 addr-reneg set8 then
823
824	\ If, at that point, the 'reneg' value is still 0, then the client
825	\ did not send the extension or the SCSV, so we have to assume
826	\ that secure renegotiation is not supported by that client.
827	addr-reneg get8 ifnot 1 addr-reneg set8 then
828
829	\ Check compression.
830	ok-compression ifnot 40 fail-alert then
831
832	\ Filter hash function support by what the server also supports.
833	\ If no common hash function remains with RSA and/or ECDSA, then
834	\ the corresponding ECDHE suites are not possible.
835	supported-hash-functions drop 257 * 0xFFFF0000 or
836	addr-hashes get32 and dup addr-hashes set32
837	\ In 'can-ecdhe', bit 12 is set if ECDHE_RSA is possible, bit 13 is
838	\ set if ECDHE_ECDSA is possible.
839	dup 0xFF and 0<> neg
840	swap 8 >> 0<> 2 and or 12 << { can-ecdhe }
841
842	\ Filter supported curves. If there is no common curve between
843	\ client and us, then ECDHE suites cannot be used. Note that we
844	\ may still allow ECDH, depending on the EC key handler.
845	addr-curves get32 supported-curves and dup addr-curves set32
846	ifnot 0 >can-ecdhe then
847
848	\ If resuming a session, then the next steps are not necessary;
849	\ we won't invoke the policy handler.
850	resume if -1 ret then
851
852	\ We are not resuming, so a new session ID should be generated.
853	\ We don't check that the new ID is distinct from the one sent
854	\ by the client because probability of such an event is 2^(-256),
855	\ i.e. much (much) lower than that of an undetected transmission
856	\ error or hardware miscomputation, and with similar consequences
857	\ (handshake simply fails).
858	addr-session_id 32 mkrand
859	32 addr-session_id_len set8
860
861	\ Translate common cipher suites, then squeeze out holes: there
862	\ may be holes because of the way we fill the list when the
863	\ server preference order is enforced, and also in case some
864	\ suites are filtered out. In particular:
865	\ -- ECDHE suites are removed if there is no common hash function
866	\    (for the relevant signature algorithm) or no common curve.
867	\ -- TLS-1.2-only suites are removed if the negotiated version is
868	\    TLS-1.1 or lower.
869	addr-client_suites dup >css-off
870	begin dup css-max < while
871		dup get16 dup cipher-suite-to-elements
872		dup 12 >> dup 1 = swap 2 = or if
873			dup can-ecdhe and ifnot
874				2drop 0 dup
875			then
876		then
877		can-tls12 ifnot
878			\ Suites compatible with TLS-1.0 and TLS-1.1 are
879			\ exactly the ones that use HMAC/SHA-1.
880			dup 0xF0 and 0x20 <> if
881				2drop 0 dup
882			then
883		then
884		dup if
885			css-off 2+ set16 css-off set16
886			css-off 4 + >css-off
887		else
888			2drop
889		then
890		4 +
891	repeat
892	drop
893	css-off addr-client_suites - 2 >>
894	dup ifnot
895		\ No common cipher suite: handshake failure.
896		40 fail-alert
897	then
898	addr-client_suites_num set8
899
900	\ Check ALPN.
901	addr-selected_protocol get16 0xFFFF = if
902		3 flag? if 120 fail-alert then
903		0 addr-selected_protocol set16
904	then
905
906	\ Call policy handler to obtain the cipher suite and other
907	\ parameters.
908	call-policy-handler ifnot 40 fail-alert then
909
910	\ We are not resuming a session.
911	0 ;
912
913\ Write ServerHello.
914: write-ServerHello ( initial -- )
915	{ initial }
916	\ Compute ServerHello length.
917	2 write8 70
918
919	\ Compute length of Secure Renegotiation extension.
920	addr-reneg get8 2 = if
921		initial if 5 else 29 then
922	else
923		0
924	then
925	{ ext-reneg-len }
926
927	\ Compute length of Max Fragment Length extension.
928	addr-peer_log_max_frag_len get8 if 5 else 0 then
929	{ ext-max-frag-len }
930
931	\ Compute length of ALPN extension. This also copy the
932	\ selected protocol name into the pad.
933	addr-selected_protocol get16 dup if 1- copy-protocol-name 7 + then
934	{ ext-ALPN-len }
935
936	\ Adjust ServerHello length to account for the extensions.
937	ext-reneg-len ext-max-frag-len + ext-ALPN-len + dup if 2 + then +
938	write24
939
940	\ Protocol version
941	addr-version get16 write16
942
943	\ Server random
944	addr-server_random 4 bzero
945	addr-server_random 4 + 28 mkrand
946	addr-server_random 32 write-blob
947
948	\ Session ID
949	\ TODO: if we have no session cache at all, we might send here
950	\ an empty session ID. This would save a bit of network
951	\ bandwidth.
952	32 write8
953	addr-session_id 32 write-blob
954
955	\ Cipher suite
956	addr-cipher_suite get16 write16
957
958	\ Compression method
959	0 write8
960
961	\ Extensions
962	ext-reneg-len ext-max-frag-len + ext-ALPN-len + dup if
963		write16
964		ext-reneg-len dup if
965			0xFF01 write16
966			4 - dup write16
967			1- addr-saved_finished swap write-blob-head8
968		else
969			drop
970		then
971		ext-max-frag-len if
972			0x0001 write16
973			1 write16 addr-peer_log_max_frag_len get8 8 - write8
974		then
975		ext-ALPN-len dup if
976			\ Note: the selected protocol name was previously
977			\ copied into the pad.
978			0x0010 write16
979			4 - dup write16
980			2- dup write16
981			1- addr-pad swap write-blob-head8
982		else
983			drop
984		then
985	else
986		drop
987	then ;
988
989\ Do the first part of ECDHE. Returned value is the computed signature
990\ length, or a negative error code on error.
991cc: do-ecdhe-part1 ( curve -- len ) {
992	int curve = T0_POPi();
993	T0_PUSHi(do_ecdhe_part1(CTX, curve));
994}
995
996\ Get index of first bit set to 1 (in low to high order).
997: lowest-1 ( bits -- n )
998	dup ifnot drop -1 ret then
999	0 begin dup2 >> 1 and 0= while 1+ repeat
1000	swap drop ;
1001
1002\ Write the Server Key Exchange message (if applicable).
1003: write-ServerKeyExchange ( -- )
1004	addr-cipher_suite get16 use-ecdhe? ifnot ret then
1005
1006	\ We must select an appropriate curve among the curves that
1007	\ are supported both by us and the peer. Right now, we apply
1008	\ a fixed preference order: Curve25519, P-256, P-384, P-521,
1009	\ then the common curve with the lowest ID.
1010	\ (TODO: add some option to make that behaviour configurable.)
1011	\
1012	\ This loop always terminates because previous processing made
1013	\ sure that ECDHE suites are not selectable if there is no common
1014	\ curve.
1015	addr-curves get32
1016	dup 0x20000000 and if
1017		drop 29
1018	else
1019		dup 0x38000000 and dup if swap then
1020		drop lowest-1
1021	then
1022	{ curve-id }
1023
1024	\ Compute the signed curve point to send.
1025	curve-id do-ecdhe-part1 dup 0< if neg fail then { sig-len }
1026
1027	\ If using TLS-1.2+, then the hash function and signature
1028	\ algorithm are explicitly encoded in the message.
1029	addr-version get16 0x0303 >= { tls1.2+ }
1030
1031	12 write8
1032	sig-len addr-ecdhe_point_len get8 + tls1.2+ 2 and + 6 + write24
1033
1034	\ Curve parameters: named curve with 16-bit ID.
1035	3 write8 curve-id write16
1036
1037	\ Public point.
1038	addr-ecdhe_point addr-ecdhe_point_len get8 write-blob-head8
1039
1040	\ If TLS-1.2+, write hash and signature identifiers.
1041	tls1.2+ if
1042		\ sign_hash_id contains either a hash identifier,
1043		\ or the complete 16-bit value to write.
1044		addr-sign_hash_id get16
1045		dup 0xFF00 < if
1046			write16
1047		else
1048			0xFF and write8
1049			\ 'use-rsa-ecdhe?' returns -1 for RSA, 0 for
1050			\ ECDSA. The byte on the wire shall be 1 for RSA,
1051			\ 3 for ECDSA.
1052			addr-cipher_suite get16 use-rsa-ecdhe? 1 << 3 + write8
1053		then
1054	then
1055
1056	\ Signature.
1057	sig-len write16
1058	addr-pad sig-len write-blob ;
1059
1060\ Get length of the list of anchor names to send to the client. The length
1061\ includes the per-name 2-byte header, but _not_ the 2-byte header for
1062\ the list itself. If no client certificate is requested, then this
1063\ returns 0.
1064cc: ta-names-total-length ( -- len ) {
1065	size_t u, len;
1066
1067	len = 0;
1068	if (CTX->ta_names != NULL) {
1069		for (u = 0; u < CTX->num_tas; u ++) {
1070			len += CTX->ta_names[u].len + 2;
1071		}
1072	} else if (CTX->tas != NULL) {
1073		for (u = 0; u < CTX->num_tas; u ++) {
1074			len += CTX->tas[u].dn.len + 2;
1075		}
1076	}
1077	T0_PUSH(len);
1078}
1079
1080\ Compute length and optionally write the contents of the list of
1081\ supported client authentication methods.
1082: write-list-auth ( do_write -- len )
1083	0
1084	addr-cipher_suite get16 use-ecdh? if
1085		2+ over if 65 write8 66 write8 then
1086	then
1087	supports-rsa-sign? if 1+ over if 1 write8 then then
1088	supports-ecdsa? if 1+ over if 64 write8 then then
1089	swap drop ;
1090
1091: write-signhash-inner2 ( dow algo hashes len id -- dow algo hashes len )
1092	{ id }
1093	over 1 id << and ifnot ret then
1094	2+
1095	3 pick if id write8 2 pick write8 then ;
1096
1097: write-signhash-inner1 ( dow algo hashes -- dow len )
1098	0
1099	4 write-signhash-inner2
1100	5 write-signhash-inner2
1101	6 write-signhash-inner2
1102	3 write-signhash-inner2
1103	2 write-signhash-inner2
1104	-rot 2drop ;
1105
1106\ Compute length and optionally write the contents of the list of
1107\ supported sign+hash algorithms.
1108: write-list-signhash ( do_write -- len )
1109	0 { len }
1110	\ If supporting neither RSA nor ECDSA in the engine, then we
1111	\ will do only static ECDH, and thus we claim support for
1112	\ everything (for the X.509 validator).
1113	supports-rsa-sign? supports-ecdsa? or ifnot
1114		1 0x7C write-signhash-inner1 >len
1115		3 0x7C write-signhash-inner1 len +
1116		swap drop ret
1117	then
1118	supports-rsa-sign? if
1119		1 supported-hash-functions drop
1120		write-signhash-inner1 >len
1121	then
1122	supports-ecdsa? if
1123		3 supported-hash-functions drop
1124		write-signhash-inner1 len + >len
1125	then
1126	drop len ;
1127
1128\ Initialise index for sending the list of anchor DN.
1129cc: begin-ta-name-list ( -- ) {
1130	CTX->cur_dn_index = 0;
1131}
1132
1133\ Switch to next DN in the list. Returned value is the DN length, or -1
1134\ if the end of the list was reached.
1135cc: begin-ta-name ( -- len ) {
1136	const br_x500_name *dn;
1137	if (CTX->cur_dn_index >= CTX->num_tas) {
1138		T0_PUSHi(-1);
1139	} else {
1140		if (CTX->ta_names == NULL) {
1141			dn = &CTX->tas[CTX->cur_dn_index].dn;
1142		} else {
1143			dn = &CTX->ta_names[CTX->cur_dn_index];
1144		}
1145		CTX->cur_dn_index ++;
1146		CTX->cur_dn = dn->data;
1147		CTX->cur_dn_len = dn->len;
1148		T0_PUSH(CTX->cur_dn_len);
1149	}
1150}
1151
1152\ Copy a chunk of the current DN into the pad. Returned value is the
1153\ chunk length; this is 0 when the end of the current DN is reached.
1154cc: copy-dn-chunk ( -- len ) {
1155	size_t clen;
1156
1157	clen = CTX->cur_dn_len;
1158	if (clen > sizeof ENG->pad) {
1159		clen = sizeof ENG->pad;
1160	}
1161	memcpy(ENG->pad, CTX->cur_dn, clen);
1162	CTX->cur_dn += clen;
1163	CTX->cur_dn_len -= clen;
1164	T0_PUSH(clen);
1165}
1166
1167\ Write a CertificateRequest message.
1168: write-CertificateRequest ( -- )
1169	\ The list of client authentication types includes:
1170	\    rsa_sign (1)
1171	\    ecdsa_sign (64)
1172	\    rsa_fixed_ecdh (65)
1173	\    ecdsa_fixed_ecdh (66)
1174	\ rsa_sign and ecdsa_sign require, respectively, RSA and ECDSA
1175	\ support. Static ECDH requires that the cipher suite is ECDH.
1176	\ When we ask for static ECDH, we always send both rsa_fixed_ecdh
1177	\ and ecdsa_fixed_ecdh because what matters there is what the
1178	\ X.509 engine may support, and we do not control that.
1179	\
1180	\ With TLS 1.2, we must also send a list of supported signature
1181	\ and hash algorithms. That list is supposed to qualify both
1182	\ the engine itself, and the X.509 validator, which are separate
1183	\ in BearSSL. There again, we use the engine capabilities in that
1184	\ list, and resort to a generic all-support list if only
1185	\ static ECDH is accepted.
1186	\
1187	\ (In practice, client implementations tend to have at most one
1188	\ or two certificates, and send the chain regardless of what
1189	\ algorithms are used in it.)
1190
1191	0 write-list-auth
1192	addr-version get16 0x0303 >= if
1193		2+ 0 write-list-signhash +
1194	then
1195	ta-names-total-length + 3 +
1196
1197	\ Message header
1198	13 write8 write24
1199
1200	\ List of authentication methods
1201	0 write-list-auth write8 1 write-list-auth drop
1202
1203	\ For TLS 1.2+, list of sign+hash
1204	addr-version get16 0x0303 >= if
1205		0 write-list-signhash write16 1 write-list-signhash drop
1206	then
1207
1208	\ Trust anchor names
1209	ta-names-total-length write16
1210	begin-ta-name-list
1211	begin
1212		begin-ta-name
1213		dup 0< if drop ret then write16
1214		begin copy-dn-chunk dup while
1215			addr-pad swap write-blob
1216		repeat
1217		drop
1218	again ;
1219
1220\ Write the Server Hello Done message.
1221: write-ServerHelloDone ( -- )
1222	14 write8 0 write24 ;
1223
1224\ Perform RSA decryption of the client-sent pre-master secret. The value
1225\ is in the pad, and its length is provided as parameter.
1226cc: do-rsa-decrypt ( len prf_id -- ) {
1227	int prf_id = T0_POPi();
1228	size_t len = T0_POP();
1229	do_rsa_decrypt(CTX, prf_id, ENG->pad, len);
1230}
1231
1232\ Perform ECDH (not ECDHE). The point from the client is in the pad, and
1233\ its length is provided as parameter.
1234cc: do-ecdh ( len prf_id -- ) {
1235	int prf_id = T0_POPi();
1236	size_t len = T0_POP();
1237	do_ecdh(CTX, prf_id, ENG->pad, len);
1238}
1239
1240\ Do the second part of ECDHE.
1241cc: do-ecdhe-part2 ( len prf_id -- ) {
1242	int prf_id = T0_POPi();
1243	size_t len = T0_POP();
1244	do_ecdhe_part2(CTX, prf_id, ENG->pad, len);
1245}
1246
1247\ Perform static ECDH. The point from the client is the public key
1248\ extracted from its certificate.
1249cc: do-static-ecdh ( prf_id -- ) {
1250	do_static_ecdh(CTX, T0_POP());
1251}
1252
1253\ Read a ClientKeyExchange header.
1254: read-ClientKeyExchange-header ( -- len )
1255	read-handshake-header 16 = ifnot ERR_UNEXPECTED fail then ;
1256
1257\ Read the Client Key Exchange contents (non-empty case).
1258: read-ClientKeyExchange-contents ( lim -- )
1259	\ What we should get depends on the cipher suite.
1260	addr-cipher_suite get16 use-rsa-keyx? if
1261		\ RSA key exchange: we expect a RSA-encrypted value.
1262		read16
1263		dup 512 > if ERR_LIMIT_EXCEEDED fail then
1264		dup { enc-rsa-len }
1265		addr-pad swap read-blob
1266		enc-rsa-len addr-cipher_suite get16 prf-id do-rsa-decrypt
1267	then
1268	addr-cipher_suite get16 dup use-ecdhe? swap use-ecdh? { ecdhe ecdh }
1269	ecdh ecdhe or if
1270		\ ECDH or ECDHE key exchange: we expect an EC point.
1271		read8 dup { ec-point-len }
1272		addr-pad swap read-blob
1273		ec-point-len addr-cipher_suite get16 prf-id
1274		ecdhe if do-ecdhe-part2 else do-ecdh then
1275	then
1276	close-elt ;
1277
1278\ Read the Client Key Exchange (normal case).
1279: read-ClientKeyExchange ( -- )
1280	read-ClientKeyExchange-header
1281	read-ClientKeyExchange-contents ;
1282
1283\ Obtain all possible hash values for handshake messages so far. This
1284\ is done because we need the hash value for the CertificateVerify
1285\ _before_ knowing which hash function will actually be used, as this
1286\ information is obtained from decoding the message header itself.
1287\ All hash values are stored in the pad (208 bytes in total).
1288cc: compute-hash-CV ( -- ) {
1289	int i;
1290
1291	for (i = 1; i <= 6; i ++) {
1292		br_multihash_out(&ENG->mhash, i,
1293			ENG->pad + HASH_PAD_OFF[i - 1]);
1294	}
1295}
1296
1297\ Copy the proper hash value from the pad into the dedicated buffer.
1298\ Returned value is true (-1) on success, false (0) on error (error
1299\ being an unimplemented hash function). The id has already been verified
1300\ to be either 0 (for MD5+SHA-1) or one of the SHA-* functions.
1301cc: copy-hash-CV ( hash_id -- bool ) {
1302	int id = T0_POP();
1303	size_t off, len;
1304
1305	if (id == 0) {
1306		off = 0;
1307		len = 36;
1308	} else {
1309		if (br_multihash_getimpl(&ENG->mhash, id) == 0) {
1310			T0_PUSH(0);
1311			T0_RET();
1312		}
1313		off = HASH_PAD_OFF[id - 1];
1314		len = HASH_PAD_OFF[id] - off;
1315	}
1316	memcpy(CTX->hash_CV, ENG->pad + off, len);
1317	CTX->hash_CV_len = len;
1318	CTX->hash_CV_id = id;
1319	T0_PUSHi(-1);
1320}
1321
1322\ Verify signature in CertificateVerify. Output is 0 on success, or a
1323\ non-zero error code.
1324cc: verify-CV-sig ( sig-len -- err ) {
1325	int err;
1326
1327	err = verify_CV_sig(CTX, T0_POP());
1328	T0_PUSHi(err);
1329}
1330
1331\ Process static ECDH.
1332: process-static-ECDH ( ktu -- )
1333	\ Static ECDH is allowed only if the cipher suite uses ECDH, and
1334	\ the client's public key has type EC and allows key exchange.
1335	\ BR_KEYTYPE_KEYX is 0x10, and BR_KEYTYPE_EC is 2.
1336	0x1F and 0x12 = ifnot ERR_WRONG_KEY_USAGE fail then
1337	addr-cipher_suite get16
1338	dup use-ecdh? ifnot ERR_UNEXPECTED fail then
1339	prf-id
1340	do-static-ecdh ;
1341
1342\ Read CertificateVerify header.
1343: read-CertificateVerify-header ( -- lim )
1344	compute-hash-CV
1345	read-handshake-header 15 = ifnot ERR_UNEXPECTED fail then ;
1346
1347\ Read CertificateVerify. The client key type + usage is expected on the
1348\ stack.
1349: read-CertificateVerify ( ktu -- )
1350	\ Check that the key allows for signatures.
1351	dup 0x20 and ifnot ERR_WRONG_KEY_USAGE fail then
1352	0x0F and { key-type }
1353
1354	\ Get header.
1355	read-CertificateVerify-header
1356
1357	\ With TLS 1.2+, there is an explicit hash + signature indication,
1358	\ which must be compatible with the key type.
1359	addr-version get16 0x0303 >= if
1360		\ Get hash function, then signature algorithm. The
1361		\ signature algorithm is 1 (RSA) or 3 (ECDSA) while our
1362		\ symbolic constants for key types are 1 (RSA) or 2 (EC).
1363		read16
1364		dup 0xFF and 1+ 1 >> key-type = ifnot
1365			ERR_BAD_SIGNATURE fail
1366		then
1367		8 >>
1368
1369		\ We support only SHA-1, SHA-224, SHA-256, SHA-384
1370		\ and SHA-512. We explicitly reject MD5.
1371		dup 2 < over 6 > or if ERR_INVALID_ALGORITHM fail then
1372	else
1373		\ With TLS 1.0 and 1.1, hash is MD5+SHA-1 (0) for RSA,
1374		\ SHA-1 (2) for ECDSA.
1375		key-type 0x01 = if 0 else 2 then
1376	then
1377	copy-hash-CV ifnot ERR_INVALID_ALGORITHM fail then
1378
1379	\ Read signature.
1380	read16 dup { sig-len }
1381	dup 512 > if ERR_LIMIT_EXCEEDED fail then
1382	addr-pad swap read-blob
1383	sig-len verify-CV-sig
1384	dup if fail then drop
1385
1386	close-elt ;
1387
1388\ Send a HelloRequest.
1389: send-HelloRequest ( -- )
1390	flush-record
1391	begin can-output? not while wait-co drop repeat
1392	22 addr-record_type_out set8
1393	0 write8 0 write24 flush-record
1394	23 addr-record_type_out set8 ;
1395
1396\ Make a handshake.
1397: do-handshake ( initial -- )
1398	0 addr-application_data set8
1399	22 addr-record_type_out set8
1400	0 addr-selected_protocol set16
1401	multihash-init
1402	read-ClientHello
1403	more-incoming-bytes? if ERR_UNEXPECTED fail then
1404	if
1405		\ Session resumption
1406		write-ServerHello
1407		0 write-CCS-Finished
1408		0 read-CCS-Finished
1409	else
1410		\ Not a session resumption
1411		write-ServerHello
1412		write-Certificate drop
1413		write-ServerKeyExchange
1414		ta-names-total-length if
1415			write-CertificateRequest
1416		then
1417		write-ServerHelloDone
1418		flush-record
1419
1420		\ If we sent a CertificateRequest then we expect a
1421		\ Certificate message.
1422		ta-names-total-length if
1423			\ Read client certificate.
1424			0 read-Certificate
1425
1426			choice
1427				dup 0< uf
1428					\ Client certificate validation failed.
1429					2 flag? ifnot neg fail then
1430					drop
1431					read-ClientKeyExchange
1432					read-CertificateVerify-header
1433					dup skip-blob drop
1434				enduf
1435				dup 0= uf
1436					\ Client sent no certificate at all.
1437					drop
1438					2 flag? ifnot
1439						ERR_NO_CLIENT_AUTH fail
1440					then
1441					read-ClientKeyExchange
1442				enduf
1443
1444				\ Client certificate was validated.
1445				read-ClientKeyExchange-header
1446				dup ifnot
1447					\ Empty ClientKeyExchange.
1448					drop
1449					process-static-ECDH
1450				else
1451					read-ClientKeyExchange-contents
1452					read-CertificateVerify
1453				then
1454			endchoice
1455		else
1456			\ No client certificate request, we just expect
1457			\ a non-empty ClientKeyExchange.
1458			read-ClientKeyExchange
1459		then
1460		0 read-CCS-Finished
1461		0 write-CCS-Finished
1462		save-session
1463	then
1464	1 addr-application_data set8
1465	23 addr-record_type_out set8 ;
1466
1467\ Entry point.
1468: main ( -- ! )
1469	\ Perform initial handshake.
1470	-1 do-handshake
1471
1472	begin
1473		\ Wait for further invocation. At that point, we should
1474		\ get either an explicit call for renegotiation, or
1475		\ an incoming ClientHello handshake message.
1476		wait-co
1477		dup 0x07 and case
1478			0x00 of
1479				0x10 and if
1480					\ The best we can do is ask for a
1481					\ renegotiation, then wait for it
1482					\ to happen.
1483					0 addr-application_data set8
1484					send-HelloRequest
1485				then
1486			endof
1487			0x01 of
1488				\ Reject renegotiations if the peer does not
1489				\ support secure renegotiation, or if the
1490				\ "no renegotiation" flag is set.
1491				drop
1492				addr-reneg get8 1 = 1 flag? or if
1493					skip-ClientHello
1494					flush-record
1495					begin can-output? not while
1496						wait-co drop
1497					repeat
1498					100 send-warning
1499					\ Put back connection in "application
1500					\ data" state: it's not dead yet.
1501					1 addr-application_data set8
1502					23 addr-record_type_out set8
1503				else
1504					0 do-handshake
1505				then
1506			endof
1507			ERR_UNEXPECTED fail
1508		endcase
1509	again
1510	;
1511