Эмулятор SMTP-сервера для Денвера

Sanja v.2 11.04.2004 00:15 / 11.04.2004 00:35

Как вы знаете, в состав Денвера входит эмулятор sendmail, от которого нет проку - Парсер под Win32 умеет пользоваться только SMTP. Если хочется проверить mail:send на локальной машине, приходится ставить какой-либо smtp-сервер, что неудобно.

Дело было вечером, делать было нечего, и я накатал эмулятор SMTP-сервера на Perl. Часть кода позаимствована из модуля NET::SMTP::Server. Инструкция по использованию - вывалить в папку три файла, запустить perl.exe emulator.pl и смотреть результат в smtp_log.txt

Можете использовать Денверный wrapper (такой как apacherun.exe) - создайте какой-нибудь smtp.exe, чтобы запускать эмулятор в виде иконки в трее (чтобы лишнее DOS-style окошко не загораживало экран).

Файл emulator.pl

# Эмулятор работы SMTP-сервера - ничего не отправляет, но аккуратно
# журналирует все переговоры с клиентами.
# 
# Copyright (c) 2004 Alexander Bougakov, http://www.bougakov.com/go/cityblog/

unshift @INC, './';

use Carp;
use smtpserver;
use smtpclient;

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

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

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

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

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

#################################################################

print "SMTP server emulator is now working on \"" . $host .":" . $port ."\"\n";
print "Conversations with clients will be logged to \"" . $log ."\" file\n";
print "(overwrites older one, if present). Hit Ctrl+C to close this.\n";
print "___________________________________________________________________\n\n";

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

# Цепляемся к указанным локальным хосту и порту:
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;

require 5.001;

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);
    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;

#   print "$_";
    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;
    open(LOG, ">>$LOGF");
    print LOG $_ , "";
    close(LOG);
 
 
    if(/^\.\r*\n*$/) {
        $self->{MSG} = join ('', @msg);
        return 0;
    }
 
    # Совместимость с RFC 821.
    s/^\.\./\./;
    push @msg, $_;
    }
 
    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;

Вот. Пользуйтесь на здоровье.

Эмулятор SMTP-сервера для Денвера, Sanja v.2 [M] 11.04.2004 00:15 / 11.04.2004 00:35
- Почему же не связались со мной?, Дмитрий Котеров 11.04.2004 22:46
  - Потому что он сырой, Sanja v.2 [M] 12.04.2004 10:22
    - lol (-), Misha v.3 [M] 12.04.2004 11:02
      - Production release, Sanja v.2 [M] 12.04.2004 12:27
- Большое спасибо и одно маленькое пожалуйста, cypher 11.04.2004 16:14
  - Разумно., Sanja v.2 [M] 11.04.2004 17:04
- Не существует: http://www.bougakov.com/go/cityblog/ (-), Bobych v.3 11.04.2004 01:56
  - Будет, Sanja v.2 [M] 11.04.2004 13:34
    - требуется англоязычный вариант, Александр Петросян (PAF) [M] 12.04.2004 12:46
      - Enjoy, Sanja v.2 [M] 12.04.2004 13:17
        Красотища!, Дмитрий Котеров 12.04.2004 15:02
        Красивости кода - это к, Sanja v.2 [M] 12.04.2004 16:49
        Ответ, Дмитрий Котеров 12.04.2004 22:35
        Да пользуйтесь на здоровье... (-), Sanja v.2 [M] 13.04.2004 09:52

Новости	FAQ	Авторы	Документация	В действии	Библиотека
Инструменты	Полезные ссылки	Хостинги	Скачать	Примеры	Форум