--- a/hs12 Tue Sep 04 07:48:53 2007 +0000
+++ b/hs12 Wed Sep 05 08:53:01 2007 +0000
@@ -2,97 +2,99 @@
use strict;
use warnings;
+use Fatal qw(:void select);
use File::Temp qw(tempfile);
use Smart::Comments;
+sub read_message();
+sub parse(*);
sub pass_mime($);
sub forward_to_boundary($*);
sub read_header(*);
+sub process(*);
MAIN: {
- my $message = tempfile();
- my $out = tempfile();
+ my $message = read_message();
+ my $tmpout = tempfile();
+ my $stdout = select $tmpout;
- select $out or die "Can't select: $!\n";
+ seek($message, 0, 0);
+ process($message);
+
+ # spit out everthing
+ select $stdout;
+ seek($tmpout, 0, 0);
- # read the message into our tmp file
+ { # the tmpout may contain only parts of the message
+ # to avoid unnessesary copy actioins
+ local $/ = \10240;
+ print while <$tmpout>;
+ print while <$message>;
+ }
+}
+
+sub process(*) {
+ my $m = shift;
+ my ($header, %header) = read_header($m);
+
+ if ( !$header{"mime-version"}
+ or !$header{"content-type"})
{
- local $/ = \102400;
- print {$message} <>;
- chmod 0400, $message or die "Can't fchmod on tmpfile: $!\n";
+ print $header;
+ return;
}
- seek($message, 0, 0);
- my %header = read_header $message;
+ if (my $boundary = pass_mime($header{"content-type"})) {
+ warn "passing ", ($header{"content-type"} =~ /^(.*?);/)[0], "\n";
+ print $header;
+ while (<$m>) { print; last if /^--\Q$boundary\E--\s*/ }
+ }
-BODY: {
-last BODY;
-
- if (!$header{"mime-version"}) {
- warn "no mime-version in header\n";
- last BODY;
- }
-
- if (!$header{"content-type"}) {
- warn "no content-type in header\n";
- last BODY;
- }
-
- if (pass_mime($header{"content-type"})) {
- warn "passing message ($header{'content-type'})\n";
- last BODY;
- }
-
- # looks more complicated
-
- my (undef, $boundary)
- = ($header{"content-type"} =~ /boundary=(["'])(.*?)\1/);
-
- if (!$boundary) {
- warn "no boundary in content-type\n";
- last BODY;
- }
-
- ### boundary: $boundary
-
- $_ = forward_to_boundary($boundary, $message);
-
- }
- print <$message>; # the rest
-
- # nun das TMP-File auch ausgeben
- select STDOUT;
- seek($out, 0, 0);
- print while <$out>;
+ #my $boundary;
+ #$boundary = $2
+ # if ($header{"content-type"} =~ m{boundary=(['"])(.*?)\1});
}
sub forward_to_boundary($*) {
my ($b, $fh) = @_;
while (<$fh>) {
- print;
- return if /^--$b/;
+ print;
+ return if /^--$b/;
}
}
sub pass_mime($) {
- return $_[0] =~ m{^text/plain};
+ return $_[0] =~ m{/signed};
}
+sub read_message() {
+ my $tmp = tempfile();
+
+ local $/ = \102400;
+ print {$tmp} $_ while <>;
+ chmod 0400, $tmp or die "Can't fchmod on tmpfile: $!\n";
+
+ return $tmp;
+}
+
+# in: current message file handle
+# out: ($orignal_header, %parsed_header)
sub read_header(*) {
my $msg = shift;
+ my ($from, $h);
- local $/ = "";
local $_ = <$msg>;
-
- print;
+ $from = /^from\s/i ? $_ : "";
- s/\r?\n\s+/ /gm; # FIXME: decode quoted printable
- s/^(\S+):/\L$1:/gm; # header fields to lower case
+ while (<$msg>) { $h .= $_; last if /^\s*$/ }
+ $_ = $h;
- return (":UNIX_FROM:" => split(/^(\S+):\s*/m, $_) );
+ 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$_"));
}
__END__