From dd1cba00d0dd442e4514d0249fc627c0a0865287 Mon Sep 17 00:00:00 2001 From: Jens Rehsack Date: Mon, 13 Aug 2012 17:19:28 +0200 Subject: [PATCH] add basic script test --- t/10-live.t | 171 +++++++++++++++++++++++++++++++++++++++++++++++++++ t/mock-daemon.pl | 118 +++++++++++++++++++++++++++++++++++ t/talk-to-ourself.pl | 61 ++++++++++++++++++ 3 files changed, 350 insertions(+) create mode 100644 t/10-live.t create mode 100644 t/mock-daemon.pl create mode 100644 t/talk-to-ourself.pl diff --git a/t/10-live.t b/t/10-live.t new file mode 100644 index 0000000..752c3cf --- /dev/null +++ b/t/10-live.t @@ -0,0 +1,171 @@ +#! perl + +use strict; +use warnings; + +use Test::More; +use File::Spec; +use File::Basename; +use IO::CaptureOutput qw(capture); + +# check whether we can talk to ourself or not ... +# ... + +delete $ENV{PERL_LWP_ENV_PROXY}; + +use Config; +my $perl = $Config{'perlpath'}; +$perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i; + +my $loc = dirname($0); + +$| = 1; # autoflush + +# First we ensure that we can talk to ourself ... + +system( $perl, File::Spec->catfile( $loc, "talk-to-ourself.pl" ) ); +my $status = $?; +$status and BAIL_OUT("Can't talk to ourself"); + +require IO::Socket; # make sure this work before we try to make a HTTP::Daemon +use POSIX ":sys_wait_h"; # for nonblocking read + +# Seconds we make a daemon in another process + +my ( $daemon_pipe, $daemon_pid ); +local $SIG{CHLD} = sub { + local ( $!, $? ); + my $pid = waitpid( -1, WNOHANG ); + $pid == $daemon_pid or return; + $daemon_pid = undef; + close($daemon_pipe); + $daemon_pipe = undef; +}; + +$daemon_pid = open( $daemon_pipe, + "$perl " . File::Spec->catfile( $loc, "mock-daemon.pl" ) . " --httpd-opts Timeout=10 --httpd-opts hdf=1 |" ) + or die "Can't exec daemon: $!"; + +END { $daemon_pid and kill( $daemon_pid => 0 ); $daemon_pipe and close($daemon_pipe); } + +my $greeting = <$daemon_pipe>; +$greeting =~ /(<[^>]+>)/; + +require URI; +my $base = URI->new($1); + +sub url +{ + my $u = URI->new(@_); + $u = $u->abs( $_[1] ) if @_ > 1; + $u->as_string; +} + +note "Will access HTTP server at $base\n"; + +use WWW::Mechanize::Script; + +my %cfg = ( + "defaults" => { + "check" => { + "code_cmp" => ">", + "response_code" => 2, + "min_bytes_code" => 2, + "max_bytes_code" => 1, + "regex_forbid_code" => 2, + "regex_require_code" => 2, + "text_forbid_code" => 2, + "text_require_code" => 2, + "min_elapsed_time_code" => 1, + "max_elapsed_time_code" => 2, + }, + "request" => { "method" => "GET" } + }, + "templating" => { + "vars" => + { "CODE_NAMES" => [ "OK", "WARNING", "CRITICAL", "UNKNOWN", "DEPENDENT", "EXCEPTION" ] }, + }, + "summary" => { + "template" => + "[% CODE_NAMES.\$CODE; IF MESSAGES.size > 0 %] - [% MESSAGES.join(', '); END %]\n", + "target" => "-" + }, + "report" => { + "template" => "[% USE Dumper; Dumper.dump(RESPONSE) %]", + "target" => "-" + } + ); +my @script = ( + { + "request" => { + "method" => "get", + "uri" => url("/etc/passwd", $base), + }, + "check" => { + "test_name" => "passwd1", + "text_require" => [ "/root", "daemon", ":bin:" ], + "text_forbid" => [ "staff", ], + }, + }, + { + "request" => { + "method" => "get", + "uri" => url("/etc/passwd", $base), + }, + "check" => { + "test_name" => "passwd2", + "min_rtime" => "0.01", + "max_rtime" => "1", + }, + }, + { + "request" => { + "method" => "get", + "uri" => url("/etc/passwd", $base), + }, + "check" => { + "test_name" => "passwd3", + "min_bytes" => "1", + "max_bytes" => "65536", + }, + }, + { + "request" => { + "method" => "get", + "uri" => url("/etc/passwd", $base), + }, + "check" => { + "test_name" => "passwd4", + "regex_require" => [ + "(?:\\:\\d){2}", # uid/gid + "(?:/\\w+){2}", # shell ;) + ], + "regex_forbid" => [ "^\\w+:\\w{2,}", ], # password + }, + }, + { + "request" => { + "method" => "get", + "uri" => url("/etc/master.passwd", $base), + }, + "check" => { + "test_name" => "exit_status", + "response" => 418, + }, + } + ); + +my $wms = WWW::Mechanize::Script->new( \%cfg ); + +isa_ok($wms, "WWW::Mechanize::Script") or BAIL_OUT("Need WWW::Mechanize::Script"); + +my ( $code, @msgs ) = (0); +my ( $stdout, $stderr ); +#capture { +eval { ( $code, @msgs ) = $wms->run_script(@script); }; +#} \$stdout, \$stderr; + +cmp_ok($code, '==', 0, "Test script runs without error"); +is_deeply( \@msgs, [], "No messages" ); + +done_testing(); diff --git a/t/mock-daemon.pl b/t/mock-daemon.pl new file mode 100644 index 0000000..cb77875 --- /dev/null +++ b/t/mock-daemon.pl @@ -0,0 +1,118 @@ +#!perl + +use strict; +use warnings; + +package HTTP::Daemon::MockClient; + +use HTTP::Daemon; +use base qw(HTTP::Daemon::ClientConn); + +use HTTP::Status qw(:constants); +use Params::Util qw(_ARRAY _STRING); + +my %documents = ( + "/etc/passwd" => [ + "root:x:0:0:root:/root:/bin/sh", "daemon:x:1:1:daemon:/usr/sbin:/bin/sh", + "bin:x:2:2:bin:/bin:/bin/sh" + ], + "/etc/fstab" => [ + "# ", + "proc /proc proc nodev,noexec,nosuid 0 0", + "/dev/sda1 / ext2 defaults 0 0", + "/dev/sdb1 /data ext2 defaults 0 0", + "none /tmp tmpfs defaults,noatime 0 0", + ], + "/etc/master.passwd" => "/etc/master.passwd", + "/var/run/dmesg.boot" => [ + '[ 0.000000] Initializing cgroup subsys cpuset', + '[ 0.000000] Initializing cgroup subsys cpu', + '[ 0.000000] Linux version 2.6.32-41-generic (buildd@allspice) (gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5.1) ) #94-Ubuntu SMP Fri Jul 6 18:00:34 UTC 2012 (Ubuntu 2.6.32-41.94-generic 2.6.32.59+drm33.24)' + ], + "/var/log/messages" => "/var/run/dmesg.boot", +); + +sub respond_text_content +{ + my ( $c, @cnt ) = @_; + my $resp = HTTP::Response->new(HTTP_OK); + $resp->header( "Content-Type", "text/plain" ); + $resp->content( join( "\n", @cnt ) ); + $c->send_response($resp); +} + +sub handle_httpd_get +{ + my ( $c, $req ) = @_; + my $p = $req->uri()->path(); + if ( exists( $documents{$p} ) ) + { + if ( _ARRAY( $documents{$p} ) ) + { + $c->respond_text_content( @{ $documents{$p} } ); + } + elsif ( _STRING( $documents{$p} ) ) + { + my $tgt = $documents{$p}; + if ( $p eq $tgt ) + { + $c->send_error(HTTP_I_AM_A_TEAPOT); + $c->send_crlf; + return 0 - HTTP_I_AM_A_TEAPOT; + } + else + { + $c->send_redirect( $tgt, HTTP_TEMPORARY_REDIRECT ); + $c->send_crlf; + } + } + else + { + $c->send_error(HTTP_FORBIDDEN); + $c->send_crlf; + } + } + else + { + $c->send_error(HTTP_NOT_FOUND); + $c->send_crlf; + } + + return 0; +} + +package main; + +use Getopt::Long; + +use HTTP::Daemon; +use HTTP::Status qw(:constants); + +my %opts = (); +GetOptions( "httpd-opts=s%" => \%opts ); + +my $d = HTTP::Daemon->new(%opts); + +print "Please to meet you at: url, ">\n"; +open( STDOUT, $^O eq 'VMS' ? ">nl: " : ">/dev/null" ); + +my $go = 1; +while ( $go and my $c = $d->accept("HTTP::Daemon::MockClient") ) +{ + while ( my $r = $c->get_request ) + { + my $func = lc( "handle_httpd_" . $r->method ); + if ( $c->can($func) ) + { + 0 == $c->$func($r) or $go = 0; + } + else + { + $c->send_error(HTTP_METHOD_NOT_ALLOWED); + } + } + $c = undef; # close connection +} +$opts{hdf} or print STDERR "HTTP Server terminated\n"; +exit; + diff --git a/t/talk-to-ourself.pl b/t/talk-to-ourself.pl new file mode 100644 index 0000000..dbb0e4c --- /dev/null +++ b/t/talk-to-ourself.pl @@ -0,0 +1,61 @@ +#!perl -w + +# This program check if we are able to talk to ourself. Misconfigured +# systems that can't talk to their own 'hostname' was the most commonly +# reported libwww-failure. + +use strict; +require IO::Socket; + +if ( @ARGV >= 2 && $ARGV[0] eq "--port" ) +{ + my $port = $ARGV[1]; + require Sys::Hostname; + my $host = Sys::Hostname::hostname(); + if ( + my $socket = IO::Socket::INET->new( PeerAddr => "$host:$port", + Timeout => 5 ) + ) + { + require IO::Select; + if ( IO::Select->new($socket)->can_read(1) ) + { + my ( $n, $buf ); + if ( $n = sysread( $socket, $buf, 512 ) ) + { + exit if $buf eq "Hi there!\n"; + die "Seems to be talking to the wrong server at $host:$port, got \"$buf\"\n"; + } + elsif ( defined $n ) + { + die "Immediate EOF from server at $host:$port\n"; + } + else + { + die "Can't read from server at $host:$port: $!"; + } + } + die "No response from server at $host:$port\n"; + } + die "Can't connect: $@\n"; +} + +# server code +my $socket = IO::Socket::INET->new( Listen => 1, + Timeout => 5 ); +my $port = $socket->sockport; +open( CLIENT, qq("$^X" "$0" --port $port |) ) || die "Can't run $^X $0: $!\n"; + +if ( my $client = $socket->accept ) +{ + print $client "Hi there!\n"; + close($client) || die "Can't close socket: $!"; +} +else +{ + warn "Test server timeout\n"; +} + +exit if close(CLIENT); +die "Can't wait for client: $!" if $!; +die "The can-we-talk-to-ourself test failed.\n"; -- 2.11.4.GIT