FAQ
Hi all,

As a small 'get to know perl' project I have been writing a simple pop3
server (implementing rfc1939). As such my script opens a socket to listen on
and accepts commands & responds in a while ($line=<S_IN>) { } loop.

$line is parsed to get the POP3 command and any parameters, then I have a
seies of if / elsif / else statements to decide what to do.

Telneting to this 'server' works fine & I can send commands and get the
expected responses - peculiar thing is, when I send command string LIST (by
itself on a line, LIST followed by white space and / or other chars works
fine) I get the expected reponse, however _any_ further commands are not
handles, where they would be handled (even in the same session, but before
LIST). I have tested the code on Windows NT4 SP5 & XP PRO - this behaviour
only shows up in XP. Incase it had something to do with the code which was
executed when LIST was handld, I replaced it so it performs exactly the same
action as the NOOP command string (namely returns string '+OK' ), however
the weirdness persists!

I was runnign ActiveState PERL 5.8 on both boxes.
Any ideas ?

thanks,
Andy.

# Code excerpt

socket(Server, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die
"setsockopt: $!";
bind(Server, sockaddr_in($s_port, INADDR_ANY)) or die "bind: $!";
listen(Server,SOMAXCONN) or die "listen: $!";
print "server started on port $s_port\n";
my $paddr;
$SIG{CHLD} = \&REAPER;
for ( ; $paddr = accept(Client,Server); close Client) {
$s_user = "";
$s_state = "AUTHORIZATION";
$s_maildrop = "";
my($port,$iaddr) = sockaddr_in($paddr);
print "request accepted\n";
open (S_IN, "<&Client") or die "can't dup client to sockin";
open (S_OUT, ">&Client") or die "can't dup client to sockout";
S_OUT->autoflush();
s_ok("ready");
while (my $line=<S_IN>) {
$line =~ s/[\r\n]//g;
my @cmd = split(/ /, $line);
$_ = "";
$line = "";
$cmd[0] =~ tr/a-z/A-Z/;
if ($s_state eq "AUTHORIZATION") {

if ($cmd[0] eq "APOP") {

# Do not implement yet

}
elsif ($cmd[0] eq "PASS") {

$s_state = "TRANSACTION";
$s_maildrop = "$home$s_user\/";
s_ok("authenticated");

}
elsif ($cmd[0] eq "QUIT") {



}
elsif ($cmd[0] eq "USER") {

if ($#cmd > 0) {

$s_user = $cmd[1];
s_ok();

}
else {

s_err("PROTOCOL ERROR");

}

}
else {
s_err("PROTOCOL ERROR");
}

}
elsif ($s_state eq "TRANSACTION") {

if ($cmd[0] eq "DELE") {



}
elsif ($cmd[0] eq 'LIST') {

s_ok();

}
elsif ($cmd[0] eq "NOOP") {

s_ok();

}
elsif ($cmd[0] eq "QUIT") {



}
elsif ($cmd[0] eq "RETR") {



}
elsif ($cmd[0] eq "RSET") {



}
elsif ($cmd[0] eq "STAT") {

s_ok();

}
elsif ($cmd[0] eq "TOP") {



}
elsif ($cmd[0] eq "UIDL") {



}
else {
s_err("PROTOCOL ERROR");
}

}
elsif ($s_state eq "UPDATE") {

s_err("PROTOCOL ERROR")

}
else {
s_err("PROTOCOL ERROR")
}
}
}

sub s_ok {
my $response = "\+OK";
for my $param (@_) { $response .= " $param"; }
print S_OUT "$response\r\n";
}

sub s_err {
my $response = "-ERR";
for my $param (@_) { $response .= " $param"; }
print S_OUT "$response\r\n";
}

sub s_out {
my $response = "";
for my $param (@_) { $response .= "$param "; }
chomp $response;
print S_OUT "$response\r\n";
}

Search Discussions

Related Discussions

Discussion Navigation
viewthread | post
Discussion Overview
groupbeginners @
categoriesperl
postedJan 8, '04 at 10:08p
activeJan 8, '04 at 10:08p
posts1
users1
websiteperl.org

1 user in discussion

Andy: 1 post

People

Translate

site design / logo © 2022 Grokbase