forward mail body part only

getbody

#!/usr/bin/perl

use Getopt::Long;

$TRUNCATE_AT = 32000;

$OMIT_RECEIVED = 1;
$OMIT_MESSAGE_ID = 0;
$OMIT_RESENT_ANY = 0;

@char64 = (
    -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1,
    -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1,
    -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,62, -1,-1,-1,63,
    52,53,54,55, 56,57,58,59, 60,61,-1,-1, -1,-1,-1,-1,
    -1, 0, 1, 2,  3, 4, 5, 6,  7, 8, 9,10, 11,12,13,14,
    15,16,17,18, 19,20,21,22, 23,24,25,-1, -1,-1,-1,-1,
    -1,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
    41,42,43,44, 45,46,47,48, 49,50,51,-1, -1,-1,-1,-1
);

sub decode_b($)
{
    my @char = split(//, shift);
    my $buf = "";

    while ($#char >= 0) {
        $c1 = shift(@char);
        $c2 = shift(@char);
        $c3 = shift(@char);
        $c4 = shift(@char);

        $c1 = $char64[ord($c1)];
        $c2 = $char64[ord($c2)];

        $ch = (($c1<<2) | (($c2&0x30)>>4));
        $buf .= sprintf('%c', $ch);
        if ($c3 ne "=") {
            $c3 = $char64[ord($c3)];
            $ch =  ((($c2&0x0f) << 4) | (($c3&0x3c) >> 2));
            $buf .= sprintf('%c', $ch);
            if ($c4 ne "=") {
                $c4 = $char64[ord($c4)];
                $ch = ((($c3&0x03) <<6) | $c4);
                $buf .= sprintf('%c', $ch);
            }
        }
    }
    return $buf;
}

sub decode_qp ($)
{
    my $res = shift;
    $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
    $res;
}

sub decode_mime($$)
{
    my $type = shift;
    my $encoded = shift;

    if ($type =~ /[Bb]/) {
        return decode_b($encoded);
    } elsif ($type =~ /[Qq]/) {
        return decode_qp($encoded);
    }
}

sub decode_header($)
{
    my $buf = "";
    my $post;
    foreach (split(/\s+/, shift)) {
        s/=\?ISO-2022-JP\?([BQ])\?([^?]*)\?=/decode_mime($1,$2)/ieg;
        $buf .= "$_ ";
    }
    $buf =~ s/\s+$//;
    return $buf;
}

sub process_header()
{
    my($OMIT) = 0;

    while(<STDIN>) {
        last if (/^$/);
        if (/^From /i) {
            $field = "UNIX From";
            $OMIT = 0;
        } elsif (/^(\S+): /) {
            $field = $1;
            $field =~ tr/a-z/A-Z/;

            if ($field eq "RECEIVED") {
                $OMIT = $OMIT_RECEIVED;
            } elsif ($field eq "MESSAGE-ID") {
                $OMIT =  $OMIT_MESSAGE_ID;
            } elsif ($field eq "FROM") {
                if ($REPLACE_FROM) {
                    $OMIT = 1;
                    $HEADER .= "$REPLACE_FROM\n";
                    $REPLACE_FROM = undef;
                } else {
                    $OMIT = 0;
                }
            } elsif ($field eq "SENDER") {
                if ($REPLACE_SENDER) {
                    $OMIT = 1;
                    $HEADER .= "$REPLACE_SENDER\n";
                    $REPLACE_SENDER = undef;
                } else {
                    $OMIT = 0;
                }
            } elsif ($field eq "ERRORS-TO") {
                if ($REPLACE_ERRORS_TO) {
                    $OMIT = 1;
                    $HEADER .= "$REPLACE_ERRORS_TO\n";
                    $REPLACE_ERRORS_TO = undef;
                } else {
                    $OMIT = 0;
                }
            } elsif ($field eq "CONTENT-TYPE") {
                $OMIT = 1;
            } elsif ($field =~ /^RESENT-/i) {
                $OMIT = $OMIT_RESENT_ANY;
            } elsif ($field eq "X-OPENMAIL-HOPS") {
                $CANDY_HACK = 1;
            } elsif ($field eq "X-MAILER" && /ccMail/) {
                $CCMAIL = 1;
            } else {
                $OMIT = 0;
            }
        }
        $HEADER{$field} .= $_;
        if (!$OMIT) {
            $HEADER .= "$_";
        }
    }

    if ($_ = $HEADER{"MIME-VERSION"}) {
        /^MIME-Version:\s+(\d[\d\.]+)/i;
        $MIME_VERSION = $1;
    }

    if ($_ = $HEADER{"CONTENT-TYPE"}) {
        if (/^Content-Type:\s+([^;\s]+)/i) {
            $MIME_TYPE = lc($1);
        }
        if (/boundary=\"([^\"]*)\"/i || /boundary=(\S+)/i) {
            $BOUNDARY = $1;
            $BOUNDARY_LEN = length($BOUNDARY) + 2;
        }
        $HEADER .= "Content-Type: text/plain\n";
    }
}

sub print_header()
{
    print $HEADER;
}

sub additional_header()
{
    print "$REPLACE_SENDER\n" if ($REPLACE_SENDER);
    print "$REPLACE_ERRORS_TO\n" if ($REPLACE_ERRORS_TO);
    print "\n";
}

sub print_plain($)
{
    my $boundary = shift;
    my $boundary_len = length($boundary) + 2;
    my @body;
    while (<STDIN>) {
        if (substr($_, 0, $boundary_len) eq "--$boundary") {
            last if (substr($_, $boundary_len) =~ /^(--|)$/);
        }
        if (defined($MOBILE_MAIL)) {
            s/^\s+// if ($CCMAIL);
            next if (/^[>|]/);
            next if (/^<\S+\@\S+>/);
            next if (/^\s+<\S+\@\S+>.*[:,]$/);
            next if (/\s+<\S+\@\S+>\s+\x1b\$[\@B]\$5\$s!\"\x1b\([BJ]$/);
            next if (/ writes:$/);
            next if (/ wrote:$/);
            next if (/^At .* wrote:$/);
            next if (/^On .* wrote:$/);
            next if (/^(On)?\s+\S{3}, \d{2} \S{3} \d{4} \d{2}:\d{2}:\d{2} (\(\?S{3}\)?|[-+]\d{4}),$/);
            next if (/^\S+\@\S+\s+\((.*)\)/);
            next if (/^(From|Subject|Date|Message-Id): /);
            s/([-#%]){10,}/$1/g;
            s/[ \t]+/ /g;
            s/^(\x1b\$B)(!!)+/$1/;

            if (/^$/) {
                next if ($BLANK_LINE);
                $BLANK_LINE = 1;
            } else {
                $_ =~ s/^\s+//;
                $BLANK_LINE = 0;
            }
        }
        $LENGTH += length($_);
        push(@body, $_) if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
    }
    if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT) {
        pop(@body) while ($body[-1] =~ /^\s+$/);
        my $line = $body[-1];
        my $n;
        for (my $i = 2; $i <= 16 && @body - $i >= 0; $i++) {
            $n = $i if ($body[-$i] eq $line);
        }
        if ($n) {
            splice(@body, -$n, $n);
        } else {
            for (my $i = 1; $i <= 16 && @body - $i >= 0; $i++) {
                if ($body[-$i] =~ /^-{2,} ?$/) {
                    splice(@body, -$i, $i);
                    last;
                }
            }
        }
    }
    print @body;
}

sub print_quoted($)
{
    my $boundary = shift;
    my $boundary_len = length($boundary) + 2;
    while (<STDIN>) {
        if (substr($_, 0, $boundary_len) eq "--$boundary") {
            return if (substr($_, $boundary_len) =~ /^(--|)$/);
        }
        s/=\n//;
        s/=([0-9A-Fa-f]{2})/pack("H2", $1)/ge;
        $LENGTH += length($_);
        print if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
    }
}

sub print_base64($)
{
    my $boundary = shift;
    my $boundary_len = length($boundary) + 2;
    my($buf, $ch);
    $buf = "";
    while (<STDIN>) {
        if (substr($_, 0, $boundary_len) eq "--$boundary") {
            return if (substr($_, $boundary_len) =~ /^(--|)$/);
        }
        chomp;
        @char = split(//, $_);
        while ($#char >= 0) {
            $c1 = shift(@char);
            $c2 = shift(@char);
            $c3 = shift(@char);
            $c4 = shift(@char);

            $c1 = $char64[ord($c1)];
            $c2 = $char64[ord($c2)];

            $ch = (($c1<<2) | (($c2&0x30)>>4));
            $buf .= sprintf('%c', $ch);
            if ($ch == 0x0a) {
                $LENGTH += length($buf);
                print $buf if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
                $buf = "";
            }
            if ($c3 ne "=") {
                $c3 = $char64[ord($c3)];
                $ch =  ((($c2&0x0f) << 4) | (($c3&0x3c) >> 2));
                $buf .= sprintf('%c', $ch);
                if ($ch == 0x0a) {
                    $LENGTH += length($buf);
                    print $buf if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
                    $buf = "";
                }
                if ($c4 ne "=") {
                    $c4 = $char64[ord($c4)];
                    $ch = ((($c3&0x03) <<6) | $c4);
                    $buf .= sprintf('%c', $ch);
                    if ($ch == 0x0a) {
                        $LENGTH += length($buf);
                        print $buf if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
                        $buf = "";
                    }
                }
            }
        }
    }
}

sub skip_part($)
{
    my $boundary = shift;
    my $boundary_len = length($boundary) + 2;
    while (<STDIN>) {
        if (substr($_, 0, $boundary_len) eq "--$boundary") {
            return if (substr($_, $boundary_len) =~ /^(--|)$/);
        }
    }
}

sub mime_part(@)
{
    my(%CONTENT_INFO) = ();
    my($field) = undef;
    my($CONTENT_TYPE) = undef;
    my $DISPOSITION;
    my $FILENAME;

    while (<STDIN>) {
        last if (/^$/);
        if (/^(\S+): /) {
            $field = $1;
            $field =~ tr/a-z/A-Z/;
        }
        $CONTENT_INFO{$field} .= $_;
    }

    if ($_ = $CONTENT_INFO{"CONTENT-TYPE"}) {
        if (/^Content-Type:\s+([^;\s]+)/i) {
            $CONTENT_TYPE = lc($1);
        }
    }
    if ($_ = $CONTENT_INFO{"CONTENT-DISPOSITION"}) {
        if (/^Content-Disposition:\s+([^;\s]+)/i) {
            $DISPOSITION = $1;
            ($FILENAME) = /filename="([^"]+)"/;
            $FILENAME = decode_header($FILENAME);
        }
    }
    if ($_ = $CONTENT_INFO{"CONTENT-TRANSFER-ENCODING"}) {
        if (/^Content-Transfer-Encoding:\s+(\S+)/i) {
            $ENCODING = $1;
        }
    }

    if ($CONTENT_TYPE =~ ?^text/plain?i) {
        if ($DISPOSITION =~ /^attachment$/i) {
            &part_skip(@_);
        } else {
            if ($ENCODING =~ /base64/i) {
                &print_base64(@_);
            } elsif ($ENCODING =~ /quoted-printable/i) {
                &print_quoted(@_);
            } else {
                &print_plain(@_);
            }
        }
    } elsif ($CONTENT_TYPE =~ m!(message/)?rfc822!i) {
        &rfc822($BOUNDARY);
    } else {
        #print "[$FILENAME]\n" if ($DISPOSITION =~ /^attachment$/i);
        &skip_part($BOUNDARY);
    }
}

sub rfc822($)
{
    my $boundary = shift;
    my $boundary_len = length($boundary) + 2;
    my %header;
    my $field = '-';
    my $mime_version;
    my $mime_type;

    while(<STDIN>) {
        last if (/^$/);
        if (/^(\S+): /) {
            $field = $1;
            $field =~ tr/a-z/A-Z/;
        }
        $header{$field} .= $_;
    }

    if ($_ = $header{"MIME-VERSION"}) {
        /^MIME-Version:\s+(\d[\d\.]+)/i;
        $mime_version = $1;
    }

    if ($_ = $header{"CONTENT-TYPE"}) {
        if (/^Content-Type:\s+([^;\s]+)/i) {
            $mime_type = lc($1);
        }
        if (/boundary=\"([^\"]*)\"/i || /boundary=(\S+)/i) {
            $boundary = $1;
            $boundary_len = length($boundary) + 2;
        }
    }
    my @context = ($MIME_TYPE, $BOUNDARY, $BOUNDARY_LEN);
    my %saved = %HEADER;

    ($MIME_TYPE, $BOUNDARY, $BOUNDARY_LEN) =
        ($mime_type, $boundary, $boundary_len);
    %HEADER = %header;
    $LENGTH += 18;
    print "[RFC822 INCLUDED]\n" if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
    &process_body;
    ($MIME_TYPE, $BOUNDARY, $BOUNDARY_LEN) = @context;
    %HEADER = %saved;
}

sub candy_part($)
{
    my($type) = shift;
    candy: {
        if ($type =~ /\.xls$/i) {
            while (<STDIN>) {
                return if (/^\.{71}$/);
                if (/^Item Subject: (.*)$/) {
                    $type = $1;
                    redo candy;
                }
            }
        } elsif ($type eq "TEXT ITEM") {
            while (<STDIN>) {
                return if (/^\.{71}$/);
                $_ =~ s/^\s+//;
                $LENGTH += length($_);
                print if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
            }
        } else {
            while (<STDIN>) {
                return if (/^\.{71}$/);
                if (/^Item Subject: (.*)$/) {
                    $type = $1;
                    redo candy;
                }
                $_ =~ s/^\s+//;
                $LENGTH += length($_);
                print if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
            }
        }
    }
}

sub uuencode_part($)
{
    my($type) = shift;
    if ($type eq "TEXT ITEM") {
    } else {
    }
    while (<STDIN>) {
        return if (/^end$/);
    }
}

sub multipart_mixed($)
{
    my $boundary = shift;
    my $boundary_len = length($boundary) + 2;
    for ($_ = <STDIN> ; $_ ; $_ = <STDIN>) {
        if ($_ eq "--$boundary\n") {
            &mime_part($boundary);
            redo;
        }
    }
}

sub multipart_alternative($)
{
    my $boundary = shift;
    my $boundary_len = length($boundary) + 2;
    for ($_ = <STDIN> ; $_ ; $_ = <STDIN>) {
        if ($_ eq "--$boundary\n") {
            &mime_part($boundary);
            redo;
        }
    }
}

sub multipart_related()
{
    my(%CONTENT_INFO) = ();
    my($field) = undef;
    my($CONTENT_TYPE) = undef;
    my($CONTENT_BOUNDARY) = undef;

    while (<STDIN>) {
        last if (/^$/);
        if (/^(\S+): /) {
            $field = $1;
            $field =~ tr/a-z/A-Z/;
        }
        $CONTENT_INFO{$field} .= $_;
    }

    if ($_ = $CONTENT_INFO{"CONTENT-TYPE"}) {
        if (/^Content-Type:\s+([^;\s]+)/i) {
            $CONTENT_TYPE = $1;
        }
        if (/boundary=\"([^\"]*)\"/i || /boundary=(\S+)/i) {
            $CONTENT_BOUNDARY = $1;
            $CONTENT_BOUNDARY_LEN = length($CONTENT_BOUNDARY) + 2;
        }
    }
    if ($_ = $CONTENT_INFO{"CONTENT-DISPOSITION"}) {
        if (/^Content-Disposition:\s+([^;\s]+)/i) {
            $DISPOSITION = $1;
        }
    }
    if ($_ = $CONTENT_INFO{"CONTENT-TRANSFER-ENCODING"}) {
        if (/^Content-Transfer-Encoding:\s+(\S+)/i) {
            $ENCODING = $1;
        }
    }

    for ($_ = <STDIN> ; $_ ; $_ = <STDIN>) {
        if ($_ eq "--$CONTENT_BOUNDARY\n") {
            &mime_part($CONTENT_BOUNDARY);
            redo;
        }
    }
}

sub singlepart($)
{
    my $boundary = shift;
    my $boundary_len = length($boundary) + 2;
    my @body;
    if ($_ = $HEADER{"CONTENT-TRANSFER-ENCODING"}) {
        /^Content-Transfer-Encoding:\s+(\S+)/;
        $ENCODING = $1;
        if ($ENCODING =~ /base64/i) {
            &print_base64($boundary);
        } elsif ($ENCODING =~ /quoted-printable/i) {
            &print_quoted($boundary);
        } else {
            &print_plain($boundary);
        }
    } else {
        while(<STDIN>) {
            if ($boundary && substr($_, 0, $boundary_len) eq "--$boundary") {
                last if (substr($_, $boundary_len) =~ /^(--|)$/);
            }
            if (/^begin \d\d\d /) {
                &uuencode_part();
                next;
            } elsif ($CANDY_HACK && /^Item Subject: (.*)$/) {
                &candy_part($1);
                next;
            }
            if (defined($MOBILE_MAIL)) {
                s/^\s+// if ($CCMAIL);
                next if (/^[>|]/);
                next if (/^<\S+\@\S+>/);
                next if (/^\s+<\S+\@\S+>.*[:,]$/);
                next if (/\s+<\S+\@\S+>\s+\x1b\$[\@B]\$5\$s!\"\x1b\([BJ]$/);
                next if (/ writes:$/);
                next if (/ wrote:$/);
                next if (/^At .* wrote:$/);
                next if (/^On .* wrote:$/);
                next if (/^(On)?\s+\S{3}, \d{2} \S{3} \d{4} \d{2}:\d{2}:\d{2} (\(\?S{3}\)?|[-+]\d{4}),$/);
                next if (/^\s+<\S+\@\S+>,$/);
                next if (/^\S+\@\S+\s+\((.*)\)/);
                next if (/^(From|Subject|Date|Message-Id): /);
                last if (/^-{2,}$/);
                s/([-#%]){10,}/$1/g;
                s/[ \t]+/ /g;
                if (/^$/) {
                    next if ($BLANK_LINE);
                    $BLANK_LINE = 1;
                } else {
                    $_ =~ s/^\s+//;
                    $BLANK_LINE = 0;
                }
            }
            $LENGTH += length($_);
            push(@body, $_) if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT);
        }
        if ($TRUNCATE_AT <= 0 || $LENGTH < $TRUNCATE_AT) {
            pop(@body) while ($body[-1] =~ /^\s+$/);
            my $line = $body[-1];
            my $n;
            for (my $i = 2; $i <= 16 && @body - $i >= 0; $i++) {
                $n = $i if ($body[-$i] eq $line);
            }
            if ($n) {
                splice(@body, -$n, $n);
            } else {
                for (my $i = 1; $i <= 16 && @body - $i >= 0; $i++) {
                    if ($body[-$i] =~ /^-{2,} ?$/) {
                        splice(@body, -$i, $i);
                        last;
                    }
                }
            }
        }
        print @body;
    }
}

sub process_body()
{
    if ($MIME_TYPE eq 'multipart/mixed') {
            &multipart_mixed($BOUNDARY);
    } elsif ($MIME_TYPE eq 'multipart/alternative') {
            &multipart_alternative($BOUNDARY);
    } elsif ($MIME_TYPE eq 'multipart/related') {
        for ($_ = <STDIN> ; $_ ; $_ = <STDIN>) {
            if ($_ eq "--$BOUNDARY\n") {
                &multipart_related();
                redo;
            }
        }
    } else {
        &singlepart($BOUNDARY);
    }
}

sub process_opts()
{
    %optctl = (
    );
    &GetOptions(
        "limit=i" => \$TRUNCATE_AT,
        "errors=s" => \$ERRORS_TO,
        "sender=s" => \$SENDER,
        "skywalker" => \$SKYWALKER,
        "ezweb" => \$EZWEB,
        "imode" => \$IMODE,
        "foma" => \$FOMA,
        "pmaildx" => \$PMAILDX
    );
    if ($SKYWALKER) {
        $MOBILE_MAIL = 1;
        $TRUNCATE_AT = 350;
        $SENDER = $MAIL_ADDR;
        $ERRORS_TO = $MAIL_ADDR;
    }
    if ($PMAILDX) {
        $MOBILE_MAIL = 1;
        $TRUNCATE_AT = 5000;
        $SENDER = $MAIL_ADDR;
        $ERRORS_TO = $MAIL_ADDR;
    }
    if ($IMODE) {
        $MOBILE_MAIL = 1;
        $TRUNCATE_AT = 4000;
        $SENDER = $MAIL_ADDR;
        $ERRORS_TO = $MAIL_ADDR;
        $REPLACE_FROM = "From: \$MAIL_ADDR";
    }
    if ($FOMA) {
        $MOBILE_MAIL = 1;
        $TRUNCATE_AT = 10000;
        $SENDER = $MAIL_ADDR;
        $ERRORS_TO = $MAIL_ADDR;
        $REPLACE_FROM = "From: \$MAIL_ADDR";
    }
    if ($EZWEB) {
        $MOBILE_MAIL = 1;
        $TRUNCATE_AT = 10000;
        $SENDER = $MAIL_ADDR;
        $ERRORS_TO = $MAIL_ADDR;
        $REPLACE_FROM = "From: \$MAIL_ADDR";
    }
    $REPLACE_SENDER = "Sender: $SENDER" if ($SENDER);
    $REPLACE_ERRORS_TO = "Errors-To: $ERRORS_TO" if ($ERRORS_TO);
}

sub main()
{
    &process_opts;
    $MAIL_ADDR = $ARGV[0] || $ENV{USER} || $ENV{LOGNAME};
    #$REPLACE_SENDER = "Sender: $ARGV[0]";
    #$REPLACE_ERRORS_TO = 'Errors-To: "$ARGV[0]";
    if ($REPLACE_FROM) {
        eval "\$REPLACE_FROM = \"$REPLACE_FROM\"";
    }
    &process_header;
    if (defined($HEADER{"CONTENT-DISPOSITION"})) {
        $_ = $HEADER{"CONTENT-DISPOSITION"};
        if (/^Content-Disposition:\s+([^;\s]+)/i) {
            $CONTENT_DISPOSITION = $1;
            exit 75 if ($CONTENT_DISPOSITION =~ /^attachment$/i);
        }
    }
    &print_header;
    &additional_header;
    if ($SKYWALKER || $IMODE) {
        $_ = $HEADER{"FROM"};
        if ($SKYWALKER) {
            s/\n/ /g;
            if (/From:\s+\S+\s+\((.*)\)/i) {
                $_ = $1;
            } elsif (/From:\s+(.*)\s+<\S+>/i) {
                $_ = $1;
            } else {
                /From:\s+(\S+)/i;
                $_ = $1;
                $_ =~ s/(\@[^.]*)\..*$/$1/;
            }
        }
        $_ = decode_header($_);
        $LENGTH += length($_);
        print "$_";
        if ($SKYWALKER) {
            if (defined($HEADER{"SUBJECT"})) {
                $_ = $HEADER{"SUBJECT"};
                s/\n/ /g;
                /^Subject:\s+(.*)$/i;
                $_ = "$1";
                $_ = decode_header($_);
                $LENGTH += length($_);
                print "/$_";
            }
        }
        print "\n";
    }
    $LENGTH = 0;
    &process_body;
}

&main;

exit(0);