From c9cf025fadfe043f0f2f679e10d1207d8a158bb6 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 7 Apr 2024 17:01:31 +0200 Subject: Adding debian version 2.4.57-2. Signed-off-by: Daniel Baumann --- debian/perl-framework/t/modules/http2.t | 535 ++++++++++++++++++++++++++++++++ 1 file changed, 535 insertions(+) create mode 100644 debian/perl-framework/t/modules/http2.t (limited to 'debian/perl-framework/t/modules/http2.t') diff --git a/debian/perl-framework/t/modules/http2.t b/debian/perl-framework/t/modules/http2.t new file mode 100644 index 0000000..02725f5 --- /dev/null +++ b/debian/perl-framework/t/modules/http2.t @@ -0,0 +1,535 @@ +use strict; +use warnings FATAL => 'all'; + +use Net::SSLeay; +use Apache::Test; +use Apache::TestRequest; +use Apache::TestUtil; +use Apache::TestConfig (); + +my $tls_version_suite = 4; +my $num_suite = 24; +my $vhost_suite = 4; +my $total_tests = 2 * $num_suite + $vhost_suite + $tls_version_suite; + +Net::SSLeay::initialize(); + +my $sni_available = Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000; +my $alpn_available = $sni_available && exists &Net::SSLeay::CTX_set_alpn_protos; + +plan tests => $total_tests, need 'Protocol::HTTP2::Client', 'AnyEvent', + need_module 'http2', need_min_apache_version('2.4.17'); + +# Check support for TLSv1_2 and later + +Apache::TestRequest::set_ca_cert(); + +# If we can, detect the SSL protocol the server speaks and do not run +# against anything pre-TLSv1.2 +# On some setups, we do not get a socket here (for not understood reasons) +# and run the tests. Better to fail visibly then. +# +my $tls_modern = 1; +my $tls_version = 0; + +my $sock = Apache::TestRequest::vhost_socket('h2'); +if ($sock) { + ok ($sock->connected); + + my $req = "GET / HTTP/1.1\r\n". + "Host: " . Apache::TestRequest::hostport() . "\r\n". + "\r\n"; + + ok $sock->print($req); + my $line = Apache::TestRequest::getline($sock) || ''; + ok t_cmp($line, qr{^HTTP/1\.. 200}, "read first response-line"); + $tls_version = $sock->get_sslversion(); + ok t_cmp($tls_version, qr{^(SSL|TLSv\d(_\d)?$)}, "TLS version in use"); + + if ($tls_version =~ /^(SSL|TLSv1(|_0|_1)$)/) { + print STDOUT "Disabling TLS tests due to TLS version $tls_version\n"; + $tls_modern = 0; + } +} +else { + skip "skipping test as socket not defined" foreach(1..$tls_version_suite); +} + +Apache::TestRequest::module("http2"); + +my $config = Apache::Test::config(); +my $host = $config->{vhosts}->{h2c}->{servername}; +my $port = $config->{vhosts}->{h2c}->{port}; + +my $shost = $config->{vhosts}->{h2}->{servername}; +my $sport = $config->{vhosts}->{h2}->{port}; +my $serverdir = $config->{vars}->{t_dir}; +my $htdocs = $serverdir . "/htdocs"; + +require Protocol::HTTP2::Client; +use AnyEvent; +use AnyEvent::Socket; +use AnyEvent::Handle; +use Net::SSLeay; +use AnyEvent::TLS; +use Carp qw( croak ); + +no warnings 'redefine'; +no strict 'refs'; +{ + my $old_ref = \&{ 'AnyEvent::TLS::new' }; + *{ 'AnyEvent::TLS::new' } = sub { + my ( $class, %param ) = @_; + + my $self = $old_ref->( $class, %param ); + + $self->{host_name} = $param{host_name} + if exists $param{host_name}; + + $self; + }; +} + +{ + my $old_ref = \&{ 'AnyEvent::TLS::_get_session' }; + *{ 'AnyEvent::TLS::_get_session' } = sub($$;$$) { + my ($self, $mode, $ref, $cn) = @_; + + my $session = $old_ref->( @_ ); + + if ( $mode eq 'connect' ) { + if ( $self->{host_name} ) { + print 'setting host_name to ' . $self->{host_name}; + Net::SSLeay::set_tlsext_host_name( $session, $self->{host_name} ); + } + } + + $session; + }; +} + + +sub connect_and_do { + my %args = ( + @_ + ); + my $scheme = $args{ctx}->{scheme}; + my $host = $args{ctx}->{host}; + my $port = $args{ctx}->{port}; + my $client = $args{ctx}->{client}; + my $host_name = $args{ctx}->{host_name}; + my $w = AnyEvent->condvar; + + tcp_connect $host, $port, sub { + my ($fh) = @_ or do { + print "connection failed: $!\n"; + $w->send; + return; + }; + + my $tls; + my $tls_ctx; + if ($scheme eq 'https') { + $tls = "connect"; + eval { + # ALPN (Net-SSLeay > 1.55, openssl >= 1.0.1) + if ( $alpn_available ) { + $tls_ctx = AnyEvent::TLS->new( method => "TLSv1_2", + host_name => $host_name ); + Net::SSLeay::CTX_set_alpn_protos( $tls_ctx->ctx, ['h2'] ); + } + else { + $tls_ctx = AnyEvent::TLS->new( host_name => $host_name ); + } + }; + if ($@) { + print "Some problem with SSL CTX: $@\n"; + $w->send; + return; + } + } + + my $handle; + $handle = AnyEvent::Handle->new( + fh => $fh, + tls => $tls, + tls_ctx => $tls_ctx, + autocork => 1, + on_error => sub { + $_[0]->destroy; + print "connection error\n"; + $w->send; + }, + on_eof => sub { + $handle->destroy; + $w->send; + } + ); + + # First write preface to peer + while ( my $frame = $client->next_frame ) { + $handle->push_write($frame); + } + + $handle->on_read(sub { + my $handle = shift; + + $client->feed( $handle->{rbuf} ); + $handle->{rbuf} = undef; + + while ( my $frame = $client->next_frame ) { + $handle->push_write($frame); + } + + # Terminate connection if all done + $handle->push_shutdown if $client->shutdown; + }); + }; + $w->recv; + +} + +################################################################################ +# +# Add a request to the client, will be started whenever a STREAM to +# the server is available. +# +sub add_request { + my ($scheme, $client, $host, $port); + my %args = ( + method => 'GET', + headers => [], + rc => 200, + on_done => sub { + my %args = ( @_ ); + my $ctx = $args{ctx}; + my $req = $args{request}; + my $resp = $args{response}; + my $hr = $resp->{headers}; + my %headers = @$hr; + ok t_cmp($headers{':status'}, $req->{rc}, + "$req->{method} $ctx->{scheme}://$ctx->{host}:$ctx->{port}$req->{path}"); + }, + @_ + ); + $client = $args{ctx}->{client}; + $scheme = $args{ctx}->{scheme}; + $host = $args{ctx}->{host}; + $port = $args{ctx}->{port}; + + $client->request( + ':scheme' => $scheme, + ':authority' => $args{authority} || $host . ':' . $port, + ':path' => $args{path}, + ':method' => $args{method}, + headers => $args{headers}, + on_done => sub { + my ($headers, $data) = @_; + $args{on_done}( + ctx => $args{ctx}, + request => \%args, + response => { headers => \@$headers, data => $data } + ); + } + ); +} + +################################################################################ +# +# Add a list of request that will be processed in order. Only when the previous +# request is done, will a new one be started. +# +sub add_sequential { + my ($scheme, $client, $host, $port); + my %args = ( @_ ); + my $ctx = $args{ctx}; + my $requests = $args{requests}; + + $client = $args{ctx}->{client}; + $scheme = $args{ctx}->{scheme}; + $host = $args{ctx}->{host}; + $port = $args{ctx}->{port}; + + my $request = shift @$requests; + + if ($request) { + my %r = ( + method => 'GET', + headers => [], + rc => 200, + on_done => sub { + my %args = ( @_ ); + my $ctx = $args{ctx}; + my $req = $args{request}; + my $resp = $args{response}; + my $hr = $resp->{headers}; + my %headers = @$hr; + ok t_cmp($headers{':status'}, $req->{rc}, + "$req->{method} $ctx->{scheme}://$ctx->{host}:$ctx->{port}$req->{path}"); + }, + %$request + ); + + print "test case: $r{descr}: $r{method} $ctx->{scheme}://$ctx->{host}:$ctx->{port}$r{path}\n"; + $client->request( + ':scheme' => $scheme, + ':authority' => $r{authority} || $host . ':' . $port, + ':path' => $r{path}, + ':method' => $r{method}, + headers => $r{headers}, + on_done => sub { + my ($headers, $data) = @_; + $r{on_done}( + ctx => ${ctx}, + request => \%r, + response => { headers => \@$headers, data => $data } + ); + add_sequential( + ctx => $ctx, + requests => $requests + ); + } + ); + } +} + +sub cmp_content_length { + my %args = ( @_ ); + my $ctx = $args{ctx}; + my $req = $args{request}; + my $resp = $args{response}; + my $hr = $resp->{headers}; + my %headers = @$hr; + ok t_cmp($headers{':status'}, $req->{rc}, "response status"); + ok t_cmp(length $resp->{data}, $req->{content_length}, "content-length"); +} + +sub cmp_content { + my %args = ( @_ ); + my $ctx = $args{ctx}; + my $req = $args{request}; + my $resp = $args{response}; + my $hr = $resp->{headers}; + my %headers = @$hr; + ok t_cmp($headers{':status'}, $req->{rc}, "response status"); + ok t_cmp($resp->{data}, $req->{content}, "content comparision"); +} + +sub cmp_file_response { + my %args = ( @_ ); + my $ctx = $args{ctx}; + my $req = $args{request}; + my $resp = $args{response}; + my $hr = $resp->{headers}; + my %headers = @$hr; + ok t_cmp($headers{':status'}, $req->{rc}, "response status"); + open(FILE, "<$htdocs$req->{path}") or die "cannot open $req->{path}"; + undef $/; + my $content = ; + close(FILE); + ok t_is_equal($resp->{data}, $content); +} + +sub check_redir { + my %args = ( @_ ); + my $ctx = $args{ctx}; + my $req = $args{request}; + my $resp = $args{response}; + my $hr = $resp->{headers}; + my %headers = @$hr; + ok t_cmp($headers{':status'}, 302, "response status"); + ok t_cmp( + $headers{location}, + "$ctx->{scheme}://$ctx->{host}:$ctx->{port}$req->{redir_path}", + "location header" + ); +} + +################################################################################ +# +# Perform common tests to h2c + h2 hosts +# +sub do_common { + my %args = ( + scheme => 'http', + host => 'localhost', + port => 80, + @_ + ); + my $true_tls = ($args{scheme} eq 'https' and $sni_available); + + $args{client} = Protocol::HTTP2::Client->new( upgrade => 0 ); + + my $r = [ + { + descr => 'TC0001, expecting 200', + path => '/' + }, + { + descr => 'TC0002, expecting 404', + rc => 404, + path => '/not_here' + }, + { + descr => 'TC0005, cmp index.html file', + path => '/modules/h2/index.html', + on_done => \&cmp_file_response + }, + { + descr => 'TC0006, cmp image file', + path => '/modules/h2/003/003_img.jpg', + on_done => \&cmp_file_response + }, + ]; + + if (have_module 'mod_rewrite') { + push @$r, { + descr => 'TC0007, rewrite handling', + path => '/modules/h2/latest.tar.gz', + redir_path => "/modules/h2/xxx-1.0.2a.tar.gz", + on_done => \&check_redir + } + } + else { + skip "skipping test as mod_rewrite not available" foreach(1..2); + } + + if (have_cgi) { + # my $sni_host = $true_tls? 'localhost' : ''; + my $content = < +

