File Coverage

blib/lib/NetSDS/App/SMTPD.pm

Criterion	Covered	Total	%
statement	15	15	100.0
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	20	20	100.0

package NetSDS::App::SMTPD;

use 5.8.0;
use strict;
use warnings;

package NetSDS::App::SMTPD::Socket;

use IO::Socket;
use base 'NetSDS::App';

use version; our $VERSION = '1.301';

sub new {
	my ( $proto, %args ) = @_;

	my $class = ref $proto || $proto;
	my $self = ( %args ? $class->SUPER::new(%args) : bless {}, $class );

	return $self->create_socket( $args{'port'} );
}

sub create_socket {
	my $self   = shift;
	my $socket = IO::Socket->new;

	$socket->socket( PF_INET, SOCK_STREAM, scalar getprotobyname('tcp') );
	$socket->blocking(0);
	$self->{'_socket'} = $socket;
	return $self;
}

sub get_socket_handle { +shift->{'_socket'} }
sub close             { +shift->get_socket_handle->close }

package NetSDS::App::SMTPD::Client;

use Net::Server::Mail::SMTP;
use base 'NetSDS::App::SMTPD::Socket';

sub set_smtp {
	my $self = shift;
	$self->{'ip'} = shift;

	$self->{'_smtp'} = Net::Server::Mail::SMTP->new( socket => $self->get_socket_handle );
	return $self;
}

sub set_callback { +shift->get_smtp->set_callback(@_) }
sub process      { +shift->get_smtp->process(@_) }
sub get_smtp     { +shift->{'_smtp'} }
sub get_header   { $_[0]->{'headers'}{ lc $_[1] } }
sub get_msg      { +shift->{'msg'} }
sub get_ip       { +shift->{'ip'} }

sub get_mail {
	my ( $self, $data ) = @_;
	my @lines = split /\r\n(?! )/, $$data;

	$self->{'headers'} = {};
	my $i;

	for ( $i = 0 ; $lines[$i] ; $i++ ) {
		my ( $key, $value ) = split /:\s*/, $lines[$i], 2;

		$key = lc $key;

		if ( exists $self->{'headers'}{$key} ) {
			unless ( ref $self->{'headers'}{$key} ) {
				my $temp = $self->{'headers'}{$key};
				$self->{'headers'}{$key} = [ $temp, $value ];
			} else {
				push @{ $self->{'headers'}{$key} }, $value;
			}
		} else {
			$self->{'headers'}{$key} = $value;    #TODO fix me could be several Received
		}
	}

	$self->{'msg'} = join "\r\n", @lines[ $i + 1 .. $#lines ];
	return 1;
} ## end sub get_mail

package NetSDS::App::SMTPD;

use base 'NetSDS::App::SMTPD::Socket';
use IO::Socket;

sub create_socket {
	my ( $self, $port ) = @_;
	$port ||= 2525;
	return unless $port;

	$self->SUPER::create_socket;

	setsockopt( $self->get_socket_handle, SOL_SOCKET, SO_REUSEADDR, 1 );
	bind( $self->get_socket_handle, sockaddr_in( $port, INADDR_ANY ) ) or die "Can't use port $port";
	listen( $self->get_socket_handle, SOMAXCONN ) or die "Can't listen on port: $port";

	return $self;
}

sub can_read {
	my $self = shift;
	my $rin  = '';

	vec( $rin, fileno( $self->get_socket_handle ), 1 ) = 1;
	return select( $rin, undef, undef, undef );
}

sub accept {
	my $self = shift;
	$self->can_read;

	my $client = NetSDS::App::SMTPD::Client->new;
	my $peer   = accept( $client->get_socket_handle, $self->get_socket_handle );

	if ($peer) {
		$client->set_smtp( inet_ntoa( ( sockaddr_in($peer) )[1] ) );
		$self->speak( "connection from ip [" . $client->get_ip . "]" );
		$client->set_callback( DATA => \&data, $client );

		return $client;
	}
}

sub data {
	my ( $smtp, $data ) = @_;
	return $smtp->{'_context'}->get_mail($data);
}

sub process {
	my $self   = shift;
	my $client = $self->accept;

	return unless $client;
	$client->process;

	$client->close;
	$self->speak( "connection from ip [" . $client->get_ip . "] closed" );

	return $client;
}

1;

__END__