Tesing Protocol Handlers got strange result!

LUKE Fri, 17 Feb 2006 22:28:01 -0800

Then code is from http://perl.apache.org/docs/2.0/user/handlers/protocols.html Command Server.

When i start to test. It will not response Welcome Message until i type enter. Why?

The FTP Server or SMTP Server will response Welcome Message first. If i want to implement

those protocol using Apache2's Protocol Handlers. It will fail.

PS. You can connect telnet se2.program.com.tw 25 to testing the program.

PS. linux(Red Hat) + apache2.0.55 + mod_perlv2.02 + perl 5.8.7

package TestPH;

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;
          }
      }

      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__

Tesing Protocol Handlers got strange result!

Reply via email to