Mercurial > hg > nginx-tests
comparison lib/Test/Nginx/HTTP3.pm @ 1874:d57a0fd293a3
Tests: basic QUIC support.
- handshake using X25519 TLS secrets
- TLS PSK, session tickets, session resumption, early data, retry support
- packet numbers and packet acknowledgment
- QUIC frames handling
author | Sergey Kandaurov <pluknet@nginx.com> |
---|---|
date | Tue, 01 Feb 2022 14:54:32 +0300 |
parents | |
children | f50c2a65ccc0 |
comparison
equal
deleted
inserted
replaced
1873:f7f1f349dd26 | 1874:d57a0fd293a3 |
---|---|
1 package Test::Nginx::HTTP3; | |
2 | |
3 # (C) Sergey Kandaurov | |
4 # (C) Nginx, Inc. | |
5 | |
6 # Module for nginx QUIC tests. | |
7 | |
8 ############################################################################### | |
9 | |
10 use warnings; | |
11 use strict; | |
12 | |
13 use IO::Socket::INET; | |
14 use IO::Select; | |
15 use Data::Dumper; | |
16 | |
17 use Test::Nginx; | |
18 | |
19 sub new { | |
20 my $self = {}; | |
21 bless $self, shift @_; | |
22 | |
23 my ($port, %extra) = @_; | |
24 | |
25 require Crypt::KeyDerivation; | |
26 require Crypt::PK::X25519; | |
27 require Crypt::PRNG; | |
28 require Crypt::AuthEnc::GCM; | |
29 require Crypt::Mode::CTR; | |
30 require Crypt::Digest; | |
31 require Crypt::Mac::HMAC; | |
32 | |
33 $self->{socket} = IO::Socket::INET->new( | |
34 Proto => "udp", | |
35 PeerAddr => '127.0.0.1:' . port($port || 8980), | |
36 ); | |
37 | |
38 $self->{repeat} = 0; | |
39 $self->{token} = ''; | |
40 $self->{psk_list} = $extra{psk_list} || []; | |
41 | |
42 $self->{sni} = exists $extra{sni} ? $extra{sni} : 'localhost'; | |
43 $self->{opts} = $extra{opts}; | |
44 | |
45 $self->{zero} = pack("x5"); | |
46 | |
47 $self->{buf} = ''; | |
48 | |
49 $self->init(); | |
50 $self->init_key_schedule(); | |
51 $self->initial(); | |
52 $self->handshake() or return; | |
53 | |
54 return $self; | |
55 } | |
56 | |
57 sub init { | |
58 my ($self, $early_data) = @_; | |
59 $self->{keys} = []; | |
60 $self->{pn} = [[-1, -1, -1, -1], [-1, -1, -1, -1]]; | |
61 $self->{crypto_in} = [[],[],[],[]]; | |
62 $self->{stream_in} = []; | |
63 $self->{frames_in} = []; | |
64 $self->{tlsm} = (); | |
65 $self->{tlsm}{$_} = '' | |
66 for 'ch', 'sh', 'ee', 'cert', 'cv', 'sf', 'cf', 'nst'; | |
67 $self->{requests} = 0; | |
68 | |
69 # Initial | |
70 | |
71 $self->{odcid} = undef; | |
72 $self->{scid} = Crypt::PRNG::random_bytes(17); | |
73 $self->{dcid} = Crypt::PRNG::random_bytes(18); | |
74 $self->{salt} = "\x38\x76\x2c\xf7\xf5\x59\x34\xb3\x4d\x17" | |
75 . "\x9a\xe6\xa4\xc8\x0c\xad\xcc\xbb\x7f\x0a"; | |
76 $self->{ncid} = []; | |
77 $self->{early_data} = $early_data; | |
78 | |
79 $self->retry(); | |
80 } | |
81 | |
82 sub retry { | |
83 my ($self) = @_; | |
84 my $prk = Crypt::KeyDerivation::hkdf_extract($self->{dcid}, | |
85 $self->{salt}, 'SHA256'); | |
86 | |
87 Test::Nginx::log_core('||', "scid = " . unpack("H*", $self->{scid})); | |
88 Test::Nginx::log_core('||', "dcid = " . unpack("H*", $self->{dcid})); | |
89 Test::Nginx::log_core('||', "prk = " . unpack("H*", $prk)); | |
90 | |
91 $self->set_traffic_keys('tls13 client in', 0, 'w', $prk); | |
92 $self->set_traffic_keys('tls13 server in', 0, 'r', $prk); | |
93 } | |
94 | |
95 sub init_key_schedule { | |
96 my ($self) = @_; | |
97 $self->{psk} = $self->{psk_list}[0]; | |
98 $self->{es_prk} = Crypt::KeyDerivation::hkdf_extract( | |
99 $self->{psk}->{secret} || pack("x32"), pack("x32"), 'SHA256'); | |
100 $self->{sk} = Crypt::PK::X25519->new->generate_key; | |
101 } | |
102 | |
103 sub initial { | |
104 my ($self, $ed) = @_; | |
105 $self->{tlsm}{ch} = $self->build_tls_client_hello(); | |
106 my $ch = $self->{tlsm}{ch}; | |
107 my $crypto = build_crypto($ch); | |
108 my $padding = 1200 - length($crypto); | |
109 $padding = 0 if $padding < 0 || $self->{psk}->{ed}; | |
110 my $payload = $crypto . pack("x$padding"); | |
111 my $initial = $self->encrypt_aead($payload, 0); | |
112 | |
113 if ($ed && $self->{psk}->{ed}) { | |
114 $self->set_traffic_keys('tls13 c e traffic', 1, 'w', | |
115 $self->{es_prk}, Crypt::Digest::digest_data('SHA256', | |
116 $self->{tlsm}{ch})); | |
117 | |
118 # my $ed = "\x0a\x02\x08\x00\x04\x02\x06\x1f\x0d\x00\x0a" | |
119 # . $self->build_stream("\x01\x06\x00\x00\xc0"); | |
120 $payload = $ed; | |
121 # $payload = $self->build_stream("GET /\n"); | |
122 $padding = 1200 - length($crypto) - length($payload); | |
123 $payload .= pack("x$padding") if $padding > 0; | |
124 $initial .= $self->encrypt_aead($payload, 1); | |
125 } | |
126 | |
127 $self->{socket}->syswrite($initial); | |
128 } | |
129 | |
130 sub handshake { | |
131 my ($self) = @_; | |
132 my $buf = ''; | |
133 | |
134 $self->read_tls_message(\$buf, \&parse_tls_server_hello) or return; | |
135 | |
136 my $sh = $self->{tlsm}{sh}; | |
137 my $extens_len = unpack("C*", substr($sh, 6 + 32 + 4, 2)) * 8 | |
138 + unpack("C*", substr($sh, 6 + 32 + 5, 1)); | |
139 my $extens = substr($sh, 6 + 32 + 4 + 2, $extens_len); | |
140 my $pub = key_share($extens); | |
141 Test::Nginx::log_core('||', "pub = " . unpack("H*", $pub)); | |
142 | |
143 my $pk = Crypt::PK::X25519->new; | |
144 $pk->import_key_raw($pub, "public"); | |
145 my $shared_secret = $self->{sk}->shared_secret($pk); | |
146 Test::Nginx::log_core('||', "shared = " . unpack("H*", $shared_secret)); | |
147 | |
148 # tls13_advance_key_schedule | |
149 | |
150 $self->{hs_prk} = hkdf_advance($shared_secret, $self->{es_prk}); | |
151 Test::Nginx::log_core('||', "hs = " . unpack("H*", $self->{hs_prk})); | |
152 | |
153 # derive_secret_with_transcript | |
154 | |
155 my $digest = Crypt::Digest::digest_data('SHA256', $self->{tlsm}{ch} | |
156 . $self->{tlsm}{sh}); | |
157 $self->set_traffic_keys('tls13 c hs traffic', 2, 'w', | |
158 $self->{hs_prk}, $digest); | |
159 $self->set_traffic_keys('tls13 s hs traffic', 2, 'r', | |
160 $self->{hs_prk}, $digest); | |
161 | |
162 $self->read_tls_message(\$buf, \&parse_tls_encrypted_extensions); | |
163 | |
164 unless (keys %{$self->{psk}}) { | |
165 $self->read_tls_message(\$buf, \&parse_tls_certificate); | |
166 $self->read_tls_message(\$buf, \&parse_tls_certificate_verify); | |
167 } | |
168 | |
169 $self->read_tls_message(\$buf, \&parse_tls_finished); | |
170 | |
171 # tls13_advance_key_schedule(application) | |
172 | |
173 $self->{ms_prk} = hkdf_advance(pack("x32"), $self->{hs_prk}); | |
174 Test::Nginx::log_core('||', | |
175 "master = " . unpack("H*", $self->{ms_prk})); | |
176 | |
177 # derive_secret_with_transcript(application) | |
178 | |
179 $digest = Crypt::Digest::digest_data('SHA256', $self->{tlsm}{ch} | |
180 . $self->{tlsm}{sh} . $self->{tlsm}{ee} . $self->{tlsm}{cert} | |
181 . $self->{tlsm}{cv} . $self->{tlsm}{sf}); | |
182 $self->set_traffic_keys('tls13 c ap traffic', 3, 'w', | |
183 $self->{ms_prk}, $digest); | |
184 $self->set_traffic_keys('tls13 s ap traffic', 3, 'r', | |
185 $self->{ms_prk}, $digest); | |
186 | |
187 # client finished | |
188 | |
189 my $finished = tls13_finished($self->{keys}[2]{w}{prk}, $digest); | |
190 Test::Nginx::log_core('||', "finished = " . unpack("H*", $finished)); | |
191 | |
192 $self->{tlsm}{cf} = $finished; | |
193 | |
194 $digest = Crypt::Digest::digest_data('SHA256', $self->{tlsm}{ch} | |
195 . $self->{tlsm}{sh} . $self->{tlsm}{ee} . $self->{tlsm}{cert} | |
196 . $self->{tlsm}{cv} . $self->{tlsm}{sf} . $self->{tlsm}{cf}); | |
197 $self->{rms_prk} = hkdf_expand_label("tls13 res master", 32, | |
198 $self->{ms_prk}, $digest); | |
199 Test::Nginx::log_core('||', | |
200 "resumption = " . unpack("H*", $self->{rms_prk})); | |
201 | |
202 my $crypto = build_crypto($finished); | |
203 $self->{socket}->syswrite($self->encrypt_aead($crypto, 2)); | |
204 } | |
205 | |
206 #if (!$psk->{ed}) { | |
207 # my $r = "\x0a\x02\x08\x00\x04\x02\x06\x1f\x0d\x00\x0a"; | |
208 # $s->syswrite(encrypt_aead($r, 3)); | |
209 # $r = "\x01\x06\x00\x00\xc0"; | |
210 # $s->syswrite(encrypt_aead($self->build_stream($r), 3)); | |
211 #} | |
212 | |
213 sub DESTROY { | |
214 my ($self) = @_; | |
215 | |
216 return unless $self->{socket}; | |
217 return unless $self->{keys}[3]; | |
218 my $frame = build_cc(0, "graceful shutdown"); | |
219 $self->{socket}->syswrite($self->encrypt_aead($frame, 3)); | |
220 } | |
221 | |
222 sub ping { | |
223 my ($self) = @_; | |
224 my $frame = "\x01\x00\x00\x00"; | |
225 $self->{socket}->syswrite($self->encrypt_aead($frame, 3)); | |
226 } | |
227 | |
228 sub reset_stream { | |
229 my ($self, $sid, $code) = @_; | |
230 my $final_size = $self->{streams}{$sid}{sent}; | |
231 my $frame = "\x04" . build_int($sid) . build_int($code) | |
232 . build_int($final_size); | |
233 $self->{socket}->syswrite($self->encrypt_aead($frame, 3)); | |
234 } | |
235 | |
236 sub stop_sending { | |
237 my ($self, $sid, $code) = @_; | |
238 my $frame = "\x05" . build_int($sid) . build_int($code); | |
239 $self->{socket}->syswrite($self->encrypt_aead($frame, 3)); | |
240 } | |
241 | |
242 sub new_connection_id { | |
243 my ($self, $seqno, $ret, $id, $token) = @_; | |
244 my $frame = "\x18" . build_int($seqno) . build_int($ret) | |
245 . pack("C", length($id)) . $id . $token; | |
246 $self->{socket}->syswrite($self->encrypt_aead($frame, 3)); | |
247 } | |
248 | |
249 sub path_challenge { | |
250 my ($self, $data) = @_; | |
251 my $frame = "\x1a" . $data; | |
252 $self->{socket}->syswrite($self->encrypt_aead($frame, 3)); | |
253 } | |
254 | |
255 sub path_response { | |
256 my ($self, $data) = @_; | |
257 my $frame = "\x1b" . $data; | |
258 $self->{socket}->syswrite($self->encrypt_aead($frame, 3)); | |
259 } | |
260 | |
261 ############################################################################### | |
262 | |
263 sub parse_frames { | |
264 my ($buf) = @_; | |
265 my @frames; | |
266 my $offset = 0; | |
267 | |
268 while ($offset < length($buf)) { | |
269 my ($tlen, $type) = parse_int(substr($buf, $offset)); | |
270 $offset += $tlen; | |
271 next if $type == 0; | |
272 my $frame = { type => $type }; | |
273 | |
274 if ($type == 1) { | |
275 $frame->{type} = 'PING'; | |
276 } | |
277 if ($type == 2) { | |
278 $frame->{type} = 'ACK'; | |
279 my ($len, $val) = parse_int(substr($buf, $offset)); | |
280 $frame->{largest} = $val; | |
281 $offset += $len; | |
282 ($len, $val) = parse_int(substr($buf, $offset)); | |
283 $frame->{delay} = $val; | |
284 $offset += $len; | |
285 ($len, $val) = parse_int(substr($buf, $offset)); | |
286 $frame->{count} = $val; | |
287 $offset += $len; | |
288 ($len, $val) = parse_int(substr($buf, $offset)); | |
289 $frame->{first} = $val; | |
290 $offset += $len; | |
291 } | |
292 if ($type == 4) { | |
293 $frame->{type} = 'RESET_STREAM'; | |
294 my ($len, $val) = parse_int(substr($buf, $offset)); | |
295 $frame->{sid} = $val; | |
296 $offset += $len; | |
297 ($len, $val) = parse_int(substr($buf, $offset)); | |
298 $frame->{code} = $val; | |
299 $offset += $len; | |
300 ($len, $val) = parse_int(substr($buf, $offset)); | |
301 $frame->{final_size} = $val; | |
302 $offset += $len; | |
303 } | |
304 if ($type == 5) { | |
305 $frame->{type} = 'STOP_SENDING'; | |
306 my ($len, $val) = parse_int(substr($buf, $offset)); | |
307 $frame->{sid} = $val; | |
308 $offset += $len; | |
309 ($len, $val) = parse_int(substr($buf, $offset)); | |
310 $frame->{code} = $val; | |
311 $offset += $len; | |
312 } | |
313 if ($type == 6) { | |
314 my ($olen, $off) = parse_int(substr($buf, $offset)); | |
315 $offset += $olen; | |
316 my ($llen, $len) = parse_int(substr($buf, $offset)); | |
317 $offset += $llen; | |
318 $frame->{type} = 'CRYPTO'; | |
319 $frame->{length} = $len; | |
320 $frame->{offset} = $off; | |
321 $frame->{payload} = substr($buf, $offset, $len); | |
322 $offset += $len; | |
323 } | |
324 if ($type == 7) { | |
325 $frame->{type} = 'NEW_TOKEN'; | |
326 my ($len, $val) = parse_int(substr($buf, $offset)); | |
327 $offset += $len; | |
328 $frame->{token} = substr($buf, $offset, $val); | |
329 $offset += $val; | |
330 } | |
331 if (($type & 0xf8) == 0x08) { | |
332 $frame->{type} = 'STREAM'; | |
333 my ($len, $val) = parse_int(substr($buf, $offset)); | |
334 $frame->{id} = $val; | |
335 $offset += $len; | |
336 if ($type & 0x4) { | |
337 ($len, $val) = parse_int(substr($buf, $offset)); | |
338 $frame->{offset} = $val; | |
339 $offset += $len; | |
340 } else { | |
341 $frame->{offset} = 0; | |
342 } | |
343 if ($type & 0x2) { | |
344 ($len, $val) = parse_int(substr($buf, $offset)); | |
345 $frame->{length} = $val; | |
346 $offset += $len; | |
347 } else { | |
348 $frame->{length} = length($buf) - $offset; | |
349 } | |
350 if ($type & 0x1) { | |
351 $frame->{fin} = 1; | |
352 } | |
353 $frame->{payload} = | |
354 substr($buf, $offset, $frame->{length}); | |
355 $offset += $frame->{length}; | |
356 } | |
357 if ($type == 18 || $type == 19) { | |
358 $frame->{type} = 'MAX_STREAMS'; | |
359 my ($len, $val) = parse_int(substr($buf, $offset)); | |
360 $frame->{val} = $val; | |
361 $frame->{uni} = 1 if $type == 19; | |
362 $offset += $len; | |
363 } | |
364 if ($type == 24) { | |
365 $frame->{type} = 'NCID'; | |
366 my ($len, $val) = parse_int(substr($buf, $offset)); | |
367 $frame->{seqno} = $val; | |
368 $offset += $len; | |
369 ($len, $val) = parse_int(substr($buf, $offset)); | |
370 $frame->{rpt} = $val; | |
371 $offset += $len; | |
372 $len = unpack("C", substr($buf, $offset, 1)); | |
373 $frame->{length} = $len; | |
374 $offset += 1; | |
375 $frame->{cid} = substr($buf, $offset, $len); | |
376 $offset += $len; | |
377 $frame->{token} = substr($buf, $offset, 16); | |
378 $offset += 16; | |
379 } | |
380 if ($type == 26) { | |
381 $frame->{type} = 'PATH_CHALLENGE'; | |
382 $frame->{data} = substr($buf, $offset, 8); | |
383 $offset += 8; | |
384 } | |
385 if ($type == 27) { | |
386 $frame->{type} = 'PATH_RESPONSE'; | |
387 $frame->{data} = substr($buf, $offset, 8); | |
388 $offset += 8; | |
389 } | |
390 if ($type == 28 || $type == 29) { | |
391 $frame->{type} = 'CONNECTION_CLOSE'; | |
392 my ($len, $val) = parse_int(substr($buf, $offset)); | |
393 $frame->{error} = $val; | |
394 $offset += $len; | |
395 if ($type == 28) { | |
396 ($len, $val) = parse_int(substr($buf, $offset)); | |
397 $frame->{frame_type} = $val; | |
398 $offset += $len; | |
399 } | |
400 ($len, $val) = parse_int(substr($buf, $offset)); | |
401 $offset += $len; | |
402 $frame->{phrase} = substr($buf, $offset, $val); | |
403 $offset += $val; | |
404 } | |
405 if ($type == 30) { | |
406 $frame->{type} = 'HANDSHAKE_DONE'; | |
407 } | |
408 push @frames, $frame; | |
409 } | |
410 return \@frames; | |
411 } | |
412 | |
413 sub handle_frames { | |
414 my ($self, $frames, $level) = @_; | |
415 | |
416 my @frames = grep { $_->{type} eq 'CRYPTO' } @$frames; | |
417 while (my $frame = shift @frames) { | |
418 insert_crypto($self->{crypto_in}[$level], [ | |
419 $frame->{offset}, | |
420 $frame->{length}, | |
421 $frame->{payload}, | |
422 ]); | |
423 | |
424 $self->parse_tls_nst() if $level == 3; | |
425 } | |
426 | |
427 @frames = grep { $_->{type} eq 'STREAM' } @$frames; | |
428 while (my $frame = shift @frames) { | |
429 $self->{stream_in}[$frame->{id}] ||= { buf => [], pos => 0 }; | |
430 insert_crypto($self->{stream_in}[$frame->{id}]->{buf}, [ | |
431 $frame->{offset}, | |
432 $frame->{length}, | |
433 $frame->{payload}, | |
434 $frame->{fin}, | |
435 ]); | |
436 } | |
437 | |
438 @frames = grep { $_->{type} eq 'NCID' } @$frames; | |
439 while (my $frame = shift @frames) { | |
440 push @{$self->{ncid}}, $frame; | |
441 } | |
442 | |
443 my $ack = $self->{ack}[$level]; | |
444 | |
445 # stop tracking acknowledged ACK ranges | |
446 | |
447 @frames = grep { $_->{type} eq 'ACK' } @$frames; | |
448 while (my $frame = shift @frames) { | |
449 my $max = $frame->{largest}; | |
450 my $min = $max - $frame->{first}; | |
451 | |
452 for my $num ($min .. $max) { | |
453 for my $pn (keys %$ack) { | |
454 delete $ack->{$pn} if $ack->{$pn} == $num; | |
455 } | |
456 } | |
457 } | |
458 | |
459 $self->{socket}->syswrite($self->encrypt_aead(build_ack($ack), $level)); | |
460 | |
461 for my $pn (keys %$ack) { | |
462 $ack->{$pn} = $self->{pn}[0][$level] if $ack->{$pn} == -1; | |
463 } | |
464 | |
465 my ($frame) = grep { $_->{type} eq 'NEW_TOKEN' } @$frames; | |
466 $self->{token} = $frame->{token} || ''; | |
467 | |
468 push @{$self->{frames_in}}, grep { $_->{type} ne 'CRYPTO' | |
469 && $_->{type} ne 'STREAM' } @$frames; | |
470 } | |
471 | |
472 sub insert_crypto { | |
473 my ($crypto, $frame) = @_; | |
474 my $i; | |
475 | |
476 for ($i = 0; $i < scalar @$crypto; $i++) { | |
477 # frame][crypto][frame | |
478 my $this = @$crypto[$i]; | |
479 if (@$frame[0] <= @$this[0] && | |
480 @$frame[0] + @$frame[1] >= @$this[0] + @$this[1]) | |
481 { | |
482 my $old = substr(@$frame[2], @$this[0] - @$frame[0], | |
483 @$this[1]); | |
484 die "bad inner" if $old ne @$this[2]; | |
485 splice @$crypto, $i, 1; $i--; | |
486 } | |
487 } | |
488 | |
489 return push @$crypto, $frame if !@$crypto; | |
490 | |
491 for ($i = 0; $i < @$crypto; $i++) { | |
492 if (@$frame[0] <= @{@$crypto[$i]}[0] + @{@$crypto[$i]}[1]) { | |
493 last; | |
494 } | |
495 } | |
496 | |
497 return push @$crypto, $frame if $i == @$crypto; | |
498 | |
499 my $this = @$crypto[$i]; | |
500 my $next = @$crypto[$i + 1]; | |
501 | |
502 if (@$frame[0] + @$frame[1] == @$this[0]) { | |
503 # frame][crypto | |
504 @$this[0] = @$frame[0]; | |
505 @$this[1] += @$frame[1]; | |
506 @$this[2] = @$frame[2] . @$this[2]; | |
507 | |
508 } elsif (@$this[0] + @$this[1] == @$frame[0]) { | |
509 # crypto][frame | |
510 @$this[1] += @$frame[1]; | |
511 @$this[2] .= @$frame[2]; | |
512 @$this[3] = @$frame[3]; | |
513 | |
514 } elsif (@$frame[0] + @$frame[1] < @$this[0]) { | |
515 # frame..crypto | |
516 return splice @$crypto, $i, 0, $frame; | |
517 | |
518 } else { | |
519 # overlay | |
520 my ($b1, $b2) = @$this[0] < @$frame[0] | |
521 ? ($this, $frame) : ($frame, $this); | |
522 my ($o1, $o2) = @$this[0] + @$this[1] < @$frame[0] + @$frame[1] | |
523 ? ($this, $frame) : ($frame, $this); | |
524 my $offset = @$b2[0] - @$b1[0]; | |
525 my $length = @$o1[0] + @$o1[1] - @$b2[0]; | |
526 my $old = substr @$b1[2], $offset, $length, @$b2[2]; | |
527 die "bad repl" if substr(@$b1[2], $offset, $length) ne $old; | |
528 @$this = (@$b1[0], @$o2[0] + @$o2[1] - @$b1[0], @$b1[2]); | |
529 } | |
530 | |
531 return if !defined $next; | |
532 | |
533 # combine with next overlay if any | |
534 if (@$this[0] + @$this[1] >= @$next[0]) { | |
535 my $offset = @$next[0] - @$this[0]; | |
536 my $length = @$this[0] + @$this[1] - @$next[0]; | |
537 my $old = substr @$this[2], $offset, $length, @$next[2]; | |
538 die "bad repl2" if substr(@$this[2], $offset, $length) ne $old; | |
539 @$this[1] = @$next[0] + @$next[1] - @$this[0]; | |
540 splice @$crypto, $i + 1, 1; | |
541 } | |
542 } | |
543 | |
544 ############################################################################### | |
545 | |
546 sub save_session_tickets { | |
547 my ($self, $content) = @_; | |
548 | |
549 my $nst_len = unpack("n", substr($content, 2, 2)); | |
550 my $nst = substr($content, 4, $nst_len); | |
551 | |
552 my $psk = {}; | |
553 my $lifetime = substr($nst, 0, 4); | |
554 $psk->{age_add} = substr($nst, 4, 4); | |
555 my $nonce_len = unpack("C", substr($nst, 8, 1)); | |
556 my $nonce = substr($nst, 9, $nonce_len); | |
557 my $len = unpack("n", substr($nst, 8 + 1 + $nonce_len, 2)); | |
558 $psk->{ticket} = substr($nst, 11 + $nonce_len, $len); | |
559 | |
560 my $extens_len = unpack("n", substr($nst, 11 + $nonce_len + $len, 2)); | |
561 my $extens = substr($nst, 11 + $nonce_len + $len + 2, $extens_len); | |
562 | |
563 $psk->{ed} = early_data($extens); | |
564 $psk->{secret} = hkdf_expand_label("tls13 resumption", 32, | |
565 $self->{rms_prk}, $nonce); | |
566 push @{$self->{psk_list}}, $psk; | |
567 } | |
568 | |
569 sub decode_pn { | |
570 my ($self, $pn, $pnl, $level) = @_; | |
571 my $expected = $self->{pn}[1][$level] + 1; | |
572 my $pn_win = 1 << $pnl * 8; | |
573 my $pn_hwin = $pn_win / 2; | |
574 | |
575 $pn |= $expected & ~($pn_win - 1); | |
576 | |
577 if ($pn <= $expected - $pn_hwin && $pn < (1 << 62) - $pn_win) { | |
578 $pn += $pn_win; | |
579 | |
580 } elsif ($pn > $expected + $pn_hwin && $pn >= $pn_win) { | |
581 $pn -= $pn_win; | |
582 } | |
583 | |
584 return $pn; | |
585 } | |
586 | |
587 sub decrypt_aead { | |
588 my ($self, $buf) = @_; | |
589 my $flags = unpack("C", substr($buf, 0, 1)); | |
590 return 0, $self->decrypt_retry($buf) if ($flags & 0xf0) == 0xf0; | |
591 my $level = $flags & 0x80 ? $flags - 0xc0 >> 4 : 3; | |
592 my $offpn = 1 + length($self->{scid}) if $level == 3; | |
593 $offpn = ( | |
594 $offpn = unpack("C", substr($buf, 5, 1)), | |
595 $self->{scid} = substr($buf, 6, $offpn), | |
596 $offpn = unpack("C", substr($buf, 6 + length($self->{scid}), 1)), | |
597 $self->{dcid} = | |
598 substr($buf, 6 + length($self->{scid}) + 1, $offpn), | |
599 7 + ($level == 0) + length($self->{scid}) | |
600 + length($self->{dcid})) if $level != 3; | |
601 my ($len, $val) = $level != 3 | |
602 ? parse_int(substr($buf, $offpn)) | |
603 : (0, length($buf) - $offpn); | |
604 $offpn += $len; | |
605 | |
606 my $sample = substr($buf, $offpn + 4, 16); | |
607 my ($ad, $pnl, $pn) = $self->decrypt_ad($buf, | |
608 $self->{keys}[$level]{r}{hp}, $sample, $offpn, $level == 3); | |
609 Test::Nginx::log_core('||', "ad = " . unpack("H*", $ad)); | |
610 $pn = $self->decode_pn($pn, $pnl, $level); | |
611 my $nonce = substr(pack("x12") . pack("N", $pn), -12) | |
612 ^ $self->{keys}[$level]{r}{iv}; | |
613 my $ciphertext = substr($buf, $offpn + $pnl, $val - 16 - $pnl); | |
614 my $tag = substr($buf, $offpn + $val - 16, 16); | |
615 my $plaintext = Crypt::AuthEnc::GCM::gcm_decrypt_verify('AES', | |
616 $self->{keys}[$level]{r}{key}, $nonce, $ad, $ciphertext, $tag); | |
617 return if !defined $plaintext; | |
618 Test::Nginx::log_core('||', | |
619 "pn = $pn, level = $level, length = " . length($plaintext)); | |
620 | |
621 $self->{pn}[1][$level] = $pn; | |
622 $self->{ack}[$level]{$pn} = -1; | |
623 $self->{ack}[$_] = undef for (0 .. $level - 1); | |
624 | |
625 return ($level, $plaintext, | |
626 substr($buf, length($ad . $ciphertext . $tag)), ''); | |
627 } | |
628 | |
629 sub decrypt_ad { | |
630 my ($self, $buf, $hp, $sample, $offset, $short) = @_; | |
631 my $m = Crypt::Mode::CTR->new('AES'); | |
632 my $mask = $m->encrypt($self->{zero}, $hp, $sample); | |
633 substr($buf, 0, 1) ^= substr($mask, 0, 1) & ($short ? "\x1f" : "\x0f"); | |
634 my $pnl = unpack("C", substr($buf, 0, 1) & "\x03") + 1; | |
635 for (my $i = 0; $i < $pnl; $i++) { | |
636 substr($buf, $offset + $i, 1) ^= substr($mask, $i + 1, 1); | |
637 } | |
638 my $pn = unpack("C", substr($buf, $offset, $pnl)); | |
639 my $ad = substr($buf, 0, $offset + $pnl); | |
640 return ($ad, $pnl, $pn); | |
641 } | |
642 | |
643 sub encrypt_aead { | |
644 my ($self, $payload, $level) = @_; | |
645 my $pn = ++$self->{pn}[0][$level]; | |
646 my $ad = pack("C", $level == 3 ? 0x40 : 0xc + $level << 4) | "\x03"; | |
647 $ad .= "\x00\x00\x00\x01" unless $level == 3; | |
648 $ad .= $level == 3 ? $self->{dcid} : | |
649 pack("C", length($self->{dcid})) . $self->{dcid} | |
650 . pack("C", length($self->{scid})) . $self->{scid}; | |
651 $ad .= build_int(length($self->{token})) . $self->{token} | |
652 if $level == 0; | |
653 $ad .= build_int(length($payload) + 16 + 4) unless $level == 3; | |
654 $ad .= pack("N", $pn); | |
655 my $nonce = substr(pack("x12") . pack("N", $pn), -12) | |
656 ^ $self->{keys}[$level]{w}{iv}; | |
657 my ($ciphertext, $tag) = Crypt::AuthEnc::GCM::gcm_encrypt_authenticate( | |
658 'AES', $self->{keys}[$level]{w}{key}, $nonce, $ad, $payload); | |
659 my $sample = substr($ciphertext . $tag, 0, 16); | |
660 | |
661 $ad = $self->encrypt_ad($ad, $self->{keys}[$level]{w}{hp}, | |
662 $sample, $level == 3); | |
663 return $ad . $ciphertext . $tag; | |
664 } | |
665 | |
666 sub encrypt_ad { | |
667 my ($self, $ad, $hp, $sample, $short) = @_; | |
668 my $m = Crypt::Mode::CTR->new('AES'); | |
669 my $mask = $m->encrypt($self->{zero}, $hp, $sample); | |
670 substr($ad, 0, 1) ^= substr($mask, 0, 1) & ($short ? "\x1f" : "\x0f"); | |
671 substr($ad, -4) ^= substr($mask, 1); | |
672 return $ad; | |
673 } | |
674 | |
675 sub decrypt_retry { | |
676 my ($self, $buf) = @_; | |
677 my $off = unpack("C", substr($buf, 5, 1)); | |
678 $self->{scid} = substr($buf, 6, $off); | |
679 $self->{odcid} = $self->{dcid}; | |
680 $self->{dcid} = unpack("C", substr($buf, 6 + $off, 1)); | |
681 $self->{dcid} = substr($buf, 6 + $off + 1, $self->{dcid}); | |
682 my $token = substr($buf, 6 + $off + 1 + length($self->{dcid}), -16); | |
683 my $tag = substr($buf, -16); | |
684 my $pseudo = pack("C", length($self->{odcid})) . $self->{odcid} | |
685 . substr($buf, 0, -16); | |
686 return ($tag, retry_verify_tag($pseudo), $token); | |
687 } | |
688 | |
689 sub retry_verify_tag { | |
690 my $key = "\xbe\x0c\x69\x0b\x9f\x66\x57\x5a" | |
691 . "\x1d\x76\x6b\x54\xe3\x68\xc8\x4e"; | |
692 my $nonce = "\x46\x15\x99\xd3\x5d\x63\x2b\xf2\x23\x98\x25\xbb"; | |
693 my (undef, $tag) = Crypt::AuthEnc::GCM::gcm_encrypt_authenticate('AES', | |
694 $key, $nonce, shift, ''); | |
695 return $tag; | |
696 } | |
697 | |
698 sub set_traffic_keys { | |
699 my ($self, $label, $level, $direction, $secret, $digest) = @_; | |
700 my $prk = hkdf_expand_label($label, 32, $secret, $digest); | |
701 my $key = hkdf_expand_label("tls13 quic key", 16, $prk); | |
702 my $iv = hkdf_expand_label("tls13 quic iv", 12, $prk); | |
703 my $hp = hkdf_expand_label("tls13 quic hp", 16, $prk); | |
704 $self->{keys}[$level]{$direction}{prk} = $prk; | |
705 $self->{keys}[$level]{$direction}{key} = $key; | |
706 $self->{keys}[$level]{$direction}{iv} = $iv; | |
707 $self->{keys}[$level]{$direction}{hp} = $hp; | |
708 } | |
709 | |
710 sub hmac_finished { | |
711 my ($key, $digest) = @_; | |
712 my $finished_key = hkdf_expand_label("tls13 finished", 32, $key); | |
713 Crypt::Mac::HMAC::hmac('SHA256', $finished_key, $digest); | |
714 } | |
715 | |
716 sub tls13_finished { | |
717 my ($key, $digest) = @_; | |
718 my $hmac = hmac_finished($key, $digest); | |
719 "\x14\x00" . pack('n', length($hmac)) . $hmac; | |
720 } | |
721 | |
722 sub binders { | |
723 my ($key, $digest) = @_; | |
724 my $hmac = hmac_finished($key, $digest); | |
725 pack('n', length($hmac) + 1) . pack('C', length($hmac)) . $hmac; | |
726 } | |
727 | |
728 sub hkdf_advance { | |
729 my ($secret, $prk) = @_; | |
730 my $digest0 = Crypt::Digest::digest_data('SHA256', ''); | |
731 my $expand = hkdf_expand_label("tls13 derived", 32, $prk, $digest0); | |
732 Crypt::KeyDerivation::hkdf_extract($secret, $expand, 'SHA256'); | |
733 } | |
734 | |
735 sub hkdf_expand_label { | |
736 my ($label, $len, $prk, $context) = @_; | |
737 $context = '' if !defined $context; | |
738 my $info = pack("C3", 0, $len, length($label)) . $label | |
739 . pack("C", length($context)) . $context; | |
740 return Crypt::KeyDerivation::hkdf_expand($prk, 'SHA256', $len, $info); | |
741 } | |
742 | |
743 sub key_share { | |
744 my ($extens) = @_; | |
745 my $offset = 0; | |
746 while ($offset < length($extens)) { | |
747 my $ext = substr($extens, $offset, 2); | |
748 my $len = unpack("C", substr($extens, $offset + 2, 1)) * 8 + | |
749 unpack("C", substr($extens, $offset + 3, 1)); | |
750 if ($ext eq "\x00\x33") { | |
751 return substr($extens, $offset + 4 + 4, $len - 4); | |
752 } | |
753 $offset += 4 + $len; | |
754 } | |
755 } | |
756 | |
757 sub early_data { | |
758 my ($extens) = @_; | |
759 my $offset = 0; | |
760 while ($offset < length($extens)) { | |
761 my $ext = substr($extens, $offset, 2); | |
762 my $len = unpack("C", substr($extens, $offset + 2, 1)) * 8 + | |
763 unpack("C", substr($extens, $offset + 3, 1)); | |
764 if ($ext eq "\x00\x2a") { | |
765 return substr($extens, $offset + 4, $len); | |
766 } | |
767 $offset += 4 + $len; | |
768 } | |
769 } | |
770 | |
771 ############################################################################### | |
772 | |
773 sub build_cc { | |
774 my ($code, $reason) = @_; | |
775 "\x1d" . build_int($code) . build_int(length($reason)) . $reason; | |
776 } | |
777 | |
778 sub build_ack { | |
779 my ($ack) = @_; | |
780 my @keys = sort { $b <=> $a } keys %$ack; | |
781 | |
782 return "\x02" . build_int($keys[0]) . "\x00\x00\x00" if @keys == 1; | |
783 | |
784 my $min = my $max = shift @keys; | |
785 my @acks = (); | |
786 for my $next (@keys) { | |
787 if ($next == $min - 1) { | |
788 $min = $next; | |
789 next if $next != $keys[-1]; | |
790 } | |
791 push @acks, $max, $min; | |
792 $min = $max = $next; | |
793 } | |
794 | |
795 ($max, $min) = splice @acks, 0, 2; | |
796 my $ranges = @acks / 2; | |
797 | |
798 $ack = "\x02" . build_int($max) . "\x00" . build_int($ranges) | |
799 . build_int($max - $min); | |
800 | |
801 for (my $smallest = $min; $ranges--; ) { | |
802 my ($max, $min) = splice @acks, 0, 2; | |
803 $ack .= build_int($smallest - $max - 2); | |
804 $ack .= build_int($max - $min); | |
805 $smallest = $min; | |
806 } | |
807 | |
808 return $ack; | |
809 } | |
810 | |
811 sub build_crypto { | |
812 my ($tlsm) = @_; | |
813 "\x06\x00" . build_int(length($tlsm)) . $tlsm; | |
814 } | |
815 | |
816 sub build_stream { | |
817 my ($self, $r, %extra) = @_; | |
818 my $stream = $extra{start} ? 0xe : 0xf; | |
819 my $length = $extra{length} ? $extra{length} : build_int(length($r)); | |
820 my $offset = build_int($extra{offset} ? $extra{offset} : 0); | |
821 my $sid = defined $extra{sid} ? $extra{sid} : $self->{requests}++; | |
822 pack("CC", $stream, 4 * $sid) . $offset . $length . $r; | |
823 } | |
824 | |
825 sub parse_int { | |
826 my ($buf) = @_; | |
827 my $val = unpack("C", substr($buf, 0, 1)); | |
828 my $len = my $plen = 1 << ($val >> 6); | |
829 $val = $val & 0x3f; | |
830 while (--$len) { | |
831 $val = ($val << 8) + unpack("C", substr($buf, $plen - $len, 1)) | |
832 } | |
833 return ($plen, $val); | |
834 } | |
835 | |
836 sub build_int { | |
837 my ($value) = @_; | |
838 | |
839 my $build_int_set = sub { | |
840 my ($value, $len, $bits) = @_; | |
841 (($value >> ($len * 8)) & 0xff) | ($bits << 6); | |
842 }; | |
843 | |
844 if ($value < 1 << 6) { | |
845 pack("C", $build_int_set->($value, 0, 0)); | |
846 | |
847 } elsif ($value < 1 << 14) { | |
848 pack("C*", | |
849 $build_int_set->($value, 1, 1), | |
850 $build_int_set->($value, 0, 0), | |
851 ); | |
852 | |
853 } elsif ($value < 1 << 30) { | |
854 pack("C*", | |
855 $build_int_set->($value, 3, 2), | |
856 $build_int_set->($value, 2, 0), | |
857 $build_int_set->($value, 1, 0), | |
858 $build_int_set->($value, 0, 0), | |
859 ); | |
860 | |
861 } else { | |
862 pack("C*", | |
863 build_int_set->($value, 7, 3), | |
864 build_int_set->($value, 6, 0), | |
865 build_int_set->($value, 5, 0), | |
866 build_int_set->($value, 4, 0), | |
867 build_int_set->($value, 3, 0), | |
868 build_int_set->($value, 2, 0), | |
869 build_int_set->($value, 1, 0), | |
870 build_int_set->($value, 0, 0), | |
871 ); | |
872 } | |
873 } | |
874 | |
875 ############################################################################### | |
876 | |
877 sub read_stream_message { | |
878 my ($self, $timo) = @_; | |
879 my ($level, $plaintext, @data); | |
880 my $s = $self->{socket}; | |
881 | |
882 while (1) { | |
883 @data = $self->parse_stream(); | |
884 return @data if $#data; | |
885 return if scalar @{$self->{frames_in}}; | |
886 | |
887 my $txt; | |
888 | |
889 if (!length($self->{buf})) { | |
890 return unless IO::Select->new($s)->can_read($timo || 3); | |
891 $s->sysread($self->{buf}, 65527); | |
892 $txt = "recv"; | |
893 } else { | |
894 $txt = "remaining"; | |
895 } | |
896 my $len = length $self->{buf}; | |
897 Test::Nginx::log_core('||', sprintf("$txt = [%d]", $len)); | |
898 | |
899 while ($self->{buf}) { | |
900 ($level, $plaintext, $self->{buf}, $self->{token}) | |
901 = $self->decrypt_aead($self->{buf}); | |
902 return if !defined $plaintext; | |
903 goto retry if $self->{token}; | |
904 $self->handle_frames(parse_frames($plaintext), $level); | |
905 @data = $self->parse_stream(); | |
906 return @data if $#data; | |
907 return if scalar @{$self->{frames_in}}; | |
908 } | |
909 } | |
910 return; | |
911 } | |
912 | |
913 sub parse_stream { | |
914 my ($self) = @_; | |
915 my $data; | |
916 | |
917 for my $i (0 .. $#{$self->{stream_in}}) { | |
918 my $stream = $self->{stream_in}[$i]; | |
919 next if !defined $stream; | |
920 | |
921 my $buf = $stream->{buf}[0][2]; | |
922 | |
923 if ($stream->{buf}[0][3]) { | |
924 $stream->{buf}[0][3] = 0; | |
925 $stream->{eof} = 1; | |
926 $data = ''; | |
927 } | |
928 | |
929 if (length($buf) > $stream->{pos}) { | |
930 $data = substr($buf, $stream->{pos}); | |
931 $stream->{pos} = length($buf); | |
932 } | |
933 | |
934 next if !defined $data; | |
935 | |
936 return ($i, $data, $stream->{eof} ? 1 : 0); | |
937 } | |
938 } | |
939 | |
940 ############################################################################### | |
941 | |
942 sub read_tls_message { | |
943 my ($self, $buf, $type) = @_; | |
944 my $s = $self->{socket}; | |
945 | |
946 while (!$type->($self)) { | |
947 my $txt; | |
948 | |
949 if (!length($$buf)) { | |
950 return unless IO::Select->new($s)->can_read(3); | |
951 $s->sysread($$buf, 65527); | |
952 $txt = "recv"; | |
953 } else { | |
954 $txt = "remaining"; | |
955 } | |
956 my $len = length $$buf; | |
957 Test::Nginx::log_core('||', sprintf("$txt = [%d]", $len)); | |
958 | |
959 while ($$buf) { | |
960 (my $level, my $plaintext, $$buf, $self->{token}) | |
961 = $self->decrypt_aead($$buf); | |
962 return if !defined $plaintext; | |
963 goto retry if $self->{token}; | |
964 $self->handle_frames(parse_frames($plaintext), $level); | |
965 return 1 if $type->($self); | |
966 } | |
967 } | |
968 return; | |
969 } | |
970 | |
971 sub parse_tls_server_hello { | |
972 my ($self) = @_; | |
973 my $buf = $self->{crypto_in}[0][0][2] if $self->{crypto_in}[0][0]; | |
974 return 0 if !$buf || length($buf) < 4; | |
975 my $type = unpack("C", substr($buf, 0, 1)); | |
976 my $len = unpack("n", substr($buf, 2, 2)); | |
977 my $content = substr($buf, 4, $len); | |
978 return 0 if length($content) < $len; | |
979 $self->{tlsm}{sh} = substr($buf, 0, 4) . $content; | |
980 return $self->{tlsm}{sh}; | |
981 } | |
982 | |
983 sub parse_tls_encrypted_extensions { | |
984 my ($self) = @_; | |
985 my $buf = $self->{crypto_in}[2][0][2] if $self->{crypto_in}[2][0]; | |
986 return 0 if !$buf; | |
987 my $off = 0; | |
988 my $content; | |
989 | |
990 while ($off < length($buf)) { | |
991 return 0 if length($buf) < 4; | |
992 my $type = unpack("C", substr($buf, $off, 1)); | |
993 my $len = unpack("n", substr($buf, $off + 2, 2)); | |
994 $content = substr($buf, $off + 4, $len); | |
995 return 0 if length($content) < $len; | |
996 last if $type == 8; | |
997 $off += 4 + $len; | |
998 } | |
999 $self->{tlsm}{ee} = substr($buf, $off, 4) . $content; | |
1000 return $self->{tlsm}{ee}; | |
1001 } | |
1002 | |
1003 sub parse_tls_certificate { | |
1004 my ($self) = @_; | |
1005 my $buf = $self->{crypto_in}[2][0][2] if $self->{crypto_in}[2][0]; | |
1006 return 0 if !$buf; | |
1007 my $off = 0; | |
1008 my $content; | |
1009 | |
1010 while ($off < length($buf)) { | |
1011 return 0 if length($buf) < 4; | |
1012 my $type = unpack("C", substr($buf, $off, 1)); | |
1013 my $len = unpack("n", substr($buf, $off + 2, 2)); | |
1014 $content = substr($buf, $off + 4, $len); | |
1015 return 0 if length($content) < $len; | |
1016 last if $type == 11; | |
1017 $off += 4 + $len; | |
1018 } | |
1019 $self->{tlsm}{cert} = substr($buf, $off, 4) . $content; | |
1020 return $self->{tlsm}{cert}; | |
1021 } | |
1022 | |
1023 sub parse_tls_certificate_verify { | |
1024 my ($self) = @_; | |
1025 my $buf = $self->{crypto_in}[2][0][2] if $self->{crypto_in}[2][0]; | |
1026 return 0 if !$buf; | |
1027 my $off = 0; | |
1028 my $content; | |
1029 | |
1030 while ($off < length($buf)) { | |
1031 return 0 if length($buf) < 4; | |
1032 my $type = unpack("C", substr($buf, $off, 1)); | |
1033 my $len = unpack("n", substr($buf, $off + 2, 2)); | |
1034 $content = substr($buf, $off + 4, $len); | |
1035 return 0 if length($content) < $len; | |
1036 last if $type == 15; | |
1037 $off += 4 + $len; | |
1038 } | |
1039 $self->{tlsm}{cv} = substr($buf, $off, 4) . $content; | |
1040 return $self->{tlsm}{cv}; | |
1041 } | |
1042 | |
1043 sub parse_tls_finished { | |
1044 my ($self) = @_; | |
1045 my $buf = $self->{crypto_in}[2][0][2] if $self->{crypto_in}[2][0]; | |
1046 return 0 if !$buf; | |
1047 my $off = 0; | |
1048 my $content; | |
1049 | |
1050 while ($off < length($buf)) { | |
1051 return 0 if length($buf) < 4; | |
1052 my $type = unpack("C", substr($buf, $off, 1)); | |
1053 my $len = unpack("n", substr($buf, $off + 2, 2)); | |
1054 $content = substr($buf, $off + 4, $len); | |
1055 return 0 if length($content) < $len; | |
1056 last if $type == 20; | |
1057 $off += 4 + $len; | |
1058 } | |
1059 $self->{tlsm}{sf} = substr($buf, $off, 4) . $content; | |
1060 return $self->{tlsm}{sf}; | |
1061 } | |
1062 | |
1063 sub parse_tls_nst { | |
1064 my ($self) = @_; | |
1065 my $buf = $self->{crypto_in}[3][0][2] if $self->{crypto_in}[3][0]; | |
1066 return 0 if !$buf; | |
1067 my $off = 0; | |
1068 my $content; | |
1069 | |
1070 while ($off < length($buf)) { | |
1071 return 0 if length($buf) < 4; | |
1072 my $type = unpack("C", substr($buf, $off, 1)); | |
1073 my $len = unpack("n", substr($buf, $off + 2, 2)); | |
1074 $content = substr($buf, $off + 4, $len); | |
1075 return 0 if length($content) < $len; | |
1076 $self->{tlsm}{nst} .= substr($buf, $off, 4) . $content; | |
1077 $self->save_session_tickets(substr($buf, $off, 4) . $content); | |
1078 $off += 4 + $len; | |
1079 substr($self->{crypto_in}[3][0][2], 0, $off) = ''; | |
1080 } | |
1081 } | |
1082 | |
1083 sub build_tls_client_hello { | |
1084 my ($self) = @_; | |
1085 my $key_share = $self->{sk}->export_key_raw('public'); | |
1086 | |
1087 my $version = "\x03\x03"; | |
1088 my $random = Crypt::PRNG::random_bytes(32); | |
1089 my $session = "\x00"; | |
1090 my $cipher = "\x00\x02\x13\x01"; | |
1091 my $compr = "\x01\x00"; | |
1092 my $ext = build_tlsext_server_name($self->{sni}) | |
1093 . build_tlsext_supported_groups(29) | |
1094 . build_tlsext_alpn("h3", "hq-interop") | |
1095 . build_tlsext_sigalgs(0x0804, 0x0805, 0x0806) | |
1096 . build_tlsext_supported_versions(0x0304) | |
1097 . build_tlsext_ke_modes(1) | |
1098 . build_tlsext_key_share(29, $key_share) | |
1099 . build_tlsext_quic_tp($self->{scid}, $self->{opts}); | |
1100 | |
1101 $ext .= build_tlsext_early_data($self->{psk}) | |
1102 . build_tlsext_psk($self->{psk}) if keys %{$self->{psk}}; | |
1103 | |
1104 my $len = pack('n', length($ext)); | |
1105 my $ch = $version . $random . $session . $cipher . $compr . $len . $ext; | |
1106 $ch = "\x01\x00" . pack('n', length($ch)) . $ch; | |
1107 $ch = build_tls_ch_with_binder($ch, $self->{es_prk}) | |
1108 if keys %{$self->{psk}}; | |
1109 return $ch; | |
1110 } | |
1111 | |
1112 sub build_tlsext_server_name { | |
1113 my ($name) = @_; | |
1114 my $sname = pack('xn', length($name)) . $name; | |
1115 my $snamelist = pack('n', length($sname)) . $sname; | |
1116 pack('n2', 0, length($snamelist)) . $snamelist; | |
1117 } | |
1118 | |
1119 sub build_tlsext_supported_groups { | |
1120 my $ngrouplist = pack('n*', @_ * 2, @_); | |
1121 pack('n2', 10, length($ngrouplist)) . $ngrouplist; | |
1122 } | |
1123 | |
1124 sub build_tlsext_alpn { | |
1125 my $protoname = pack('(C/a*)*', @_); | |
1126 my $protonamelist = pack('n', length($protoname)) . $protoname; | |
1127 pack('n2', 16, length($protonamelist)) . $protonamelist; | |
1128 } | |
1129 | |
1130 sub build_tlsext_sigalgs { | |
1131 my $sschemelist = pack('n*', @_ * 2, @_); | |
1132 pack('n2', 13, length($sschemelist)) . $sschemelist; | |
1133 } | |
1134 | |
1135 sub build_tlsext_supported_versions { | |
1136 my $versions = pack('Cn*', @_ * 2, @_); | |
1137 pack('n2', 43, length($versions)) . $versions; | |
1138 } | |
1139 | |
1140 sub build_tlsext_ke_modes { | |
1141 my $versions = pack('C*', scalar(@_), @_); | |
1142 pack('n2', 45, length($versions)) . $versions; | |
1143 } | |
1144 | |
1145 sub build_tlsext_key_share { | |
1146 my ($group, $share) = @_; | |
1147 my $kse = pack("n2", $group, length($share)) . $share; | |
1148 my $ksch = pack("n", length($kse)) . $kse; | |
1149 pack('n2', 51, length($ksch)) . $ksch; | |
1150 } | |
1151 | |
1152 sub build_tlsext_quic_tp { | |
1153 my ($scid, $opts) = @_; | |
1154 my $tp = ''; | |
1155 my $quic_tp_tlv = sub { | |
1156 my ($id, $val) = @_; | |
1157 $val = $opts->{$id} // $val; | |
1158 $val = build_int($val) unless $id == 15; | |
1159 $tp .= build_int($id) . pack("C*", length($val)) . $val; | |
1160 }; | |
1161 $quic_tp_tlv->(1, 30000); | |
1162 $quic_tp_tlv->(4, 1048576); | |
1163 $quic_tp_tlv->(5, 262144); | |
1164 $quic_tp_tlv->(7, 262144); | |
1165 $quic_tp_tlv->(9, 100); | |
1166 $quic_tp_tlv->(15, $scid); | |
1167 pack('n2', 57, length($tp)) . $tp; | |
1168 } | |
1169 | |
1170 sub build_tlsext_early_data { | |
1171 my ($psk) = @_; | |
1172 $psk->{ed} ? pack('n2', 42, 0) : ''; | |
1173 } | |
1174 | |
1175 sub build_tlsext_psk { | |
1176 my ($psk) = @_; | |
1177 my $identity = pack('n', length($psk->{ticket})) . $psk->{ticket} | |
1178 . $psk->{age_add}; | |
1179 my $identities = pack('n', length($identity)) . $identity; | |
1180 my $hash = pack('x32'); # SHA256 | |
1181 my $binder = pack('C', length($hash)) . $hash; | |
1182 my $binders = pack('n', length($binder)) . $binder; | |
1183 pack('n2', 41, length($identities . $binders)) . $identities . $binders; | |
1184 } | |
1185 | |
1186 sub build_tls_ch_with_binder { | |
1187 my ($ch, $prk) = @_; | |
1188 my $digest0 = Crypt::Digest::digest_data('SHA256', ''); | |
1189 my $key = hkdf_expand_label("tls13 res binder", 32, $prk, $digest0); | |
1190 my $truncated = substr($ch, 0, -35); | |
1191 my $context = Crypt::Digest::digest_data('SHA256', $truncated); | |
1192 $truncated . binders($key, $context); | |
1193 } | |
1194 | |
1195 ############################################################################### | |
1196 | |
1197 1; | |
1198 | |
1199 ############################################################################### |