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 client.
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 client context, under that
31 * specific name. It must be noted that since the engine context is the
32 * first field of the br_ssl_client_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_client_context *)ENG)
38
39/*
40 * Generate the pre-master secret for RSA key exchange, and encrypt it
41 * with the server's public key. Returned value is either the encrypted
42 * data length (in bytes), or -x on error, with 'x' being an error code.
43 *
44 * This code assumes that the public key has been already verified (it
45 * was properly obtained by the X.509 engine, and it has the right type,
46 * i.e. it is of type RSA and suitable for encryption).
47 */
48static int
49make_pms_rsa(br_ssl_client_context *ctx, int prf_id)
50{
51	const br_x509_class **xc;
52	const br_x509_pkey *pk;
53	const unsigned char *n;
54	unsigned char *pms;
55	size_t nlen, u;
56
57	xc = ctx->eng.x509ctx;
58	pk = (*xc)->get_pkey(xc, NULL);
59
60	/*
61	 * Compute actual RSA key length, in case there are leading zeros.
62	 */
63	n = pk->key.rsa.n;
64	nlen = pk->key.rsa.nlen;
65	while (nlen > 0 && *n == 0) {
66		n ++;
67		nlen --;
68	}
69
70	/*
71	 * We need at least 59 bytes (48 bytes for pre-master secret, and
72	 * 11 bytes for the PKCS#1 type 2 padding). Note that the X.509
73	 * minimal engine normally blocks RSA keys shorter than 128 bytes,
74	 * so this is mostly for public keys provided explicitly by the
75	 * caller.
76	 */
77	if (nlen < 59) {
78		return -BR_ERR_X509_WEAK_PUBLIC_KEY;
79	}
80	if (nlen > sizeof ctx->eng.pad) {
81		return -BR_ERR_LIMIT_EXCEEDED;
82	}
83
84	/*
85	 * Make PMS.
86	 */
87	pms = ctx->eng.pad + nlen - 48;
88	br_enc16be(pms, ctx->eng.version_max);
89	br_hmac_drbg_generate(&ctx->eng.rng, pms + 2, 46);
90	br_ssl_engine_compute_master(&ctx->eng, prf_id, pms, 48);
91
92	/*
93	 * Apply PKCS#1 type 2 padding.
94	 */
95	ctx->eng.pad[0] = 0x00;
96	ctx->eng.pad[1] = 0x02;
97	ctx->eng.pad[nlen - 49] = 0x00;
98	br_hmac_drbg_generate(&ctx->eng.rng, ctx->eng.pad + 2, nlen - 51);
99	for (u = 2; u < nlen - 49; u ++) {
100		while (ctx->eng.pad[u] == 0) {
101			br_hmac_drbg_generate(&ctx->eng.rng,
102				&ctx->eng.pad[u], 1);
103		}
104	}
105
106	/*
107	 * Compute RSA encryption.
108	 */
109	if (!ctx->irsapub(ctx->eng.pad, nlen, &pk->key.rsa)) {
110		return -BR_ERR_LIMIT_EXCEEDED;
111	}
112	return (int)nlen;
113}
114
115/*
116 * OID for hash functions in RSA signatures.
117 */
118static const unsigned char *HASH_OID[] = {
119	BR_HASH_OID_SHA1,
120	BR_HASH_OID_SHA224,
121	BR_HASH_OID_SHA256,
122	BR_HASH_OID_SHA384,
123	BR_HASH_OID_SHA512
124};
125
126/*
127 * Check the RSA signature on the ServerKeyExchange message.
128 *
129 *   hash      hash function ID (2 to 6), or 0 for MD5+SHA-1 (with RSA only)
130 *   use_rsa   non-zero for RSA signature, zero for ECDSA
131 *   sig_len   signature length (in bytes); signature value is in the pad
132 *
133 * Returned value is 0 on success, or an error code.
134 */
135static int
136verify_SKE_sig(br_ssl_client_context *ctx,
137	int hash, int use_rsa, size_t sig_len)
138{
139	const br_x509_class **xc;
140	const br_x509_pkey *pk;
141	br_multihash_context mhc;
142	unsigned char hv[64], head[4];
143	size_t hv_len;
144
145	xc = ctx->eng.x509ctx;
146	pk = (*xc)->get_pkey(xc, NULL);
147	br_multihash_zero(&mhc);
148	br_multihash_copyimpl(&mhc, &ctx->eng.mhash);
149	br_multihash_init(&mhc);
150	br_multihash_update(&mhc,
151		ctx->eng.client_random, sizeof ctx->eng.client_random);
152	br_multihash_update(&mhc,
153		ctx->eng.server_random, sizeof ctx->eng.server_random);
154	head[0] = 3;
155	head[1] = 0;
156	head[2] = ctx->eng.ecdhe_curve;
157	head[3] = ctx->eng.ecdhe_point_len;
158	br_multihash_update(&mhc, head, sizeof head);
159	br_multihash_update(&mhc,
160		ctx->eng.ecdhe_point, ctx->eng.ecdhe_point_len);
161	if (hash) {
162		hv_len = br_multihash_out(&mhc, hash, hv);
163		if (hv_len == 0) {
164			return BR_ERR_INVALID_ALGORITHM;
165		}
166	} else {
167		if (!br_multihash_out(&mhc, br_md5_ID, hv)
168			|| !br_multihash_out(&mhc, br_sha1_ID, hv + 16))
169		{
170			return BR_ERR_INVALID_ALGORITHM;
171		}
172		hv_len = 36;
173	}
174	if (use_rsa) {
175		unsigned char tmp[64];
176		const unsigned char *hash_oid;
177
178		if (hash) {
179			hash_oid = HASH_OID[hash - 2];
180		} else {
181			hash_oid = NULL;
182		}
183		if (!ctx->eng.irsavrfy(ctx->eng.pad, sig_len,
184			hash_oid, hv_len, &pk->key.rsa, tmp)
185			|| memcmp(tmp, hv, hv_len) != 0)
186		{
187			return BR_ERR_BAD_SIGNATURE;
188		}
189	} else {
190		if (!ctx->eng.iecdsa(ctx->eng.iec, hv, hv_len, &pk->key.ec,
191			ctx->eng.pad, sig_len))
192		{
193			return BR_ERR_BAD_SIGNATURE;
194		}
195	}
196	return 0;
197}
198
199/*
200 * Perform client-side ECDH (or ECDHE). The point that should be sent to
201 * the server is written in the pad; returned value is either the point
202 * length (in bytes), or -x on error, with 'x' being an error code.
203 *
204 * The point _from_ the server is taken from ecdhe_point[] if 'ecdhe'
205 * is non-zero, or from the X.509 engine context if 'ecdhe' is zero
206 * (for static ECDH).
207 */
208static int
209make_pms_ecdh(br_ssl_client_context *ctx, unsigned ecdhe, int prf_id)
210{
211	int curve;
212	unsigned char key[66], point[133];
213	const unsigned char *order, *point_src;
214	size_t glen, olen, point_len, xoff, xlen;
215	unsigned char mask;
216
217	if (ecdhe) {
218		curve = ctx->eng.ecdhe_curve;
219		point_src = ctx->eng.ecdhe_point;
220		point_len = ctx->eng.ecdhe_point_len;
221	} else {
222		const br_x509_class **xc;
223		const br_x509_pkey *pk;
224
225		xc = ctx->eng.x509ctx;
226		pk = (*xc)->get_pkey(xc, NULL);
227		curve = pk->key.ec.curve;
228		point_src = pk->key.ec.q;
229		point_len = pk->key.ec.qlen;
230	}
231	if ((ctx->eng.iec->supported_curves & ((uint32_t)1 << curve)) == 0) {
232		return -BR_ERR_INVALID_ALGORITHM;
233	}
234
235	/*
236	 * We need to generate our key, as a non-zero random value which
237	 * is lower than the curve order, in a "large enough" range. We
238	 * force top bit to 0 and bottom bit to 1, which guarantees that
239	 * the value is in the proper range.
240	 */
241	order = ctx->eng.iec->order(curve, &olen);
242	mask = 0xFF;
243	while (mask >= order[0]) {
244		mask >>= 1;
245	}
246	br_hmac_drbg_generate(&ctx->eng.rng, key, olen);
247	key[0] &= mask;
248	key[olen - 1] |= 0x01;
249
250	/*
251	 * Compute the common ECDH point, whose X coordinate is the
252	 * pre-master secret.
253	 */
254	ctx->eng.iec->generator(curve, &glen);
255	if (glen != point_len) {
256		return -BR_ERR_INVALID_ALGORITHM;
257	}
258
259	memcpy(point, point_src, glen);
260	if (!ctx->eng.iec->mul(point, glen, key, olen, curve)) {
261		return -BR_ERR_INVALID_ALGORITHM;
262	}
263
264	/*
265	 * The pre-master secret is the X coordinate.
266	 */
267	xoff = ctx->eng.iec->xoff(curve, &xlen);
268	br_ssl_engine_compute_master(&ctx->eng, prf_id, point + xoff, xlen);
269
270	ctx->eng.iec->mulgen(point, key, olen, curve);
271	memcpy(ctx->eng.pad, point, glen);
272	return (int)glen;
273}
274
275/*
276 * Perform full static ECDH. This occurs only in the context of client
277 * authentication with certificates: the server uses an EC public key,
278 * the cipher suite is of type ECDH (not ECDHE), the server requested a
279 * client certificate and accepts static ECDH, the client has a
280 * certificate with an EC public key in the same curve, and accepts
281 * static ECDH as well.
282 *
283 * Returned value is 0 on success, -1 on error.
284 */
285static int
286make_pms_static_ecdh(br_ssl_client_context *ctx, int prf_id)
287{
288	unsigned char point[133];
289	size_t point_len;
290	const br_x509_class **xc;
291	const br_x509_pkey *pk;
292
293	xc = ctx->eng.x509ctx;
294	pk = (*xc)->get_pkey(xc, NULL);
295	point_len = pk->key.ec.qlen;
296	if (point_len > sizeof point) {
297		return -1;
298	}
299	memcpy(point, pk->key.ec.q, point_len);
300	if (!(*ctx->client_auth_vtable)->do_keyx(
301		ctx->client_auth_vtable, point, &point_len))
302	{
303		return -1;
304	}
305	br_ssl_engine_compute_master(&ctx->eng,
306		prf_id, point, point_len);
307	return 0;
308}
309
310/*
311 * Compute the client-side signature. This is invoked only when a
312 * signature-based client authentication was selected. The computed
313 * signature is in the pad; its length (in bytes) is returned. On
314 * error, 0 is returned.
315 */
316static size_t
317make_client_sign(br_ssl_client_context *ctx)
318{
319	size_t hv_len;
320
321	/*
322	 * Compute hash of handshake messages so far. This "cannot" fail
323	 * because the list of supported hash functions provided to the
324	 * client certificate handler was trimmed to include only the
325	 * hash functions that the multi-hasher supports.
326	 */
327	if (ctx->hash_id) {
328		hv_len = br_multihash_out(&ctx->eng.mhash,
329			ctx->hash_id, ctx->eng.pad);
330	} else {
331		br_multihash_out(&ctx->eng.mhash,
332			br_md5_ID, ctx->eng.pad);
333		br_multihash_out(&ctx->eng.mhash,
334			br_sha1_ID, ctx->eng.pad + 16);
335		hv_len = 36;
336	}
337	return (*ctx->client_auth_vtable)->do_sign(
338		ctx->client_auth_vtable, ctx->hash_id, hv_len,
339		ctx->eng.pad, sizeof ctx->eng.pad);
340}
341
342}
343
344\ =======================================================================
345
346: addr-ctx:
347	next-word { field }
348	"addr-" field + 0 1 define-word
349	0 8191 "offsetof(br_ssl_client_context, " field + ")" + make-CX
350	postpone literal postpone ; ;
351
352addr-ctx: min_clienthello_len
353addr-ctx: hashes
354addr-ctx: auth_type
355addr-ctx: hash_id
356
357\ Length of the Secure Renegotiation extension. This is 5 for the
358\ first handshake, 17 for a renegotiation (if the server supports the
359\ extension), or 0 if we know that the server does not support the
360\ extension.
361: ext-reneg-length ( -- n )
362	addr-reneg get8 dup if 1 - 17 * else drop 5 then ;
363
364\ Length of SNI extension.
365: ext-sni-length ( -- len )
366	addr-server_name strlen dup if 9 + then ;
367
368\ Length of Maximum Fragment Length extension.
369: ext-frag-length ( -- len )
370	addr-log_max_frag_len get8 14 = if 0 else 5 then ;
371
372\ Length of Signatures extension.
373: ext-signatures-length ( -- len )
374	supported-hash-functions { num } drop 0
375	supports-rsa-sign? if num + then
376	supports-ecdsa? if num + then
377	dup if 1 << 6 + then ;
378
379\ Write supported hash functions ( sign -- )
380: write-hashes
381	{ sign }
382	supported-hash-functions drop
383	\ We advertise hash functions in the following preference order:
384	\   SHA-256 SHA-224 SHA-384 SHA-512 SHA-1
385	\ Rationale:
386	\ -- SHA-256 and SHA-224 are more efficient on 32-bit architectures
387	\ -- SHA-1 is less than ideally collision-resistant
388	dup 0x10 and if 4 write8 sign write8 then
389	dup 0x08 and if 3 write8 sign write8 then
390	dup 0x20 and if 5 write8 sign write8 then
391	dup 0x40 and if 6 write8 sign write8 then
392	0x04 and if 2 write8 sign write8 then ;
393
394\ Length of Supported Curves extension.
395: ext-supported-curves-length ( -- len )
396	supported-curves dup if
397		0 { x }
398		begin dup while
399			dup 1 and x + >x
400			1 >>
401		repeat
402		drop x 1 << 6 +
403	then ;
404
405\ Length of Supported Point Formats extension.
406: ext-point-format-length ( -- len )
407	supported-curves if 6 else 0 then ;
408
409\ Length of ALPN extension.
410cc: ext-ALPN-length ( -- len ) {
411	size_t u, len;
412
413	if (ENG->protocol_names_num == 0) {
414		T0_PUSH(0);
415		T0_RET();
416	}
417	len = 6;
418	for (u = 0; u < ENG->protocol_names_num; u ++) {
419		len += 1 + strlen(ENG->protocol_names[u]);
420	}
421	T0_PUSH(len);
422}
423
424\ Write handshake message: ClientHello
425: write-ClientHello ( -- )
426	{ ; total-ext-length }
427
428	\ Compute length for extensions (without the general two-byte header).
429	\ This does not take padding extension into account.
430	ext-reneg-length ext-sni-length + ext-frag-length +
431	ext-signatures-length +
432	ext-supported-curves-length + ext-point-format-length +
433	ext-ALPN-length +
434	>total-ext-length
435
436	\ ClientHello type
437	1 write8
438
439	\ Compute and write length
440	39 addr-session_id_len get8 + addr-suites_num get8 1 << +
441	total-ext-length if 2+ total-ext-length + then
442	\ Compute padding (if requested).
443	addr-min_clienthello_len get16 over - dup 0> if
444		\ We well add a Pad ClientHello extension, which has its
445		\ own header (4 bytes) and might be the only extension
446		\ (2 extra bytes for the extension list header).
447		total-ext-length ifnot swap 2+ swap 2- then
448		\ Account for the extension header.
449		4 - dup 0< if drop 0 then
450		\ Adjust total extension length.
451		dup 4 + total-ext-length + >total-ext-length
452		\ Adjust ClientHello length.
453		swap 4 + over + swap
454	else
455		drop
456		-1
457	then
458	{ ext-padding-amount }
459	write24
460
461	\ Protocol version
462	addr-version_max get16 write16
463
464	\ Client random
465	addr-client_random 4 bzero
466	addr-client_random 4 + 28 mkrand
467	addr-client_random 32 write-blob
468
469	\ Session ID
470	addr-session_id addr-session_id_len get8 write-blob-head8
471
472	\ Supported cipher suites. We also check here that we indeed
473	\ support all these suites.
474	addr-suites_num get8 dup 1 << write16
475	addr-suites_buf swap
476	begin
477		dup while 1-
478		over get16
479		dup suite-supported? ifnot ERR_BAD_CIPHER_SUITE fail then
480		write16
481		swap 2+ swap
482	repeat
483	2drop
484
485	\ Compression methods (only "null" compression)
486	1 write8 0 write8
487
488	\ Extensions
489	total-ext-length if
490		total-ext-length write16
491		ext-reneg-length if
492			0xFF01 write16          \ extension type (0xFF01)
493			addr-saved_finished
494			ext-reneg-length 4 - dup write16 \ extension length
495			1- write-blob-head8              \ verify data
496		then
497		ext-sni-length if
498			0x0000 write16          \ extension type (0)
499			addr-server_name
500			ext-sni-length 4 - dup write16 \ extension length
501			2 - dup write16                \ ServerNameList length
502			0 write8                       \ name type: host_name
503			3 - write-blob-head16          \ the name itself
504		then
505		ext-frag-length if
506			0x0001 write16          \ extension type (1)
507			0x0001 write16          \ extension length
508			addr-log_max_frag_len get8 8 - write8
509		then
510		ext-signatures-length if
511			0x000D write16          \ extension type (13)
512			ext-signatures-length 4 - dup write16 \ extension length
513			2 - write16             \ list length
514			supports-ecdsa? if 3 write-hashes then
515			supports-rsa-sign? if 1 write-hashes then
516		then
517		\ TODO: add an API to specify preference order for curves.
518		\ Right now we send Curve25519 first, then other curves in
519		\ increasing ID values (hence P-256 in second).
520		ext-supported-curves-length dup if
521			0x000A write16          \ extension type (10)
522			4 - dup write16         \ extension length
523			2- write16              \ list length
524			supported-curves 0
525			dup 0x20000000 and if
526				0xDFFFFFFF and 29 write16
527			then
528			begin dup 32 < while
529				dup2 >> 1 and if dup write16 then
530				1+
531			repeat
532			2drop
533		else
534			drop
535		then
536		ext-point-format-length if
537			0x000B write16          \ extension type (11)
538			0x0002 write16          \ extension length
539			0x0100 write16          \ value: 1 format: uncompressed
540		then
541		ext-ALPN-length dup if
542			0x0010 write16          \ extension type (16)
543			4 - dup write16         \ extension length
544			2- write16              \ list length
545			addr-protocol_names_num get16 0
546			begin
547				dup2 > while
548				dup copy-protocol-name
549				dup write8 addr-pad swap write-blob
550				1+
551			repeat
552			2drop
553		else
554			drop
555		then
556		ext-padding-amount 0< ifnot
557			0x0015 write16          \ extension value (21)
558			ext-padding-amount
559			dup write16             \ extension length
560			begin dup while
561			1- 0 write8 repeat      \ value (only zeros)
562			drop
563		then
564	then
565	;
566
567\ =======================================================================
568
569\ Parse server SNI extension. If present, then it should be empty.
570: read-server-sni ( lim -- lim )
571	read16 if ERR_BAD_SNI fail then ;
572
573\ Parse server Max Fragment Length extension. If present, then it should
574\ advertise the same length as the client. Note that whether the server
575\ sends it or not changes nothing for us: we won't send any record larger
576\ than the advertised value anyway, and we will accept incoming records
577\ up to our input buffer length.
578: read-server-frag ( lim -- lim )
579	read16 1 = ifnot ERR_BAD_FRAGLEN fail then
580	read8 8 + addr-log_max_frag_len get8 = ifnot ERR_BAD_FRAGLEN fail then ;
581
582\ Parse server Secure Renegotiation extension. This is called only if
583\ the client sent that extension, so we only have two cases to
584\ distinguish: first handshake, and renegotiation; in the latter case,
585\ we know that the server supports the extension, otherwise the client
586\ would not have sent it.
587: read-server-reneg ( lim -- lim )
588	read16
589	addr-reneg get8 ifnot
590		\ "reneg" is 0, so this is a first handshake. The server's
591		\ extension MUST be empty. We also learn that the server
592		\ supports the extension.
593		1 = ifnot ERR_BAD_SECRENEG fail then
594		read8 0 = ifnot ERR_BAD_SECRENEG fail then
595		2 addr-reneg set8
596	else
597		\ "reneg" is non-zero, and we sent an extension, so it must
598		\ be 2 and this is a renegotiation. We must verify that
599		\ the extension contents have length exactly 24 bytes and
600		\ match the saved client and server "Finished".
601		25 = ifnot ERR_BAD_SECRENEG fail then
602		read8 24 = ifnot ERR_BAD_SECRENEG fail then
603		addr-pad 24 read-blob
604		addr-saved_finished addr-pad 24 memcmp ifnot
605			ERR_BAD_SECRENEG fail
606		then
607	then ;
608
609\ Read the ALPN extension from the server. It must contain a single name,
610\ and that name must match one of our names.
611: read-ALPN-from-server ( lim -- lim )
612	\ Extension contents length.
613	read16 open-elt
614	\ Length of list of names.
615	read16 open-elt
616	\ There should be a single name.
617	read8 addr-pad swap dup { len } read-blob
618	close-elt
619	close-elt
620	len test-protocol-name dup 0< if
621		3 flag? if ERR_UNEXPECTED fail then
622		drop
623	else
624		1+ addr-selected_protocol set16
625	then ;
626
627\ Save a value in a 16-bit field, or check it in case of session resumption.
628: check-resume ( val addr resume -- )
629	if get16 = ifnot ERR_RESUME_MISMATCH fail then else set16 then ;
630
631cc: DEBUG-BLOB ( addr len -- ) {
632	extern int printf(const char *fmt, ...);
633
634	size_t len = T0_POP();
635	unsigned char *buf = (unsigned char *)CTX + T0_POP();
636	size_t u;
637
638	printf("BLOB:");
639	for (u = 0; u < len; u ++) {
640		if (u % 16 == 0) {
641			printf("\n    ");
642		}
643		printf(" %02x", buf[u]);
644	}
645	printf("\n");
646}
647
648\ Parse incoming ServerHello. Returned value is true (-1) on session
649\ resumption.
650: read-ServerHello ( -- bool )
651	\ Get header, and check message type.
652	read-handshake-header 2 = ifnot ERR_UNEXPECTED fail then
653
654	\ Get protocol version.
655	read16 { version }
656	version addr-version_min get16 < version addr-version_max get16 > or if
657		ERR_UNSUPPORTED_VERSION fail
658	then
659
660	\ Enforce chosen version for subsequent records in both directions.
661	version addr-version_in get16 <> if ERR_BAD_VERSION fail then
662	version addr-version_out set16
663
664	\ Server random.
665	addr-server_random 32 read-blob
666
667	\ The "session resumption" flag.
668	0 { resume }
669
670	\ Session ID.
671	read8 { idlen }
672	idlen 32 > if ERR_OVERSIZED_ID fail then
673	addr-pad idlen read-blob
674	idlen addr-session_id_len get8 = idlen 0 > and if
675		addr-session_id addr-pad idlen memcmp if
676			\ Server session ID is non-empty and matches what
677			\ we sent, so this is a session resumption.
678			-1 >resume
679		then
680	then
681	addr-session_id addr-pad idlen memcpy
682	idlen addr-session_id_len set8
683
684	\ Record version.
685	version addr-version resume check-resume
686
687	\ Cipher suite. We check that it is part of the list of cipher
688	\ suites that we advertised.
689	read16
690	dup scan-suite 0< if ERR_BAD_CIPHER_SUITE fail then
691	\ Also check that the cipher suite is compatible with the
692	\ announced version: suites that don't use HMAC/SHA-1 are
693	\ for TLS-1.2 only, not older versions.
694	dup use-tls12? version 0x0303 < and if ERR_BAD_CIPHER_SUITE fail then
695	addr-cipher_suite resume check-resume
696
697	\ Compression method. Should be 0 (no compression).
698	read8 if ERR_BAD_COMPRESSION fail then
699
700	\ Parse extensions (if any). If there is no extension, then the
701	\ read limit (on the TOS) should be 0 at that point.
702	dup if
703		\ Length of extension list.
704		\ message size.
705		read16 open-elt
706
707		\ Enumerate extensions. For each of them, check that we
708		\ sent an extension of that type, and did not see it
709		\ yet; and then process it.
710		ext-sni-length { ok-sni }
711		ext-reneg-length { ok-reneg }
712		ext-frag-length { ok-frag }
713		ext-signatures-length { ok-signatures }
714		ext-supported-curves-length { ok-curves }
715		ext-point-format-length { ok-points }
716		ext-ALPN-length { ok-ALPN }
717		begin dup while
718			read16
719			case
720				\ Server Name Indication. The server may
721				\ send such an extension if it uses the SNI
722				\ from the client, but that "response
723				\ extension" is supposed to be empty.
724				0x0000 of
725					ok-sni ifnot
726						ERR_EXTRA_EXTENSION fail
727					then
728					0 >ok-sni
729					read-server-sni
730				endof
731
732				\ Max Frag Length. The contents shall be
733				\ a single byte whose value matches the one
734				\ sent by the client.
735				0x0001 of
736					ok-frag ifnot
737						ERR_EXTRA_EXTENSION fail
738					then
739					0 >ok-frag
740					read-server-frag
741				endof
742
743				\ Secure Renegotiation.
744				0xFF01 of
745					ok-reneg ifnot
746						ERR_EXTRA_EXTENSION fail
747					then
748					0 >ok-reneg
749					read-server-reneg
750				endof
751
752				\ Signature Algorithms.
753				\ Normally, the server should never send this
754				\ extension (so says RFC 5246 #7.4.1.4.1),
755				\ but some existing servers do.
756				0x000D of
757					ok-signatures ifnot
758						ERR_EXTRA_EXTENSION fail
759					then
760					0 >ok-signatures
761					read-ignore-16
762				endof
763
764				\ Supported Curves.
765				0x000A of
766					ok-curves ifnot
767						ERR_EXTRA_EXTENSION fail
768					then
769					0 >ok-curves
770					read-ignore-16
771				endof
772
773				\ Supported Point Formats.
774				0x000B of
775					ok-points ifnot
776						ERR_EXTRA_EXTENSION fail
777					then
778					0 >ok-points
779					read-ignore-16
780				endof
781
782				\ ALPN.
783				0x0010 of
784					ok-ALPN ifnot
785						ERR_EXTRA_EXTENSION fail
786					then
787					0 >ok-ALPN
788					read-ALPN-from-server
789				endof
790
791				ERR_EXTRA_EXTENSION fail
792			endcase
793		repeat
794
795		\ If we sent a secure renegotiation extension but did not
796		\ receive a response, then the server does not support
797		\ secure renegotiation. This is a hard failure if this
798		\ is a renegotiation.
799		ok-reneg if
800			ok-reneg 5 > if ERR_BAD_SECRENEG fail then
801			1 addr-reneg set8
802		then
803		close-elt
804	else
805		\ No extension received at all, so the server does not
806		\ support secure renegotiation. This is a hard failure
807		\ if the server was previously known to support it (i.e.
808		\ this is a renegotiation).
809		ext-reneg-length 5 > if ERR_BAD_SECRENEG fail then
810		1 addr-reneg set8
811	then
812	close-elt
813	resume
814	;
815
816cc: set-server-curve ( -- ) {
817	const br_x509_class *xc;
818	const br_x509_pkey *pk;
819
820	xc = *(ENG->x509ctx);
821	pk = xc->get_pkey(ENG->x509ctx, NULL);
822	CTX->server_curve =
823		(pk->key_type == BR_KEYTYPE_EC) ? pk->key.ec.curve : 0;
824}
825
826\ Read Certificate message from server.
827: read-Certificate-from-server ( -- )
828	addr-cipher_suite get16 expected-key-type
829	-1 read-Certificate
830	dup 0< if neg fail then
831	dup ifnot ERR_UNEXPECTED fail then
832	over and <> if ERR_WRONG_KEY_USAGE fail then
833
834	\ Set server curve (used for static ECDH).
835	set-server-curve ;
836
837\ Verify signature on ECDHE point sent by the server.
838\   'hash' is the hash function to use (1 to 6, or 0 for RSA with MD5+SHA-1)
839\   'use-rsa' is 0 for ECDSA, -1 for for RSA
840\   'sig-len' is the signature length (in bytes)
841\ The signature itself is in the pad.
842cc: verify-SKE-sig ( hash use-rsa sig-len -- err ) {
843	size_t sig_len = T0_POP();
844	int use_rsa = T0_POPi();
845	int hash = T0_POPi();
846
847	T0_PUSH(verify_SKE_sig(CTX, hash, use_rsa, sig_len));
848}
849
850\ Parse ServerKeyExchange
851: read-ServerKeyExchange ( -- )
852	\ Get header, and check message type.
853	read-handshake-header 12 = ifnot ERR_UNEXPECTED fail then
854
855	\ We expect a named curve, and we must support it.
856	read8 3 = ifnot ERR_INVALID_ALGORITHM fail then
857	read16 dup addr-ecdhe_curve set8
858	dup 32 >= if ERR_INVALID_ALGORITHM fail then
859	supported-curves swap >> 1 and ifnot ERR_INVALID_ALGORITHM fail then
860
861	\ Read the server point.
862	read8
863	dup 133 > if ERR_INVALID_ALGORITHM fail then
864	dup addr-ecdhe_point_len set8
865	addr-ecdhe_point swap read-blob
866
867	\ If using TLS-1.2+, then the hash function and signature algorithm
868	\ are explicitly provided; the signature algorithm must match what
869	\ the cipher suite specifies. With TLS-1.0 and 1.1, the signature
870	\ algorithm is inferred from the cipher suite, and the hash is
871	\ either MD5+SHA-1 (for RSA signatures) or SHA-1 (for ECDSA).
872	addr-version get16 0x0303 >= { tls1.2+ }
873	addr-cipher_suite get16 use-rsa-ecdhe? { use-rsa }
874	2 { hash }
875	tls1.2+ if
876		\ Read hash function; accept only the SHA-* identifiers
877		\ (from SHA-1 to SHA-512, no MD5 here).
878		read8
879		dup dup 2 < swap 6 > or if ERR_INVALID_ALGORITHM fail then
880		>hash
881		read8
882		\ Get expected signature algorithm and compare with what
883		\ the server just sent. Expected value is 1 for RSA, 3
884		\ for ECDSA. Note that 'use-rsa' evaluates to -1 for RSA,
885		\ 0 for ECDSA.
886		use-rsa 1 << 3 + = ifnot ERR_INVALID_ALGORITHM fail then
887	else
888		\ For MD5+SHA-1, we set 'hash' to 0.
889		use-rsa if 0 >hash then
890	then
891
892	\ Read signature into the pad.
893	read16 dup { sig-len }
894
895	dup 512 > if ERR_LIMIT_EXCEEDED fail then
896	addr-pad swap read-blob
897
898	\ Verify signature.
899	hash use-rsa sig-len verify-SKE-sig
900	dup if fail then drop
901
902	close-elt ;
903
904\ Client certificate: start processing of anchor names.
905cc: anchor-dn-start-name-list ( -- ) {
906	if (CTX->client_auth_vtable != NULL) {
907		(*CTX->client_auth_vtable)->start_name_list(
908			CTX->client_auth_vtable);
909	}
910}
911
912\ Client certificate: start a new anchor DN (length is 16-bit).
913cc: anchor-dn-start-name ( length -- ) {
914	size_t len;
915
916	len = T0_POP();
917	if (CTX->client_auth_vtable != NULL) {
918		(*CTX->client_auth_vtable)->start_name(
919			CTX->client_auth_vtable, len);
920	}
921}
922
923\ Client certificate: push some data for current anchor DN.
924cc: anchor-dn-append-name ( length -- ) {
925	size_t len;
926
927	len = T0_POP();
928	if (CTX->client_auth_vtable != NULL) {
929		(*CTX->client_auth_vtable)->append_name(
930			CTX->client_auth_vtable, ENG->pad, len);
931	}
932}
933
934\ Client certificate: end current anchor DN.
935cc: anchor-dn-end-name ( -- ) {
936	if (CTX->client_auth_vtable != NULL) {
937		(*CTX->client_auth_vtable)->end_name(
938			CTX->client_auth_vtable);
939	}
940}
941
942\ Client certificate: end list of anchor DN.
943cc: anchor-dn-end-name-list ( -- ) {
944	if (CTX->client_auth_vtable != NULL) {
945		(*CTX->client_auth_vtable)->end_name_list(
946			CTX->client_auth_vtable);
947	}
948}
949
950\ Client certificate: obtain the client certificate chain.
951cc: get-client-chain ( auth_types -- ) {
952	uint32_t auth_types;
953
954	auth_types = T0_POP();
955	if (CTX->client_auth_vtable != NULL) {
956		br_ssl_client_certificate ux;
957
958		(*CTX->client_auth_vtable)->choose(CTX->client_auth_vtable,
959			CTX, auth_types, &ux);
960		CTX->auth_type = (unsigned char)ux.auth_type;
961		CTX->hash_id = (unsigned char)ux.hash_id;
962		ENG->chain = ux.chain;
963		ENG->chain_len = ux.chain_len;
964	} else {
965		CTX->hash_id = 0;
966		ENG->chain_len = 0;
967	}
968}
969
970\ Parse CertificateRequest. Header has already been read.
971: read-contents-CertificateRequest ( lim -- )
972	\ Read supported client authentication types. We keep only
973	\ RSA, ECDSA, and ECDH.
974	0 { auth_types }
975	read8 open-elt
976	begin dup while
977		read8 case
978			1  of 0x0000FF endof
979			64 of 0x00FF00 endof
980			65 of 0x010000 endof
981			66 of 0x020000 endof
982			0 swap
983		endcase
984		auth_types or >auth_types
985	repeat
986	close-elt
987
988	\ Full static ECDH is allowed only if the cipher suite is ECDH
989	\ (not ECDHE). It would be theoretically feasible to use static
990	\ ECDH on the client side with an ephemeral key pair from the
991	\ server, but RFC 4492 (section 3) forbids it because ECDHE suites
992	\ are supposed to provide forward secrecy, and static ECDH would
993	\ negate that property.
994	addr-cipher_suite get16 use-ecdh? ifnot
995		auth_types 0xFFFF and >auth_types
996	then
997
998	\ Note: if the cipher suite is ECDH, then the X.509 validation
999	\ engine was invoked with the BR_KEYTYPE_EC | BR_KEYTYPE_KEYX
1000	\ combination, so the server's public key has already been
1001	\ checked to be fit for a key exchange.
1002
1003	\ With TLS 1.2:
1004	\  - rsa_fixed_ecdh and ecdsa_fixed_ecdh are synoymous.
1005	\  - There is an explicit list of supported sign+hash.
1006	\ With TLS 1.0,
1007	addr-version get16 0x0303 >= if
1008		\ With TLS 1.2:
1009		\  - There is an explicit list of supported sign+hash.
1010		\  - The ECDH flags must be adjusted for RSA/ECDSA
1011		\    support.
1012		read-list-sign-algos dup addr-hashes set32
1013
1014		\ Trim down the list depending on what hash functions
1015		\ we support (since the hashing itself is done by the SSL
1016		\ engine, not by the certificate handler).
1017		supported-hash-functions drop dup 8 << or 0x030000 or and
1018
1019		auth_types and
1020		auth_types 0x030000 and if
1021			dup 0x0000FF and if 0x010000 or then
1022			dup 0x00FF00 and if 0x020000 or then
1023		then
1024		>auth_types
1025	else
1026		\ TLS 1.0 or 1.1. The hash function is fixed for signatures
1027		\ (MD5+SHA-1 for RSA, SHA-1 for ECDSA).
1028		auth_types 0x030401 and >auth_types
1029	then
1030
1031	\ Parse list of anchor DN.
1032	anchor-dn-start-name-list
1033	read16 open-elt
1034	begin dup while
1035		read16 open-elt
1036		dup anchor-dn-start-name
1037
1038		\ We read the DN by chunks through the pad, so
1039		\ as to use the existing reading function (read-blob)
1040		\ that also ensures proper hashing.
1041		begin
1042			dup while
1043			dup 256 > if 256 else dup then { len }
1044			addr-pad len read-blob
1045			len anchor-dn-append-name
1046		repeat
1047		close-elt
1048		anchor-dn-end-name
1049	repeat
1050	close-elt
1051	anchor-dn-end-name-list
1052
1053	\ We should have reached the message end.
1054	close-elt
1055
1056	\ Obtain the client chain.
1057	auth_types get-client-chain
1058	;
1059
1060\ (obsolete)
1061\ Write an empty Certificate message.
1062\ : write-empty-Certificate ( -- )
1063\ 	11 write8 3 write24 0 write24 ;
1064
1065cc: do-rsa-encrypt ( prf_id -- nlen ) {
1066	int x;
1067
1068	x = make_pms_rsa(CTX, T0_POP());
1069	if (x < 0) {
1070		br_ssl_engine_fail(ENG, -x);
1071		T0_CO();
1072	} else {
1073		T0_PUSH(x);
1074	}
1075}
1076
1077cc: do-ecdh ( echde prf_id -- ulen ) {
1078	unsigned prf_id = T0_POP();
1079	unsigned ecdhe = T0_POP();
1080	int x;
1081
1082	x = make_pms_ecdh(CTX, ecdhe, prf_id);
1083	if (x < 0) {
1084		br_ssl_engine_fail(ENG, -x);
1085		T0_CO();
1086	} else {
1087		T0_PUSH(x);
1088	}
1089}
1090
1091cc: do-static-ecdh ( prf-id -- ) {
1092	unsigned prf_id = T0_POP();
1093
1094	if (make_pms_static_ecdh(CTX, prf_id) < 0) {
1095		br_ssl_engine_fail(ENG, BR_ERR_INVALID_ALGORITHM);
1096		T0_CO();
1097	}
1098}
1099
1100cc: do-client-sign ( -- sig_len ) {
1101	size_t sig_len;
1102
1103	sig_len = make_client_sign(CTX);
1104	if (sig_len == 0) {
1105		br_ssl_engine_fail(ENG, BR_ERR_INVALID_ALGORITHM);
1106		T0_CO();
1107	}
1108	T0_PUSH(sig_len);
1109}
1110
1111\ Write ClientKeyExchange.
1112: write-ClientKeyExchange ( -- )
1113	16 write8
1114	addr-cipher_suite get16
1115	dup use-rsa-keyx? if
1116		prf-id do-rsa-encrypt
1117		dup 2+ write24
1118		dup write16
1119		addr-pad swap write-blob
1120	else
1121		dup use-ecdhe? swap prf-id do-ecdh
1122		dup 1+ write24
1123		dup write8
1124		addr-pad swap write-blob
1125	then ;
1126
1127\ Write CertificateVerify. This is invoked only if a client certificate
1128\ was requested and sent, and the authentication is not full static ECDH.
1129: write-CertificateVerify ( -- )
1130	do-client-sign
1131	15 write8 dup
1132	addr-version get16 0x0303 >= if
1133		4 + write24
1134		addr-hash_id get8 write8
1135		addr-auth_type get8 write8
1136	else
1137		2+ write24
1138	then
1139	dup write16 addr-pad swap write-blob ;
1140
1141\ =======================================================================
1142
1143\ Perform a handshake.
1144: do-handshake ( -- )
1145	0 addr-application_data set8
1146	22 addr-record_type_out set8
1147	0 addr-selected_protocol set16
1148	multihash-init
1149
1150	write-ClientHello
1151	flush-record
1152	read-ServerHello
1153
1154	if
1155		\ Session resumption.
1156		-1 read-CCS-Finished
1157		-1 write-CCS-Finished
1158
1159	else
1160
1161		\ Not a session resumption.
1162
1163		\ Read certificate; then check key type and usages against
1164		\ cipher suite.
1165		read-Certificate-from-server
1166
1167		\ Depending on cipher suite, we may now expect a
1168		\ ServerKeyExchange.
1169		addr-cipher_suite get16 expected-key-type
1170		CX 0 63 { BR_KEYTYPE_SIGN } and if
1171			read-ServerKeyExchange
1172		then
1173
1174		\ Get next header.
1175		read-handshake-header
1176
1177		\ If this is a CertificateRequest, parse it, then read
1178		\ next header.
1179		dup 13 = if
1180			drop read-contents-CertificateRequest
1181			read-handshake-header
1182			-1
1183		else
1184			0
1185		then
1186		{ seen-CR }
1187
1188		\ At that point, we should have a ServerHelloDone,
1189		\ whose length must be 0.
1190		14 = ifnot ERR_UNEXPECTED fail then
1191		if ERR_BAD_HELLO_DONE fail then
1192
1193		\ There should not be more bytes in the record at that point.
1194		more-incoming-bytes? if ERR_UNEXPECTED fail then
1195
1196		seen-CR if
1197			\ If the server requested a client certificate, then
1198			\ we must write a Certificate message (it may be
1199			\ empty).
1200			write-Certificate
1201
1202			\ If using static ECDH, then the ClientKeyExchange
1203			\ is empty, and there is no CertificateVerify.
1204			\ Otherwise, there is a ClientKeyExchange; there
1205			\ will then be a CertificateVerify if a client chain
1206			\ was indeed sent.
1207			addr-hash_id get8 0xFF = if
1208				drop
1209				16 write8 0 write24
1210				addr-cipher_suite get16 prf-id do-static-ecdh
1211			else
1212				write-ClientKeyExchange
1213				if write-CertificateVerify then
1214			then
1215		else
1216			write-ClientKeyExchange
1217		then
1218
1219		-1 write-CCS-Finished
1220		-1 read-CCS-Finished
1221	then
1222
1223	\ Now we should be invoked only in case of renegotiation.
1224	1 addr-application_data set8
1225	23 addr-record_type_out set8 ;
1226
1227\ Read a HelloRequest message.
1228: read-HelloRequest ( -- )
1229	\ A HelloRequest has length 0 and type 0.
1230	read-handshake-header-core
1231	if ERR_UNEXPECTED fail then
1232	if ERR_BAD_HANDSHAKE fail then ;
1233
1234\ Entry point.
1235: main ( -- ! )
1236	\ Perform initial handshake.
1237	do-handshake
1238
1239	begin
1240		\ Wait for further invocation. At that point, we should
1241		\ get either an explicit call for renegotiation, or
1242		\ an incoming HelloRequest handshake message.
1243		wait-co
1244		dup 0x07 and case
1245			0x00 of
1246				0x10 and if
1247					do-handshake
1248				then
1249			endof
1250			0x01 of
1251				drop
1252				0 addr-application_data set8
1253				read-HelloRequest
1254				\ Reject renegotiations if the peer does not
1255				\ support secure renegotiation, or if the
1256				\ "no renegotiation" flag is set.
1257				addr-reneg get8 1 = 1 flag? or if
1258					flush-record
1259					begin can-output? not while
1260						wait-co drop
1261					repeat
1262					100 send-warning
1263					\ We rejected the renegotiation,
1264					\ but the connection is not dead.
1265					\ We must set back things into
1266					\ working "application data" state.
1267					1 addr-application_data set8
1268					23 addr-record_type_out set8
1269				else
1270					do-handshake
1271				then
1272			endof
1273			ERR_UNEXPECTED fail
1274		endcase
1275	again
1276	;
1277