Mercurial > hg > nginx-tests
view lib/Test/Nginx.pm @ 1990:85d88cd5091c
Tests: SSI include stub tests.
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Thu, 04 Jul 2024 17:42:55 +0300 |
parents | fb25cbe9d4ec |
children | e9235c647f45 |
line wrap: on
line source
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 http_content /; 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'; 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; local $Test::Nginx::TODO = 'alerts' if @alerts && $^O eq 'solaris' && ! grep { $_ !~ /phantom event/ } @alerts; local $Test::Nginx::TODO = 'alerts' if @alerts && $^O eq 'MSWin32' && ! grep { $_ !~ qr/CloseHandle|TerminateProcess/ } @alerts; Test::More::is(join("\n", @alerts), '', 'no alerts'); } if (Test::More->builder->expected_tests) { my $errors = $self->read_file('error.log'); $errors = join "\n", $errors =~ /.+Sanitizer.+/gm; Test::More::is($errors, '', 'no sanitizer errors'); } if (Test::More->builder->expected_tests && $ENV{TEST_NGINX_VALGRIND}) { my $errors = $self->read_file('valgrind.log'); $errors = join "\n", $errors =~ /^==\d+== .+/gm; Test::More::is($errors, '', 'no valgrind 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', tickets => '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_set => '(?s)^(?!.*--without-stream_set_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'; } if ($feature =~ /^socket_ssl/) { eval { require IO::Socket::SSL; }; return 0 if $@; eval { IO::Socket::SSL::SSL_VERIFY_NONE(); }; return 0 if $@; if ($feature eq 'socket_ssl') { return 1; } if ($feature eq 'socket_ssl_sni') { eval { IO::Socket::SSL->can_client_sni() or die; }; return !$@; } if ($feature eq 'socket_ssl_alpn') { eval { IO::Socket::SSL->can_alpn() or die; }; return !$@; } if ($feature eq 'socket_ssl_sslversion') { return IO::Socket::SSL->can('get_sslversion'); } if ($feature eq 'socket_ssl_reused') { return IO::Socket::SSL->can('get_session_reused'); } return 0; } if ($feature =~ /^(openssl|libressl):([0-9.]+)([a-z]*)/) { my $library = $1; my $need = $2; my $patch = $3; $self->{_configure_args} = `$NGINX -V 2>&1` if !defined $self->{_configure_args}; return 0 unless $self->{_configure_args} =~ /with $library ([0-9.]+)([a-z]*)/i; my @v = (split(/\./, $1), unpack("C*", $2)); my ($n, $v); for $n (split(/\./, $need), unpack("C*", $patch)) { $v = shift @v || 0; return 0 if $n > $v; return 1 if $v > $n; } return 1; } if ($feature eq 'cryptx') { eval { require Crypt::Misc; }; return 0 if $@; eval { die if $Crypt::Misc::VERSION < 0.067; }; return !$@; } 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: \w+/([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 2>/dev/null`; 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}) { open F, '<', $self->{_testdir} . '/error.log' or die "Can't open error.log: $!"; log_core($_) while (<F>); close F; } Test::More::plan(skip_all => $message); return $self; } sub plan($) { my ($self, $plan) = @_; $plan += 2; $plan += 1 if $ENV{TEST_NGINX_VALGRIND}; Test::More::plan(tests => $plan); 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;"); my @valgrind = (not $ENV{TEST_NGINX_VALGRIND}) ? () : ('valgrind', '-q', "--log-file=$testdir/valgrind.log"); exec(@valgrind, $NGINX, '-p', "$testdir/", '-c', 'nginx.conf', '-e', 'error.log', @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 " . "-e error.log " . 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 .. 100) { 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', '-e', 'error.log', @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', 'quit', '-e', 'error.log', @globals) == 0 or die "system() failed: $?\n"; } else { kill 'QUIT', $pid; } my $exited; for (1 .. 900) { $exited = waitpid($pid, WNOHANG) != 0; last if $exited; select undef, undef, undef, 0.1; } if (!$exited) { 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', '-e', 'error.log', @globals) == 0 or die "system() failed: $?\n"; } else { kill 'TERM', $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; my $exited; for (1 .. 50) { $exited = waitpid($p, WNOHANG) != 0; last if $exited; select undef, undef, undef, 0.1; } if (!$exited) { 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/%%TEST_GLOBALS_STREAM%%/$self->test_globals_stream()/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 test_globals_stream() { my ($self) = @_; return $self->{_test_globals_stream} if defined $self->{_test_globals_stream}; my $s = ''; $s .= $ENV{TEST_NGINX_GLOBALS_STREAM} if $ENV{TEST_NGINX_GLOBALS_STREAM}; $self->{_test_globals_stream} = $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, %extra); } sub http_start($;%) { my ($request, %extra) = @_; my $s; my $port = $extra{SSL} ? 8443 : 8080; 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($port), %extra ) or die "Can't connect to nginx: $!\n"; if ($extra{SSL}) { require IO::Socket::SSL; IO::Socket::SSL->start_SSL( $s, SSL_version => 'SSLv23', SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(), %extra ) or die $IO::Socket::SSL::SSL_ERROR . "\n"; log_in("ssl cipher: " . $s->get_cipher()); log_in("ssl cert: " . $s->peer_certificate('subject')); } 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(); $s->close(); 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 = ''; my $len = -1; while ($body =~ /\G\x0d?\x0a?([0-9a-f]+)\x0d\x0a?/gcmsi) { $len = hex($1); $content .= substr($body, pos($body), $len); pos($body) += $len; } if ($len != 0) { $content .= '[no-last-chunk]'; } 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; ###############################################################################