- signed mails gehen jetzt auch (musste nur in die config rein)
- etwas die Config-verarbeitung aufgerÀumt
--- a/mimecut.pl Fri Sep 07 21:48:38 2007 +0000
+++ b/mimecut.pl Fri Sep 07 22:16:36 2007 +0000
@@ -2,9 +2,6 @@
# $Id$
# $URL$
#
-# ** Just proof of concept ** to see if we really need to decode all the
-# mime parts.
-#
use strict;
use warnings;
@@ -12,27 +9,22 @@
use Fatal qw(:void select);
use File::Temp qw(tempfile);
use if $ENV{DEBUG} => "Smart::Comments";
+use File::Basename;
use FindBin qw($Bin);
sub print_message(*@);
sub read_message();
-sub pass_mime($$);
-sub forward_to_boundary($*);
+sub pass_mime($);
sub read_header(*);
+sub process(*;@);
-#
-sub process($*;@);
-my $confdir = -f "$Bin/.build" ? $Bin : "/etc/$0";
-my @mimes;
+my $ME = basename $0;
+my $CONFDIR = -f "$Bin/.build" ? $Bin : "/etc/$ME";
$SIG{__WARN__} = sub { print STDERR "### ", @_ };
MAIN: {
- 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();
@@ -45,7 +37,7 @@
# now we start processing but at the beginning - of course
seek($message, 0, 0);
- process(\@mimes, $message, boundary => undef);
+ process($message, boundary => undef);
# everything is done, probably some rest is still unprocessed (some
# epilogue, but this shouldn't be a problem at all
@@ -71,8 +63,8 @@
}
}
-sub process($*;@) {
- my ($mimes, $m, %arg) = @_;
+sub process(*;@) {
+ my ($m, %arg) = @_;
my ($header, %header) = read_header($m);
my ($type, $boundary);
@@ -87,7 +79,7 @@
$boundary ||= $arg{boundary};
- if (not $type or pass_mime($type, $mimes)) {
+ if (not $type or pass_mime($type)) {
#warn "passing: " . ($type ? $type : "no mime type") . "\n";
print $header;
@@ -102,7 +94,7 @@
print_message($m, to => $boundary);
while (not eof($m)) {
- process($mimes, $m, boundary => $boundary);
+ process($m, boundary => $boundary);
}
return;
@@ -130,12 +122,19 @@
}
-sub pass_mime($$) {
- my ($type, $mimes) = @_;
- local $_ = $type;
- my $re = join "|",
- map { $a = $_; $a =~ s/([^\da-z])/\\$1/gi; $a } @$mimes;
- return m{$re};
+{
+ my $re;
+
+ sub pass_mime($) {
+ my ($type) = @_;
+
+ if (!$re) {
+ open(my $fh, "<$CONFDIR/mimes.conf")
+ or die "can't read $CONFDIR/mimes.conf!\n";
+ $re = qr{@{[join "|", map { chomp; "(?:".quotemeta($_).")" } grep !/(?:^\s*#|^\s*$)/, <$fh>]}};
+ }
+ return $type =~ /$re/;
+ }
}
sub read_message() {
--- a/mimes.conf Fri Sep 07 21:48:38 2007 +0000
+++ b/mimes.conf Fri Sep 07 22:16:36 2007 +0000
@@ -4,6 +4,7 @@
# All other mime types will NOT be archived!
text/
+/signed
#text/plain
#text/html
#text/css