#!/usr/local/bin/perl
#
# This program is copyright (c) 2003 by Daniel Born <dan@danborn.net>
# and is released under the GNU General Public License Version 2
# (http://www.fsf.org/copyleft/gpl.txt).  This program is free
# software; you can redistribute it and/or modify it under the terms
# of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any
# later version.  This program is distributed in the hope that it will
# be useful, but WITHOUT ANY WARRANTY; without even the implied
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
#
# Dan Born
# dan@danborn.net
# 29/April/2003
#

use strict;
use warnings;
use English;
use MIME::Base64;

my($save, $mdir);
while(@ARGV and $ARGV[0] =~ /^--/) {
    if($ARGV[0] =~ /^--save(=?)(.*)$/) {
        if($1 eq '=') {
            $save = $2;
        } else {
            $save = $ARGV[1];
            shift @ARGV;
        }
    } elsif($ARGV[0] eq '--mdir') {
        $mdir = 1;
    } elsif($ARGV[0] eq '--mbox') {
        $mdir = 0;
    } else {
        die "Bad option: $ARGV[0]\n";
    }
    shift @ARGV;
}

if(not defined($mdir)) {
    die "Must specify either --mdir or --mbox\n" .
        "Usage: delatt --mbox|--mdir [--save=<directory>] [<files>]\n";
}
my @filelist = @ARGV;

if($mdir) {
    # Input is maildir message files.
    if(@filelist) {
        scan_mdir($_, $save) foreach @filelist;
    } else {
        scan_mdir(undef, $save);
    }
} else {
    # Input is mbox folder files.
    if(@filelist) {
        scan_mbox($_, $save) foreach @filelist;
    } else {
        scan_mbox(undef, $save);
    }
}


##
# void scan_mdir($filename, $savedir)
#
sub scan_mdir {
    my($filename, $savedir) = @_;

    # Read in the message.
    my @file;
    if(defined $filename) {
        open FILE, "< $filename" or die "$filename: $!";
        @file = <FILE>;
        close FILE;
    } else {
        @file = <STDIN>;
    }
    chomp @file;
    # Strip attachments.
    scan_msg(\@file, $savedir);
    if(defined $filename) {
        open FILE, "> $filename" or die "$filename: $!";
        print FILE "$_\n" foreach @file;
        close FILE;
    } else {
        # Write output to stdout if message came from stdin.
        print "$_\n" foreach @file;
    }
}


##
# void scan_mbox($mbox, $savedir)
#
sub scan_mbox {
    my($mbox, $savedir) = @_;

    my($line, @msgs, $i, $blank, $mbox_fh);

    # Read in the mbox file.
    $i = -1;
    $blank = 1; # 1 if previous line was blank, 0 otherwise.
    if(defined $mbox) {
        open $mbox_fh, "< $mbox" or die "$mbox: $!";
    } else {
        $mbox_fh = \*STDIN;
    }
    while(defined($line = <$mbox_fh>)) {
        chomp $line;
        if($blank and $line =~ /^From\s+/i) {
            $i++;
            $blank = 0;
        } elsif($line =~ /^\s*$/) {
            $blank = 1;
        } else {
            $blank = 0;
        }
        if($i < 0) {
            # Badly formatted mbox folder.  Grrrrr....
            $i = 0;
        }
        push @{$msgs[$i]}, $line;
    }
    if(defined $mbox) {
        close $mbox_fh;
    }
    # Strip attachments.
    scan_msg($_, $savedir) foreach @msgs;

    if(defined $mbox) {
        open MBOX, "> $mbox" or die "$mbox: $!";
        foreach my $msg_ref (@msgs) {
            print MBOX "$_\n" foreach @$msg_ref;
        }
        close MBOX;
    } else {
        foreach my $msg_ref (@msgs) {
            print "$_\n" foreach @$msg_ref;
        }
    }
}


##
# $filename get_filename($line)
#
# Look for a MIME filename in $line, and return it if found.
# Return undef if a filename isn't found in $line.
#
sub get_filename {
    my($line) = @_;

    if($line =~ /filename=\"(.+?)\"/i or $line =~ /filename=(.+?)(\s|$)/i) {
        my $name = $1;
        # Can't allow slashes in file names.  Convert them to dashes.
        $name =~ s|/|-|g;
        return $name;
    } else {
        return undef;
    }
}


