summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/t/modules/http2.t
diff options
context:
space:
mode:
Diffstat (limited to 'debian/perl-framework/t/modules/http2.t')
-rw-r--r--debian/perl-framework/t/modules/http2.t535
1 files changed, 0 insertions, 535 deletions
diff --git a/debian/perl-framework/t/modules/http2.t b/debian/perl-framework/t/modules/http2.t
deleted file mode 100644
index 02725f5..0000000
--- a/debian/perl-framework/t/modules/http2.t
+++ /dev/null
@@ -1,535 +0,0 @@
-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 = <FILE>;
- 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 = <<EOF;
-<html><body>
-<h2>Hello World!</h2>
-</body></html>
-EOF
-
- push @$r, {
- descr => 'TC0008, hello.pl with ssl vars',
- path => '/modules/h2/hello.pl',
- content => $content,
- on_done => \&cmp_content,
- };
-
- $content = <<EOF;
-<html><body>
-<p>No query was specified.</p>
-</body></html>
-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);
-}
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-07 01:27:05 +0000