SPAM対策

電信8号は、

• そもそもHTMLメールを表示する機能がないのでウィルスにひっかかりにくい
• メールをテキストとして、別に処理できる

ので、便利だから使っているのだが、欠点がない訳でもなく、大量にやってくるスパムメールを選別する手段を手動で設定しなければならないところ。
なのでそれとは別に後述のスパム選別の小さなプログラムを組んでみた。
IN.fldと同じディレクトリに置いて、時々起動する。INディレクトリの中にあるスパムと思しきメールを、DIRECTMAILディレクトリに移動させるもの。起動後はINとDIRECTMAILでそれぞれ「最新の状態に更新する」を実行しなければならないが。（※SPAMはDIRECTMAIL.fldに（一旦）保存するように私はしているので）
原理としては単純で、サブジェクトを比較して同じサブジェクトのものが複数届いていれば、それはSPAMであると判断できる。これによってかなりのメールが絞り込める。ちなみにこれはどっかのブログで提案されていたネタなんだが、それがどこか思い出せないでいる。情報募集。

move_spam.pl

use strict;
use File::Copy;
# 母集団の取得。
opendir ( DIR, 'IN' );
my @file = grep { /^\d{4}\.TXT$/ } readdir ( DIR );
closedir ( DIR );
# タイトル→ファイルを保存する変数の設定
my %list = ();

# ひとつひとつを開いて調べる。
foreach my $file ( @file ) {
	my $path = 'IN/'.$file;
	open ( IN, $path );
	while ( my $line = <IN> ) {
		$line =~ s/^Subject\: // or next;
		push @{$list{$line}}, $path;
		last;
	}
	close ( IN );
}
# 移動先の数値を調べる。
opendir ( DIR, 'DIRECTMAIL' );
my @l = sort grep { /\^\d{4}/ } readdir ( DIR );
closedir ( DIR );
my $last = pop @l;
my $count = $last;
$count =~ s/\D//g;
++ $count; # この値からはじめる。
# 移動させる。
while ( my ( $subject, $list ) = each %list ) {
	my @list = @{$list};
	1 == scalar @list and next; # 同じタイトルのものがなければ無視して次のループに。
	foreach my $file ( @list ) {
		my $to = sprintf "DIRECTMAIL/%04d", $count;
		$to .= '.TXT';
		move ($file, $to);
		++ $count;
		$count > 9999 and last;
	}
}