t/10-live.t

   1 #! perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use File::Spec;
   8 use File::Basename;
   9 use IO::CaptureOutput qw(capture);
  10
  11 # check whether we can talk to ourself or not ...
  12 # ...
  13
  14 delete $ENV{PERL_LWP_ENV_PROXY};
  15
  16 use Config;
  17 my $perl = $Config{'perlpath'};
  18 $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i;
  19
  20 my $loc = dirname($0);
  21
  22 $| = 1;    # autoflush
  23
  24 # First we ensure that we can talk to ourself ...
  25
  26 system( $perl, File::Spec->catfile( $loc, "talk-to-ourself.pl" ) );
  27 my $status = $?;
  28 $status and BAIL_OUT("Can't talk to ourself");
  29
  30 require IO::Socket;         # make sure this work before we try to make a HTTP::Daemon
  31 use POSIX ":sys_wait_h";    # for nonblocking read
  32
  33 # Seconds we make a daemon in another process
  34
  35 my ( $daemon_pipe, $daemon_pid );
  36 local $SIG{CHLD} = sub {
  37     local ( $!, $? );
  38     my $pid = waitpid( -1, WNOHANG );
  39     $pid == $daemon_pid or return;
  40     $daemon_pid = undef;
  41     close($daemon_pipe);
  42     $daemon_pipe = undef;
  43 };
  44
  45 $daemon_pid = open( $daemon_pipe,
  46            "$perl " . File::Spec->catfile( $loc, "mock-daemon.pl" ) . " --httpd-opts Timeout=10  --httpd-opts hdf=1 |" )
  47   or die "Can't exec daemon: $!";
  48
  49 END { $daemon_pid and kill( $daemon_pid => 0 ); $daemon_pipe and close($daemon_pipe); }
  50
  51 my $greeting = <$daemon_pipe>;
  52 $greeting =~ /(<[^>]+>)/;
  53
  54 require URI;
  55 my $base = URI->new($1);
  56
  57 sub url
  58 {
  59     my $u = URI->new(@_);
  60     $u = $u->abs( $_[1] ) if @_ > 1;
  61     $u->as_string;
  62 }
  63
  64 note "Will access HTTP server at $base\n";
  65
  66 use WWW::Mechanize::Script;
  67
  68 my %cfg = (
  69      "defaults" => {
  70                      "check" => {
  71                                   "code_cmp"              => ">",
  72                                   "response_code"         => 2,
  73                                   "min_bytes_code"        => 2,
  74                                   "max_bytes_code"        => 1,
  75                                   "regex_forbid_code"     => 2,
  76                                   "regex_require_code"    => 2,
  77                                   "text_forbid_code"      => 2,
  78                                   "text_require_code"     => 2,
  79                                   "min_elapsed_time_code" => 1,
  80                                   "max_elapsed_time_code" => 2,
  81                                 },
  82                      "request" => { "method" => "GET" }
  83                    },
  84      "templating" => {
  85          "vars" =>
  86            { "CODE_NAMES" => [ "OK", "WARNING", "CRITICAL", "UNKNOWN", "DEPENDENT", "EXCEPTION" ] },
  87      },
  88      "summary" => {
  89                 "template" =>
  90                   "[% CODE_NAMES.\$CODE; IF MESSAGES.size > 0 %] - [% MESSAGES.join(', '); END %]\n",
  91                 "target" => "-"
  92      },
  93      "report" => {
  94                    "template" => "[% USE Dumper; Dumper.dump(RESPONSE) %]",
  95                    "target"   => "-"
  96                  }
  97           );
  98 my @script = (
  99     {
 100        "request" => {
 101                       "method" => "get",
 102                       "uri"    => url("/etc/passwd", $base),
 103                     },
 104        "check" => {
 105                     "test_name"    => "passwd1",
 106                     "text_require" => [ "/root", "daemon", ":bin:" ],
 107                     "text_forbid"  => [ "staff", ],
 108                   },
 109     },
 110     {
 111        "request" => {
 112                       "method" => "get",
 113                       "uri"    => url("/etc/passwd", $base),
 114                     },
 115        "check" => {
 116                     "test_name" => "passwd2",
 117                     "min_rtime" => "0.01",
 118                     "max_rtime" => "1",
 119                   },
 120     },
 121     {
 122        "request" => {
 123                       "method" => "get",
 124                       "uri"    => url("/etc/passwd", $base),
 125                     },
 126        "check" => {
 127                     "test_name" => "passwd3",
 128                     "min_bytes" => "1",
 129                     "max_bytes" => "65536",
 130                   },
 131     },
 132     {
 133        "request" => {
 134                       "method" => "get",
 135                       "uri"    => url("/etc/passwd", $base),
 136                     },
 137        "check" => {
 138            "test_name"     => "passwd4",
 139            "regex_require" => [
 140                                 "(?:\\:\\d){2}",    # uid/gid
 141                                 "(?:/\\w+){2}",     # shell ;)
 142                               ],
 143            "regex_forbid" => [ "^\\w+:\\w{2,}", ],  # password
 144                   },
 145     },
 146     {
 147        "request" => {
 148                       "method" => "get",
 149                       "uri"    => url("/etc/master.passwd", $base),
 150                     },
 151        "check" => {
 152            "test_name"     => "exit_status",
 153            "response" => 418,
 154         },
 155     }
 156              );
 157
 158 my $wms = WWW::Mechanize::Script->new( \%cfg );
 159
 160 isa_ok($wms, "WWW::Mechanize::Script") or BAIL_OUT("Need WWW::Mechanize::Script");
 161
 162 my ( $code, @msgs ) = (0);
 163 my ( $stdout, $stderr );
 164 #capture {
 165 eval { ( $code, @msgs ) = $wms->run_script(@script); };
 166 #} \$stdout, \$stderr;
 167
 168 cmp_ok($code, '==', 0, "Test script runs without error");
 169 is_deeply( \@msgs, [], "No messages" );
 170
 171 done_testing();