hs12
changeset 8 b6703bbc3466
child 9 26659f592363
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/hs12	Tue Sep 04 07:48:53 2007 +0000
@@ -0,0 +1,102 @@
+#! /usr/bin/perl
+use strict;
+use warnings;
+
+use File::Temp qw(tempfile);
+use Smart::Comments;
+
+sub pass_mime($);
+sub forward_to_boundary($*);
+sub read_header(*);
+
+MAIN: {
+    my $message = tempfile();
+    my $out     = tempfile();
+
+    select $out or die "Can't select: $!\n";
+
+    # read the message into our tmp file
+    {
+        local $/ = \102400;
+        print {$message} <>;
+        chmod 0400, $message or die "Can't fchmod on tmpfile: $!\n";
+    }
+
+    seek($message, 0, 0);
+    my %header = read_header $message;
+
+
+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>;
+
+}
+
+sub forward_to_boundary($*) {
+    my ($b, $fh) = @_;
+    while (<$fh>) {
+	print;
+	return if /^--$b/;
+    }
+}
+
+sub pass_mime($) {
+    return $_[0] =~ m{^text/plain};
+}
+
+sub read_header(*) {
+    my $msg = shift;
+
+    local $/ = "";
+    local $_ = <$msg>;
+
+    print;
+
+    s/\r?\n\s+/ /gm;       # FIXME: decode quoted printable
+    s/^(\S+):/\L$1:/gm;    # header fields to lower case
+
+    return (":UNIX_FROM:" => split(/^(\S+):\s*/m, $_) );
+
+}
+__END__
+
+my $parser = new MIME::Parser;
+
+# read the complete mail
+my $entity = $parser->parse(\*STDIN);