qpsmtpd/lib/Qpsmtpd/PollServer.pm

# $Id: Server.pm,v 1.10 2005/02/14 22:04:48 msergeant Exp $

package Qpsmtpd::PollServer;

use base ('Danga::Client', 'Qpsmtpd::SMTP');
# use fields required to be a subclass of Danga::Client. Have to include
# all fields used by Qpsmtpd.pm here too.
use fields qw(
    input_sock
    mode
    header_lines
    in_header
    data_size
    max_size
    hooks
    start_time
    cmd_timeout
    conn
    _auth
    _auth_mechanism
    _auth_state
    _auth_ticket
    _auth_user
    _commands
    _config_cache
    _connection
    _continuation
    _extras
    _test_mode
    _transaction
);
use Qpsmtpd::Constants;
use Qpsmtpd::Address;
use ParaDNS;
use Mail::Header;
use POSIX qw(strftime);
use Socket qw(inet_aton AF_INET CRLF);
use Time::HiRes qw(time);
use strict;

sub max_idle_time { 60 }
sub max_connect_time { 1200 }

sub input_sock {
    my $self = shift;
    @_ and $self->{input_sock} = shift;
    $self->{input_sock} || $self;
}

sub new {
    my Qpsmtpd::PollServer $self = shift;
    
    $self = fields::new($self) unless ref $self;
    $self->SUPER::new( @_ );
    $self->{cmd_timeout} = 5;
    $self->{start_time} = time;
    $self->{mode} = 'connect';
    $self->load_plugins;
    $self->load_logging;
    return $self;
}

sub uptime {
    my Qpsmtpd::PollServer $self = shift;
    
    return (time() - $self->{start_time});
}

sub reset_for_next_message {
    my Qpsmtpd::PollServer $self = shift;
    $self->SUPER::reset_for_next_message(@_);
    
    $self->{_commands} = {
        ehlo => 1,
        helo => 1,
        rset => 1,
        mail => 1,
        rcpt => 1,
        data => 1,
        help => 1,
        vrfy => 1,
        noop => 1,
        quit => 1,
        auth => 0, # disabled by default
    };
    $self->{mode} = 'cmd';
    $self->{_extras} = {};
}

sub respond {
    my Qpsmtpd::PollServer $self = shift;
    my ($code, @messages) = @_;
    while (my $msg = shift @messages) {
        my $line = $code . (@messages ? "-" : " ") . $msg;
        $self->write("$line\r\n");
    }
    return 1;
}

sub fault {
    my Qpsmtpd::PollServer $self = shift;
    $self->SUPER::fault(@_);
    return;
}

my %cmd_cache;

sub process_line {
    my Qpsmtpd::PollServer $self = shift;
    my $line = shift || return;
    if ($::DEBUG > 1) { print "$$:".($self+0)."C($self->{mode}): $line"; }
    if ($self->{mode} eq 'cmd') {
        $line =~ s/\r?\n//;
        my ($cmd, @params) = split(/ +/, $line, 2);
        my $meth = lc($cmd);
        if (my $lookup = $cmd_cache{$meth} || $self->{_commands}->{$meth} && $self->can($meth)) {
            $cmd_cache{$meth} = $lookup;
            eval {
                $lookup->($self, @params);
            };
            if ($@) {
                my $error = $@;
                chomp($error);
                $self->log(LOGERROR, "Command Error: $error");
                $self->fault("command '$cmd' failed unexpectedly");
            }
        }
        else {
            # No such method - i.e. unrecognized command
            my ($rc, $msg) = $self->run_hooks("unrecognized_command", $meth, @params);
        }
    }
    elsif ($self->{mode} eq 'connect') {
        $self->{mode} = 'cmd';
        # I've removed an eval{} from around this. It shouldn't ever die()
        # but if it does we're a bit screwed... Ah well :-)
        $self->start_conversation;
    }
    else {
        die "Unknown mode";
    }
    return;
}

sub disconnect {
    my Qpsmtpd::PollServer $self = shift;
    $self->SUPER::disconnect(@_);
    $self->close;
}

sub start_conversation {
    my Qpsmtpd::PollServer $self = shift;
    
    my $conn = $self->connection;
    # set remote_host, remote_ip and remote_port
    my ($ip, $port) = split(':', $self->peer_addr_string);
    return $self->close() unless $ip;
    $conn->remote_ip($ip);
    $conn->remote_port($port);
    $conn->remote_info("[$ip]");
    
    ParaDNS->new(
        finished   => sub { $self->run_hooks("connect") },
        # NB: Setting remote_info to the same as remote_host
        callback   => sub { $conn->remote_info($conn->remote_host($_[0])) },
        host       => $ip,
    );
    
    return;
}

