#!/usr/bin/perl

#
# unbase64
#
# allyn fratkin <allyn@fratkin.com>
#
# DO NOT USE AS A FILTER!!
# USE ONLY AS INPUT TO BOGOFILTER WITHOUT -p OPTION!
#
# decodes base64 and quoted-printable text attachments
# deletes binary base64 attachments
# other minor preprocessing for bogofilter
# 
# decoding routines were "lifted" from dmmh script found on internet
# dmmh author is Per Hedeland <per@erix.ericsson.se>
#

$inbase64 = 0;
$inqp = 0;
$base64approaching = 0;
$qpapproaching = 0;
$textattachment = 0;

while (<>) {
	s/\r$//;	# bogofilter can't deal with \r correctly
	if (/^$/) {
		$inqp = $qpapproaching;
		$inbase64 = $base64approaching;
	}
	if (/^--[^>]/ || /^From /) {
		$inbase64 = 0;
		$inqp = 0;
		$base64approaching = 0;
		$qpapproaching = 0;
		$textattachment = 0;
	}
	if ($textattachment) {
		if ($inbase64) {
			print db64($_);
			next;
		}
		if ($inqp) {
			print dqp($_);
			next;
		}
	}
	next if ($inbase64);
	if (/^Content-Type.*text\//i) {
		$textattachment++;
	}
	if (/^Content-Transfer-Encoding.*base64/i) {
		$base64approaching++;
	}
	if (/^Content-Transfer-Encoding.*quoted-printable/i) {
		$qpapproaching++;
	}
	$_ =~ s/\0//g;	# bogofilter can't deal with \0 correctly
	print;
}

print "\n";

sub dqp {
    my $res = shift;

    $res =~ s/=\n//ms;          # = at end of line continues on next line
    #$res =~ s/_/=20/g;          # code hex 20 may be encoded as '_'
    $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
    $res =~ s/\0//g;	# bogofilter can't deal with \0 correctly
    $res;
}

sub db64 {
    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.001m

    my $str = shift;
    my $res = "";
   
    $str =~ tr|A-Za-z0-9+/||cd;             # remove non-base64 chars (padding)
    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
    while ($str =~ /(.{1,60})/gs) {
        my $len = chr(32 + length($1)*3/4); # compute length byte
        $res .= unpack("u", $len . $1 );    # uudecode
    }
    $res =~ s/\0//g;	# bogofilter can't deal with \0 correctly
    $res;
}

