hs12
changeset 16 0e1c0994309a
parent 15 9482d3366306
child 17 e9aa9cb9f61f
--- a/hs12	Fri Sep 07 15:25:39 2007 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,169 +0,0 @@
-#! /usr/bin/perl
-# $Id$
-# $URL$
-#
-# ** Just proof of concept ** to see if we really need to decode all the
-# mime parts.
-#
-
-use strict;
-use warnings;
-
-use Fatal qw(:void select);
-use File::Temp qw(tempfile);
-use if $ENV{DEBUG} => "Smart::Comments";
-use FindBin qw($Bin);
-
-sub print_message(*@);
-sub read_message();
-sub pass_mime($$);
-sub forward_to_boundary($*);
-sub read_header(*);
-
-#
-sub process($*;@);
-my $confdir = -f "$Bin/.build" ? $Bin : "/etc/$0";
-my @mimes;
-
-$SIG{__WARN__} = sub { print STDERR "### ", @_ };
-
-MAIN: {
-
-	open ( my $fh, "< $confdir/mimes.conf")
-		or warn "can't read config!\n";
-	my @mimes = map { chomp; $_ } grep !/(?:^\s*#|^\s*$)/, <$fh>;
-	
-    # create an r/o tmp file containing the message  for sequential
-    # processing and optional failback in face of some processing error
-    my $message = read_message();
-
-    # during processing everything is printed into some tmp file
-    # - this way we can abort processing at any time and just send
-    # the above temporary file down the river
-    my $tmpout = tempfile();
-    my $stdout = select $tmpout;
-
-    # now we start processing but at the beginning - of course
-    seek($message, 0, 0);
-    process(\@mimes, $message, boundary => undef);
-
-    # everything is done, probably some rest is still unprocessed (some
-    # epilogue, but this shouldn't be a problem at all
-    {
-        local $/ = \10240;
-        if ($tmpout) {
-            seek($tmpout, 0, 0);
-            select $stdout;
-            print while <$tmpout>;
-        }
-        print while <$message>;
-    }
-
-    exit 0;
-}
-
-sub print_message(*@) {
-    my ($m, %arg) = @_;
-
-    while (<$m>) {
-        print;
-        last if $arg{to} and /^--\Q$arg{to}\E/;
-    }
-}
-
-sub process($*;@) {
-    my ($mimes, $m, %arg)    = @_;
-    my ($header, %header) = read_header($m);
-    my ($type, $boundary);
-
-    if ($header{"content-type"}) {
-        ($type) = ($header{"content-type"} =~ /^([^;]*)/);
-        (undef, $boundary)
-            = ($header{"content-type"} =~ /boundary=(['"])(.*?)\1/);
-        ### h{content-type}:  $header{"content-type"}
-        ### type:	      $type
-        ### bound:            $boundary
-    }
-
-    $boundary ||= $arg{boundary};
-
-    if (not $type or pass_mime($type, $mimes)) {
-        warn "passing: " . ($type ? $type : "no mime type") . "\n";
-        print $header;
-        print_message($m, to => $boundary);
-        return;
-    }
-
-    if ($type =~ m{^multipart/}) {
-        warn "forward to next multipart boundary: $boundary\n";
-        print $header;
-        print_message($m, to => $boundary);
-
-        while (not eof($m)) {
-            process($mimes, $m, boundary => $boundary);
-        }
-
-	return;
-    }
-
-    warn "removed: $type\n";
-
-    my ($eol) = ($header =~ /(\s*)$/);
-    $header =~ s/\s*$//;
-    $header =~ s/^/-- /gm;
-
-    print "Content-Type: text/plain" . $eol x 2
-	. "Content removed (" . localtime() . ")$eol"
-	. $header
-	. $eol;
-
-    while (<$m>) {
-	if (/^--\Q$boundary\E/) {
-	    print;
-	    last;
-	}
-    }
-
-}
-
-sub pass_mime($$) {
-	my ($type, $mimes) = @_;
-    local $_ = $type;
-	my $re = join "|", map { $a = $_; $a =~ s/([^\da-z])/\\$1/gi; $a } @$mimes;
-	return m{$re};
-}
-
-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) = @_;
-    my $h = "";
-
-    while (<$msg>) {
-        $h .= $_;
-        last if /^\s*$/m;
-    }
-
-    $_ = $h;    # unmodified header (excl. $from)
-
-    ### $_
-
-    s/\r?\n\s+(?=\S)/ /gm;    # continuation lines
-    s/^(\S+):/\L$1:/gm;       # header fields to lower case
-
-    return ($h,
-            map { ($a = $_) =~ s/\s*$//; $a }
-                ":unix_from:" => split(/^(\S+):\s*/m, $_));
-}
-__END__
-# vim:ts=4