月別: 2013年3月

メールを大量にテスト受信するサーバを作ってみた話

とにかく大量のメールを受信するだけサーバが欲しかったのでPerlで作ってみました。

Net::Server::Mail::SMTP + Parallel::Preforkを使ったプリフォーク型サーバにしました。
Net::Server::Mail::SMTPSMTPコマンドそれぞれの処理を書き、
Parallel::Preforkでプリフォークの制御を行っています。

以下がサーバのプログラムになります。
プログラムの構成としては、Starletのコードを参考にしています。

package TestMailReceiver;
use strict;
use warnings;
use IO::Socket::INET;
use Parallel::Prefork;
use Net::Server::Mail::SMTP;
use Socket qw(IPPROTO_TCP TCP_NODELAY);
sub new {
my ($class, %args) = @_;
my $self = bless {
host        => $args{host} || 0,
port        => $args{port} || 25,
max_workers => $args{max_workers} || 10,
};
$self;
}
sub setup_listener {
my $self = shift;
$self->{listen_sock} ||= IO::Socket::INET->new(
Listen    => SOMAXCONN,
LocalPort => $self->{port},
LocalAddr => $self->{host},
Proto     => 'tcp',
ReuseAddr => 1,
) or die "failed to listen to port $self->{port}:$!";
if ($^O eq 'linux') {
setsockopt($self->{listen_sock}, IPPROTO_TCP, 9, 1)
and $self->{_using_defer_accept} = 1;
}
}
sub accept_loop {
my ($self, $max_reqs_per_child) = @_;
my $proc_req_count = 0;
while (! defined $max_reqs_per_child || $proc_req_count < $max_reqs_per_child) {
if (my $conn = $self->{listen_sock}->accept) {
$self->{_is_deferred_accept} = $self->{_using_defer_accept};
$conn->blocking(0)
or die "failed to set socket to nonblocking mode:$!";
$conn->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1)
or die "setsockopt(TCP_NODELAY) failed:$!";
$proc_req_count++;
my $smtp = Net::Server::Mail::SMTP->new( 'socket' => $conn );
$smtp->set_callback( 'RCPT' => sub { return (1) } );
$smtp->set_callback( 'DATA' => sub { return (1, 250, 'message queued') });
$smtp->process;
$conn->close;
}
}
}
sub run {
my ($self) = @_;
$self->setup_listener();
if ($self->{max_workers} != 0) {
# use Parallel::Prefork
my %pm_args = (
max_workers => $self->{max_workers},
trap_signals => {
TERM => 'TERM',
HUP  => 'TERM',
},
);
my $pm = Parallel::Prefork->new(\%pm_args);
while ($pm->signal_received !~ /^(TERM|USR1)$/) {
$pm->start and next;
$self->accept_loop();
$pm->finish;
}
} else {
# run directly, mainly for debugging
local $SIG{TERM} = sub { exit 0; };
while (1) {
$self->accept_loop();
}
}
}
1;
package main;
my $server = TestMailReceiver->new(
host => '',
port => 25,
max_workers => 200,
);
$server->run;

メールを受信してファイル書き込まずに捨てるだけのサーバです。
メールをファイルに書き出す処理など、普通のサーバで行われる処理を全部無くしているので、
大量のメールを受信してもだいぶ軽い動作になりました。

TODOとしては、テストでメール受信統計などを取ることができるようになればいいなと思ってます。

以下、主に使っているモジュールについての解説です。

Net::Server::Mail::SMTP

Net::Server::Mail::SMTPSMTPプロトコルを実装したモジュールです。
Net::Server::Mail::SMTPを使えば、自前のSMTPサーバを簡単に作ることができます。
HELO, MAIL, RCPT, DATAなどのコマンドに対する処理をコールバックの形で書きます。

