Enjoy

Sanja v.2 12.04.2004 13:17

############################################################################
#
# SMTP-server Emulator - doesn't send anything, just talks to clients
# and saves the result to log plus Outlook-readable EML-file.
# Now you don't need to run 'real' SMTP server to test your scripts ;-)
#
############################################################################
# 
# Copyright (c) 2004 Alexander Bougakov, http://www.bougakov.com/go/cityblog/
# You are free to use this code, until you obey the  Creative Commons License:
# http://creativecommons.org/licenses/by-nc-sa/1.0/
#
# Based on Perl modules Net::SMTP::Server, Net::SMTP::Server::Client and
# Net::SMTP::Server::Client2 by Habeeb J. Dihu and David Nicole,
# respectively.
#
############################################################################

unshift @INC, './'; # tells Perl to look for the modules in the
                    # current folder, not only in /lib/
use Carp;
use smtpserver;
use smtpclient;

# Messages larger than this size (in bytes) won't be accepted:
# (client will get RfC 821 error No. 552):
my $limit   = 9900000;

# Server will be working on following host and port:
my $host    = "localhost";
my $port    = 25;

# Log file to write all conversations between server and client:
# (Outlook-readable copy will be saved to the same file, but with
# EML extension. When the emulator starts, it deletes old logfiles,
# if present.)
my $log     = "SMTP_log.txt";

## Don't edit anything below: ##############################################

# Welcome-screen:
print "___________________________________________________________________\n\n";
print " SMTP server emulator is now working on \"" . $host .":" . $port ."\"\n\n";
print " Conversations with clients will be logged to \"" . $log ."\" file\n";
print " (overwrites older one, if present). Outlook-readable copy will be\n"; 
print " saved to \"" . $log .".eml\" (If several messages will be sent in\n";
print " the batch, only the last one will be there!) Server's responses\n";
print " will be echoed to this window.\n\n";
print " Press Ctrl+C to close this window and stop the emulator.\n";
print "___________________________________________________________________\n\n";

# Deletes old logs:
unlink $log;
unlink $log . ".eml";

# Binds SMTP server to host:port:
my $server = new smtpserver($host => $port) || croak("Unable to launch or bind server: $!\n");
while($conn = $server->accept()) {
    fork and last;
    $conn->close;
};

# Waits for connections:
my $count = '';
my $client = new smtpclient($conn, $log) || croak("Unable to start interface: $!\n");
$client->greet;
while($client->get_message){
    if (length($client->{MSG}) > $limit){
        $client->too_long;
    } else {
        $count++;
        $client->okay("Message accepted");
        $client->closelog;
    }
}

package smtpserver;

use strict;
use vars qw(@ISA @EXPORT);

require Exporter;
require AutoLoader;

use Carp;
use IO::Socket;
use Sys::Hostname;

@ISA	= qw(Exporter AutoLoader);
@EXPORT	= qw();

sub new {
    my $this	  = shift;
    my $class	  = ref($this) || $this;
    my $self	  = {};
    $self->{HOST} = shift;
    $self->{PORT} = shift;
    bless($self, $class);
    $self->{HOST} = hostname	unless defined($self->{HOST});
    $self->{PORT} = 25			unless defined($self->{PORT});
    $self->{SOCK} = IO::Socket::INET->new(
    	Proto	  => 'tcp',
    	LocalAddr => $self->{HOST},
    	LocalPort => $self->{PORT},
    	Listen    => SOMAXCONN,
    	Reuse     => 1
    );
    return defined($self->{SOCK}) ? $self : undef;
}

sub accept {
    my $self = shift;
    my $client;
    if($client = $self->{SOCK}->accept()) {
	    $self->{SOCK}->autoflush(1);
	    return $client;
    }
    return undef;
}

sub DESTROY {
    shift->{SOCK}->close;
}

1;

package smtpclient;

use strict;
use vars qw($LOGF);
use Carp;
use IO::Socket;

# Default value:
my $LOGF = "SMTP_log.txt";

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

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 Mail transaction aborted");
}

sub new {
    my($this, $sock, $log) = @_;
    my $class = ref($this) || $this;
    my $self = {};
    $LOGF = $log;
    bless($self, $class);
    $self->_reset0;
    $self->{SOCK} = $sock;
    croak("No client connection specified.") unless defined($self->{SOCK});
    open(LOG, ">>$LOGF");
    print LOG "### SMTP Emulator' log ### " . scalar(localtime) . " ###\n\n";
    close(LOG);
    unlink $log . ".eml";
    return $self;
}

sub greet {
    $_[0]->_put("220 SMTP Emulator ready.");
}

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

sub get_message {
    my $self = shift;
    my($cmd, @args);
    my $sock = $self->{SOCK};
    $self->_reset0;
    while(<$sock>) {
        chomp;
        open(LOG, ">>$LOGF");
        print LOG $_ , "";
        close(LOG);
        $$self{faults} > 15 and $self->basta and last;
        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 Server doesn't know how to $cmd");
            next;
        };
        &{$_cmds{$cmd}}($self, \@args) or
            return(defined($self->{MSG}));
        }
        return undef;
}

sub find_addresses {
    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 Requested mail action aborted: exceeded storage allocation");
};

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 _put {
    print {shift->{SOCK}} @_, "\r\n";
    print "### ", @_, "\n";
    open(LOG, ">>$LOGF");
    print LOG "", @_ , "\n";
    close(LOG);
}

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 Start mail input, end with CRLF-dot-CRLF");
    my $sock    = $self->{SOCK};
    while(<$sock>) {
        chomp;
        s/\x0D/\x0A/sg;
        s/\x0D\x0D/\x0D/sg;
        if(/^\.\r*\n*$/) {
            $self->{MSG} = join ('', @msg);
            return 0;
        }
        # RFC 821 compatibility.
        s/^\.\./\./;
        push @msg, $_;
        open(LOG, ">>$LOGF");
        print LOG $_;
        close(LOG);
        open(EML, ">>$LOGF.eml");
        print EML $_;
        close(EML);
    }
    return 0;
}

sub closelog {
    open(LOG, ">>$LOGF");
    print LOG "\n\n### End of log entry ###\n\n\n\n";
    close(LOG);
}

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

sub _noop {
    shift->_put("250 OK, server will wait.");
}

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 Closing communication");
    $self->{SOCK}->close;
    return 0;
}

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

1;