Mercurial > hg > nginx-tests

comparison lib/Test/Nginx/HTTP3.pm @ 1874:d57a0fd293a3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 ###############################################################################