----- Original Message -----
Sent: Saturday, February 18, 2006 2:25
PM
Subject: Tesing Protocol Handlers got
strange result!
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__