hero_picture

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

2013/03/16
# プログラミング# html# Linux# PHP

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

Net::Server::Mail::SMTP + Parallel::Preforkを使ったプリフォーク型サーバにしました。

Net::Server::Mail::SMTPでSMTPコマンドそれぞれの処理を書き、

Parallel::Preforkでプリフォークの制御を行っています。

以下がサーバのプログラムになります。

プログラムの構成としては、Starletのコードを参考にしています。

1package TestMailReceiver;
2use strict;
3use warnings;
4use IO::Socket::INET;
5use Parallel::Prefork;
6use Net::Server::Mail::SMTP;
7use Socket qw(IPPROTO_TCP TCP_NODELAY);
8sub new {
9my ($class, %args) = @_;
10my $self = bless {
11host        => $args{host} || 0,
12port        => $args{port} || 25,
13max_workers => $args{max_workers} || 10,
14};
15$self;
16}
17sub setup_listener {
18my $self = shift;
19$self->{listen_sock} ||= IO::Socket::INET->new(
20Listen    => SOMAXCONN,
21LocalPort => $self->{port},
22LocalAddr => $self->{host},
23Proto     => 'tcp',
24ReuseAddr => 1,
25) or die "failed to listen to port $self->{port}:$!";
26if ($^O eq 'linux') {
27setsockopt($self->{listen_sock}, IPPROTO_TCP, 9, 1)
28and $self->{_using_defer_accept} = 1;
29}
30}
31sub accept_loop {
32my ($self, $max_reqs_per_child) = @_;
33my $proc_req_count = 0;
34while (! defined $max_reqs_per_child || $proc_req_count < $max_reqs_per_child) {
35if (my $conn = $self->{listen_sock}->accept) {
36$self->{_is_deferred_accept} = $self->{_using_defer_accept};
37$conn->blocking(0)
38or die "failed to set socket to nonblocking mode:$!";
39$conn->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1)
40or die "setsockopt(TCP_NODELAY) failed:$!";
41$proc_req_count++;
42my $smtp = Net::Server::Mail::SMTP->new( 'socket' => $conn );
43$smtp->set_callback( 'RCPT' => sub { return (1) } );
44$smtp->set_callback( 'DATA' => sub { return (1, 250, 'message queued') });
45$smtp->process;
46$conn->close;
47}
48}
49}
50sub run {
51my ($self) = @_;
52$self->setup_listener();
53if ($self->{max_workers} != 0) {
54# use Parallel::Prefork
55my %pm_args = (
56max_workers => $self->{max_workers},
57trap_signals => {
58TERM => 'TERM',
59HUP  => 'TERM',
60},
61);
62my $pm = Parallel::Prefork->new(\%pm_args);
63while ($pm->signal_received !~ /^(TERM|USR1)$/) {
64$pm->start and next;
65$self->accept_loop();
66$pm->finish;
67}
68} else {
69# run directly, mainly for debugging
70local $SIG{TERM} = sub { exit 0; };
71while (1) {
72$self->accept_loop();
73}
74}
75}
761;
77package main;
78my $server = TestMailReceiver->new(
79host => '',
80port => 25,
81max_workers => 200,
82);
83$server->run;
84

メールを受信してファイル書き込まずに捨てるだけのサーバです。

メールをファイルに書き出す処理など、普通のサーバで行われる処理を全部無くしているので、

大量のメールを受信してもだいぶ軽い動作になりました。

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

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

Net::Server::Mail::SMTP

Net::Server::Mail::SMTPはSMTPプロトコルを実装したモジュールです。

Net::Server::Mail::SMTPを使えば、自前のSMTPサーバを簡単に作ることができます。

HELO, MAIL, RCPT, DATAなどのコマンドに対する処理をコールバックの形で書きます。

