# HG changeset patch
# User heiko
# Date 1188982381 0
# Node ID 26659f592363363f3c79df4434a0b7d324b4c50c
# Parent  b6703bbc34664b0d63c360e02ff01ddbfee59227
- weitere Gehversuche

diff -r b6703bbc3466 -r 26659f592363 hs12
--- 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__