[prev in list] [next in list] [prev in thread] [next in thread] 

List:       apache-modperl
Subject:    Re: The mod_perl protocol handler sample code have some problem!
From:       Randy Kobes <randy () theoryx5 ! uwinnipeg ! ca>
Date:       2005-07-31 19:44:02
Message-ID: Pine.LNX.4.63.0507311424210.2257 () theoryx5 ! uwinnipeg ! ca
[Download RAW message or body]

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
[prev in list] [next in list] [prev in thread] [next in thread]