On Tue, 14 Oct 2003, Stas Bekman wrote:
> Steve Hay wrote:
> [...]
> > Would it be possible to change TestSmoke to create a TestServer object
> > and call the start() and stop() methods on it, rather than using "t/TEST
> > -start" and "t/TEST -stop", or is that a really stupid question?
>
> As someone said, there are no stupid questions ;)
>
> Sure, we can do that, but what would be the gain?
> TestSmoke really doesn't want to be complicated and wants
> to delegate all control to TestServer. All it does is
> parsing TestRun's output. So if anything that needs to be
> fixed is TestServer. TestSmoke should just be able to say,
> ok start the server, and then please run this test, and
> then please stop (without ever needing to repeat the
> command, "I said stop already!").
>
> If you suggest the same thing for TestRun/Server, remember
> that anybody can issue t/TEST -start/-stop from the
> outside, rendering the object approach useless (since
> -stop it won't have an access to the object created by
> -start, as the request is coming from theoutside)
>
> p.s. I'd let you guys figure it out on win32 and once you
> are happy we will see how to make that behavior similar on
> other platforms. Of course if you need to change things in
> the non-win32 area, please do so. As mentioned before the
> left over pid file happens on unix as well, but it's not a
> critical issue there, since unices rotate pids and don't
> immediately re-use them.
I'm not sure there is a complete solution here ... That's
a good point, Stas - the changes have to go into
TestServer.pm, as someone can run t/TEST in the same way
as t/SMOKE. And so we can't rely on the Win32::Process
object being available. However, if we fall back to using
t/logs/httpd.pid, then in some circumstances this pid may
have been recycled to another process, and killing that
wouldn't be good ... We could look up the process info
using Win32::Process::Info, but that module's not included
by default on ActivePerl.
I think Steve has a good point that, on Win32, it's a bit
too dangerous to go around killing processes that may not
be Apache ones. Given that, it seems to me better to use
Win32::Process::Info to get the name of the process, and
kill that if the name is 'Apache.exe' (of course, this
isn't foolproof, as it may be a legitimate Apache process
started from somewhere else, but one has to draw a line ..).
Stas, would you object to making Win32::Process::Info a
requirement on Win32 for Apache-Test? I'll supply ppm
versions of it (and also the required Win32::API), so
for most users it should be easy to install.
I've attached two patches - one using Win32::Process::Info
and one not - perhaps we could choose one and refine it ...
There's one non-Win32 modification made - to the kill_proc()
sub of TestSmoke, where `cat $file` is replaced by an
explicit open and read.
--
best regards,
randy
Index: TestServer.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.67
diff -u -r1.67 TestServer.pm
--- TestServer.pm 10 Oct 2003 04:05:56 -0000 1.67
+++ TestServer.pm 15 Oct 2003 03:50:26 -0000
@@ -12,6 +12,7 @@
use Apache::TestRequest ();
use constant COLOR => Apache::TestConfig::COLOR;
+use constant WIN32 => Apache::TestConfig::WIN32;
my $CTRL_M = COLOR ? "\r" : "\n";
@@ -313,19 +314,22 @@
my $self = shift;
my $aborted = shift;
- if (Apache::TestConfig::WIN32) {
- if ($self->{config}->{win32obj}) {
- $self->{config}->{win32obj}->Kill(0);
- warning "server $self->{name} shutdown";
- return 1;
+ if (WIN32) {
+ require Win32::Process;
+ require Win32;
+ my $obj = $self->{config}->{win32obj};
+ if (my $pid = $obj ? $obj->GetProcessID : $self->pid) {
+ if (kill(0, $pid)) {
+ Win32::Process::KillProcess($pid, 0);
+ warning "server $self->{name} shutdown";
+ }
+ else {
+ warning "Could not shutdown $self->{name}: " .
+ Win32::FormatMessage(Win32::GetLastError());
+ }
}
- else {
- require Win32::Process;
- my $pid = $self->pid;
- Win32::Process::KillProcess($pid, 0);
- warning "server $self->{name} shutdown";
- return 1;
- }
+ unlink $self->pid_file if (-f $self->pid_file);
+ return 1;
}
my $pid = 0;
@@ -436,11 +440,18 @@
print "$cmd\n";
my $old_sig;
- if (Apache::TestConfig::WIN32) {
+ if (WIN32) {
+ # check for (and remove) any stale pid file
+ if (-f $self->pid_file) {
+ warn "Removing old PID file -- " .
+ "Unclean shutdown of previous test run?\n";
+ unlink $self->pid_file;
+ }
#make sure only 1 process is started for win32
#else Kill will only shutdown the parent
my $one_process = $self->version_of(\%one_process);
require Win32::Process;
+ require Win32;
my $obj;
# We need the "1" below to inherit the calling processes
# handles when running Apache::TestSmoke so as to properly
@@ -450,7 +461,11 @@
"$cmd $one_process",
1,
Win32::Process::NORMAL_PRIORITY_CLASS(),
- '.') || die Win32::Process::ErrorReport();
+ '.');
+ unless ($obj) {
+ die "Could not start the server: " .
+ Win32::FormatMessage(Win32::GetLastError());
+ }
$config->{win32obj} = $obj;
}
else {
Index: TestSmoke.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm,v
retrieving revision 1.24
diff -u -r1.24 TestSmoke.pm
--- TestSmoke.pm 10 Oct 2003 04:05:56 -0000 1.24
+++ TestSmoke.pm 15 Oct 2003 03:50:27 -0000
@@ -717,6 +717,7 @@
}
sub kill_proc {
+ return if Apache::TestConfig::WIN32;
my($self) = @_;
# a hack
@@ -724,8 +725,9 @@
my $file = catfile $t_logs, "httpd.pid";
return unless -f $file;
- my $pid = `cat $file`;
- chomp $pid;
+ my $fh = Symbol::gensym();
+ open $fh, $file or return;
+ chomp(my $pid = <$fh> || '');
return unless $pid;
kill SIGINT => $pid;
Index: TestServer.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.67
diff -u -r1.67 TestServer.pm
--- TestServer.pm 10 Oct 2003 04:05:56 -0000 1.67
+++ TestServer.pm 15 Oct 2003 04:37:58 -0000
@@ -12,6 +12,7 @@
use Apache::TestRequest ();
use constant COLOR => Apache::TestConfig::COLOR;
+use constant WIN32 => Apache::TestConfig::WIN32;
my $CTRL_M = COLOR ? "\r" : "\n";
@@ -313,19 +314,30 @@
my $self = shift;
my $aborted = shift;
- if (Apache::TestConfig::WIN32) {
- if ($self->{config}->{win32obj}) {
- $self->{config}->{win32obj}->Kill(0);
- warning "server $self->{name} shutdown";
- return 1;
+ if (WIN32) {
+ require Win32::Process;
+ require Win32;
+ require Win32::Process::Info;
+ my $obj = $self->{config}->{win32obj};
+ if (my $pid = $obj ? $obj->GetProcessID : $self->pid) {
+ my $pi = Win32::Process::Info->new();
+ (my $info) = $pi->GetProcInfo($pid);
+ if ($info->{Name} eq 'Apache.exe') {
+ if (kill(0, $pid)) {
+ Win32::Process::KillProcess($pid, 0);
+ warning "server $self->{name} shutdown";
+ }
+ else {
+ warning "Could not shutdown $self->{name}: " .
+ Win32::FormatMessage(Win32::GetLastError());
+ }
+ }
+ else {
+ warning "Stale pid file found -- will remove";
+ }
}
- else {
- require Win32::Process;
- my $pid = $self->pid;
- Win32::Process::KillProcess($pid, 0);
- warning "server $self->{name} shutdown";
- return 1;
- }
+ unlink $self->pid_file if (-f $self->pid_file);
+ return 1;
}
my $pid = 0;
@@ -436,11 +448,18 @@
print "$cmd\n";
my $old_sig;
- if (Apache::TestConfig::WIN32) {
+ if (WIN32) {
+ # check for (and remove) any stale pid file
+ if (-f $self->pid_file) {
+ warn "Removing old PID file -- " .
+ "Unclean shutdown of previous test run?\n";
+ unlink $self->pid_file;
+ }
#make sure only 1 process is started for win32
#else Kill will only shutdown the parent
my $one_process = $self->version_of(\%one_process);
require Win32::Process;
+ require Win32;
my $obj;
# We need the "1" below to inherit the calling processes
# handles when running Apache::TestSmoke so as to properly
@@ -450,7 +469,11 @@
"$cmd $one_process",
1,
Win32::Process::NORMAL_PRIORITY_CLASS(),
- '.') || die Win32::Process::ErrorReport();
+ '.');
+ unless ($obj) {
+ die "Could not start the server: " .
+ Win32::FormatMessage(Win32::GetLastError());
+ }
$config->{win32obj} = $obj;
}
else {
Index: TestSmoke.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm,v
retrieving revision 1.24
diff -u -r1.24 TestSmoke.pm
--- TestSmoke.pm 10 Oct 2003 04:05:56 -0000 1.24
+++ TestSmoke.pm 15 Oct 2003 04:37:58 -0000
@@ -717,6 +717,7 @@
}
sub kill_proc {
+ return if Apache::TestConfig::WIN32;
my($self) = @_;
# a hack
@@ -724,8 +725,9 @@
my $file = catfile $t_logs, "httpd.pid";
return unless -f $file;
- my $pid = `cat $file`;
- chomp $pid;
+ my $fh = Symbol::gensym();
+ open $fh, $file or return;
+ chomp(my $pid = <$fh> || '');
return unless $pid;
kill SIGINT => $pid;
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