1use strict;
2use warnings;
3use utf8;
4use IO::Socket::INET;
5use Net::Server::Mail::SMTP;
6my @local_domains = qw(example.com example.org localhost);
7my $msgid = 1;
8sub add_queue {
9return $msgid++;
10}
11my $server = IO::Socket::INET->new(
12Listen => 1,
13LocalPort => 2500,
14);
15my $conn;
16while ($conn = $server->accept) {
17my $smtp = Net::Server::Mail::SMTP->new(
18socket => $conn,
19);
20# HELOコマンドの処理
21$smtp->set_callback(
22HELO => sub {
23my ($session, $hostname) = @_;
24if ($hostname eq 'localhost') {
25return (0, 553, q(I don't like this hostname, try again.));
26}
27return 1;
28},
29);
30# RCPTコマンドの処理
31$smtp->set_callback(
32RCPT => sub {
33my ($session, $recipient) = @_;
34my $domain;
35if ($recipient =~ /@(.*)\s*$/) {
36$domain = $1;
37}
38if (not defined $domain) {
39return (0, 513, 'Syntax error.');
40}
41elsif (not(grep $domain eq $_, @local_domains)) {
42return (0, 554, "$recipient: Recipient address rejected: Relay access denied");
43}
44return (1);
45}
46);
47# DATAコマンドの処理
48$smtp->set_callback(
49DATA => sub {
50my ($session, $data) = @_;
51my $sender = $session->get_sender();
52my @recipients = $session->get_recipients();
53return (0, 554, 'Error: no valid recipients') unless @recipients;
54# キューに追加。add_queueは自前で実装する必要がある
55my $msgid = add_queue($sender, \@recipients, $data) or return(0);
56return (1, 250, "message queued $msgid");
57}
58);
59$smtp->process();
60$conn->close();
61}
62

このコードを実行し、以下のようにtelnetで繋いで各コマンドの動作を確かめると、

意図したレスポンスがサーバから返ってくることが確認できます。

1$ telnet localhost 2500
2Trying 127.0.0.1...
3Connected to localhost.
4Escape character is '^]'.
5220 debian2 SMTP Net::Server::Mail (Perl) Service ready
6HELO localhost
7553 I don't like this hostname, try again.
8HELO hogehoge
9250 Requested mail action okay, completed
10MAIL FROM:
11250 sender hogehoge@example.com OK
12RCPT TO:
13554 hogehoge@example.net: Recipient address rejected: Relay access denied
14RCPT TO:
15250 recipient hogehoge@example.com OK
16DATA
17354 Start mail input; end with .
18test
19.
20250 message queued 1
21quit
22221 debian2 Service closing transmission channel
23Connection closed by foreign host.
24

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

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

Parallel::Prefork

Parallel::Preforkはプリフォークサーバを書くためのモジュールです。

似た名前で似た使い方をするParallel::ForkManagerというモジュールがありますが、

Parallel::Preforkはシグナル管理が可能になっています。

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

1use strict;
2use warnings;
3use utf8;
4use IO::Socket::INET;
5use Parallel::Prefork;
6sub MaxRequestsPerChild() { 100 }
7my $listen_sock = IO::Socket::INET->new(
8Listen => 5,
9LocalAddr => '0.0.0.0:5000',
10Proto  => 'tcp',
11) or die $!;
12my $pm = Parallel::Prefork->new({
13max_workers => 10,
14trap_signals => {
15TERM => 'TERM',
16HUP  => 'TERM',
17}
18});
19while ($pm->signal_received ne 'TERM') {
20# ワーカープロセス生成処理
21$pm->start and next;
22#### ここからワーカープロセス処理
23# 1ワーカーがリクエストを受け付ける数
24my $reqs_before_exit = MaxRequestsPerChild;
25$SIG{TERM} = sub { $reqs_before_exit = 0 };
26while ($reqs_before_exit-- > 0) {
27if (my $conn = $listen_sock->accept()) {
28while (my $str = ) {
29print $conn "$reqs_before_exit($$): ".$str;
30}
31$conn->close;
32}
33}
34# ワーカープロセスの終了処理
35$pm->finish;
36}
37# 子プロセス待ち受け
38$pm->wait_all_children;
39

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

1$ perl prefork_echo.pl &
2$ ps a | grep prefork_echo.pl
33963 pts/3    S      0:00 perl prefork_echo.pl
43964 pts/3    S      0:00 perl prefork_echo.pl
53965 pts/3    S      0:00 perl prefork_echo.pl
63966 pts/3    S      0:00 perl prefork_echo.pl
73968 pts/3    S      0:00 perl prefork_echo.pl
83969 pts/3    S      0:00 perl prefork_echo.pl
93970 pts/3    S      0:00 perl prefork_echo.pl
103971 pts/3    S      0:00 perl prefork_echo.pl
113972 pts/3    S      0:00 perl prefork_echo.pl
123973 pts/3    S      0:00 perl prefork_echo.pl
133983 pts/3    S      0:00 perl prefork_echo.pl
144085 pts/3    S+     0:00 grep prefork_echo
15

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

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

$ kill -TERM 3963

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