メールボックス掃除機

前提

昔から使っているメールアドレスを、直接電信8号で受け取るのはやめて、外からでも見れるようにGmailからアクセスするようにした。
ところが、この機能を使っている人は御存じのとおり、Gmailのこの横取り機能は、メールボックスに怪しいファイルがあったら警告だけ飛ばして取得せず、いつまでもメールボックスに怪しいメールが残ってしまう。
そもそも最近のスマートなメールサーバーは、怪しいメールは最初からメールボックスにため込まないような機能がついていることが多いのだが、今回横取りしたメールのメールサーバーはかなり古く、そういう洒落た機能がついていない。
仕方なく、自前でメールボックスにアクセスして、ダウンロードし、日付が今日でない(古い)メールは削除する、そういうスクリプトを組んでみた。

スクリプト(pop3.pl)

use strict;
use warnings;

my $today = join(' ',(split /[^a-zA-Z0-9]+/, scalar localtime)[0..2]);

use Net::POP3;

my $server = 'server';
my $account = 'xxxx';
my $password = 'xxxx';
my $protocol = 'pop3';
my $output = './mail';

-d $output or mkdir($output, 0777);
my $pop3 = Net::POP3->new($server) or die("Can't access ".$server);
my $login = ('apop' eq lc $protocol) ? 'apop' : 'login';
my $count = $pop3->$login($account, $password);
my $messages = $pop3->list();

my $delete_flag = 0;
foreach my $id ( sort keys %{$messages} ) {

	my $message = $pop3->get($id);
	my $outfile = sprintf('%s/%d_%s.eml', $output, $$, $id);
	open ( OUT, ">$outfile" ) or next;
	print OUT @{$message};
	close ( OUT );

	$delete_flag = 0;
	open ( IN, $outfile ) or next;
	while ( my $line = <IN> ) {
		print "$line\n";
		$line =~ s/^Date:\s+//i or next;
		my $date = join(' ',(split /[^a-zA-Z0-9]+/, $line)[0..2]);
		$date eq $today and last;
		$delete_flag = 1;
	}
	close ( IN );
	$delete_flag and $pop3->delete($id);
	
	unlink $outfile;
}
$pop3->quit();
exit(0);

結果

一旦ローカルにメールを全てダウンロードするので、ポートを見張っているアンチウィルスソフトが反応してしまい、意味がなかった。しかしアンチウィルスソフトは勤勉だな。素人のお手製プログラムもきちんと見張っている。

対策

前回の起動時間を記録して、それから24時間以上経過していなければそのまま終了(起動時間の更新はしない)。24時間以上経過していれば、その時にサーバーにあるメールは、ダウンロードする前に問答無用に削除。ああ、三つくらい残しておいてもいいかな。
それで行こう。