package Yaa::Daemon::Protocol::SMTP;

# inherit everything from Yaa::Daemon and 
@ISA = qw(
	Yaa::Daemon
);

# standard modules
use strict;
use Yaa::Daemon;

# specific modules
use Net::Server::Mail::SMTP;

sub new {
	my $proto = shift;
	my $args = shift;
	my $class = ref($proto) || $proto;
	my $self = Yaa::Daemon->new();
	
	$self->{error_sleep_time} = 5;

	bless($self, $class);
	return $self;
}

# Net::Server Hook
sub process_request {
	my ($self) = @_;

	# initialize Net::Server::Mail::SMTP object and configure it
	unless (defined $self->{_smtp}) {
		$self->{_smtp} = Net::Server::Mail::SMTP->new(
			error_sleep_time => $self->{error_sleep_time}
		);
		
		unless (defined $self->{_smtp}) {
			$self->{error} = "SMTP server initialization failed.";
			$self->_logger("Error: " . $self->{error});
			return 0;
		}

		# RCPT callback. Any recipient is sufficient.
		$self->{_smtp}->set_callback(RCPT => sub { return 1; });
	
		# DATA command. fetch message and process it.
		$self->{_smtp}->set_callback(DATA => sub {
				my ($session, $data) = @_;

				# clear request parameters
				$self->clearRequest();

				# remove <> chars from sender address
				my $addr = $session->get_sender();
				$addr =~ s/[<>]//g;
				$self->{_smtp_sender} = $addr;
				
				# remove <> chars from recipient addresses
				foreach ($session->get_recipients()) {
					$_ =~ s/[<>]//g;
					push(@{$self->{_smtp_recipients}}, $_);
				}
				
				# process message utilizing Yaa!
				my $result = $self->processMessage($data);
			
				# send success or failure status back to SMTP client
				my $msgid = $self->{_msgid};
				$self->{_msgid} = undef;
				if ($result) {
					return(1, 250, "Message successfully queued as " . $msgid);
				} else {
					return(0, 450, "Error queueing message with id " . $msgid);
				}
			}
		);
	}
	
	# process connection
	return $self->{_smtp}->process;
}

sub clearRequest {
	my ($self) = @_;
	$self->{_sender} = undef;
	@{$self->{_smtp_recipients}} = undef;
}

sub _getProtocolSender {
	my ($self) = @_;
	$self->_logger("Protocol sender address: " . $self->{_smtp_sender});
	return $self->{_smtp_sender};
}

sub _getProtocolRecipients {
	my ($self) = @_;
	$self->_logger("Protocol recipient address(es): " . join(", ", @{$self->{_smtp_recipients}}));
	return @{$self->{_smtp_recipients}};
}

1;

=head1 SEE ALSO

perldoc Yaa
perldoc Yaa::Daemon

=cut

=head1 AUTHOR

Branko F. Gracnar <bfg@frost.ath.cx>
http://frost.ath.cx/~bfg

=cut

=head1 LICENSE

This software is released under BSD-style license. If you like this software, send me a nice postcard from somewhere to the snail mail address published on my website.

=cut

