File Coverage

blib/lib/Net/SMTP/Server/Client2.pm

Criterion	Covered	Total	%
statement	15	128	11.7
branch	0	26	0.0
condition	0	6	0.0
subroutine	5	25	20.0
pod	0	9	0.0
total	20	194	10.3

package Net::SMTP::Server::Client2;

use 5.001;
use strict;

use vars qw($VERSION );

use Carp;
use IO::Socket;


$VERSION = '0.2';

my %_cmds = (
	    DATA => \&_data,
	    EXPN => \&_noway,
	    HELO => \&_hello,
	    HELP => \&_help,
	    MAIL => \&_mail,
	    NOOP => \&_noop,
	    QUIT => \&_quit,
	    RCPT => \&_receipt,
	    RSET => \&_reset,
	    VRFY => \&_noway
	    );

# Utility functions.
sub _put {
    print {shift->{SOCK}} @_, "\r\n";

}

sub _reset0 {
    my $self = shift;
    $self->{FROM} = undef;
    $self->{TO} = [];
    $self->{MSG} = undef;
    $self->{faults} = 0;
}


sub _reset {
    my $self = shift;
    $self->_reset0;
    $self->_put("250 buffahs ah cleah, suh!");
}

# New instance.
sub new {
    my($this, $sock) = @_;

    my $class = ref($this) || $this;
    my $self = {};

    bless($self, $class);
    $self->_reset0;
    $self->{SOCK} = $sock;

    croak("No client connection specified.") unless defined($self->{SOCK});
    return $self;
}

sub greet {

    $_[0]->_put("220 Debatable SMTP $VERSION Ready.");
}

sub basta{
	my $self = shift;
	$self -> _put("421 closing transmission channel");
        $self->{SOCK}->close;
	1;
}

# sub process {
sub get_message {
    my $self = shift;
    my($cmd, @args);

    my $sock = $self->{SOCK};
    $self->_reset0;

    while(<$sock>) {
	print "$$ command: $_";
	$$self{faults} > 15 and $self->basta and last;
	# Clean up.
	chomp;
	s/^\s+//;
	s/\s+$//;
	unless(length $_){
		++$$self{faults};
		$self->greet;
		next;
	};
	($cmd, @args) = split(/\s+/);

	$cmd =~ tr/a-z/A-Z/;

	if(!defined($_cmds{$cmd})) {
	    sleep ++$$self{faults};
	    $self->_put("500 sorry, I don't know how to $cmd");
	   next;
	};

	# all commands return TRUE to indicate that
	# we need to keep working to get the message.
	&{$_cmds{$cmd}}($self, \@args) or
	    return(defined($self->{MSG}));
    }

    return undef;
}

sub find_addresses {
	# find e-mail addresses in the arguments and return them.
	# max one e-mail address per argument.
	# print "looking for addresses in <@_>\n";
	return map { /([^<|;]+\@[^>|;&,\s]+)/ ? $1 : () } @_;
};

sub okay {
	my $self = shift;
	$self -> _put("250 OK @_");
}

sub fail {
	my $self = shift;
	$self -> _put("554 @_");
}

sub too_long {
	$_[0] -> _put("552 Too much mail data");
};

sub _mail {
    my $self = $_[0];
    my @who = find_addresses(@{$_[1]});
    my $who = shift @who;
    if ($who){
	$self->{FROM} = $who;
	return $self->okay("Envelope sender set to <$who> ")
    }else{
	$self->{faults}++;
	return $self-> _put("501 could not find name\@postoffice in <@{$_[1]}>")
    };
}

sub rcpt_syntax{
	$_[0] -> _put("553 no user\@host addresses found in <@{$_[1]}>");
}

sub _receipt {
    my $self = $_[0];
    my @recipients = find_addresses(@{$_[1]});
    @recipients or return $self->rcpt_syntax($_[1]);
    push @{ $self->{TO} }, @recipients;
    $self->okay("sending to @{$self->{TO}}");
}

sub _data {
    my $self = shift;

    my @msg;

    if(!$self->{FROM}) {
	$self-> _put("503 start with 'mail from: ...'");
	$self->{faults}++;
	return 1;
    }

    if(!@{$self->{TO}}) {
	$self->_put("503 specify recipients with 'rcpt to: ...'");
	$self->{faults}++;
	return 1;
    }

    $self->_put("354 And what am I to tell them?");

    my $sock = $self->{SOCK};

    while(<$sock>) {
	print "$$ data: $_";
	if(/^\.\r*\n*$/) {
	    $self->{MSG} = join ('', @msg);
	    return 0; # please examine MSG
	}

	# RFC 821 compliance.
	s/^\.\./\./;
	push @msg, $_;
    }

    return 0; # socket died
}

sub _noway {
    shift->_put("252 Nice try.");
}

sub _noop {
    shift->_put("250 Whatever.");
}

sub _help {
    my $self = shift;
    my $i = 0;
    my $str = "214-Commands\r\n";
    my $total = keys(%_cmds);

    foreach(sort(keys(%_cmds))) {
	if(!($i++ % 5)) {
	    if(($total - $i) < 5) {
		$str .= "\r\n214 ";
	    } else {
		$str .= "\r\n214-";
	    }
	} else {
	    $str .= ' ';
	}

	$str .= $_;
    }

    $self->_put($str);
}

sub _quit {
    my $self = shift;

    $self->_put("221 Ciao");
    $self->{SOCK}->close;
    return 0;
}

sub _hello {
    shift->okay( "Welcome" );
}

1;
__END__