package Net::SMTP::Server::Client;
require 5.001;
use strict;
use vars qw($VERSION @ISA @EXPORT);
require Exporter;
require AutoLoader;
use Carp;
use IO::Socket;
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
$VERSION = '1.1';
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 _reset {
my $self = shift;
$self->{FROM} = undef;
$self->{TO} = [];
$self->_put("250 Fine fine.");
}
# New instance.
sub new {
my($this, $sock) = @_;
my $class = ref($this) || $this;
my $self = {};
$self->{FROM} = undef;
$self->{TO} = [];
$self->{MSG} = undef;
$self->{SOCK} = $sock;
bless($self, $class);
croak("No client connection specified.") unless defined($self->{SOCK});
$self->_put("220 MacGyver SMTP Ready.");
return $self;
}
sub process {
my $self = shift;
my($cmd, @args);
my $sock = $self->{SOCK};
while(<$sock>) {
# Clean up.
chomp;
s/^\s+//;
s/\s+$//;
goto bad unless length($_);
($cmd, @args) = split(/\s+/);
$cmd =~ tr/a-z/A-Z/;
if(!defined($_cmds{$cmd})) {
bad:
$self->_put("500 Learn to type!");
next;
}
return(defined($self->{MSG}) ? 1 : 0) unless
&{$_cmds{$cmd}}($self, \@args);
}
return undef;
}
sub _fromto {
my $self = shift;
my($which, $var, $args) = @_;
if(!($$args[0] =~ /^$which\s*([^\s]+)/i)) {
if(!$$args[1] || !($$args[0] =~ /^$which$/i)) {
$self->_put("501 Bzzzz.");
return -1;
}
ref($var) eq 'ARRAY' ? (push @$var, $$args[1]) : ($$var = $$args[1]);
}
ref($var) eq 'ARRAY' ? (push @$var, $1) : ($$var = $1) unless !defined($1);
$self->_put("250 Ok...got it.");
}
sub _mail {
my $self = shift;
return $self->_fromto('FROM:', \$self->{FROM}, @_);
}
sub _receipt {
my $self = shift;
return $self->_fromto('TO:', \@{ $self->{TO} }, @_);
}
sub _data {
my $self = shift;
my $done = undef;
if(!defined($self->{FROM})) {
$self->_put("503 Yeah, right. Tell me who you are first!");
return 1;
}
if(!defined(@{$self->{TO}})) {
$self->_put("503 You want me to read your mind? Tell me who to send it to!");
return 1;
}
$self->_put("354 Give it to me, big daddy.");
my $sock = $self->{SOCK};
while(<$sock>) {
if(/^\.\r\n$/) {
$done = 1;
last;
}
# RFC 821 compliance.
s/^\.\./\./;
$self->{MSG} .= $_;
}
if(!defined($done)) {
$self->_put("550 Fine...who needs you anyway!");
return 1;
}
$self->_put("250 I got it darlin'.");
}
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 Good.");
$self->{SOCK}->close;
return 0;
}
sub _hello {
shift->_put("250 You're polite.");
}
1;
__END__
# POD begins here.
=head1 NAME
Net::SMTP::Server::Client - Client session handling for Net::SMTP::Server.
=head1 SYNOPSIS
use Carp;
use Net::SMTP::Server;
use Net::SMTP::Server::Client;
use Net::SMTP::Server::Relay;
$server = new Net::SMTP::Server('localhost', 25) ||
croak("Unable to handle client connection: $!\n");
while($conn = $server->accept()) {
# We can perform all sorts of checks here for spammers, ACLs,
# and other useful stuff to check on a connection.
# Handle the client's connection and spawn off a new parser.
# This can/should be a fork() or a new thread,
# but for simplicity...
my $client = new Net::SMTP::Server::Client($conn) ||
croak("Unable to handle client connection: $!\n");
# Process the client. This command will block until
# the connecting client completes the SMTP transaction.
$client->process || next;
# In this simple server, we're just relaying everything
# to a server. If a real server were implemented, you
# could save email to a file, or perform various other
# actions on it here.
my $relay = new Net::SMTP::Server::Relay($client->{FROM},
$client->{TO},
$client->{MSG});
}
=head1 DESCRIPTION
The Net::SMTP::Server::Client module implements all the session
handling required for a Net::SMTP::Server::Client connection. The
above example demonstrates how to use Net::SMTP::Server::Client with
Net::SMTP::Server to handle SMTP connections.
$client = new Net::SMTP::Server::Client($conn)
Net::SMTP::Server::Client accepts one argument that must be a handle
to a connection that will be used for communication.
Once you have a new client session, simply call:
$client->process
This processes an SMTP transaction. THIS MAY APPEAR TO HANG --
ESPECIALLY IF THERE IS A LARGE AMOUNT OF DATA BEING SENT. Once this
method returns, the server will have processed an entire SMTP
transaction, and is ready to continue.
Once $client->process returns, various fields have been filled in.
Those are:
$client->{TO} -- This is an array containing the intended
recipients for this message. There may be
multiple recipients for any given message.
$client->{FROM} -- This is the sender of the given message.
$client->{MSG} -- The actual message data. :)
=head1 AUTHOR AND COPYRIGHT
Net::SMTP::Server / SMTP::Server is Copyright(C) 1999,
MacGyver (aka Habeeb J. Dihu) <macgyver@tos.net>. ALL RIGHTS RESERVED.
You may distribute this package under the terms of either the GNU
General Public License or the Artistic License, as specified in the
Perl README file.
=head1 SEE ALSO
Net::SMTP::Server::Server, Net::SMTP::Server::Relay
=cut
syntax highlighted by Code2HTML, v. 0.9.1