diff -r af315e1a9b1e -r 1fccf68e52c6 hs12 --- 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__