| package Test::Nginx; |
| |
| # (C) Maxim Dounin |
| |
| # Generic module for nginx tests. |
| |
| ############################################################################### |
| |
| use warnings; |
| use strict; |
| |
| use base qw/ Exporter /; |
| |
| our @EXPORT = qw/ log_in log_out http http_get http_head port /; |
| our @EXPORT_OK = qw/ http_gzip_request http_gzip_like http_start http_end /; |
| our %EXPORT_TAGS = ( |
| gzip => [ qw/ http_gzip_request http_gzip_like / ] |
| ); |
| |
| ############################################################################### |
| |
| use File::Path qw/ rmtree /; |
| use File::Spec qw//; |
| use File::Temp qw/ tempdir /; |
| use IO::Socket; |
| use POSIX qw/ waitpid WNOHANG /; |
| use Socket qw/ CRLF /; |
| use Test::More qw//; |
| |
| ############################################################################### |
| |
| our $NGINX = defined $ENV{TEST_NGINX_BINARY} ? $ENV{TEST_NGINX_BINARY} |
| : '../nginx/objs/nginx'; |
| our %ports = (); |
| |
| sub new { |
| my $self = {}; |
| bless $self; |
| |
| $self->{_pid} = $$; |
| $self->{_alerts} = 1; |
| |
| $self->{_testdir} = tempdir( |
| 'nginx-test-XXXXXXXXXX', |
| TMPDIR => 1 |
| ) |
| or die "Can't create temp directory: $!\n"; |
| $self->{_testdir} =~ s!\\!/!g if $^O eq 'MSWin32'; |
| mkdir "$self->{_testdir}/logs" |
| or die "Can't create logs directory: $!\n"; |
| |
| Test::More::BAIL_OUT("no $NGINX binary found") |
| unless -x $NGINX; |
| |
| return $self; |
| } |
| |
| sub DESTROY { |
| my ($self) = @_; |
| local $?; |
| |
| return if $self->{_pid} != $$; |
| |
| $self->stop(); |
| $self->stop_daemons(); |
| |
| if (Test::More->builder->expected_tests) { |
| local $Test::Nginx::TODO = 'alerts' unless $self->{_alerts}; |
| |
| my @alerts = $self->read_file('error.log') =~ /.+\[alert\].+/gm; |
| |
| if ($^O eq 'solaris') { |
| $Test::Nginx::TODO = 'alerts' if @alerts |
| && ! grep { $_ !~ /phantom event/ } @alerts; |
| } |
| if ($^O eq 'MSWin32') { |
| my $re = qr/CloseHandle|TerminateProcess/; |
| $Test::Nginx::TODO = 'alerts' if @alerts |
| && ! grep { $_ !~ $re } @alerts; |
| } |
| |
| Test::More::is(join("\n", @alerts), '', 'no alerts'); |
| } |
| |
| if (Test::More->builder->expected_tests) { |
| local $Test::Nginx::TODO; |
| my $errors = $self->read_file('error.log'); |
| $errors = join "\n", $errors =~ /.+Sanitizer.+/gm; |
| Test::More::is($errors, '', 'no sanitizer errors'); |
| } |
| |
| if ($ENV{TEST_NGINX_CATLOG}) { |
| system("cat $self->{_testdir}/error.log"); |
| } |
| if (not $ENV{TEST_NGINX_LEAVE}) { |
| eval { rmtree($self->{_testdir}); }; |
| } |
| } |
| |
| sub has($;) { |
| my ($self, @features) = @_; |
| |
| foreach my $feature (@features) { |
| Test::More::plan(skip_all => "no $feature available") |
| unless $self->has_module($feature) |
| or $self->has_feature($feature); |
| } |
| |
| return $self; |
| } |
| |
| sub has_module($) { |
| my ($self, $feature) = @_; |
| |
| my %regex = ( |
| sni => 'TLS SNI support enabled', |
| mail => '--with-mail((?!\S)|=dynamic)', |
| flv => '--with-http_flv_module', |
| perl => '--with-http_perl_module', |
| auth_request |
| => '--with-http_auth_request_module', |
| realip => '--with-http_realip_module', |
| sub => '--with-http_sub_module', |
| charset => '(?s)^(?!.*--without-http_charset_module)', |
| gzip => '(?s)^(?!.*--without-http_gzip_module)', |
| ssi => '(?s)^(?!.*--without-http_ssi_module)', |
| mirror => '(?s)^(?!.*--without-http_mirror_module)', |
| userid => '(?s)^(?!.*--without-http_userid_module)', |
| access => '(?s)^(?!.*--without-http_access_module)', |
| auth_basic |
| => '(?s)^(?!.*--without-http_auth_basic_module)', |
| autoindex |
| => '(?s)^(?!.*--without-http_autoindex_module)', |
| geo => '(?s)^(?!.*--without-http_geo_module)', |
| map => '(?s)^(?!.*--without-http_map_module)', |
| referer => '(?s)^(?!.*--without-http_referer_module)', |
| rewrite => '(?s)^(?!.*--without-http_rewrite_module)', |
| proxy => '(?s)^(?!.*--without-http_proxy_module)', |
| fastcgi => '(?s)^(?!.*--without-http_fastcgi_module)', |
| uwsgi => '(?s)^(?!.*--without-http_uwsgi_module)', |
| scgi => '(?s)^(?!.*--without-http_scgi_module)', |
| grpc => '(?s)^(?!.*--without-http_grpc_module)', |
| memcached |
| => '(?s)^(?!.*--without-http_memcached_module)', |
| limit_conn |
| => '(?s)^(?!.*--without-http_limit_conn_module)', |
| limit_req |
| => '(?s)^(?!.*--without-http_limit_req_module)', |
| empty_gif |
| => '(?s)^(?!.*--without-http_empty_gif_module)', |
| browser => '(?s)^(?!.*--without-http_browser_module)', |
| upstream_hash |
| => '(?s)^(?!.*--without-http_upstream_hash_module)', |
| upstream_ip_hash |
| => '(?s)^(?!.*--without-http_upstream_ip_hash_module)', |
| upstream_least_conn |
| => '(?s)^(?!.*--without-http_upstream_least_conn_mod)', |
| upstream_random |
| => '(?s)^(?!.*--without-http_upstream_random_module)', |
| upstream_keepalive |
| => '(?s)^(?!.*--without-http_upstream_keepalive_modu)', |
| upstream_zone |
| => '(?s)^(?!.*--without-http_upstream_zone_module)', |
| http => '(?s)^(?!.*--without-http(?!\S))', |
| cache => '(?s)^(?!.*--without-http-cache)', |
| pop3 => '(?s)^(?!.*--without-mail_pop3_module)', |
| imap => '(?s)^(?!.*--without-mail_imap_module)', |
| smtp => '(?s)^(?!.*--without-mail_smtp_module)', |
| pcre => '(?s)^(?!.*--without-pcre)', |
| split_clients |
| => '(?s)^(?!.*--without-http_split_clients_module)', |
| stream => '--with-stream((?!\S)|=dynamic)', |
| stream_access |
| => '(?s)^(?!.*--without-stream_access_module)', |
| stream_geo |
| => '(?s)^(?!.*--without-stream_geo_module)', |
| stream_limit_conn |
| => '(?s)^(?!.*--without-stream_limit_conn_module)', |
| stream_map |
| => '(?s)^(?!.*--without-stream_map_module)', |
| stream_return |
| => '(?s)^(?!.*--without-stream_return_module)', |
| stream_split_clients |
| => '(?s)^(?!.*--without-stream_split_clients_module)', |
| stream_ssl |
| => '--with-stream_ssl_module', |
| stream_upstream_hash |
| => '(?s)^(?!.*--without-stream_upstream_hash_module)', |
| stream_upstream_least_conn |
| => '(?s)^(?!.*--without-stream_upstream_least_conn_m)', |
| stream_upstream_random |
| => '(?s)^(?!.*--without-stream_upstream_random_modul)', |
| stream_upstream_zone |
| => '(?s)^(?!.*--without-stream_upstream_zone_module)', |
| ); |
| |
| my $re = $regex{$feature}; |
| $re = $feature if !defined $re; |
| |
| $self->{_configure_args} = `$NGINX -V 2>&1` |
| if !defined $self->{_configure_args}; |
| |
| return 1 if $self->{_configure_args} =~ $re; |
| |
| my %modules = ( |
| http_geoip |
| => 'ngx_http_geoip_module', |
| image_filter |
| => 'ngx_http_image_filter_module', |
| perl => 'ngx_http_perl_module', |
| xslt => 'ngx_http_xslt_filter_module', |
| mail => 'ngx_mail_module', |
| stream => 'ngx_stream_module', |
| stream_geoip |
| => 'ngx_stream_geoip_module', |
| ); |
| |
| my $module = $modules{$feature}; |
| if (defined $module && defined $ENV{TEST_NGINX_GLOBALS}) { |
| $re = qr/load_module\s+[^;]*\Q$module\E[-\w]*\.so\s*;/; |
| return 1 if $ENV{TEST_NGINX_GLOBALS} =~ $re; |
| } |
| |
| return 0; |
| } |
| |
| sub has_feature($) { |
| my ($self, $feature) = @_; |
| |
| if ($feature eq 'symlink') { |
| return $^O ne 'MSWin32'; |
| } |
| |
| if ($feature eq 'unix') { |
| return $^O ne 'MSWin32'; |
| } |
| |
| if ($feature eq 'udp') { |
| return $^O ne 'MSWin32'; |
| } |
| |
| return 0; |
| } |
| |
| sub has_version($) { |
| my ($self, $need) = @_; |
| |
| $self->{_configure_args} = `$NGINX -V 2>&1` |
| if !defined $self->{_configure_args}; |
| |
| $self->{_configure_args} =~ m!nginx version: nginx/([0-9.]+)!; |
| |
| my @v = split(/\./, $1); |
| my ($n, $v); |
| |
| for $n (split(/\./, $need)) { |
| $v = shift @v || 0; |
| return 0 if $n > $v; |
| return 1 if $v > $n; |
| } |
| |
| return 1; |
| } |
| |
| sub has_daemon($) { |
| my ($self, $daemon) = @_; |
| |
| if ($^O eq 'MSWin32') { |
| `for %i in ($daemon.exe) do \@echo | set /p x=%~\$PATH:i` |
| or Test::More::plan(skip_all => "$daemon not found"); |
| return $self; |
| } |
| |
| if ($^O eq 'solaris') { |
| Test::More::plan(skip_all => "$daemon not found") |
| unless `command -v $daemon`; |
| return $self; |
| } |
| |
| Test::More::plan(skip_all => "$daemon not found") |
| unless `which $daemon`; |
| |
| return $self; |
| } |
| |
| sub try_run($$) { |
| my ($self, $message) = @_; |
| |
| eval { |
| open OLDERR, ">&", \*STDERR; close STDERR; |
| $self->run(); |
| open STDERR, ">&", \*OLDERR; |
| }; |
| |
| return $self unless $@; |
| |
| if ($ENV{TEST_NGINX_VERBOSE}) { |
| my $path = $self->{_configure_args} =~ m!--error-log-path=(\S+)! |
| ? $1 : 'logs/error.log'; |
| $path = "$self->{_testdir}/$path" if index($path, '/'); |
| |
| open F, '<', $path or die "Can't open $path: $!"; |
| log_core($_) while (<F>); |
| close F; |
| } |
| |
| Test::More::plan(skip_all => $message); |
| return $self; |
| } |
| |
| sub plan($) { |
| my ($self, $plan) = @_; |
| |
| Test::More::plan(tests => $plan + 2); |
| |
| return $self; |
| } |
| |
| sub todo_alerts() { |
| my ($self) = @_; |
| |
| $self->{_alerts} = 0; |
| |
| return $self; |
| } |
| |
| sub run(;$) { |
| my ($self, $conf) = @_; |
| |
| my $testdir = $self->{_testdir}; |
| |
| if (defined $conf) { |
| my $c = `cat $conf`; |
| $self->write_file_expand('nginx.conf', $c); |
| } |
| |
| my $pid = fork(); |
| die "Unable to fork(): $!\n" unless defined $pid; |
| |
| if ($pid == 0) { |
| my @globals = $self->{_test_globals} ? |
| () : ('-g', "pid $testdir/nginx.pid; " |
| . "error_log $testdir/error.log debug;"); |
| exec($NGINX, '-p', "$testdir/", '-c', 'nginx.conf', @globals), |
| or die "Unable to exec(): $!\n"; |
| } |
| |
| # wait for nginx to start |
| |
| $self->waitforfile("$testdir/nginx.pid", $pid) |
| or die "Can't start nginx"; |
| |
| for (1 .. 50) { |
| last if $^O ne 'MSWin32'; |
| last if $self->read_file('error.log') =~ /create thread/; |
| select undef, undef, undef, 0.1; |
| } |
| |
| $self->{_started} = 1; |
| return $self; |
| } |
| |
| sub port { |
| my ($num, %opts) = @_; |
| my ($sock, $lock, $port); |
| |
| goto done if defined $ports{$num}; |
| |
| my $socket = sub { |
| IO::Socket::INET->new( |
| Proto => 'tcp', |
| LocalAddr => '127.0.0.1:' . shift, |
| Listen => 1, |
| Reuse => ($^O ne 'MSWin32'), |
| ); |
| }; |
| |
| my $socketl = sub { |
| IO::Socket::INET->new( |
| Proto => 'udp', |
| LocalAddr => '127.0.0.1:' . shift, |
| ); |
| }; |
| |
| ($socket, $socketl) = ($socketl, $socket) if $opts{udp}; |
| |
| $port = $num; |
| |
| for (1 .. 10) { |
| $port = int($port / 500) * 500 + int(rand(500)) unless $_ == 1; |
| |
| $lock = $socketl->($port) or next; |
| $sock = $socket->($port) and last; |
| } |
| |
| die "Port limit exceeded" unless defined $lock and defined $sock; |
| |
| $ports{$num} = { |
| port => $port, |
| socket => $lock |
| }; |
| |
| done: |
| return $ports{$num}{socket} if $opts{socket}; |
| return $ports{$num}{port}; |
| } |
| |
| sub dump_config() { |
| my ($self) = @_; |
| |
| my $testdir = $self->{_testdir}; |
| |
| my @globals = $self->{_test_globals} ? |
| () : ('-g', "pid $testdir/nginx.pid; " |
| . "error_log $testdir/error.log debug;"); |
| my $command = "$NGINX -T -p $testdir/ -c nginx.conf " |
| . join(' ', @globals); |
| |
| return qx/$command 2>&1/; |
| } |
| |
| sub waitforfile($;$) { |
| my ($self, $file, $pid) = @_; |
| my $exited; |
| |
| # wait for file to appear |
| # or specified process to exit |
| |
| for (1 .. 50) { |
| return 1 if -e $file; |
| return 0 if $exited; |
| $exited = waitpid($pid, WNOHANG) != 0 if $pid; |
| select undef, undef, undef, 0.1; |
| } |
| |
| return undef; |
| } |
| |
| sub waitforsocket($) { |
| my ($self, $peer) = @_; |
| |
| # wait for socket to accept connections |
| |
| for (1 .. 50) { |
| my $s = IO::Socket::INET->new( |
| Proto => 'tcp', |
| PeerAddr => $peer |
| ); |
| |
| return 1 if defined $s; |
| |
| select undef, undef, undef, 0.1; |
| } |
| |
| return undef; |
| } |
| |
| sub reload() { |
| my ($self) = @_; |
| |
| return $self unless $self->{_started}; |
| |
| my $pid = $self->read_file('nginx.pid'); |
| |
| if ($^O eq 'MSWin32') { |
| my $testdir = $self->{_testdir}; |
| my @globals = $self->{_test_globals} ? |
| () : ('-g', "pid $testdir/nginx.pid; " |
| . "error_log $testdir/error.log debug;"); |
| system($NGINX, '-p', $testdir, '-c', "nginx.conf", |
| '-s', 'reload', @globals) == 0 |
| or die "system() failed: $?\n"; |
| |
| } else { |
| kill 'HUP', $pid; |
| } |
| |
| return $self; |
| } |
| |
| sub stop() { |
| my ($self) = @_; |
| |
| return $self unless $self->{_started}; |
| |
| my $pid = $self->read_file('nginx.pid'); |
| |
| if ($^O eq 'MSWin32') { |
| my $testdir = $self->{_testdir}; |
| my @globals = $self->{_test_globals} ? |
| () : ('-g', "pid $testdir/nginx.pid; " |
| . "error_log $testdir/error.log debug;"); |
| system($NGINX, '-p', $testdir, '-c', "nginx.conf", |
| '-s', 'stop', @globals) == 0 |
| or die "system() failed: $?\n"; |
| |
| } else { |
| kill 'QUIT', $pid; |
| } |
| |
| waitpid($pid, 0); |
| |
| $self->{_started} = 0; |
| |
| return $self; |
| } |
| |
| sub stop_daemons() { |
| my ($self) = @_; |
| |
| while ($self->{_daemons} && scalar @{$self->{_daemons}}) { |
| my $p = shift @{$self->{_daemons}}; |
| kill $^O eq 'MSWin32' ? 9 : 'TERM', $p; |
| waitpid($p, 0); |
| } |
| |
| return $self; |
| } |
| |
| sub read_file($) { |
| my ($self, $name) = @_; |
| local $/; |
| |
| open F, '<', $self->{_testdir} . '/' . $name |
| or die "Can't open $name: $!"; |
| my $content = <F>; |
| close F; |
| |
| return $content; |
| } |
| |
| sub write_file($$) { |
| my ($self, $name, $content) = @_; |
| |
| open F, '>' . $self->{_testdir} . '/' . $name |
| or die "Can't create $name: $!"; |
| binmode F; |
| print F $content; |
| close F; |
| |
| return $self; |
| } |
| |
| sub write_file_expand($$) { |
| my ($self, $name, $content) = @_; |
| |
| $content =~ s/%%TEST_GLOBALS%%/$self->test_globals()/gmse; |
| $content =~ s/%%TEST_GLOBALS_HTTP%%/$self->test_globals_http()/gmse; |
| $content =~ s/%%TESTDIR%%/$self->{_testdir}/gms; |
| |
| $content =~ s/127\.0\.0\.1:(8\d\d\d)/'127.0.0.1:' . port($1)/gmse; |
| |
| $content =~ s/%%PORT_(\d+)%%/port($1)/gmse; |
| $content =~ s/%%PORT_(\d+)_UDP%%/port($1, udp => 1)/gmse; |
| |
| return $self->write_file($name, $content); |
| } |
| |
| sub run_daemon($;@) { |
| my ($self, $code, @args) = @_; |
| |
| my $pid = fork(); |
| die "Can't fork daemon: $!\n" unless defined $pid; |
| |
| if ($pid == 0) { |
| if (ref($code) eq 'CODE') { |
| $code->(@args); |
| exit 0; |
| } else { |
| exec($code, @args); |
| exit 0; |
| } |
| } |
| |
| $self->{_daemons} = [] unless defined $self->{_daemons}; |
| push @{$self->{_daemons}}, $pid; |
| |
| return $self; |
| } |
| |
| sub testdir() { |
| my ($self) = @_; |
| return $self->{_testdir}; |
| } |
| |
| sub test_globals() { |
| my ($self) = @_; |
| |
| return $self->{_test_globals} |
| if defined $self->{_test_globals}; |
| |
| my $s = ''; |
| |
| $s .= "pid $self->{_testdir}/nginx.pid;\n"; |
| $s .= "error_log $self->{_testdir}/error.log debug;\n"; |
| |
| $s .= $ENV{TEST_NGINX_GLOBALS} |
| if $ENV{TEST_NGINX_GLOBALS}; |
| |
| $s .= $self->test_globals_modules(); |
| $s .= $self->test_globals_perl5lib() if $s !~ /env PERL5LIB/; |
| |
| $self->{_test_globals} = $s; |
| } |
| |
| sub test_globals_modules() { |
| my ($self) = @_; |
| |
| my $modules = $ENV{TEST_NGINX_MODULES}; |
| |
| if (!defined $modules) { |
| my ($volume, $dir) = File::Spec->splitpath($NGINX); |
| $modules = File::Spec->catpath($volume, $dir, ''); |
| } |
| |
| $modules = File::Spec->rel2abs($modules); |
| $modules =~ s!\\!/!g if $^O eq 'MSWin32'; |
| |
| my $s = ''; |
| |
| $s .= "load_module $modules/ngx_http_geoip_module.so;\n" |
| if $self->has_module('http_geoip\S+=dynamic'); |
| |
| $s .= "load_module $modules/ngx_http_image_filter_module.so;\n" |
| if $self->has_module('image_filter\S+=dynamic'); |
| |
| $s .= "load_module $modules/ngx_http_perl_module.so;\n" |
| if $self->has_module('perl\S+=dynamic'); |
| |
| $s .= "load_module $modules/ngx_http_xslt_filter_module.so;\n" |
| if $self->has_module('xslt\S+=dynamic'); |
| |
| $s .= "load_module $modules/ngx_mail_module.so;\n" |
| if $self->has_module('mail=dynamic'); |
| |
| $s .= "load_module $modules/ngx_stream_module.so;\n" |
| if $self->has_module('stream=dynamic'); |
| |
| $s .= "load_module $modules/ngx_stream_geoip_module.so;\n" |
| if $self->has_module('stream_geoip\S+=dynamic'); |
| |
| return $s; |
| } |
| |
| sub test_globals_perl5lib() { |
| my ($self) = @_; |
| |
| return '' unless $self->has_module('perl'); |
| |
| my ($volume, $dir) = File::Spec->splitpath($NGINX); |
| my $objs = File::Spec->catpath($volume, $dir, ''); |
| |
| $objs = File::Spec->rel2abs($objs); |
| $objs =~ s!\\!/!g if $^O eq 'MSWin32'; |
| |
| return "env PERL5LIB=$objs/src/http/modules/perl:" |
| . "$objs/src/http/modules/perl/blib/arch;\n"; |
| } |
| |
| sub test_globals_http() { |
| my ($self) = @_; |
| |
| return $self->{_test_globals_http} |
| if defined $self->{_test_globals_http}; |
| |
| my $s = ''; |
| |
| $s .= "root $self->{_testdir};\n"; |
| $s .= "access_log $self->{_testdir}/access.log;\n"; |
| $s .= "client_body_temp_path $self->{_testdir}/client_body_temp;\n"; |
| |
| $s .= "fastcgi_temp_path $self->{_testdir}/fastcgi_temp;\n" |
| if $self->has_module('fastcgi'); |
| |
| $s .= "proxy_temp_path $self->{_testdir}/proxy_temp;\n" |
| if $self->has_module('proxy'); |
| |
| $s .= "uwsgi_temp_path $self->{_testdir}/uwsgi_temp;\n" |
| if $self->has_module('uwsgi'); |
| |
| $s .= "scgi_temp_path $self->{_testdir}/scgi_temp;\n" |
| if $self->has_module('scgi'); |
| |
| $s .= $ENV{TEST_NGINX_GLOBALS_HTTP} |
| if $ENV{TEST_NGINX_GLOBALS_HTTP}; |
| |
| $self->{_test_globals_http} = $s; |
| } |
| |
| ############################################################################### |
| |
| sub log_core { |
| return unless $ENV{TEST_NGINX_VERBOSE}; |
| my ($prefix, $msg) = @_; |
| ($prefix, $msg) = ('', $prefix) unless defined $msg; |
| $prefix .= ' ' if length($prefix) > 0; |
| |
| if (length($msg) > 2048) { |
| $msg = substr($msg, 0, 2048) |
| . "(...logged only 2048 of " . length($msg) |
| . " bytes)"; |
| } |
| |
| $msg =~ s/^/# $prefix/gm; |
| $msg =~ s/([^\x20-\x7e])/sprintf('\\x%02x', ord($1)) . (($1 eq "\n") ? "\n" : '')/gmxe; |
| $msg .= "\n" unless $msg =~ /\n\Z/; |
| print $msg; |
| } |
| |
| sub log_out { |
| log_core('>>', @_); |
| } |
| |
| sub log_in { |
| log_core('<<', @_); |
| } |
| |
| ############################################################################### |
| |
| sub http_get($;%) { |
| my ($url, %extra) = @_; |
| return http(<<EOF, %extra); |
| GET $url HTTP/1.0 |
| Host: localhost |
| |
| EOF |
| } |
| |
| sub http_head($;%) { |
| my ($url, %extra) = @_; |
| return http(<<EOF, %extra); |
| HEAD $url HTTP/1.0 |
| Host: localhost |
| |
| EOF |
| } |
| |
| sub http($;%) { |
| my ($request, %extra) = @_; |
| |
| my $s = http_start($request, %extra); |
| |
| return $s if $extra{start} or !defined $s; |
| return http_end($s); |
| } |
| |
| sub http_start($;%) { |
| my ($request, %extra) = @_; |
| my $s; |
| |
| eval { |
| local $SIG{ALRM} = sub { die "timeout\n" }; |
| local $SIG{PIPE} = sub { die "sigpipe\n" }; |
| alarm(8); |
| |
| $s = $extra{socket} || IO::Socket::INET->new( |
| Proto => 'tcp', |
| PeerAddr => '127.0.0.1:' . port(8080) |
| ) |
| or die "Can't connect to nginx: $!\n"; |
| |
| log_out($request); |
| $s->print($request); |
| |
| select undef, undef, undef, $extra{sleep} if $extra{sleep}; |
| return '' if $extra{aborted}; |
| |
| if ($extra{body}) { |
| log_out($extra{body}); |
| $s->print($extra{body}); |
| } |
| |
| alarm(0); |
| }; |
| alarm(0); |
| if ($@) { |
| log_in("died: $@"); |
| return undef; |
| } |
| |
| return $s; |
| } |
| |
| sub http_end($;%) { |
| my ($s) = @_; |
| my $reply; |
| |
| eval { |
| local $SIG{ALRM} = sub { die "timeout\n" }; |
| local $SIG{PIPE} = sub { die "sigpipe\n" }; |
| alarm(8); |
| |
| local $/; |
| $reply = $s->getline(); |
| |
| alarm(0); |
| }; |
| alarm(0); |
| if ($@) { |
| log_in("died: $@"); |
| return undef; |
| } |
| |
| log_in($reply); |
| return $reply; |
| } |
| |
| ############################################################################### |
| |
| sub http_gzip_request { |
| my ($url) = @_; |
| my $r = http(<<EOF); |
| GET $url HTTP/1.1 |
| Host: localhost |
| Connection: close |
| Accept-Encoding: gzip |
| |
| EOF |
| } |
| |
| sub http_content { |
| my ($text) = @_; |
| |
| return undef if !defined $text; |
| |
| if ($text !~ /(.*?)\x0d\x0a?\x0d\x0a?(.*)/ms) { |
| return undef; |
| } |
| |
| my ($headers, $body) = ($1, $2); |
| |
| if ($headers !~ /Transfer-Encoding: chunked/i) { |
| return $body; |
| } |
| |
| my $content = ''; |
| while ($body =~ /\G\x0d?\x0a?([0-9a-f]+)\x0d\x0a?/gcmsi) { |
| my $len = hex($1); |
| $content .= substr($body, pos($body), $len); |
| pos($body) += $len; |
| } |
| |
| return $content; |
| } |
| |
| sub http_gzip_like { |
| my ($text, $re, $name) = @_; |
| |
| SKIP: { |
| eval { require IO::Uncompress::Gunzip; }; |
| Test::More::skip( |
| "IO::Uncompress::Gunzip not installed", 1) if $@; |
| |
| my $in = http_content($text); |
| my $out; |
| |
| IO::Uncompress::Gunzip::gunzip(\$in => \$out); |
| |
| Test::More->builder->like($out, $re, $name); |
| } |
| } |
| |
| ############################################################################### |
| |
| 1; |
| |
| ############################################################################### |