sub data {
    my Qpsmtpd::PollServer $self = shift;
    
    my ($rc, $msg) = $self->run_hooks("data");
    return 1;
}

sub data_respond {
    my Qpsmtpd::PollServer $self = shift;
    my ($rc, $msg) = @_;
    if ($rc == DONE) {
        return;
    }
    elsif ($rc == DENY) {
        $msg->[0] ||= "Message denied";
        $self->respond(554, @$msg);
        $self->reset_transaction();
        return;
    }
    elsif ($rc == DENYSOFT) {
        $msg->[0] ||= "Message denied temporarily";
        $self->respond(451, @$msg);
        $self->reset_transaction();
        return;
    } 
    elsif ($rc == DENY_DISCONNECT) {
        $msg->[0] ||= "Message denied";
        $self->respond(554, @$msg);
        $self->disconnect;
        return;
    }
    elsif ($rc == DENYSOFT_DISCONNECT) {
        $msg->[0] ||= "Message denied temporarily";
        $self->respond(451, @$msg);
        $self->disconnect;
        return;
    }
    return $self->respond(503, "MAIL first") unless $self->transaction->sender;
    return $self->respond(503, "RCPT first") unless $self->transaction->recipients;
    
    $self->{header_lines} = '';
    $self->{data_size} = 0;
    $self->{in_header} = 1;
    $self->{max_size} = ($self->config('databytes'))[0] || 0;
    
    $self->log(LOGDEBUG, "max_size: $self->{max_size} / size: $self->{data_size}");

    $self->respond(354, "go ahead");

    my $max_get = $self->{max_size} || 1048576;
    $self->get_chunks($max_get, sub { $self->got_data($_[0]) });
    return 1;
}

sub got_data {
    my Qpsmtpd::PollServer $self = shift;
    my $data = shift;

    my $done = 0;
    my $remainder;
    if ($data =~ s/^\.\r\n(.*)\z//ms) {
        $remainder = $1;
        $done = 1;
    }

    # add a transaction->blocked check back here when we have line by line plugin access...
    unless (($self->{max_size} and $self->{data_size} > $self->{max_size})) {
        $data =~ s/\r\n/\n/mg;
        $data =~ s/^\.\./\./mg;
        
        if ($self->{in_header}) {
            $self->{header_lines} .= $data;
            
            if ($self->{header_lines} =~ s/\n(\n.*)\z/\n/ms) {
                $data = $1;
                # end of headers
                $self->{in_header} = 0;
                
                # ... need to check that we don't reformat any of the received lines.
                #
                # 3.8.2 Received Lines in Gatewaying
                #   When forwarding a message into or out of the Internet environment, a
                #   gateway MUST prepend a Received: line, but it MUST NOT alter in any
                #   way a Received: line that is already in the header.
                my @header_lines = split(/^/m, $self->{header_lines});
    
                my $header = Mail::Header->new(\@header_lines,
                                                Modify => 0, MailFrom => "COERCE");
                $self->transaction->header($header);
                $self->{header_lines} = '';

                #$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/");
    
                # FIXME - call plugins to work on just the header here; can
                # save us buffering the mail content.
            
                # Save the start of just the body itself	
                $self->transaction->set_body_start();
            }
        }

        $self->transaction->body_write(\$data);
        $self->{data_size} += length $data;
    }
 

    if ($done) {
        $self->end_of_data;
        $self->end_get_chunks($remainder);
    }

}

sub end_of_data {
    my Qpsmtpd::PollServer $self = shift;
    
    #$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300);
    
    $self->log(LOGDEBUG, "max_size: $self->{max_size} / size: $self->{data_size}");
    
    my $header = $self->transaction->header;
    if (!$header) {
        $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE");
        $self->transaction->header($header);
    }
    
    my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
    my $esmtp = substr($smtp,0,1) eq "E";
    my $authheader;
    my $sslheader;
    
    if (defined $self->connection->notes('tls_enabled')
            and $self->connection->notes('tls_enabled'))
    {
        $smtp .= "S" if $esmtp; # RFC3848
        $sslheader = "(".$self->connection->notes('tls_socket')->get_cipher()." encrypted) ";
    }
    
    if (defined $self->{_auth} and $self->{_auth} == OK) {
        $smtp .= "A" if $esmtp; # RFC3848
        $authheader = "(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n";
    }
    
    $header->add("Received", $self->received_line($smtp, $authheader, $sslheader), 0);
    
    return $self->respond(552, "Message too big!") if $self->{max_size} and $self->{data_size} > $self->{max_size};
    
    my ($rc, $msg) = $self->run_hooks("data_post");
    return 1;
}

1;