You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl@perl.apache.org by 薛共和 <lu...@tc.program.com.tw> on 2005/07/20 21:12:16 UTC
The mod_perl protocol handler sample code have some problem!
The sample code have some problem. When i telnet then CommandServer in win32 everything is ok.
But if i close then console window(terminal) immediate, the apache is hang. CPU use 100% resource.
I try to use
$c->aborted()
OR
($@ == APR::Const::ECONNABORTED )
to check the connect but it can not detect the client is disconnect.
How can i solve the problem?
ps: OS:WIN32 VERSION:APACHE/2.053 mod_perl/v2.01
The code is from http://search.cpan.org/~gozer/mod_perl-2.0.0/docs/user/handlers/protocols.pod
package MyApache::CommandServer;
use strict;
use warnings FATAL => 'all';
use Apache2::Connection ();
use Apache2::RequestUtil ();
use Apache2::HookRun ();
use Apache2::Access ();
use APR::Socket ();
use Apache2::Const -compile => qw(OK DONE DECLINED);
my @cmds = qw(motd date who quit);
my %commands = map { $_, \&{$_} } @cmds;
sub handler {
my $c = shift;
my $socket = $c->client_socket;
if ((my $rc = login($c)) != Apache2::Const::OK) {
$socket->send("Access Denied\n");
return $rc;
}
$socket->send("Welcome to " . __PACKAGE__ .
"\nAvailable commands: @cmds\n");
while (1) {
my $cmd;
next unless $cmd = getline($socket);
if (my $sub = $commands{$cmd}) {
last unless $sub->($socket) == Apache2::Const::OK;
}
else {
$socket->send("Commands: @cmds\n");
}
}
return Apache2::Const::OK;
}
sub login {
my $c = shift;
my $r = Apache2::RequestRec->new($c);
$r->location_merge(__PACKAGE__);
for my $method (qw(run_access_checker run_check_user_id
run_auth_checker)) {
my $rc = $r->$method();
if ($rc != Apache2::Const::OK and $rc != Apache2::Const::DECLINED) {
return $rc;
}
last unless $r->some_auth_required;
unless ($r->user) {
my $socket = $c->client_socket;
my $username = prompt($socket, "Login");
my $password = prompt($socket, "Password");
$r->set_basic_credentials($username, $password);
}
}
return Apache2::Const::OK;
}
sub getline {
my $socket = shift;
my $line;
$socket->recv($line, 1024);
return unless $line;
$line =~ s/[\r\n]*$//;
return $line;
}
sub prompt {
my($socket, $msg) = @_;
$socket->send("$msg: ");
getline($socket);
}
sub motd {
my $socket = shift;
open my $fh, '/etc/motd' or return;
local $/;
$socket->send(scalar <$fh>);
close $fh;
return Apache2::Const::OK;
}
sub date {
my $socket = shift;
$socket->send(scalar(localtime) . "\n");
return Apache2::Const::OK;
}
sub who {
my $socket = shift;
# make -T happy
local $ENV{PATH} = "/bin:/usr/bin";
$socket->send(scalar `who`);
return Apache2::Const::OK;
}
sub quit { Apache2::Const::DONE }
1;
__END__
Re: The mod_perl protocol handler sample code have some problem!
Posted by Randy Kobes <ra...@theoryx5.uwinnipeg.ca>.
On Fri, 12 Aug 2005, Stas Bekman wrote:
> OK, I wrote a test case that reproduces the problem.
>
> If you run:
>
> perl Makefile.PL
> make test
>
> things work, but if you do:
>
> t/TEST -start
> t/TEST -run
>
> the process starts spinning in the getline() call, as $sock->recv doesn't
> fail.
[ ... ]
> Here is a rewrite that doesn't spin. Notice that I've
> dropped the $c-aborted check, I don't know if it's needed,
> since recv() should have caught that anyway. But please
> restore it if needed.
Works great on Win32, without modification - thanks!
--
best regards,
randy
Re: The mod_perl protocol handler sample code have some problem!
Posted by Stas Bekman <st...@stason.org>.
Randy Kobes wrote:
> On Sun, 31 Jul 2005, Randy Kobes wrote:
>
>> On Sun, 31 Jul 2005, Randy Kobes wrote:
>
> [ ... ]
>
>> Here's a scaled-down version of the problem - I used
>> commands with single letters, as my Win32 console sent a \r\n after
>> each letter.
>
> [ ... ]
>
>> sub handler {
>> my $c = shift;
>> $| = 1;
>> my $socket = $c->client_socket;
>> $socket->opt_set(APR::Const::SO_NONBLOCK, 0);
>>
>> $socket->send("Welcome to " . __PACKAGE__ .
>> "\r\nAvailable commands: @cmds\r\n");
>>
>> while (1) {
>> my $cmd;
>> next unless $cmd = getline($socket);
>
> [ ... ]
> I found that if I change that last line to
> last unless $cmd = getline($socket);
> then one can interrupt the telnet session with 'CTRL ]'
> and close the connection without the Apache process
> consuming 100% cpu.
OK, I wrote a test case that reproduces the problem.
If you run:
perl Makefile.PL
make test
things work, but if you do:
t/TEST -start
t/TEST -run
the process starts spinning in the getline() call, as $sock->recv doesn't
fail. This is our "bug", well it was supposed to be a feature as the
internals are going as:
rc = apr_socket_recv(socket, SvPVX(buffer), &len);
if (!(rc == APR_SUCCESS || rc == APR_EOF)) {
modperl_croak(aTHX_ rc, "APR::Socket::recv");
}
So if recv has returned EOF, the call was always successful. So basically
we eat the EOF event and user tries to read again and again.
I think as long as we are in the blocking mode that approach is fine, i.e.:
- if $sock->recv was successful:
* if you received some string, you are good
* if you received nothing, that means you've got EOF
- otherwise handle the error
and that getline code doesn't seem to do the right thing anyway, since it
may return an error code but the caller expects a string.
Here is a rewrite that doesn't spin. Notice that I've dropped the
$c-aborted check, I don't know if it's needed, since recv() should have
caught that anyway. But please restore it if needed.
package MyTest::Protocol;
use strict;
use warnings FATAL => 'all';
use Apache2::Connection ();
use APR::Socket ();
use APR::Status ();
use Apache2::Const -compile => qw(OK DONE DECLINED);
use APR::Const -compile => qw(SO_NONBLOCK);
my @cmds = qw(d q);
my %commands = map { $_, \&{$_} } @cmds;
sub handler {
my $c = shift;
$| = 1;
my $socket = $c->client_socket;
$socket->opt_set(APR::Const::SO_NONBLOCK, 0);
$socket->send("Welcome to " . __PACKAGE__ .
"\r\nAvailable commands: @cmds\r\n");
while (1) {
my $cmd;
eval {
$cmd = getline($socket);
};
if ($@) {
return Apache2::Const::DONE if APR::Status::is_ECONNABORTED($@);
}
last unless defined $cmd; # EOF
next unless length $cmd; # new line with no commands
warn "READ: $cmd\n";
if (my $sub = $commands{$cmd}) {
last unless $sub->($socket) == Apache2::Const::OK;
} else {
$socket->send("Commands: @cmds\r\n");
}
}
return Apache2::Const::OK;
}
# returns either of:
# - undef on EOF
# - CRLF stripped line on normal read
#
# may throw an exception (via recv())
sub getline {
my $socket = shift;
$socket->recv(my $line, 1024);
return undef unless length $line;
$line =~ s/[\r\n]*$//;
return $line;
}
sub d {
my $socket = shift;
$socket->send(scalar(localtime) . "\r\n");
return Apache2::Const::OK;
}
sub q { Apache2::Const::DONE }
1;
__END__
<NoAutoConfig>
<VirtualHost MyTest::Protocol>
PerlProcessConnectionHandler MyTest::Protocol
<Location MyTest__Protocol>
Order Deny,Allow
Allow from all
</Location>
</VirtualHost>
</NoAutoConfig>
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
Re: The mod_perl protocol handler sample code have some problem!
Posted by Randy Kobes <ra...@theoryx5.uwinnipeg.ca>.
On Sun, 31 Jul 2005, Randy Kobes wrote:
> On Sun, 31 Jul 2005, Randy Kobes wrote:
[ ... ]
> Here's a scaled-down version of the problem - I used
> commands with single letters, as my Win32 console sent a \r\n after each
> letter.
[ ... ]
> sub handler {
> my $c = shift;
> $| = 1;
> my $socket = $c->client_socket;
> $socket->opt_set(APR::Const::SO_NONBLOCK, 0);
>
> $socket->send("Welcome to " . __PACKAGE__ .
> "\r\nAvailable commands: @cmds\r\n");
>
> while (1) {
> my $cmd;
> next unless $cmd = getline($socket);
[ ... ]
I found that if I change that last line to
last unless $cmd = getline($socket);
then one can interrupt the telnet session with 'CTRL ]'
and close the connection without the Apache process
consuming 100% cpu.
--
best regards,
randy
Re: The mod_perl protocol handler sample code have some problem!
Posted by Randy Kobes <ra...@theoryx5.uwinnipeg.ca>.
On Sun, 31 Jul 2005, Randy Kobes wrote:
> If someone has a test linux box, could they see if things
> spin out of control if one uses an xterm to telnet in, and
> then closes the xterm? This probably won't happen, but it
> would be good to see if it's a Win32-specific problem.
Here's a scaled-down version of the problem - I used
commands with single letters, as my Win32 console sent a
\r\n after each letter.
==========================================================
package Apache2::CS;
use strict;
use warnings FATAL => 'all';
use Apache2::Connection ();
use APR::Socket ();
use APR::Status ();
use Apache2::Const -compile => qw(OK DONE DECLINED);
use APR::Const -compile => qw(SO_NONBLOCK);
my @cmds = qw(d q);
my %commands = map { $_, \&{$_} } @cmds;
sub handler {
my $c = shift;
$| = 1;
my $socket = $c->client_socket;
$socket->opt_set(APR::Const::SO_NONBLOCK, 0);
$socket->send("Welcome to " . __PACKAGE__ .
"\r\nAvailable commands: @cmds\r\n");
while (1) {
my $cmd;
next unless $cmd = getline($socket);
last if $c->aborted;
if (my $sub = $commands{$cmd}) {
last unless $sub->($socket) == Apache2::Const::OK;
}
else {
$socket->send("Commands: @cmds\r\n");
}
}
# while ($socket->recv(my $buff, 1024)) {
# last if $buff =~ /^[\r\n]+$/;
# $socket->send("\r\n$buff\r\n");
# }
return Apache2::Const::OK;
}
sub getline {
my $socket = shift;
my $line;
my $len = eval{ $socket->recv($line, 1024)};
if ($@) {
return Apache2::Const::DONE if APR::Status::is_ECONNABORTED($@);
}
return unless $line;
$line =~ s/[\r\n]*$//;
return $line;
}
sub d {
my $socket = shift;
$socket->send(scalar(localtime) . "\r\n");
return Apache2::Const::OK;
}
sub q { Apache2::Const::DONE }
1;
__END__
# Apache configuration directives
#Listen 0.0.0.0:8541
#<VirtualHost _default_:8541>
# PerlProcessConnectionHandler Apache2::CS
#
# <Location Apache2::CS>
# Order Deny,Allow
# Allow from all
# </Location>
#</VirtualHost>
==================================================================
Then I try
telnet localhost 8541
If one tries a bunch of commands (the 'd' works for me in
getting the date), and then finally enters a 'q' for quit,
the connection terminates normally. However, within the
session, if one gives 'CTRL ]', one returns to the telnet
prompt, and then as soon as one enters 'quit' at that
prompt, the Apache process consumes 100% of the cpu.
If instead of the while(1){} loop within the handler
one uses the commented-out while() loop, no such problem
arises.
--
best regards,
randy
Re: The mod_perl protocol handler sample code have some problem!
Posted by Randy Kobes <ra...@theoryx5.uwinnipeg.ca>.
On Thu, 21 Jul 2005, Stas Bekman wrote:
> LUKE wrote:
>> Thanks!
>>
>> But the problem is still exist.
>
>>> The sample code have some problem. When i telnet then
>>> CommandServer in win32 everything is ok. But if i close
>>> then console window(terminal) immediate, the apache is
>>> hang. CPU use 100% resource.
>>>
>>> I try to use
>>> $c->aborted()
>>> OR
>>> ($@ == APR::Const::ECONNABORTED )
>>> to check the connect but it can not detect the client is disconnect.
>>
>> [ ... ]
>> I'm not sure if this will help, but you might try the use
>> of APR::Status::is_ECONNABORTED(), as discussed at
>> http://perl.apache.org/docs/2.0/api/APR/Status.html#C_is_ECONNABORTED_
>> to check if $@ corresponds to APR_STATUS_IS_ECONNABORTED,
>> due to variants in the error conditions.
>
> I'm not familiar with windows, but I think you need to run
> an equivalent of unix's strace(1), which shows you where
> the process is spinning and go from there. (or attach with
> debugger, or something else).
>
> Randy, can you write a test that can emulate such a situation?
I'm not sure how to do that - note that this is is based on
the t/protocal/pseudo_http.t test, which should pass on
Win32. However, I can confirm the original problem - open up
a console window, telnet to localhost:port, give a few
commands, then close the window, and the cpu usage due to
the Apache process grows to 100%.
If someone has a test linux box, could they see if things
spin out of control if one uses an xterm to telnet in, and
then closes the xterm? This probably won't happen, but it
would be good to see if it's a Win32-specific problem.
--
best regards,
randy
Re: The mod_perl protocol handler sample code have some problem!
Posted by Stas Bekman <st...@stason.org>.
LUKE wrote:
> Thanks!
>
> But the problem is still exist.
>>The sample code have some problem. When i telnet then
>>CommandServer in win32 everything is ok. But if i close
>>then console window(terminal) immediate, the apache is
>>hang. CPU use 100% resource.
>>
>>I try to use
>>$c->aborted()
>>OR
>>($@ == APR::Const::ECONNABORTED )
>>to check the connect but it can not detect the client is disconnect.
>
> [ ... ]
> I'm not sure if this will help, but you might try the use
> of APR::Status::is_ECONNABORTED(), as discussed at
> http://perl.apache.org/docs/2.0/api/APR/Status.html#C_is_ECONNABORTED_
> to check if $@ corresponds to APR_STATUS_IS_ECONNABORTED,
> due to variants in the error conditions.
I'm not familiar with windows, but I think you need to run an equivalent
of unix's strace(1), which shows you where the process is spinning and go
from there. (or attach with debugger, or something else).
Randy, can you write a test that can emulate such a situation?
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
Re: The mod_perl protocol handler sample code have some problem!
Posted by LUKE <lu...@tc.program.com.tw>.
Thanks!
But the problem is still exist.
----- Original Message -----
From: "Randy Kobes" <ra...@theoryx5.uwinnipeg.ca>
To: "薛共和" <lu...@tc.program.com.tw>
Cc: <mo...@perl.apache.org>
Sent: Thursday, July 21, 2005 12:47 PM
Subject: Re: The mod_perl protocol handler sample code have some problem!
On Thu, 21 Jul 2005, [big5] g@M wrote:
> The sample code have some problem. When i telnet then
> CommandServer in win32 everything is ok. But if i close
> then console window(terminal) immediate, the apache is
> hang. CPU use 100% resource.
>
> I try to use
> $c->aborted()
> OR
> ($@ == APR::Const::ECONNABORTED )
> to check the connect but it can not detect the client is disconnect.
[ ... ]
I'm not sure if this will help, but you might try the use
of APR::Status::is_ECONNABORTED(), as discussed at
http://perl.apache.org/docs/2.0/api/APR/Status.html#C_is_ECONNABORTED_
to check if $@ corresponds to APR_STATUS_IS_ECONNABORTED,
due to variants in the error conditions.
--
best regards,
randy kobes
Re: The mod_perl protocol handler sample code have some problem!
Posted by Randy Kobes <ra...@theoryx5.uwinnipeg.ca>.
On Thu, 21 Jul 2005, [big5] ���@�M wrote:
> The sample code have some problem. When i telnet then
> CommandServer in win32 everything is ok. But if i close
> then console window(terminal) immediate, the apache is
> hang. CPU use 100% resource.
>
> I try to use
> $c->aborted()
> OR
> ($@ == APR::Const::ECONNABORTED )
> to check the connect but it can not detect the client is disconnect.
[ ... ]
I'm not sure if this will help, but you might try the use
of APR::Status::is_ECONNABORTED(), as discussed at
http://perl.apache.org/docs/2.0/api/APR/Status.html#C_is_ECONNABORTED_
to check if $@ corresponds to APR_STATUS_IS_ECONNABORTED,
due to variants in the error conditions.
--
best regards,
randy kobes