1
package ProtoWrap::POP3;
#
# ProtoWrap::POP3 - POP3 extension to ProtoWrap
#
use ProtoWrap;
@ISA = qw(ProtoWrap);
use strict;
use vars qw($crlf);
$crlf = chr(13).chr(10);
sub new {
my ($class,$self,@pop3Specific,@pop3NotProtoWrap,%tmpHash);
$class = shift;
$self = { @_ };
bless $self, $class;
# Parameters accepted for POP3 that are not part of the base
# ProtoWrap should be stored in a temporal hash until the object is
# created if we do not want ProtoWrap to complain, and then added
# to the existing object.
# The affected attributes are:
# maxLoginAttempts: The maximum login attempts permitted before
# disconnection
@pop3NotProtoWrap = ('maxLoginAttempts');
foreach (@pop3NotProtoWrap) {
if (defined $self->{$_}) {
$tmpHash{$_} = $self->{$_};
delete $self->{$_};
}
}
# Check for wrong parameters
@pop3Specific = ('testLine','testReply');
foreach (@pop3Specific) {
if (defined $self->{$_}){
$self->log(0,"Parameter $_ incompatible with POP3");
return undef
}
}
# Set the POP3 defined parameters needed to create a ProtoWrap
$self->{destType} = 'ip' if (!defined $self->{destType});
if ($self->{destType} eq 'ip') {
$self->{destPort} = 110 unless (defined $self->{destPort});
$self->{destAddr} = '127.0.0.1' unless (defined $self->{destAddr});
} elsif ($self->{destType} eq 'pipe') {
$self->{pipeCmd} = '/usr/sbin/ipop3d' unless (defined $self->{pipeCmd});
}
$self->{standalone} = 1 unless defined $self->{standalone};
$self->{testLine} = \&defaultTestLine;
$self->{logName} = 'ProtoWrap-POP3';
$self->{testReply} = 1;
# Create the ProtoWrap. If it is undef, an error occured and we
# should not start.
$self = ProtoWrap->new(%$self);
return undef if (not defined $self);
# Add POP3-specific attributes not allowed for base PSNs,
# and free %tmpHash's memory
foreach (keys(%tmpHash)) {
$self->{$_} = $tmpHash{$_};
delete $tmpHash{$_};
}
# Set the needed parameters for a POP3 ProtoWrap that could not be
# specified before creating a ProtoWrap
$self->{maxLoginAttempts} = 0 if (not defined $self->{maxLoginAttempts});
$self->{stage}=-1;
# Make $self a POP3 object
bless $self, $class;
}
sub defaultTestLine {
my ($self,$line,$socket,$who) = @_;
if ($who == 0) {
return &fromClient($self,$line,$socket);
} elsif ($who == 1) {
return &fromServer($self,$line,$socket);
} else {
}
}
sub fromServer {
# stage indicates the current stage of the connection, thus
# indicating what will be accepted or rejected in the ongoing
# communication. The relation between stage and the stages
# defined in the RFC is:
#
# AUTHORIZATION:
# 0 - USER has not yet been specified.
# 1 - USER specified, waiting for server to answer.
# 2 - USER has been specified, waiting for PASS.
# 3 - USER and PASS specified, waiting for server's authorization
# TRANSACTION:
# 5 - Transaction state, all transaction commands are valid.
#
my($self,$line,$socket,$who,$retValue);
($self,$line,$socket,$who) = @_;
$retValue = 1;
# We strip CR and LF to do the tests, add them back at the
# end.
$$line =~ s/[\r\n]//g;
if ($self->{stage} == -1) {
# Stage -1: Waiting for the server to say hello.
# Instead of letting the real server expose its identity,
# we give ours. We only check if the first character sent
# by the server is '+', indicating success.
$$line = '+OK POP3 localhost.localdomain ProtoWrap '.$self->version() if
(substr($$line,0,1) eq '+');
# We set the stage to 0 to allow for interaction to start
$self->{stage} = 0;
# As the connection is just starting, we set to zero all the
# counters
$self->{loginAttempts} = 0;
$self->{maxMsgNumber} = 0;
$self->{deletedMessages} = undef;
} elsif ($self->{stage} == 1) {
# We do not care about the server's answer - USER should
# always get a positive answer.
$$line = '+OK User name accepted, password please';
$self->{stage} = 2;
} elsif ($self->{stage} == 3) {
if (substr($$line,0,1) eq '+') {
$self->{stage} = 5;
} else {
$$line = '-ERR Bad login';
$self->{stage} = 0;
$self->{loginAttempts}++;
if ($self->{maxLoginAttempts} && $self->{loginAttempts} >
$self->{maxLoginAttempts}) {
# Too many login attempts - Exit, terminating connection
# automatically.
$self->log(2,'Too many login attempts - terminating connection.');
exit 0;
}
}
} else {
# Checking how many messages are there waiting to be
# retrieved. This is done right after the client sends a
# STAT command.
if (defined($self->{statJustAsked})) {
# We should not go back here for the next line
$self->{statJustAsked} = undef;
# Get the relevant part of the answer into maxMsgNumber
$self->{maxMsgNumber} = $$line;
$self->{maxMsgNumber} =~ s/^.+(\d+).+$/$1/;
}
}
$$line .= chr(13).chr(10);
return $retValue;
}
sub fromClient {
# stage indicates the current stage of the connection, thus
# indicating what will be accepted or rejected in the ongoing
# communication. The relation between stage and the stages
# defined in the RFC is:
#
# AUTHORIZATION:
# 0 - USER has not yet been specified.
# 1 - USER specified, waiting for server to answer.
# 2 - USER has been specified, waiting for PASS.
# 3 - USER and PASS specified, waiting for server's authorization
# TRANSACTION:
# 5 - Transaction state, all transaction commands are valid.
#
my($self,$line,$socket,$who,$retValue);
($self,$line,$socket,$who) = @_;
$retValue = 1;
# We strip CR and LF to do the tests, add them back at
# the end.
$$line =~ s/[\r\n]//g;
#
# Our first test should be for maxLineLength
#
if (length($$line) > $self->{maxLineLength} && $self->{maxLineLength} > 0) {
$$line = substr($$line,0,$self->{maxLineLength});
$self->log(1,"Line too long\nChopping to:\n$$line");
}
# Commands that will always be handled the same way, no matter
# where are we at
if (uc(substr($$line,0,4)) eq 'QUIT') {
# If a QUIT is recieved, return only QUIT, chopping the
# rest of the line.
$$line = 'QUIT';
$self->{stage} = 10;
} elsif (uc(substr($$line,0,4)) eq 'NOOP') {
$socket->print("+OK This is your very special No-op!$crlf");
$$line = '';
$retValue = -1;
} elsif (uc(substr($$line,0,4)) eq 'RPOP') {
$socket->print("-ERR RPOP authorization not allowed$crlf");
$$line = '';
$retValue = 0;
} elsif ($self->{stage} < 0) {
# Stage -1 indicates that the server has not yet talked on
# the connection, and all traffic before this should be
# silently dropped.
$$line = '';
return -1;
} elsif ($self->{stage} == 0) {
# Stage 0 should only allow, besides non-stage-specific
# commands, USER.
if (uc(substr($$line,0,4)) eq 'USER') {
# check for format
if ($$line =~ s/^USER\s+([\w\d\.\-\_]*)$/USER $1/i) {
$self->{stage} = 1;
} else {
$$line = '';
$socket->print("-ERR Invalid username $crlf");
$retValue = -1;
}
} else {
&invalid($line,\$retValue,$socket);
}
} elsif ($self->{stage} == 2) {
if (uc(substr($$line,0,4)) eq 'PASS') {
# check for format
if ($$line =~ s/^PASS\s+([\S]*)$/PASS $1/i) {
$self->{stage} = 3;
} else {
$$line = '';
$socket->print("-ERR Invalid password$crlf");
$retValue = -1;
$self->{loginAttempts}++;
if ($self->{maxLoginAttempts} && $self->{loginAttempts} >
$self->{maxLoginAttempts}) {
# Too many login attempts - Exit, terminating connection
# automatically.
$self->log(2,'Too many login attempts - terminating connection.');
exit 0;
} else {
&invalid($line,\$retValue,$socket);
}
}
}
} elsif ($self->{stage} == 5) {
if (uc(substr($$line,0,4)) eq 'RSET') {
# Send only RSET, ignoring the rest of the line
$$line = 'RSET';
# Reset the deleted message list
$self->{deletedMessages} = undef;
} elsif (uc(substr($$line,0,4)) eq 'LAST') {
# Send only LAST, ignoring the rest of the line
$$line = 'LAST';
} elsif (uc(substr($$line,0,4)) eq 'STAT') {
# Send only STAT, ignoring the rest of the line
$$line = 'STAT';
$self->{statJustAsked} = 1;
} elsif (uc(substr($$line,0,4)) eq 'LIST') {
# Send only LIST, ignoring the rest of the line
$$line = 'LIST';
} elsif (uc(substr($$line,0,4)) eq 'RETR' || uc(substr($$line,0,3)) eq 'TOP') {
# Store in $msgNum just the message number requested
my $msgNum = $$line;
my $lines = $$line;
if (uc(substr($$line,0,4)) eq 'RETR') {
$msgNum =~ s/^RETR\s*(\d+).*$/$1/i;
} else {
$msgNum =~ s/^TOP\s*(\d+).*$/$1/i;
$lines =~ s/^TOP\s*\d+\s*(\d+).*$/$1/i;
}
# Check if it has already been deleted
if (defined($self->{deletedMessages}->{$msgNum})) {
$$line = '';
$retValue = -1;
$socket->print("-ERR Marked as deleted.$crlf");
} elsif ($msgNum > $self->{maxMsgNumber} || $self->{maxMsgNumber} == 0) {
# Message number greater than the total number of messages
$$line = '';
$retValue = -1;
$socket->print("-ERR Invalid message number.$crlf");
} else {
# Ok, go ahead...
if (uc(substr($$line,0,4)) eq 'RETR') {
$$line = "RETR $msgNum";
} else {
$$line = "TOP $msgNum $lines";
}
}
} elsif (uc(substr($$line,0,4)) eq 'DELE') {
# Store in $msgNum just the message number requested
my $msgNum = $$line;
$msgNum =~ s/^DELE\s+(\d+).+$/$1/i;
# Check if it has already been deleted
if (defined($self->{deletedMessages}->{$msgNum})) {
$$line = '';
$retValue = -1;
$socket->print('-ERR Message already deleted.$crlf');
} else {
$$line = "DELE $msgNum";
$self->{deletedMessages}->{$msgNum} = 1;
}
} else {
# Disallow everything else
&invalid($line,\$retValue,$socket);
}
} else {
# Guess the line was recieved when it is the server's turn to
# talk. Respond with an error and ignore it.
&invalid($line,\$retValue,$socket);
}
$$line .= chr(13).chr(10);
return $retValue;
}
sub invalid {
my ($line,$retValue,$socket) = @_;
$socket->print("-ERR Invalid command$crlf");
$$line = '';
$$retValue = 0;
}
1;