Re: The mod_perl protocol handler sample code have some problem!

[Stas Bekman]

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



    rc = apr_socket_recv(socket, SvPVX(buffer), &len);

    if (!(rc == APR_SUCCESS || rc == APR_EOF)) {
        modperl_croak(aTHX_ rc, "APR::Socket::recv");
    }



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





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:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org   http://ticketmaster.com

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: 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. 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.

bug-reporting-skeleton-mp2.tar.gz
Description: GNU Zip compressed data