用于qmail-qfilter的附件过滤脚本

12/3/2006来源:Qmail人气:5395

qmail-qfilter是一个不错的邮件过滤工具呢,随tarball有2个用perl写的例子,一个是禁止邮件附带某种附件,另一个是凡是附带了某一类附件的,就自动改名,但是改名的一个程序,有一点小问题,不能正确运作。
下面是一个我修改后的改附件名的perl脚本,经过测试,在OpenBSD 3.0+Qmail-1.03+Vpopmail-5.0.1+qmail-qfilter-1.5下面正常运作,Client只测试过Foxmail 4.x和Outlook ExPRess,能够同时处理uuencode的邮件和mime 64 encode的邮件。如果您在使用测试中遇到什么问题,请告诉我。

#!/usr/bin/perl

sub check_filename {
local($_) = @_;
s/"//g;
$_ .= ".scan" if /\.(chm|com|bat|exe|hlp|scr|hta|pif|reg|scr|shs|vbe|vbs|wsf|wsh)$/oi;
return $_;
}

sub parse_content_td {
local($_) = @_;
chomp;
s/\s+/ /go;
s/([;\s](file)?name\s*=\s*)(("[^"]+")|\S+)/$1 ."\"" . check_filename($3) . "\""/e;
return $_;
}

sub get_boundary {
local($_) = @_;
chomp;
s/\s+//go;
s/boundary=//go;
s/\"//go;
return $_;
}

while (<>) {

# deal with uuencode email.

$uuencode = $_ if /^begin\s+\d+\s+(.*)\s*$/oi;
if ($uuencode) {
chomp;
print %26amp;check_filename($_) . "\n";
undef $uuencode;
next;
}

# deal with mime64 encode email.

if ($content_td) {
if (/^\s*$/o || /^\S/o) {
print;
undef $content_td;
} else {
print %26amp;parse_content_td($_) . "\n";
next;
}
} else {
print;
}
$content_td = $_ if /^Content-(Type|Disposition):\s*(.*)$/oi;
}
,