Hello World!

+ +EOF + + push @$r, { + descr => 'TC0008, hello.pl with ssl vars', + path => '/modules/h2/hello.pl', + content => $content, + on_done => \&cmp_content, + }; + + $content = < +

No query was specified.

+ +EOF + push @$r, { + descr => 'TC0009, necho.pl without arguments', + path => '/modules/h2/necho.pl', + content => $content, + rc => 400, + on_done => \&cmp_content, + }; + push @$r, { + descr => 'TC0010, necho.pl 2x10', + path => '/modules/h2/necho.pl?count=2&text=0123456789', + content => "01234567890123456789", + on_done => \&cmp_content, + }; + push @$r, { + descr => 'TC0011, necho.pl 10x10', + path => '/modules/h2/necho.pl?count=10&text=0123456789', + content_length => 100, + on_done => \&cmp_content_length, + }; + push @$r, { + descr => 'TC0012, necho.pl 100x10', + path => '/modules/h2/necho.pl?count=100&text=0123456789', + content_length => 1000, + on_done => \&cmp_content_length, + }; + push @$r, { + descr => 'TC0013, necho.pl 1000x10', + path => '/modules/h2/necho.pl?count=1000&text=0123456789', + content_length => 10000, + on_done => \&cmp_content_length, + }; + push @$r, { + descr => 'TC0014, necho.pl 10000x10', + path => '/modules/h2/necho.pl?count=10000&text=0123456789', + content_length => 100000, + on_done => \&cmp_content_length, + }; + push @$r, { + descr => 'TC0015, necho.pl 100000x10', + path => '/modules/h2/necho.pl?count=100000&text=0123456789', + content_length => 1000000, + on_done => \&cmp_content_length, + }; + } + else { + skip "skipping test as mod_cgi not available" foreach(1..16); + } + + add_sequential( + ctx => \%args, + requests => $r + ); + connect_and_do( ctx => \%args ); +} + +################################################################################ +# +# Perform tests for virtual host setups, requires a client with SNI+ALPN +# +sub do_vhosts { + my %args = ( + scheme => 'http', + host => 'localhost', + port => 80, + @_ + ); + $args{client} = Protocol::HTTP2::Client->new( upgrade => 0 ); + + my $r = [ + { + descr => 'VHOST000, expecting 200', + path => '/' + }, + { + descr => 'VHOST001, expect 404 or 421 (using Host:)', + rc => 404, + path => '/misdirected', + header => [ 'host' => 'noh2.example.org' . $args{port} ] + }, + { + descr => 'VHOST002, expect 421 (using :authority)', + rc => 421, + path => '/misdirected', + authority => 'noh2.example.org:' . $args{port} + }, + { + descr => 'VHOST003, expect 421 ', + rc => (have_min_apache_version('2.4.18')? 404 : 421), + path => '/misdirected', + authority => 'test.example.org:' . $args{port} + }, + ]; + + add_sequential( + ctx => \%args, + requests => $r + ); + connect_and_do( ctx => \%args ); +} + +################################################################################ +# +# Bring it on +# +do_common( 'scheme' => 'http', 'host' => $host, 'port' => $port ); +if ($tls_modern) { + do_common( 'scheme' => 'https', 'host' => $shost, 'port' => $sport ); +} else { + skip "skipping test as TLS version '$tls_version' is not supported" foreach(1..$num_suite); +} +if ($sni_available) { + if ($tls_modern) { + do_vhosts( 'scheme' => 'https', 'host' => $shost, 'port' => $sport, host_name => "$shost:${sport}" ); + } else { + skip "skipping test as TLS version '$tls_version' is not supported" foreach(1..$vhost_suite); + } +} else { + skip "skipping test as SNI not available" foreach(1..$vhost_suite); +} -- cgit v1.2.3