#!/usr/bin/perl -w
# email MIME attach remover
# version 1.0 22/5/2002 under the latest GNU Public License 
# higuita@gmx.net
#

$version="1.0";
$release_date="22/05/2002";

#check for option and file names
&options;

foreach $files(@files) {
	print "Current file: $files\n\n";
	@boundary="";
	$level=0;
	
	#read the message file
	#for faster operation and we could the reading/parse/write
	#all at same time, but i think that isnt worth the trouble
	open (MAIL, "$files");
		@mail=<MAIL>;
	close MAIL;

	$line=0; #line counter
	#parse the email to find vital information
	foreach $mail(@mail) {
		#check for the MIME boundary
		&check_boundary;
		
		#found header size
		#the line check is because i found one email starting with a 
		#empty line (?!), so its better to check for it
		if ( $line != 0 &&  $mail =~ "^\n"  ){
			$header_size=$line;
			print " Header size: $header_size\n\n";
			last;
		}
		$line++;
	}

	# no boundary found, warn and skip to the next file
	if ( $boundary[0] eq "" ) {
		warn " * * * * * * * * * * * WARNING * * * * * * * * * * *\n";
		warn "  NO boundary found on $files\n";
		warn "  Maybe this isnt a MIME email!? (no attach, uuencode attach, etc)\n";
		warn "  Or maybe this is a BUG if there is really a MIME boundary (report it please)\n\n";
		print "Ignoring $files file... (no MIME?)\n\n";
		next;
	}

	#work on a temporary file, replace with the original on the end
	#we dont want to lose the email if the power goes down when the script is running
	open( MAIL , ">$files.tmp ") || die("ERROR - cant open tmpfile: $!");
	$line=0; #reseting line counter
	$saved=0; #saved lines counter
	$allow=1; # allow saving the email lines by defaullt until bad attach found
	foreach $mail(@mail) {
		#finding the new MIME level boundary 
		#this should be in the elsif after the header bypass, but i didnt manage
		#to put this function on the if statement... help wanted 8)
		unless ($level == $newlevel){
			print "searching new boundary...(level $level)\n";
			&check_boundary;
		}
		&search_boundary;
		#bypass headers of any check for faster running and save then 
		if ($line < $header_size) {
			continue:
		}
		# $ok=level of the MIME boundary found; $ok<0 if any found
		elsif ( $ok >= 0 ){
#		elsif ($mail =~ "$boundary[0]") {
			print " MIME Boundary (level $ok) found in the message body:";
			print "$mail";
			&check_type;
		}
		#saving all the line... with allow=1, ignoring it otherwise
		&save;
		$line++;
	}
	close MAIL;
	#move the tmp file over the original or use the --output ?!
}
exit;

# search and extract the MIME boundary for the current multipart MIME level
sub check_boundary{
	my @tmp;
	#init the boundary variable for the current level
	$boundary[$level]="" unless defined $boundary[$level];
	if ( $mail =~ "[Bb]oundary=" ) {
		$newlevel = $level; #reset the new level boundary search
		$boundary[$level] = $mail;
		$boundary[$level] =~ s/^.*boundary=//i;
		@tmp =  split(/\"/, $boundary[$level]);
		$boundary[$level] = $tmp[1];
		print " ***** Found boundary (level $level) *****\n$boundary[$level]\n";
	}
	#print "mail: $mail"; #debug
}

# search the $mail line for all the known MIME boundaries
sub search_boundary{
	my $lv=0;
	$ok=-1; #reset the "boundary found" var
	while ($lv <= $level ){
#print "-$lv-->$level\n"; #debug
		#check for the boundary if it exist for that level
		if ( $mail =~ "--$boundary[$lv]" && $boundary[$lv] ){
			$ok=$lv;
			$allow=1;
		}
		$lv++;
	}
	# print "$ok\n"; #debug
#	return sub { eval ( $ok ) };
}

# checks the type of MIME part after found a MIME boundary
sub check_type{
	my $tmp;
	print "checking type of attach\n";
#	print "teste-0:$mail[$line]"; #debug 
	print "teste-1:$mail[$line+1]"; #debug 
	$tmp = $mail[$line+1];
	if ( $tmp =~ /text\// ) {
		print "Ok, Text attach\n";
		#future, allow html on/off
		$allow=1;
	}
	elsif ( $tmp =~ /multipart\// ) {
		$level++;
		print "new MIME level found... level $level\n";
		&check_boundary;
	}
	else {
		$allow=0;
	}
}

# Saving the email to the temporary file
sub save{
	if ($allow == 1 ){
		print MAIL "$mail";
		print "SAVED:$mail"; #debug
		$saved++;
	}
}

sub options {
	$without_sig=0;
	$without_html=0;
	$strip_html=0;
	$without_octet=0;
	$strip_all=0;
	$debug=0;
		
	if (! defined($ARGV[0]) || $ARGV[0] =~ /^-[\w]*v|^-[\w]*h/ ) {
		&help;
	}
	elsif ( $ARGV[0] =~ /^-/){
		if    ($ARGV[0] =~ /s/)  { $without_sig=1;   }	# without pgp-sig
		elsif ($ARGV[0] =~ /w/)  { $without_html=1;  }	# without text/html if not unique
		elsif ($ARGV[0] =~ /W/)  { $strip_html=1;    }	# without text/html even if unique
		elsif ($ARGV[0] =~ /b/)  { $without_octet=1; }	# only strip application/octet-stream
		elsif ($ARGV[0] =~ /a/)  { $strip_all=1;     }	# strip all, keep only header if all message is in MIME 
		elsif ($ARGV[0] =~ /d/)  { $debug=1;         }	# turn debug on
		else                     { &help;            }
	}
exit;
	die "required filename missing\n" unless (defined($ARGV[0]));
	@files=@ARGV;
	print "\n Files to work on:\n @files\n\n";

}
sub help {
	print "\nrmattach $version $release_date\n\n";
	print "Removes MIME attachs from email messages stored in MH format\n";
	#print "with little changes this can work on mailbox format too\n";
	print "Build to work as one action plugin for sylpheed \n";
	print "(used in the claws version now, maybe later in time, in the main sylpheed too)\n\n";
	print "It deletes all but text attachs and pgp-signatures by default.\n\n";
	print "rmattach.pl [options] file(s)\n";
	print "Valid options:\n";
	print "\t -v\t show help and version\n";
	print "\t -h\t same as -v\n";
	print "\t -s\t delete pgp signatures\n";
	print "\t -w\t delete html attachs if there is at least one other text attach\n";
	print "\t -W\t delete ALL html attachs **WARNING** \n";
	print "\t\t  HTML only email will keep ONLY the header, you lose the email message)\n";
	print "\t -b\t deletes ONLY application/octet-stream MIME attachs\n";
	print "\t -a\t delete ALL attachs, keeps _ONLY_ the headers **WARNING**\n";
	print "\t -d\t verbose/debug flag\n";
	print "Use the Options as only one argument, like rmattach.pl -sw inbox/123,\n";
	print " using rmattach.pl -s -w inbox/123 will try to read a \"-w\" file\n\n";
}