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

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 &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 &parse_content_td($_) . "\n";
    next;
}
    } else {
        print;
    }
    $content_td = $_ if /^Content-(Type|Disposition):\s*(.*)$/oi;
}
,