view release on metacpan or  search on metacpan

lib/Apache2/Protocol/ESMTP.pm  view on Meta::CPAN

=head2 chunkmode

If set to true the next available data from the client
will be read in chunks of size B<chunksize>. If set to 
false data will be read a line at a time. The default
behaviour is to start in line mode, switch to chunkmode
after the message headers (EOH) and then switch back line
mode after the message body (EOM).

=head2 chunksize

Sets the size of the chunks of data read from the client
when B<chunkmode> is set to true.

=head2 disconnect

When set to true, the sever will close the client connection
when the current operation is complete. By default the client
connection will be shutdown when the QUIT operation has completed.

=cut

use base qw/Apache2::Protocol/;
use Apache2::ServerUtil ();
use Fcntl ':flock';
use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors(qw//);

use POSIX 'strftime';

sub handler {
    my $c = shift;
    my $p = shift || Apache2::Protocol::ESMTP->new;

    $p->connecthandler(\&_connect);
    $p->default_line_handler(\&_unknown);
    $p->chunkhandler(\&_body);

    $p->register_callback(qr/^helo\s+(\S*?)?\s*$/i, \&_helo, 'protocol');
    $p->register_callback(qr/^ehlo\s+(\S*?)?\s*$/i, \&_ehlo, 'protocol');
    $p->register_callback(qr/^mail from:\s*<?(\S+?)?>?\s*$/i, \&_mail, 'protocol'); 
    $p->register_callback(qr/^rcpt to:\s*<?(\S+?)?>?\s*$/i, \&_rcpt, 'protocol');
    $p->register_callback(qr/^data\s*$/i, \&_data, 'protocol');
    $p->register_callback(qr/^expn\s+(\S+?)?\s*$/i, \&_expn, 'protocol');
    $p->register_callback(qr/^vrfy\s+(\S+?)?\s*$/i, \&_vrfy, 'protocol');
    $p->register_callback(qr/^rset\s*$/i, \&_rset, 'protocol');
    $p->register_callback(qr/^noop\s*$/i, \&_noop, 'protocol');
    $p->register_callback(qr/^help\s*(\S*?)?\s*$/i, \&_help, 'protocol');
    $p->register_callback(qr/^quit\s*$/i, \&_quit, 'protocol');
    $p->enable_callbacks('protocol');

    $p->setup_logging($c);

    Apache2::Protocol::handler($c, $p);
}

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my $self = bless($class->SUPER::new(@_), $class);

    $self->{_bodystate}   = '';
    $self->{_headername}  = '';
    $self->{_headervalue} = '';
    $self->{_seenDATA}    = 0;
    $self->{_seenHELO}    = 0;
    $self->{_seenMAIL}    = 0;
    $self->{_seenRCPT}    = 0;

    return $self;
}

sub setup_logging {
    my $self = shift;
    my $c = shift;

    my $s = $c->base_server;

    $self->{_log_level} = $s->dir_config('ESMTPLogLevel');
    if(defined $self->{_log_level}) {
	$self->{_log_filename} = $s->dir_config('ESMTPLogFileName');
	$self->{_log_filename} = Apache2::ServerUtil::server_root . '/logs/' . $self->{_log_filename}
	    unless $self->{_log_filename} =~ m@^/@;
	$self->{_log_remotehost} = $c->get_remote_host;
    }
}

sub log_ESMTP {
    my $self = shift;
    my $level = shift;
    unless (defined $self->{_log_filename}) {
        warn "Too early for logging: " . caller;
        return;
    }
    return unless defined $self->{_log_level} && $level <= $self->{_log_level};
    my $data = shift;
    my $date = strftime('%Y-%m-%d %H:%M:%S', localtime);

    open(LOG, ">>$self->{_log_filename}") or die "Can't open log $self->{_log_filename}: $!";
    flock(LOG, LOCK_EX);
    seek(LOG, 0, 2);
    $data = "$self->{_msgid} $data" if $self->{_msgid};
    $data .= " [$self->{_log_remotehost}]" if $self->{_log_remotehost};
    print LOG "$date $data\n";
    flock(LOG, LOCK_UN);
    close(LOG);
}

sub _unknown {
    my $self = shift;
    $self->send_response($self->UNKNOWN(@_));
}

sub UNKNOWN {
    my $self = shift;
    my $line = shift;
    chomp($line);
    return(500, "Command unrecognized: $line");
}