aging perlスクリプト

Tue, 22 Apr 2008 22:35:28 +0900

当サーバーのメール処理では、spamassassinでスパム判定されたメールも誤判定の可能性を考えて特定のメールボックスに保存していたのだが、一週間以上溜まると後からの読み出しチェックが事実上不可能になるので、直近一週間分を残して削除するperlスクリプトを作成した。

処理的にはメールスプールからglob関数で拾ったファイルを開き、Date:で始まる行を取得。年月日に分割してから、月を文字列から数字に変換し、YYYY-MM-DD形式に再編集。この時、"日"が一桁になる可能性があるので、左に"00"を付与してsubstrで右から2文字を取得しているのがポイント。

Date::Calcのcheck_date関数で日付の正当性を確認した後、$range->includesで直近一週間の範囲チェック。日付が不当だったり、範囲外だったらunlinkする。

#!/usr/bin/perl
#
# 一週間以上前のspamメールは完全に抹消するスクリプト
# by YANO 2008/04/22
#

use strict;
use Date::Simple(":all");
use Date::Range;
use Date::Calc(":all");

my @files = glob("/home/spam/Maildir/*/*");
my $file;

my $today = today();
my $lastweek = $today - 6;
my $day;
my $month;
my $year;
my $date;

my $range = Date::Range->new($lastweek, $today);

foreach $file ( @files ) # ファイルリスト
{
open(IN, $file);
while (){
if ( !/^Date:/ ) {
next;
}
s/^Date: //;
s/^.*, //;
$date = $_;
}
close(IN);

($day, $month, $year) = split(/ /, $date);
$month =~ s/Jan/01/;
$month =~ s/Feb/02/;
$month =~ s/Mar/03/;
$month =~ s/Apr/04/;
$month =~ s/May/05/;
$month =~ s/Jun/06/;
$month =~ s/Jul/07/;
$month =~ s/Aug/08/;
$month =~ s/Sep/09/;
$month =~ s/Oct/10/;
$month =~ s/Nov/11/;
$month =~ s/Dec/12/;
$day = "00".$day;
$date = $year."-".$month."-".substr($day,length($day)-2,2);

my $aged_flag = 1;

($year, $month, $day) = split(/-/, $date);
if ( 2000 < $year && check_date($year, $month, $day) ){
my $target_date = Date::Simple->new($date);
if ($range->includes($target_date)) {
$aged_flag = 0;
}
}

if ( $aged_flag ){
unlink($file);
}
}

2008/04/22 on Yano's digital garage

aging perlスクリプト