view release on metacpan or  search on metacpan

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

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

sub _header {
    my $self = shift;
    my $line = shift;
    
    if($line =~ /^([\041-\071\073-\176.]+):\s*(.+)$/) {

        my $name  = $1;
        my $value = $2;

	if($self->{_headername} ne '') {
	    $self->HEADER($self->{_headername}, $self->{_headervalue});
	}

	$self->{_headername} = $name;
	$self->{_headervalue} = $value;

	# State management
	$self->{_seenDATA} = 1;
    }
    elsif($line =~ /^(\s+.+)$/ and $self->{_headername} ne '') {
	$self->{_headervalue} .= $1;
    }
    else {
	if($self->{_headername} ne '') {
	    $self->HEADER($self->{_headername}, $self->{_headervalue});
	    $self->{_headername} = '';
	    $self->{_headervalue} = '';
	}

	$self->_eoh($line);
    }
}

sub HEADER {
}

sub _eoh {
    my $self = shift;
    my $line = shift;

    #$self->disable_callbacks('headers');
    $self->chunkmode(1);