Production release

Sanja v.2 12.04.2004 12:27

Вот, держите. С поправленными багами и сохранением полученного от клиента в EML-файл Outlook.

Файл emulator.pl

############################################################################
#
# Эмулятор работы SMTP-сервера - ничего не отправляет, но аккуратно
# журналирует все переговоры с клиентами, сохраняя копию в EML-файле Outlook.
#
############################################################################
# 
# Copyright (c) 2004 Alexander Bougakov, http://www.bougakov.com/go/cityblog/
# Вы вольны пользоваться этим кодом на условиях Creative Commons License:
# http://creativecommons.org/licenses/by-nc-sa/1.0/
#
# Основано на коде модулей Net::SMTP::Server, Net::SMTP::Server::Client и
# Net::SMTP::Server::Client2 авторства Habeeb J. Dihu и David Nicole,
# соответственно.
#
############################################################################

unshift @INC, './'; # указывает Perl искать модули 
                    # в текущей папке, а не только в /lib
use Carp;
use smtpserver;
use smtpclient;

# Сообщения больше этого размера (в байтах) не будут приниматься эмулятором
# (клиент получит ошибку 552 по RfC 821):
my $limit   = 9900000;

# Куда подцепляется эмулятор (хост, порт):
my $host    = "localhost";
my $port    = 25;

# Логфайл:
my $log     = "SMTP_log.txt";

# Также пишется логфайл с именем $log.eml - в него сохраняется последнее
# из отправленных писем. Запуск этого файла откроет его в Outlook Express
# - это даст вам проверить, такой ли результат вы ожидаете (что гораздо 
# веселее отправки его самому себе через "настоящий" почтовый сервер с
# дальнейшей выкачкой его по POP3, не правда ли?) 

# Логфайл пишется по принципу "открыть файл, записать строку, закрыть файл,
# повторить для каждой следующей строки" - работает медленнее, чем могло бы
# быть, зато в случае падения сервера или клиента будет видно, на каком месте
# проблема случилась.

# Старый логфайл, если есть на диске, затирается. Если в одном сеансе работы
# эмулятора отправляется нескольких писем, все сессии фиксируются в логе 
# (а не только самая последняя)

## Ну поехали: #############################################################

# 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";

# Удаляем прежний логфайл:
unlink $log;
unlink $log . ".eml";

# Цепляемся к указанным локальным хосту и порту:
my $server = new smtpserver($host => $port) || croak("Unable to launch or bind server: $!\n");
while($conn = $server->accept()) {
    fork and last;
    $conn->close;
};

# Ждём подключений:
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;
    }
}

Файл smtpserver.pm

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;

Файл smtpclient.pm

package smtpclient;

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

# Значение по умолчанию:
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-сервера ### " . 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.
        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### Конец журнала ###\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;

---