1#!perl
2# DTRACE_TESTS=1 to skip to check prereqisites
3# H2OLOG_DEBUG=1 for more runtime logs
4use strict;
5use warnings FATAL => "all";
6use Net::EmptyPort qw(empty_port);
7use Test::More;
8use JSON;
9use t::Util;
10
11run_as_root();
12
13my $h2olog_prog = bindir() . "/h2olog";
14my $client_prog = bindir() . "/h2o-httpclient";
15
16unless ($ENV{DTRACE_TESTS})  {
17  plan skip_all => "$h2olog_prog not found"
18      unless -e $h2olog_prog;
19
20  plan skip_all => "$client_prog not found"
21      unless -e $client_prog;
22
23  plan skip_all => 'dtrace support is off'
24      unless server_features()->{dtrace};
25}
26
27my $quic_port = empty_port({
28    host  => "127.0.0.1",
29    proto => "udp",
30});
31
32my $server = spawn_h2o({
33    opts => [qw(--mode=worker)],
34    conf => << "EOT",
35listen:
36  type: quic
37  port: $quic_port
38  ssl:
39    key-file: examples/h2o/server.key
40    certificate-file: examples/h2o/server.crt
41hosts:
42  default:
43    paths:
44      /:
45        file.dir: t/assets/doc_root
46EOT
47});
48
49subtest "h2olog", sub {
50  my $tracer = H2ologTracer->new({
51    pid => $server->{pid},
52    args => [],
53  });
54
55  my ($headers, $body) = run_prog("$client_prog -3 https://127.0.0.1:$quic_port/");
56  like $headers, qr{^HTTP/3 200\n}m, "req: HTTP/3";
57
58  my $trace;
59  until (($trace = $tracer->get_trace()) =~ m{"h3s-destroy"}) {}
60
61  if ($ENV{H2OLOG_DEBUG}) {
62    diag "h2olog output:\n", $trace;
63  }
64
65  my @events = map { decode_json($_) } split /\n/, $trace;
66  is scalar(grep { $_->{type} && $_->{tid} && $_->{seq} } @events), scalar(@events), "each event has type, tid and seq";
67
68  my($h3s_accept) = grep { $_->{type} eq "h3s-accept" } @events;
69  ok is_uuidv4($h3s_accept->{"conn-uuid"}), "h3s-accept has a UUIDv4 field `conn-uuid`"
70};
71
72subtest "h2olog -t", sub {
73  my $tracer = H2ologTracer->new({
74    pid => $server->{pid},
75    args => [
76      "-t", "h2o:send_response_header",
77      "-t", "h2o:receive_request_header",
78      "-t", "h2o:h3s_destroy",
79    ],
80  });
81
82  my ($headers, $body) = run_prog("$client_prog -3 https://127.0.0.1:$quic_port/");
83  like $headers, qr{^HTTP/3 200\n}m, "req: HTTP/3";
84
85  my $trace;
86  until (($trace = $tracer->get_trace()) =~ m{"h3s-destroy"}) {}
87
88  if ($ENV{H2OLOG_DEBUG}) {
89    diag "h2olog output:\n", $trace;
90  }
91
92  my %group_by;
93  foreach my $event (map { decode_json($_) } split /\n/, $trace) {
94    $group_by{$event->{"type"}}++;
95  }
96
97  is_deeply [sort keys %group_by], [sort qw(h3s-destroy send-response-header receive-request-header)];
98};
99
100subtest "h2olog -H", sub {
101  my $tracer = H2ologTracer->new({
102    pid => $server->{pid},
103    args => ["-H"],
104  });
105
106  my ($headers, $body) = run_prog("$client_prog -3 https://127.0.0.1:$quic_port/");
107  like $headers, qr{^HTTP/3 200\n}m, "req: HTTP/3";
108
109  my $trace;
110  until (($trace = $tracer->get_trace()) =~ m{\bRxProtocol\b}) {}
111
112  if ($ENV{H2OLOG_DEBUG}) {
113    diag "h2olog output:\n", $trace;
114  }
115
116  like $trace, qr{\bRxProtocol\s+HTTP/3.0\b};
117  like $trace, qr{\bTxStatus\s+200\b};
118};
119
120# wait until the server and the tracer exits
121diag "shutting down ...";
122undef $server;
123
124done_testing();
125
126sub is_uuidv4 {
127  my($s) = @_;
128
129  # sited from https://stackoverflow.com/a/19989922/805246
130  $s =~ /\A[0-9A-F]{8}-[0-9A-F]{4}-4[0-9A-F]{3}-[89AB][0-9A-F]{3}-[0-9A-F]{12}\z/i;
131}
132