##
# void scan_msg($msg_ary, $savedir)
#
# Strip attachments from a message, and possibly save them
# to files.
#
# Parameters:
#     $msg_ary - Reference to an array that has each line of a message
#                as array elements.
#     $savedir - If undef, delete attachments.  Otherwise, $savedir
#                is a directory to save attachments.
#
sub scan_msg {
    my($msg_ary, $savedir) = @_;

    my($boundary, $i, $att, $att_start, $alt);
    $alt = 0;

    # Search main message headers.
    for($i = 0; $i < @$msg_ary; $i++) {
	last if $msg_ary->[$i] =~ /^\s*$/;
	if($msg_ary->[$i] =~ m/^Content-Type:\s*multipart\/(mixed|alternative);/i) {
	    my $post = $POSTMATCH;
	    if(lc($1) eq 'alternative') {
		$alt = 1;
	    }
	    my $bound = qr/boundary=\"(.+?)\"/i;
	    if(($post =~ $bound) or ($i + 1 < @$msg_ary and $msg_ary->[$i + 1] =~ $bound)) {
		$boundary = '--' . $1;
		last;
	    }
	}
    }
    return unless defined $boundary;

    # Search main message body.
    for($i++; $i < @$msg_ary; $i++) {
	if($msg_ary->[$i] eq $boundary) {
	    $att = 0;
	    $att_start = $i;
	    my($atthead_end, $attname);
	    my $crap = 0;
	    my $b64 = 0;
	    # Search headers for the current part.
	    while($msg_ary->[++$i] !~ /^\s*$/) {
		if($msg_ary->[$i] =~ /^Content-Type:\s*(\S+)/i) {
		    my $type = $1;
		    if($type !~ /text/i and $type !~ /message/i) {
			$att = 1;
		    } elsif($alt and $type =~ m{text/(html|enriched)}i) {
			$crap = 1;
			$att = 1;
		    }
		 } elsif($msg_ary->[$i] =~ /^Content-Disposition:/i) {   
		    my $post = $POSTMATCH;
		    if(defined($attname = get_filename($post)) or
                       ($i + 1 < @$msg_ary and
                        defined($attname = get_filename($msg_ary->[$i + 1]))))
                    {
			$att = 1;
		    }
		} elsif($msg_ary->[$i] =~ /^Content-Transfer-Encoding:\s*base64/i) {
		    $b64 = 1;
		    $att = 1;
		}
	    }
	    $atthead_end = $i;

	    # Read through the body of the part until we find the ending boundary.
            # If no ending boundary is found, then what we have is really an
            # improperly formatted MIME message, so don't try to strip any
            # attachments from it.
            while(++$i < @$msg_ary) {
                if($msg_ary->[$i] eq $boundary or
                   $msg_ary->[$i] eq ($boundary . '--'))
                {
                    last;
                }
            }

	    if($att and $i < @$msg_ary) {
		# Splice including starting boundary, but excluding ending boundary.
		my @attdata = splice @$msg_ary, $att_start, $i - $att_start;
		$i = $att_start - 1;
		if(defined $savedir and not $crap) {
		    unless(-d $savedir) {
			system 'mkdir', '-p', '-m', '0700', $savedir and die "mkdir $savedir: $!";
		    }
		    # Splice starting boundary and headers.
		    splice @attdata, 0, $atthead_end - $att_start + 1;
		    # Save the attachment to a seperate file.
		    unless(defined $attname) {
			my($year, $month, $day) = (localtime)[5, 4, 3];
			$year += 1900;
			$month++;
			foreach ($month, $day) {
			    if($_ < 10) {
				$_ = '0' . $_;
			    }
			}
			$attname = "attachment_$year-$month-$day";
		    }
		    my $attfile = "$savedir/$attname";
		    my $j = 1;
		    my $origfile = $attfile;
		    while(-e $attfile) {
			$attfile = $origfile . '.' . $j++;
		    }
		    open ATT, "> $attfile" or die "$attfile: $!";
		    if($b64) {
			print ATT decode_base64(join("\n", @attdata));
		    } else {
			print ATT "$_\n" foreach @attdata;
		    }
		    close ATT;
		}
	    } else {
		# Back up one to put $i before the ending boundary.
		# This boundary is also the start of the next part.
		$i--;
	    }
	}
    }
}