use strict;
use warnings;
use utf8;
use IO::Socket::INET;
use Net::Server::Mail::SMTP;
my @local_domains = qw(example.com example.org localhost);
my $msgid = 1;
sub add_queue {
return $msgid++;
}
my $server = IO::Socket::INET->new(
Listen => 1,
LocalPort => 2500,
);
my $conn;
while ($conn = $server->accept) {
my $smtp = Net::Server::Mail::SMTP->new(
socket => $conn,
);
# HELOコマンドの処理
$smtp->set_callback(
HELO => sub {
my ($session, $hostname) = @_;
if ($hostname eq 'localhost') {
return (0, 553, q(I don't like this hostname, try again.));
}
return 1;
},
);
# RCPTコマンドの処理
$smtp->set_callback(
RCPT => sub {
my ($session, $recipient) = @_;
my $domain;
if ($recipient =~ /@(.*)\s*$/) {
$domain = $1;
}
if (not defined $domain) {
return (0, 513, 'Syntax error.');
}
elsif (not(grep $domain eq $_, @local_domains)) {
return (0, 554, "$recipient: Recipient address rejected: Relay access denied");
}
return (1);
}
);
# DATAコマンドの処理
$smtp->set_callback(
DATA => sub {
my ($session, $data) = @_;
my $sender = $session->get_sender();
my @recipients = $session->get_recipients();
return (0, 554, 'Error: no valid recipients') unless @recipients;
# キューに追加。add_queueは自前で実装する必要がある
my $msgid = add_queue($sender, \@recipients, $data) or return(0);
return (1, 250, "message queued $msgid");
}
);
$smtp->process();
$conn->close();
}

このコードを実行し、以下のようにtelnetで繋いで各コマンドの動作を確かめると、
意図したレスポンスがサーバから返ってくることが確認できます。

$ telnet localhost 2500
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
220 debian2 SMTP Net::Server::Mail (Perl) Service ready
HELO localhost
553 I don't like this hostname, try again.
HELO hogehoge
250 Requested mail action okay, completed
MAIL FROM: 
250 sender hogehoge@example.com OK
RCPT TO: 
554 hogehoge@example.net: Recipient address rejected: Relay access denied
RCPT TO: 
250 recipient hogehoge@example.com OK
DATA
354 Start mail input; end with .
test
.
250 message queued 1
quit
221 debian2 Service closing transmission channel
Connection closed by foreign host.

テストでSMTPサーバを作成したい場合などに便利ですね。

自動テストのためにメールサーバを一時的に起動する

Parallel::Prefork

Parallel::Preforkはプリフォークサーバを書くためのモジュールです。
似た名前で似た使い方をするParallel::ForkManagerというモジュールがありますが、
Parallel::Preforkはシグナル管理が可能になっています。

たとえば次のようなプリフォーク型Echoサーバを書くことができます(あんま有用ではないですが)。

use strict;
use warnings;
use utf8;
use IO::Socket::INET;
use Parallel::Prefork;
sub MaxRequestsPerChild() { 100 }
my $listen_sock = IO::Socket::INET->new(
Listen => 5,
LocalAddr => '0.0.0.0:5000',
Proto  => 'tcp',
) or die $!;
my $pm = Parallel::Prefork->new({
max_workers => 10,
trap_signals => {
TERM => 'TERM',
HUP  => 'TERM',
}
});
while ($pm->signal_received ne 'TERM') {
# ワーカープロセス生成処理
$pm->start and next;
#### ここからワーカープロセス処理
# 1ワーカーがリクエストを受け付ける数
my $reqs_before_exit = MaxRequestsPerChild;
$SIG{TERM} = sub { $reqs_before_exit = 0 };
while ($reqs_before_exit-- > 0) {
if (my $conn = $listen_sock->accept()) {
while (my $str = ) {
print $conn "$reqs_before_exit($$): ".$str;
}
$conn->close;
}
}
# ワーカープロセスの終了処理
$pm->finish;
}
# 子プロセス待ち受け
$pm->wait_all_children;

このサーバを実行して、psコマンドで確認してみると「max_workersで設定した数値 + 親プロセス」分のプロセスが存在していることが確認できます。

$ perl prefork_echo.pl &
$ ps a | grep prefork_echo.pl
3963 pts/3    S      0:00 perl prefork_echo.pl
3964 pts/3    S      0:00 perl prefork_echo.pl
3965 pts/3    S      0:00 perl prefork_echo.pl
3966 pts/3    S      0:00 perl prefork_echo.pl
3968 pts/3    S      0:00 perl prefork_echo.pl
3969 pts/3    S      0:00 perl prefork_echo.pl
3970 pts/3    S      0:00 perl prefork_echo.pl
3971 pts/3    S      0:00 perl prefork_echo.pl
3972 pts/3    S      0:00 perl prefork_echo.pl
3973 pts/3    S      0:00 perl prefork_echo.pl
3983 pts/3    S      0:00 perl prefork_echo.pl
4085 pts/3    S+     0:00 grep prefork_echo

また、telnetを用いて接続も確認できます。

$ telnet localhost 5000
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
test
99(3967): test
test1
99(3967): test1
test2
99(3967): test2```
何回か繋ぎ直すと、異なるプロセスが対応する様子が確認できます。
pstreeなどで親プロセスの番号を調べて、SIGTERMを送るとサーバを終了させることができます。

$ kill -TERM 3963

このように簡単にプリフォークサーバを書けるようになっています。
<h2><span style="color: #2196f3">まとめ</span></h2>
メール送信系のシステムをテストする場合は、Net::Server::Mail::SMTPで受信サーバを書くのがとても良いです。
また、プリフォークサーバを書きたい場合は、Parallel::Preforkがとても便利です。
このようなツールを書くのに便利なモジュールがあって、やっぱりCPANは素晴らしいですね。
<h2><span style="color: #2196f3">参考</span></h2>
・Net::SMTP vs. Email::Send(er)?
<a href="http://blog.azumakuniyuki.org/2011/08/netsmtp-vs-emailsender.html">http://blog.azumakuniyuki.org/2011/08/netsmtp-vs-emailsender.html</a>
・Parallel::Prefork - Perl でマルチプロセスなサーバを書く方法
<a href="http://labs.cybozu.co.jp/blog/kazuho/archives/2008/04/parallel-prefork.php">http://labs.cybozu.co.jp/blog/kazuho/archives/2008/04/parallel-prefork.php</a>

Perlに関する情報の調べ方・集め方

Perlに関する情報の調べ方や集め方、有益なサイトや書籍などをまとめてみました。

Perl入門に関する情報

サンプルコードによるPerl入門(サイト)

http://d.hatena.ne.jp/perlcodesample/

サンプルコードがたくさんあってとても分かりやすいサイトです。
現代的なPerlの書き方が学べます。

以下の目次ページを上から順番に読めば、すぐにPerlの全体像はつかめると思います。
http://d.hatena.ne.jp/perlcodesample/20091221/1260183022

Perl入学式(勉強会)

http://www.perl-entrance.org/

Perlの基本を学び、Webアプリケーションを作るまでを目標にした勉強会です。
自分で手を動かしながらの勉強会なので身につきやすいです。
2013年は大阪と東京でそれぞれ全6回を予定しているそうです。

Webサービスのつくり方 ~「新しい」を生み出すための33のエッセイ(書籍)

http://yusukebe.com/archives/20121113/091343.html

「ボケて」をPerlで開発した@yusukebeさんの本です。
アイディアを形にする方法が学べます。
Perl中心の本ではないですが、Perlで何ができるかを知ることができます。

Perlの最新情報

Perlの最新情報を得る方法には、次のような方法があります。

Perlをよく使っている人のTwitterやブログを購読する

Perlをよく使っている人たちが発信する情報はとても有益です。
Twitterやブログを購読して読んでいれば、自然とPerlの動向などが分かるようになります。
Perlをよく使っている人たちはPerl関連のイベントで発表していることが多いので、
イベントページなどから見つけましょう。

例えばYAPC::Asiaのページから見つけることができます。
http://yapcasia.org/2012/talk

以下の様なまとめもあります。
■今すぐフォローすべきPerl界のスーパーエンジニア
http://d.hatena.ne.jp/sugyan/20110616/1308203734

Perl関連のイベントに参加する

イベントに参加すると自分が知らないことをたくさん知ることができます。
インターネットや書籍だけだと、自分の興味や問題の範囲のみに無意識的に偏ってしまいます。
イベントだと自分が調べないような分野の話も聞くようになるので、とても勉強になります。

いくつかイベント情報を上げておきます。

YAPC::Asia
http://yapcasia.org/
年に一回日本で開催されるPerlのイベントです。
豪華ゲストが来ます。

■PMグループ
http://www.pm.org/groups/japan.html
地域ごとに集まって定期的(不定期?)に勉強会や情報交換会などを行います。

Perl Begginers
http://www.perl-beginners.org/
参加したことないので雰囲気は知らないですが、質疑応答が多めに取られている勉強会でしょうか。

Perlの書籍

読みやすい本をご紹介します。

Perl CPANモジュールガイド

http://www.amazon.co.jp/dp/486267108X

よく使われていて便利なモジュールが紹介されている本です。
Cpanサイトで検索しても何を使ったらいいのか分からない場合、
この本を参考にすると良いでしょう。

もっと自在にサーバを使い倒す 業務に役立つPerl

http://www.amazon.co.jp/dp/4774150258

Perlの現代的な書き方、ログデータの加工、Webフレームワークの使い方など、
実践的なPerlの使い方を学ぶことができます。

Webサービスのつくり方 ~「新しい」を生み出すための33のエッセイ

http://www.amazon.co.jp/dp/4774154075

PerlでWebAPIを利用したりフレームワークを使ってサービスを作ったりする雰囲気が学べます。

Perlスティング ハンドブック

http://www.amazon.co.jp/dp/B00A5Q6EM2

Perlでテストを書くときのノウハウを知ることができます。
どんなテストモジュールを使ったら良いのか、どのようにテストを書いたら良いのかを学ぶことができます。

Plack Handbook

http://www.amazon.co.jp/dp/B009Z30LRA

PlackベースのWebフレームワークを扱う場合に知っておいたほうが良い内容です。

ググりにくいこと

正規表現について

■実践で役立つPerl正規表現 完全解説
http://d.hatena.ne.jp/perlcodesample/20100827/1278596435

正規表現の解説。

Perl正規表現チュートリアル
http://perldoc.jp/docs/perl/5.16.1/perlretut.pod

長めのチュートリアル

Perl正規表現のリファレンス
http://perldoc.jp/docs/perl/5.16.1/perlreref.pod

記号の意味を知りたいとき。

特殊変数について

$|とか$!とかの意味を知りたい場合。

Perl で定義済みの変数
http://perldoc.jp/docs/perl/5.16.1/perlvar.pod

ブラウザページ内検索をすれば、引っかかるでしょう。

■perldocコマンド
以下のように「-v」オプションで調べることができます。

perldoc -v $.

© SEEDS Co.,Ltd.