diff -r 02c6b4c97bd0 -r adf9e5eea0ed mimecut.pl
--- a/mimecut.pl	Fri Nov 02 00:08:56 2007 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,189 +0,0 @@
-#! /usr/bin/perl
-# $Id$
-# $URL$
-#
-
-use strict;
-use warnings;
-
-use Fatal qw(:void select);
-use File::Temp qw(tempfile);
-use if $ENV{DEBUG} => "Smart::Comments";
-use File::Basename;
-use FindBin qw($Bin);
-
-sub print_message(*@);
-sub read_message();
-sub pass_mime($);
-sub read_header(*);
-sub process(*;@);
-
-my $ME = basename $0;
-my $CONFDIR = -f "$Bin/.build" ? $Bin : "/etc/$ME";
-
-$SIG{__WARN__} = sub { print STDERR "### ", @_ };
-
-MAIN: {
-
-    # 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($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/;
-    }
-}
-my $vips;
-
-sub process(*;@) {
-    my ($m,      %arg)    = @_;
-    my ($header, %header) = read_header($m);
-    my ($type, $boundary);
-
-    if (!$vips) {
-
-        open(my $fh, "<$CONFDIR/vips.conf")
-            or die "can't read $CONFDIR/vips.conf!\n";
-        $vips
-            = qr{@{[join "|", map { chomp; "(?:".quotemeta($_).")" } grep !/(?:^\s*#|^\s*$)/, <$fh>]}};
-
-        foreach my $h (qw(from to cc bcc return-path envelope-to)) {
-            if ($header{$h}) {
-                if ($header{$h} =~ /$vips/i) {
-                    print $header;
-                    local $/ = \10240;
-                    print while <$m>;
-                    return;
-                }
-            }
-        }
-    }
-
-    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)) {
-
-        #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($m, boundary => $boundary);
-        }
-        return;
-    }
-
-    #warn "removed: $type\n";
-
-    my ($eol) = ($header =~ /(\s*)$/);
-    $header =~ s/\s*$//;
-    $header =~ s/^/-- /gm;
-
-    print "Content-Type: text/plain$eol"
-        . "Content-Disposition: inline$eol"
-        . $eol
-        . "Content removed ("
-        . localtime() . ")$eol"
-        . $header
-        . $eol;
-
-    while (<$m>) {
-        if (/^--\Q$boundary\E/) {
-            print;
-            last;
-        }
-    }
-}
-
-{
-    my $re;
-
-    sub pass_mime($) {
-        my ($type) = @_;
-
-        if (!$re) {
-            open(my $fh, "<$CONFDIR/mimes.conf")
-                or die "can't read $CONFDIR/mimes.conf!\n";
-            $re
-                = qr{@{[join "|", map { chomp; "(?:".quotemeta($_).")" } grep !/(?:^\s*#|^\s*$)/, <$fh>]}};
-        }
-        return $type =~ /$re/i;
-    }
-}
-
-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 et: