--- a/mimecut.pl Fri Sep 07 15:30:08 2007 +0000
+++ b/mimecut.pl Fri Sep 07 21:48:38 2007 +0000
@@ -29,10 +29,10 @@
MAIN: {
- open ( my $fh, "< $confdir/mimes.conf")
- or warn "can't read config!\n";
- my @mimes = map { chomp; $_ } grep !/(?:^\s*#|^\s*$)/, <$fh>;
-
+ open(my $fh, "< $confdir/mimes.conf")
+ or warn "can't read config!\n";
+ my @mimes = map { chomp; $_ } grep !/(?:^\s*#|^\s*$)/, <$fh>;
+
# create an r/o tmp file containing the message for sequential
# processing and optional failback in face of some processing error
my $message = read_message();
@@ -72,7 +72,7 @@
}
sub process($*;@) {
- my ($mimes, $m, %arg) = @_;
+ my ($mimes, $m, %arg) = @_;
my ($header, %header) = read_header($m);
my ($type, $boundary);
@@ -88,6 +88,7 @@
$boundary ||= $arg{boundary};
if (not $type or pass_mime($type, $mimes)) {
+
#warn "passing: " . ($type ? $type : "no mime type") . "\n";
print $header;
print_message($m, to => $boundary);
@@ -95,6 +96,7 @@
}
if ($type =~ m{^multipart/}) {
+
#warn "forward to next multipart boundary: $boundary\n";
print $header;
print_message($m, to => $boundary);
@@ -103,7 +105,7 @@
process($mimes, $m, boundary => $boundary);
}
- return;
+ return;
}
#warn "removed: $type\n";
@@ -112,25 +114,28 @@
$header =~ s/\s*$//;
$header =~ s/^/-- /gm;
- print "Content-Type: text/plain" . $eol x 2
- . "Content removed (" . localtime() . ")$eol"
- . $header
- . $eol;
+ print "Content-Type: text/plain"
+ . $eol x 2
+ . "Content removed ("
+ . localtime() . ")$eol"
+ . $header
+ . $eol;
while (<$m>) {
- if (/^--\Q$boundary\E/) {
- print;
- last;
- }
+ if (/^--\Q$boundary\E/) {
+ print;
+ last;
+ }
}
}
sub pass_mime($$) {
- my ($type, $mimes) = @_;
+ my ($type, $mimes) = @_;
local $_ = $type;
- my $re = join "|", map { $a = $_; $a =~ s/([^\da-z])/\\$1/gi; $a } @$mimes;
- return m{$re};
+ my $re = join "|",
+ map { $a = $_; $a =~ s/([^\da-z])/\\$1/gi; $a } @$mimes;
+ return m{$re};
}
sub read_message() {