perl の import 関数、Storable パッケージを使ってメール転送用ルール管理ツールを作ってみる修行

飛んできたメールを、その送信元アドレスにしたがって転送するツールを perl で作ってみた。言ってみれば、会社の代表番号にかかってきた電話を、「××商事の○○と申します。」と聞いただけで、「××商事の○○様ですね。△△課の☆☆におつなぎします。」と転送する人みたいなもの。というか、発信元電話番号にしたがって自動的に該当の人の内線に切り替えるようなものか。ともかくそんなもの。
たとえば、「abc@example.com」からきたメールは基本的に「abc@example.org」と「デフォルトドメインの test-abc」の二つのアドレスに転送する、んだけど、拡張部分が「j」の場合は「abc@example.co.jp」に、「u」の場合は「abc@example.co.us」に、「org」の場合は「abc@example.org」に、それぞれ転送してね、なんてのを一つのルールとする。わかりやすく（ないかもしれないけどともかく）書いてみると、こんなのが一つのルール。

abc@example.com => abc@example.org,test-abc
 j   -> abc@example.co.jp
 u   -> abc@example.co.us
 etc -> abc@example.org

でもって、こんなルールが複数ある。これが何に便利か、という話はまた今度。

ハッシュべた書き実装

ともかく、このようなツールを作ってみたのだが、最初は特に何のパッケージも使わず、クラスの概念も用いず、さくっと書いた。ルールはハッシュをべた書き。まあ、こんな感じ。

$rules{'abc@example.com'} = {
    0     => 'abc@example.org,test-abc', # デフォルトね
    'j'   => 'abc@example.co.jp',
    'u'   => 'abc@example.co.us',
    'etc' => 'abc@example.org',
};

でも、使われ続けるうちに、やっぱりルールは別に管理して、他の人でもメンテナンスしやすくできるようにしたいと思った。

求められるもの

ということで、まずはルール周りだけを取り出して実装することにした。こんな要件か。

メールをさばくからあんまり重いのはダメだよね
- 更新はともかく読込みは速くないと
人間が読みにくいのはダメだね
- /etc/aliases みたいに更新時は追加とかじゃなくてまるごと置換えってのが面倒ないよね

で、こんな形式でルールを書くようにしてみた。

$ cat green.txt
abc@example.com => abc@example.org,test-abc
 j   -> abc@example.co.jp
 u   -> abc@example.co.us
 etc -> abc@example.org
test@why.not  => test@why.not
# test2@why.not => test@why.not
test@trash.box.com => trash-box@example.org
 1 -> trash-box-1@example.org
 2 -> trash-box-1@example.org
# 3 -> trash-box-1@example.org
 4 -> trash-box-1@example.org

（green ってのは特に意味ないけど、ルールセットの識別子。）更新時は newaliases みたいな感じでこれを食わすとデータベース化され、読込み時はハッシュとして取り出せるイメージ。あ、# で始まる行はコメントってことで。

Storable パッケージ

いろいろ調べているうちに Storable パッケージに行き着いた。MLDBM がよさそうだったけど、メールサーバに入ってなかった。メールサーバいじるのは怖いので、パッケージのインストールはなしの方向で。昔、たぶん 13 年前くらいに GDBM_File を tie/untie したとき以来。perl で RDBMS 以外のデータベースアクセスをするのは。

できたもの

で、できたものがこんな Avelio::SympleRuleStorage パッケージ。あ、simple のスペル間違ってる。しかも、simple じゃないし。もっと適切な名前考えなきゃ。

package Avelio::SympleRuleStorage;
use Storable qw(store retrieve);

my $BASE_DIR = q{};

sub import($) {
    my ($package_name, $base_dir) = @_;
    if ($base_dir) {
        $BASE_DIR = $base_dir;
    }
    else {
        $BASE_DIR = '/etc/';
    }

}

sub new($$) {
    my ($clazz, $prefix) = @_;
    bless {
        table  => {},
        prefix => $prefix,
        path   => "$BASE_DIR/$prefix.rules",
    };
}

sub updateRulesWithSTDIN($$$) {
    my ($self) = @_;
    my %rules;
    my $mainkey = q{};
    while (my $line = <STDIN>) {
        next if ($line =~ /^\#/o);
        chomp($line);
        my ($key, $value) = split(/[=-]>/, $line);
        $key   =~ s/\s+//og;
        $value =~ s/\s+//og;
        if ($line !~ /^ /o) {
            $mainkey = $key;
            $key = '0';
        }
        $rules{$mainkey}{$key} = $value;
    }
    store(\%rules, $self->{path}) or die;
}

sub showRules($) {
    my ($self) = @_;
    my $storage = $self->loadRules();
    foreach my $key (keys %{$storage}) {
        my $rule = $storage->{$key};
        print "$key => ". $rule->{0}."\n";
        foreach my $cond (keys %{$rule}) {
            next if $cond eq '0';
            print " $cond -> ". $rule->{$cond}."\n";
        }
    }
}

sub loadRules($) {
    my ($self) = @_;
    $self->{storage} = retrieve($self->{path});
}

1;
__END__

どうでもいいけど、はじめて import 関数使った。これを使っている管理ツール maintrule.pl は、こんな感じ。

#!/usr/bin/perl
BEGIN {
    unshift(@INC, '/home/gorbachev/lib');
}
use Avelio::SympleRuleStorage qw(/home/gorbachev/rules);

my ($action, $prefix) = @ARGV;
my $storage = new Avelio::SympleRuleStorage($prefix);

if (   $action eq 'show')   {    $storage->showRules();              }
elsif ($action eq 'update') {    $storage->updateRulesWithSTDIN();   }
elsif ($action eq 'test')   {                                        }
else                        {    exit;                               }

# end of file

使い方

ルールを更新するときは、こんな感じで。

$ ./maintrule.pl update green < green.txt

そうすると /home/gorbachev/rules/green.rules が更新される。なかったときには新規に作られる。
で、中身を確認するときは、こんな感じで。

$ ./maintrule.pl show green
abc@example.com => abc@example.org,test-abc
 u -> abc@example.co.us
 j -> abc@example.co.jp
 etc -> abc@example.org
test@trash.box.com => trash-box@example.org
 1 -> trash-box-1@example.org
 4 -> trash-box-1@example.org
 2 -> trash-box-1@example.org

一応、こんなこともできるはず。

$ ./maintrule.pl show green |head -20| ./maintrule.pl update red

今後

単体テスト

テストスイートを用意しておいて、

$ ./maintrule.pl test green

とかやると、テストしてくれたりすると嬉しいかな。テストスイートは green.suite とかいうディレクトリを掘って、その中にテストケースのファイルを入れておくみたいな感じかな。

メール転送ツールへの導入

これを本来の目的のメール転送ツールに導入しないと。とりあえず、本番に使っているルールセットを blue とした場合、こんなイメージ。

入れ替える予定のルールセットは skyblue とかにして、

$ ./maintrule.pl update skyblue < skyblue.txt

やら

$ ./maintrule.pl test skyblue

を繰り返して skyblue をさんざん叩く。で、大丈夫かな、と思ったら、

$ ./maintrule.pl show blue | diff - skyblue.txt

とかで変更点を確認して、問題なければさくっと

$ cp -vi /home/gorbachev/rules/skyblue.rules /home/gorbachev/rules/blue.rules

って上書きしちゃう、みたいな。

実際にメール転送ツールに導入し終わったら、それはそれで公開の予定。