[svn:modperl-modules] rev 192 - in Apache-Watchdog-RunAway/trunk: . t t/conf t/runaway
[email protected] 21 Mar 2005 17:48:36 -0000
| Newsgroups | perl.modperl.modules.svn |
|---|---|
| Message-ID | <[email protected]> |
Author: stas Date: Mon Mar 21 09:48:35 2005 New Revision: 192 Added: Apache-Watchdog-RunAway/trunk/t/ Apache-Watchdog-RunAway/trunk/t/TEST.PL (contents, props changed) Apache-Watchdog-RunAway/trunk/t/conf/ Apache-Watchdog-RunAway/trunk/t/conf/extra.conf.in Apache-Watchdog-RunAway/trunk/t/conf/modperl_extra.pl Apache-Watchdog-RunAway/trunk/t/runaway/ Apache-Watchdog-RunAway/trunk/t/runaway/basic.t (contents, props changed) Modified: Apache-Watchdog-RunAway/trunk/Changes Apache-Watchdog-RunAway/trunk/Makefile.PL Apache-Watchdog-RunAway/trunk/RunAway.pm Apache-Watchdog-RunAway/trunk/TODO Log: add a test suite Modified: Apache-Watchdog-RunAway/trunk/Changes ============================================================================== --- Apache-Watchdog-RunAway/trunk/Changes (original) +++ Apache-Watchdog-RunAway/trunk/Changes Mon Mar 21 09:48:35 2005 @@ -1,15 +1,33 @@ =head1 CHANGES (Apache::Watchdog::RunAway) -=head1 ver 0.3 - Wed Feb 20 14:09:32 SGT 2002 +=over -* rewrite debug and error handling code, so one can actually benefit - from debug levels +=item 0.4 - dev -=head1 ver 0.2 - Tue May 15 09:46:43 SGT 2001 +added a basic test suite -* now printing the request info for the hanging process that gets - killed (a patch by Philippe M. Chiasson <[email protected]>) +untaint proc id used in stop_monitor (now runs under -T) -=head1 ver 0.1 - Tue Feb 22 11:34:14 IST 2000 -* First version released + +=item 0.3 - Wed Feb 20 14:09:32 SGT 2002 + +rewrite debug and error handling code, so one can actually benefit +from debug levels + + + +=item 0.2 - Tue May 15 09:46:43 SGT 2001 + +now printing the request info for the hanging process that gets killed +(a patch by Philippe M. Chiasson <[email protected]>) + + + +=item 0.1 - Tue Feb 22 11:34:14 IST 2000 + +First version released + +=back + +=cut \ No newline at end of file Modified: Apache-Watchdog-RunAway/trunk/Makefile.PL ============================================================================== --- Apache-Watchdog-RunAway/trunk/Makefile.PL (original) +++ Apache-Watchdog-RunAway/trunk/Makefile.PL Mon Mar 21 09:48:35 2005 @@ -1,41 +1,89 @@ package Apache::Watchdog::RunAway; -require 5.005; +require 5.005003; use strict; +use File::Spec::Functions qw(catfile); -use ExtUtils::MakeMaker; - +my @clean_files = map { catfile "t", "logs", $_ } + qw(safehang.lock safehang.log); my @programs_to_install = qw(amprapmon); +my $mp_gen = satisfy_mp_generation(); +warn "Goind to build against mod_perl/$mod_perl::VERSION Perl/$]\n"; +test_configure($mp_gen); + # prerequisites -my %require = ( - "mod_perl" => "1.15", - "Apache::Scoreboard" => "0.10", -# "Time::HiRes" => "01.19", +my %require_common = ( + "Apache::Test" => "1.15", # config fixes +); + +my %require_mp1 = ( + "mod_perl" => "1.25", + "Apache::Scoreboard" => "0.15", +); + +my %require_mp2 = ( + "mod_perl" => "1.9915", + "Apache::Scoreboard" => "2.06", +); + +my %require = (%require_common, ($mp_gen == 1 ? %require_mp1 : %require_mp2)); + +# XXX +#prereqs(); + +my @scripts = qw(t/TEST); + +my %common_opts = ( + NAME => 'Apache::Watchdog::RunAway', + VERSION_FROM => 'RunAway.pm', + EXE_FILES => [ map {"bin/$_"} @programs_to_install ], + PREREQ_PM => \%require, + clean => { + FILES => "@{ clean_files() }", + } ); -# Check prerequisites -for (keys %require) { - chk_version($_ => $require{$_}) or - warn "\n" . - "*** For ".__PACKAGE__." to work you require version $require{$_}" . - ", or later, of\n$_.pm from CPAN\n\n"; +if ($mp_gen == 1) { + require ExtUtils::MakeMaker; + ExtUtils::MakeMaker::WriteMakefile( + %common_opts, + ); + +} +else { + require Apache2; + require ModPerl::MM; + ModPerl::MM::WriteMakefile( + %common_opts, + ); +} + +sub clean_files { + return \@clean_files; +} + +sub prereqs { + for (keys %require) { + chk_version($_ => $require{$_}) or + warn "\n*** For Apache::VMonitor to work you require version " . + "$require{$_}, or later, of $_.pm from CPAN\n"; + } } sub chk_version { - my($pkg,$wanted) = @_; - no strict 'refs'; + my($pkg, $wanted) = @_; + + no strict 'refs'; local $| = 1; print "Checking for $pkg..."; - eval { (my $p = $pkg . ".pm") =~ s|::|/|g; require $p;}; - - print("not ok\n$@"),return if $@; + eval { (my ($p) = $pkg . ".pm") =~ s#::#/#g; require $p;}; + print("not ok\n$@"), return if $@; - my $vstr = ${"${pkg}::VERSION"} - ? "found v" . ${"${pkg}::VERSION"} - : "not found"; + my $vstr = ${"${pkg}::VERSION"} ? "found v" . ${"${pkg}::VERSION"} + : "not found"; my $vnum = ${"${pkg}::VERSION"} || 0; print $vnum >= $wanted ? "ok\n" : " " . $vstr . "\n"; @@ -44,23 +92,144 @@ } +sub test_configure { + my $mp_gen = shift; -WriteMakefile( - NAME => __PACKAGE__, - VERSION_FROM => 'RunAway.pm', - ( - $] < 5.005 ? () : - ( - AUTHOR => 'Stas Bekman <[email protected]>', - ABSTRACT_FROM => 'RunAway.pm', - ) - ), - EXE_FILES => [ map {"bin/$_"} @programs_to_install ], - dist => { - PREOP => 'pod2text RunAway.pm > $(DISTVNAME)/README', - COMPRESS => 'gzip -9f', - SUFFIX => '.gz', - DIST_DEFAULT => 'tardist', - }, - PREREQ_PM => \%require, -); + if (eval { require Apache::TestMM }) { + Apache::TestMM->import(qw(test clean)); + my @scripts = qw(t/TEST); + # accept the configs from command line + Apache::TestMM::filter_args(); + + Apache::TestMM::generate_script($_) for @scripts; + + push @clean_files, @scripts; + } else { + warn "***: You should install Apache::Test to do real testing\n"; + # META: soon on CPAN + *MY::test = sub { + return <<'EOF'; +test : pure_all + @echo \*** This test suite requires Apache::Test available from the + @echo \*** mod_perl 2.0 sources or the httpd-test distribution. +EOF + } + } +} + +# If a specific generation was passed as an argument, +# if satisfied +# return the same generation +# else +# die +# else @ARGV and %ENV will be checked for specific orders +# if the specification will be found +# if satisfied +# return the specified generation +# else +# die +# else if any mp generation is found +# return it +# else +# die + +sub satisfy_mp_generation { + my $wanted = shift || wanted_mp_generation(); + + unless ($wanted == 1 || $wanted == 2) { + die "don't know anything about mod_perl generation: $wanted\n" . + "currently supporting only generations 1 and 2"; + } + + my $selected = 0; + + if ($wanted == 1) { + require_mod_perl(); + if ($mod_perl::VERSION >= 1.99) { + # so we don't pick 2.0 version if 1.0 is wanted + die "You don't seem to have mod_perl 1.0 installed"; + } + $selected = 1; + } + elsif ($wanted == 2) { + #warn "Looking for mod_perl 2.0"; + require Apache2; + require_mod_perl(); + if ($mod_perl::VERSION < 1.99) { + die "You don't seem to have mod_perl 2.0 installed"; + } + $selected = 2; + } + else { + require_mod_perl(); + $selected = $mod_perl::VERSION >= 1.99 ? 2 : 1; + warn "Using $mod_perl::VERSION\n"; + } + + return $selected; +} + +sub require_mod_perl { + eval { require mod_perl }; + die "Can't find mod_perl installed\nThe error was: $@" if $@; +} + + +# the function looks at %ENV and Makefile.PL option to figure out +# whether a specific mod_perl generation was requested. +# It uses the following logic: +# via options: +# perl Makefile.PL MOD_PERL=2 +# or via %ENV: +# env MOD_PERL=1 perl Makefile.PL +# +# return value is: +# 1 or 2 if the specification was found (mp 1 and mp 2 respectively) +# 0 otherwise +sub wanted_mp_generation { + + # check if we have a command line specification + # flag: 0: unknown, 1: mp1, 2: mp2 + my $flag = 0; + my @pass; + while (@ARGV) { + my $key = shift @ARGV; + if ($key =~ /^MOD_PERL=(\d)$/) { + $flag = $1; + } + else { + push @pass, $key; + } + } + @ARGV = @pass; + + # check %ENV + my $env = exists $ENV{MOD_PERL} ? $ENV{MOD_PERL} : 0; + + # check for contradicting requirements + if ($env && $flag && $flag != $env) { + die <<EOF; +Can\'t decide which mod_perl version should be used, since you have +supplied contradicting requirements: + enviroment variable MOD_PERL=$env + Makefile.PL option MOD_PERL=$flag +EOF + } + + my $wanted = 0; + $wanted = 2 if $env == 2 || $flag == 2; + $wanted = 1 if $env == 1 || $flag == 1; + + unless ($wanted) { + # if still unknown try to require mod_perl.pm + eval { require mod_perl }; + unless ($@) { + $wanted = $mod_perl::VERSION >= 1.99 ? 2 : 1; + } + } + + return $wanted; +} + + +__END__ Modified: Apache-Watchdog-RunAway/trunk/RunAway.pm ============================================================================== --- Apache-Watchdog-RunAway/trunk/RunAway.pm (original) +++ Apache-Watchdog-RunAway/trunk/RunAway.pm Mon Mar 21 09:48:35 2005 @@ -42,9 +42,7 @@ # current request number my %req_number = (); -open LOG, ">>$Apache::Watchdog::RunAway::LOG_FILE" - or die "Cannot open $Apache::Watchdog::RunAway::LOG_FILE"; -my $oldfh = select(LOG); $| = 1; select($oldfh); +my $log_fh; # check whether the monitor is already running # returns the PID if lockfile exists @@ -101,7 +99,7 @@ unless (-e $Apache::Watchdog::RunAway::LOCK_FILE) { warn <<EOT if $Apache::Watchdog::RunAway::DEBUG; -$0: Lockfile $Apache::Watchdog::RunAway::LOCK_FILE does not exist. Exitting... +$0: Lockfile $Apache::Watchdog::RunAway::LOCK_FILE does not exist. Exiting... EOT return; } @@ -242,7 +240,14 @@ } sub log_error { - print LOG "[".scalar localtime()."] $$: " . __PACKAGE__ ,": ", @_, "\n"; + unless ($log_fh) { + $log_fh = Symbol::gensym(); + open $log_fh, ">>$Apache::Watchdog::RunAway::LOG_FILE" + or die "Cannot open $Apache::Watchdog::RunAway::LOG_FILE: $!"; + my $oldfh = select($log_fh); $| = 1; select($oldfh); + } + + print $log_fh "[".scalar localtime()."] $$: " . __PACKAGE__ ,": ", @_, "\n"; } Modified: Apache-Watchdog-RunAway/trunk/TODO ============================================================================== --- Apache-Watchdog-RunAway/trunk/TODO (original) +++ Apache-Watchdog-RunAway/trunk/TODO Mon Mar 21 09:48:35 2005 @@ -1,3 +1,6 @@ +* improve the test suite to run a slow response handler (sleep 20) and + check that we actually spot and kill that process + * if it's polling the server every so often, it might as well generate a periodic report of what it finds. How many processes, how long each has been running, how much memory, etc. Added: Apache-Watchdog-RunAway/trunk/t/TEST.PL ============================================================================== --- (empty file) +++ Apache-Watchdog-RunAway/trunk/t/TEST.PL Mon Mar 21 09:48:35 2005 @@ -0,0 +1,31 @@ +#!perl + +use strict; +use warnings FATAL => 'all'; + +MyTest->new->run(@ARGV); + + + + +# sub-class Apache::TestRunPerl +package MyTest; + +# 5.005-compat +BEGIN { + require Apache::TestRunPerl; + @MyTest::ISA = qw(Apache::TestRunPerl); +} + +# so we get a nice view of procs/threads +use constant MIN_MAXCLIENTS => 5; + +# subclass new_test_config to add some config vars which will be +# replaced in generated httpd.conf +sub new_test_config { + my $self = shift; + + $self->{conf_opts}->{maxclients} ||= MIN_MAXCLIENTS; + + return $self->SUPER::new_test_config; +} Added: Apache-Watchdog-RunAway/trunk/t/conf/extra.conf.in ============================================================================== --- (empty file) +++ Apache-Watchdog-RunAway/trunk/t/conf/extra.conf.in Mon Mar 21 09:48:35 2005 @@ -0,0 +1,39 @@ +<IfModule mod_status.c> + # XXX: can try to loadmodule mod_status if it's not loaded and DSO + ExtendedStatus On +</IfModule> + +<IfDefine MODPERL2> + + # make sure that we test under Taint + warnings mode + PerlSwitches -wT + + PerlModule Apache2 + PerlModule Apache::Scoreboard + <Location /scoreboard> + SetHandler modperl + PerlResponseHandler Apache::Scoreboard::send + </Location> + +</IfDefine> + + +<IfDefine !MODPERL2> + + # make sure that we test under Taint + warnings mode + PerlTaintCheck On + PerlWarn On + + PerlModule Apache::Scoreboard + <Location /scoreboard> + SetHandler perl-script + PerlHandler Apache::Scoreboard::send + </Location> + +</IfDefine> + + +#PerlSwitches -Dm + + + Added: Apache-Watchdog-RunAway/trunk/t/conf/modperl_extra.pl ============================================================================== --- (empty file) +++ Apache-Watchdog-RunAway/trunk/t/conf/modperl_extra.pl Mon Mar 21 09:48:35 2005 @@ -0,0 +1,28 @@ + +use Apache::Watchdog::RunAway (); +use File::Spec::Functions qw(catfile); +use Apache::Test; + +my $hostport = Apache::TestRequest::hostport(Apache::Test::config()); +my $retrieve_url = "http://$hostport/scoreboard"; + +my $t_logs = Apache::Test::vars('t_logs'); + +$Apache::Watchdog::RunAway::TIMEOUT = 20; +$Apache::Watchdog::RunAway::POLLTIME = 1; +$Apache::Watchdog::RunAway::DEBUG = 2; +$Apache::Watchdog::RunAway::LOCK_FILE = catfile $t_logs, "safehang.lock"; +$Apache::Watchdog::RunAway::LOG_FILE = catfile $t_logs, "safehang.log"; +$Apache::Watchdog::RunAway::SCOREBOARD_URL = $retrieve_url; +$Apache::Watchdog::RunAway::VERBOSE = 0; + +# cleanup any remainder from the last test +Apache::Watchdog::RunAway::stop_monitor(); + +# forks a monitor +Apache::Watchdog::RunAway::start_detached_monitor(); + +# kills a monitor +Apache::Watchdog::RunAway::stop_monitor(); + +1; Added: Apache-Watchdog-RunAway/trunk/t/runaway/basic.t ============================================================================== --- (empty file) +++ Apache-Watchdog-RunAway/trunk/t/runaway/basic.t Mon Mar 21 09:48:35 2005 @@ -0,0 +1,10 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; + +plan tests => 1; + +# XXX: see if we can add a real test here +# for now just testing that the loading of the module works fine +ok 1;