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

メール本体を組み立てるロジックとメール送信部分が結合しているようなシステムを自動テストする際に、

一時的に立ち上がるメールサーバが欲しくなります。

また、メールサーバにどんなメールが届くのかをチェックできると嬉しいですね。

Test::TCPとNet::Server::Mail::SMTPを使えば、これを実現できます。

Test::TCPは、開いているポートをスキャンして、サーバ側のコードとクライアント側のコードを実行してくれるモジュールです。

Net::Server::Mail::SMTPは、メールサーバを簡単に書けるようにしてくれるモジュールです。各SMTPコマンドに対して処理を書くことができます。

この２つのモジュールを組み合わせれば、以下のようにテストを書くことができます。

1use strict;
2use warnings;
3use Test::More;
4use Test::TCP;
5use Net::SMTP;
6use Net::Server::Mail::SMTP;
7use Email::MIME;
8use Email::Address::Loose;
9use Email::MIME::MobileJP::Parser;
10my $from = 'test-from@example.com';
11my $to   = 'test-to@example.com';
12my $body = 'test-body';
13my $mime = Email::MIME->create(
14header => [
15From => $from,
16To   => $to,
17Subject => 'test-subject'
18],
19attributes => {
20content_type => 'text/plain',
21charset      => 'ISO-2022-JP',
22encoding     => '7bit',
23},
24body => $body
25);
26test_tcp(
27client => sub {
28my $port = shift;
29eval {
30my $smtp = Net::SMTP->new(
31Host => 'localhost',
32Port => $port,
33Hello => '[localhost]'
34);
35$smtp->mail('test-from@example.com');
36$smtp->to('test-to@example.com');
37$smtp->data();
38$smtp->datasend($mime->as_string);
39$smtp->quit;
40};
41if ($@) {
42warn $@;
43}
44},
45server => sub {
46my $port = shift;
47my $sock = IO::Socket::INET->new(
48LocalAddr => '127.0.0.1',
49LocalPort => $port,
50Proto     => 'tcp',
51Listen    => 1,
52) or die "Cannot open server socket: $!";
53# チェック用のリクエストが来るのでパスする
54$sock->accept();
55while (my $remote = $sock->accept()) {
56eval {
57my $smtp = Net::Server::Mail::SMTP->new('socket' => $remote);
58$smtp->set_callback(
59'RCPT' => sub {
60my $sess = shift;
61my $rcpt = shift;
62my ($email) = Email::Address::Loose->parse($rcpt);
63my $domain = $email->host;
64return (0, 513, 'Syntax error.') unless $domain;
65return 1;
66}
67);
68$smtp->set_callback(
69'DATA' => sub {
70my $sess = shift;
71my $data = shift;
72my $mail = Email::MIME::MobileJP::Parser->new($data);
73my $from = $mail->from();
74my $body = $mail->mail->body;
75is $from->address, 'test-from@example.com';
76like $body, qr/test-body/;
77return (1, 250, 'message queued');
78}
79);
80$smtp->process();
81};
82if ($@) {
83warn $@;
84$remote->close();
85}
86}
87}
88);
89done_testing;
90

Test::TCPは、serverに記述されたメールサーバが起動したあとに、clientに記述されたプログラムを実行してくれるようになっています。

便利ですね。