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



-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>


Reply via email to