| package Test::Nginx; |
| |
| # (C) Maxim Dounin |
| |
| # Generict module for nginx tests. |
| |
| ############################################################################### |
| |
| use warnings; |
| use strict; |
| |
| use base qw/ Exporter /; |
| |
| our @EXPORT = qw/ log_in log_out http http_get http_head /; |
| our @EXPORT_OK = qw/ http_gzip_request http_gzip_like /; |
| our %EXPORT_TAGS = ( |
| gzip => [ qw/ http_gzip_request http_gzip_like / ] |
| ); |
| |
| ############################################################################### |
| |
| use File::Temp qw/ tempdir /; |
| use IO::Socket; |
| use Socket qw/ CRLF /; |
| use Test::More qw//; |
| |
| ############################################################################### |
| |
| our $NGINX = defined $ENV{TEST_NGINX_BINARY} ? $ENV{TEST_NGINX_BINARY} |
| : '../nginx/objs/nginx'; |
| |
| sub new { |
| my $self = {}; |
| bless $self; |
| |
| $self->{_testdir} = tempdir( |
| 'nginx-test-XXXXXXXXXX', |
| TMPDIR => 1, |
| CLEANUP => not $ENV{LEAVE} |
| ) |
| or die "Can't create temp directory: $!\n"; |
| |
| return $self; |
| } |
| |
| sub DESTROY { |
| my ($self) = @_; |
| $self->stop(); |
| if ($ENV{TEST_NGINX_CATLOG}) { |
| system("cat $self->{_testdir}/error.log"); |
| } |
| } |
| |
| sub has($) { |
| my ($self, $feature) = @_; |
| |
| Test::More::plan(skip_all => "$feature not compiled in") |
| unless $self->has_module($feature); |
| |
| return $self; |
| } |
| |
| sub has_module($) { |
| my ($self, $feature) = @_; |
| |
| my %regex = ( |
| mail => '--with-mail', |
| flv => '--with-http_flv_module', |
| perl => '--with-http_perl_module', |
| rewrite => '(?s)^(?!.*--without-http_rewrite_module)', |
| gzip => '(?s)^(?!.*--without-http_gzip_module)', |
| cache => '(?s)^(?!.*--without-http-cache)', |
| fastcgi => '(?s)^(?!.*--without-http_fastcgi_module)', |
| proxy => '(?s)^(?!.*--without-http_proxy_module)', |
| ); |
| |
| my $re = $regex{$feature}; |
| $re = $feature if !defined $re; |
| |
| $self->{_configure_args} = `$NGINX -V 2>&1` |
| if !defined $self->{_configure_args}; |
| |
| return ($self->{_configure_args} =~ $re) ? 1 : 0; |
| } |
| |
| sub has_daemon($) { |
| my ($self, $daemon) = @_; |
| |
| Test::More::plan(skip_all => "$daemon not found") |
| unless `which $daemon`; |
| |
| return $self; |
| } |
| |
| sub plan($) { |
| my ($self, $plan) = @_; |
| |
| Test::More::plan(tests => $plan); |
| |
| 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, '-c', "$testdir/nginx.conf", @globals) |
| or die "Unable to exec(): $!\n"; |
| } |
| |
| # wait for nginx to start |
| |
| $self->waitforfile("$testdir/nginx.pid") |
| or die "Can't start nginx"; |
| |
| $self->{_started} = 1; |
| return $self; |
| } |
| |
| sub waitforfile($) { |
| my ($self, $file) = @_; |
| |
| # wait for file to appear |
| |
| for (1 .. 30) { |
| return 1 if -e $file; |
| select undef, undef, undef, 0.1; |
| } |
| |
| return undef; |
| } |
| |
| sub waitforsocket($) { |
| my ($self, $peer) = @_; |
| |
| # wait for socket to accept connections |
| |
| for (1 .. 30) { |
| my $s = IO::Socket::INET->new( |
| Proto => 'tcp', |
| PeerAddr => $peer |
| ); |
| |
| return 1 if defined $s; |
| |
| select undef, undef, undef, 0.1; |
| } |
| |
| return undef; |
| } |
| |
| sub stop() { |
| my ($self) = @_; |
| |
| while ($self->{_daemons} && scalar @{$self->{_daemons}}) { |
| my $p = shift @{$self->{_daemons}}; |
| kill 'TERM', $p; |
| wait; |
| } |
| |
| return $self unless $self->{_started}; |
| |
| kill 'TERM', `cat $self->{_testdir}/nginx.pid`; |
| wait; |
| |
| $self->{_started} = 0; |
| |
| return $self; |
| } |
| |
| sub write_file($$) { |
| my ($self, $name, $content) = @_; |
| |
| open F, '>' . $self->{_testdir} . '/' . $name |
| or die "Can't create $name: $!"; |
| 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; |
| |
| 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); |
| } |
| } |
| |
| $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"; |
| |
| $self->{_test_globals} = $s; |
| } |
| |
| 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'); |
| |
| $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; |
| |
| $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 $reply; |
| eval { |
| local $SIG{ALRM} = sub { die "timeout\n" }; |
| local $SIG{PIPE} = sub { die "sigpipe\n" }; |
| alarm(2); |
| my $s = IO::Socket::INET->new( |
| Proto => 'tcp', |
| PeerAddr => '127.0.0.1:8080' |
| ); |
| log_out($request); |
| $s->print($request); |
| local $/; |
| select undef, undef, undef, $extra{sleep} if $extra{sleep}; |
| return '' if $extra{aborted}; |
| $reply = $s->getline(); |
| log_in($reply); |
| alarm(0); |
| }; |
| alarm(0); |
| if ($@) { |
| log_in("died: $@"); |
| return undef; |
| } |
| 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->builder->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; |
| |
| ############################################################################### |