--- a/hs12 Wed Sep 05 14:52:16 2007 +0000
+++ b/hs12 Wed Sep 05 23:15:45 2007 +0000
@@ -1,36 +1,40 @@
#! /usr/bin/perl
+
use strict;
use warnings;
use Fatal qw(:void select);
use File::Temp qw(tempfile);
-use Smart::Comments;
+use if $ENV{DEBUG} => "Smart::Comments";
sub print_message(*$);
sub read_message();
sub pass_mime($);
sub forward_to_boundary($*);
-sub read_header(*);
-sub process(*$);
+sub read_header(*$);
+sub process(*$$);
MAIN: {
my $message = read_message();
my $tmpout = tempfile();
- my $stdout = select $tmpout;
+ my $stdout = select $tmpout; # print ab jetzt ins tmpout
seek($message, 0, 0);
- process($message, undef);
+ process($message, undef, undef);
# spit out everthing
select $stdout;
seek($tmpout, 0, 0);
- { # the tmpout may contain only parts of the message
- # to avoid unnessesary copy actioins
+ # now output the stuff collected in tmpout
+ # and the rest of the message
+ {
local $/ = \10240;
print while <$tmpout>;
print while <$message>;
}
+
+ exit 0;
}
sub print_message(*$) {
@@ -46,27 +50,36 @@
}
}
-sub process(*$) {
- my ($m, $boundary) = shift;
- my ($header, %header) = read_header($m);
- my $mime;
+sub process(*$$) {
+ my ($m, $boundary, $mime_version) = @_;
+ my ($header, %header) = read_header($m, $boundary);
+ my $mime_type;
- if ( $header{"mime-version"}
+ $mime_version ||= $header{"mime-version"};
+
+ ### $header
+
+ if ( $mime_version
and $header{"content-type"})
{
- ($mime, undef, $boundary) = (
+ ($mime_type, undef, $boundary) = (
$header{"content-type"} =~ /^(.*?); # mime type
(?:.*(?:boundary=(['"])(.*?)\2))? # eventuell noch mehr
/x
);
}
- if (!$mime or pass_mime($mime)) {
+ if (not $mime_type or pass_mime($mime_type)) {
+ warn "passing: " . ($mime_type ? $mime_type : "no mime_type") . "\n";
print $header;
print_message($m, $boundary);
return;
}
+ else {
+ warn "not just passing: $mime_type\n";
+ }
+ process($m, $boundary, $mime_version);
}
@@ -86,19 +99,27 @@
# in: current message file handle
# out: ($orignal_header, %parsed_header)
-sub read_header(*) {
- my $msg = shift;
- my ($from, $h);
+sub read_header(*$) {
+ my ($msg, $start) = @_;
+ my $h = "";
- local $_ = <$msg>;
- $from = /^from\s/i ? $_ : "";
+ if (defined $start) {
+ while (<$msg>) {
+ $h .= $_;
+ last if /^--$start\s*$/;
+ }
+ }
- while (<$msg>) { $h .= $_; last if /^\s*$/ }
- $_ = $h;
+ while (<$msg>) {
+ $h .= $_;
+ last if /^\s*$/;
+ }
+
+ $_ = $h; # unmodified header (excl. $from)
s/\r?\n\s+(?=\S)/ /gm; # continuation lines
s/^(\S+):/\L$1:/gm; # header fields to lower case
- return ("$from$h", ":unix_from:" => split(/^(\S+):\s*/m, "$from$_"));
+ return ($h, ":unix_from:" => split(/^(\S+):\s*/m, $_));
}
__END__