fetchmail を使った転送スクリプト

2006年12月19日

fetchmail を使った転送スクリプト >>Perl | >>メールサーバ

fetchmailを使うと、POPで定期受信を簡単に行える。
しかし、メーリングリストにそのまま無加工で送ると、メールヘッダも無加工であるから、エラー等の際にエライことになる。
というわけで、楽をするためにスクリプトを作る。ついでに、fetchmailで受信し、メーリングリストに投げつつ、procmailで受信したサーバにprocmailを使ってstoreさせる機能を追加。

できる限りヘッダを書き換えるようにしているが、メーリングリストマネージャによっては、その他のヘッダも書き換える必要があるかもしれない。
いろいろなしがらみによって客先で担当メールアドレスを作成され、それを実社内でメーリングリストにキャストすることによって社内にもそのまま通達、ついでに自分用アドレスにStoreしときたいような場合等に使う。

まあ、あんまり一般的に使うものでもないかもしれないが、mail fromをみて、これはブロードキャストするか、remoteにstoreするだけか、みたいなことも改造すればできるわけで、考えればいろいろ使えなくはないかも。（曜日によってとかも、ちょっといじればいけるでしょうし）

fetchmail.rcで
mda "/usr/bin/perl /somewhere/mailfw.pl"

というように記述する。mailfw.plの中身は以下の通りで、localを使うのであれば、procmail.rcを適宜記述しておく。
Debian Sarge環境procmail 3.22,qmail 1.03,fetchmail 6.2.5,perl5.8.4で確認。
生田　昇さんのmime_pls http://www.cc.rim.or.jp/~ikuta/mime_pls/index.html の、mimer.plが必要。

JIS環境(日本語）でしかテストしていません。
fetchmailを動かすためにcronの設定が必要。パイプで渡すことができる環境なら、そのままパイプで渡すのもありかも。（ただ、fetchmailのmdaコマンドで動作するように作っているため、改行コードcrがdeleteされて来ない、という部分があります。変更する場合は要注意。）

スクリプトは以下。持ち帰りソースはこれ

$cache = "/somedir/cache.dat"; #cache file StorePath
$lockfile = "/somedir/locks.dat"; #lock file store path

#remoteの場合は、from,to
#localの場合は、procmailrcの場所を指定する
@post_tos =(
'remote someaddr@somedomain someaddr_to@somedomain_to',
'local procmailrcs.file',
);

%commands =(
'sendmail' => '/usr/sbin/sendmail',
'procmail' => '/usr/bin/procmail',
);

$locktimeout = 10;
$lockflag = 0;

require './somedir/mimer.pl'; #mimer.pl必須

&lock_rootin($lockfile,$locktimeout);

&make_cache;
foreach (@post_tos)
{
($deli,$from,$to) = split(/\t/,$_);
if ($deli eq "remote")
{
&go_send_remote($from,$to);
}
elsif ($deli eq "local")
{
&go_send_local($from);
}

}

sub make_cache
{
open(OUT,">$cache") or &errors;
while()
{
print OUT $_;
}
close(OUT);
}

sub go_send_local
{
my($from,$rcptto) = @_;

my($cmd) = $commands{'procmail'};

#| /usr/bin/procmail -m ./.procmailrc
open(OUT,"| $cmd -m $from") or &errors;
open(IN,"$cache");
while()
{
print OUT $_;
}
close(IN);
close(OUT);

}

sub go_send_remote
{
my($from,$rcptto) = @_;
my($skip_header,$get_fromheader,$header_ended,$headers,$check_header,$head_data,
$orgfrom,$fromheaders,$origin_post);

$header_ended = 0;
$origin_post = 0;

my($cmd) = $commands{'sendmail'};

open(OUT,"| $cmd $rcptto") or &errors;
open(IN,"$cache");

print OUT "To: <$rcptto>" . "\n";
print OUT "From: <$from>" . "\n";

$skip_header = 0;
$get_fromheader = 0;
while()
{
if ($header_ended == 0)
{
#--- MDA nara cr delete ga yuukou. ----
if ($_ eq "\n")
{
$header_ended = 1;
if ($headers ne "")
{
print OUT $headers;
}
$headers ="";
}
else
{
if ($_ =~ m/^(.*?):\s(.*?)\n$/)
{
$skip_header = 0;
$check_header = $1;
$head_data = $2;

if ($headers ne "")
{
print OUT $headers;
}
$headers ="";

if ($get_fromheader == 1)
{
$get_fromheader = 0;
$orgfrom = &decode_mime($fromheaders);
}

if ($check_header =~ /^Return-Path/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^Delivered-To/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^X-Original-To/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^Delivered-To/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^Cc/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^To/i)
{
$skip_header = 1;
next;
}
if ($check_header =~ /^From/i)
{
$get_fromheader = 1;
$skip_header = 1;
$fromheaders .= $head_data . "\n";
next;
}

$headers .= $_;
next;
}
elsif($skip_header == 1)
{
if ($get_fromheader == 1)
{
$fromheaders .= $_;
}
next;
}
else
{
$headers .= $_;
}
}
}
elsif($origin_post == 0)
{
print OUT "\n";
print OUT "This is Mail Transfer Program.\n";
print OUT "Original from: " . $orgfrom . "\n";
$origin_post = 1;

print OUT $_;
}
else
{
print OUT $_;
}
}
close(IN);
close(OUT);

}

unlink($cache);
&end_lock;

sub decode_mime
{
my($orgfrom) = $_[0];
my($mimes) = "=?ISO-2022-JP";

if ($orgfrom =~ m/$mimes/)
{
$decode_from = &mimedecode($orgfrom);
return($decode_from);
}

return($orgfrom);

}

sub errors
{
if ($lockflag != 0)
{
&end_lock;
}

exit 1;
}

sub lock_rootin {
my($tmppath,$locktimeout) = @_;
$lockflag++;
if (-e $tmppath ) {
open(LOCK, "$tmppath") or &errors;
}
else
{
open(LOCK,">$tmppath") or &errors;
}
eval
{
$lockstart = 1;
local $SIG{ALRM} = sub { die "time out" }; # 時間が来たら抜け出す
alarm($locktimeout); # 制限時間
flock(LOCK, 2);
alarm(0);
};
if ($@ =~ /time out/) {
$lockstart = 0;
&end_lock;
&errors;
}
}

sub end_lock {
local($i);
for ($i = 1; $i <= $lockflag ; $i++)
{
if ($i == 1 )
{
flock(LOCK,8);
close(LOCK);
}
if ($i == 2 )
{
flock(LOCK2,8);
close(LOCK2);
}
if ($i == 3 )
{
flock(LOCK3,8);
close(LOCK3);
}
if ($i == 4 )
{
flock(LOCK4,8);
close(LOCK4);
}
}
$lockflag = 0;

}

この記事をTwitterでみんなに教える。

投稿者 debizoh : 2006年12月19日 04:39

トラックバック

現在、この記事はトラックバックを受け付けておりません。

現在、この記事はコメントを受け付けておりません。

でびぞー徒然日記

2006年12月19日

fetchmail を使った転送スクリプト >>Perl | >>メールサーバ

トラックバック

コメント

その他