《一个用于qmail-qfilter的附件过滤脚本》★

钉子

★原文转载自openbsd版zenz.hu的《一个用于qmail-qfilter的附件过滤脚本》★<br>
qmail-qfilter是一个不错的邮件过滤工具呢，随tarball有2个用perl写的例子，一个是禁止邮件附带某种附件，另一个是凡是附带了某一类附件的，就自动改名，但是改名的一个程序，有一点小问题，不能正确运作。 <br>
下面是一个我修改后的改附件名的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的邮件。如果您在使用测试中遇到什么问题，请告诉我。 <br>
<br>
#!/usr/bin/perl <br>
<br>
sub check_filename { <br>local($_) = @_; <br>s/"//g; <br>$_ .= ".scan" if /\.(chm|com|bat|exe|hlp|scr|hta|pif|reg|scr|shs|vbe|vbs|wsf|wsh)$/oi; <br>return $_; <br>
} <br>
<br>
sub parse_content_td { <br>local($_) = @_; <br>chomp; <br>s/\s+/ /go; <br>s/([;\s](file)?name\s*=\s*)(("[^"]+")|\S+)/$1 ."\"" . check_filename($3) . "\""/e; <br>return $_; <br>
} <br>
<br>
sub get_boundary { <br>local($_) = @_; <br>chomp; <br>s/\s+//go; <br>s/boundary=//go; <br>s/\"//go; <br>return $_; <br>
} <br>
<br>
while (<>) { <br>
<br>
# deal with uuencode email. <br>
<br>$uuencode = $_ if /^begin\s+\d+\s+(.*)\s*$/oi; <br>if ($uuencode) { <br>
chomp; <br>print &check_filename($_) . "\n"; <br>
undef $uuencode; <br>
next; <br>} <br>
<br>
# deal with mime64 encode email. <br>
<br>if ($content_td) { <br>
if (/^\s*$/o || /^\S/o) { <br>print; <br>undef $content_td; <br>
} else { <br>print &parse_content_td($_) . "\n"; <br>next; <br>
} <br>} else { <br>print; <br>} <br>$content_td = $_ if /^Content-(Type|Disposition):\s*(.*)$/oi; <br>
} <br>
<br>