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;
}
,
|
