#!/usr/local/bin/perl

#Experimental Perl script to delete attachments in Mozilla mailboxes
#(mbox format, text files).
#
#This script "delete-attachment.pl" must be tested extensively with copies
#before using it with original mailboxes, or at least a backup copy should
#be made to avoid any risk of data loss, specially after modifications of
#any script.
#
#Anyway, in the initial testing stage, this script is quite safe because
#it does not try to modify the original mailbox. It only modifies a copy
#with name ending in "-test" that contains all the changes: deletion of
#attachment, and a note with some data replacing the attachment, as a
#reference in the message.
#
#This allows a comparison between, for instance, "Inbox" and "Inbox-test".
#The test files can be seen in Mozilla Mail when the program starts after
#the files have been created. Mozilla finds the new mailboxes if they are
#in the same folder of the originals.
#
#Of course, in this kind of testing, only the last attachment deletion is
#retained, given that the test file is rewritten every time.
#
#In Mozilla Mail, see also Menu View / Message Source, or Ctrl+U.

###################################################################
# For testing, please write the following 3 values between ' and '.
# After a possible integration in Mozilla, these can be passed automatically.
#
#1.- The script needs the mailbox path, including directories and file name. For example, '/test/Inbox'.

$mailbox_path_with_name = '';

#2.- Also the Message-ID value, WITHOUT "<" or ">". For example, '3E3037A1.3090503@host.com'.
#(See this with menu View / Message Source, or Ctrl+U).

$message_id = '';

#3.- And the exact file name of the attachment to delete. For example, 'file.ext'.

$attachment_name = '';

#The rest of the script doesn't need more data input.
###################################################################

#English version:
$note_character_set = "us-ascii";
$note_transfer_encoding = "7bit";
$deletion_note = "Deleted attachment";
$error_no_input = "Experimental Perl script to delete attachments in Mozilla mailboxes.\n\nPlease write the mailbox path, Message-ID and attachment name.\n(See instructions in the script).";
$error_old_mailbox = "Unable to open old mailbox. Reason:";
$error_new_mailbox = "Unable to open new mailbox. Make sure dir is chmod 777 temporarily. Reason:";

#First, let's see if we have the necessary data.

print "Content-type: text/plain\n\n";              #Necessary to display errors.

unless ($mailbox_path_with_name && $message_id && $attachment_name) {
  print " \n$error_no_input\n";
  exit;
}

#We open the old and new mailbox files. The old to read and the new (called "...-test") to write.

open (OLDMAILBOX, "<$mailbox_path_with_name") or print "$error_old_mailbox $!" and exit;
open (NEWMAILBOX, ">$mailbox_path_with_name-test") or print "$error_new_mailbox $!" and exit;

while (<OLDMAILBOX>) {                             #We read the mailbox text file, line by line.
  chomp;                                           #This removes the line ending.
  $line = $_;                                      #We get the current line.
  if ($line =~ /^\s+$/) {                          #If there are only spaces in the line, then...
    $line = "";                                    #We empty the line.
  }
  if ($line =~ /^From\s.+\s\D\D\D\s\D\D\D\s?\s\d?\d\s\d\d\:\d\d.*\s\d\d\d\d/) {
                                                   #If "From_ line" (mbox format) for start of message, then...
    $header = "yes";                               #This is the start of the header part.
    $body = "";                                    #This isn't the body.
    $this_is_the_message = "";                     #We don't know yet if this is the message with the attachment.
    $multipart_header = "";                        #This isn't the "multipart" header.
    $boundary = "";                                #Old boundary no more valid.
    $header_of_part = "";                          #Empty buffer for header of part.
    $this_is_the_attachment = "";                  #We are not in the attachment.
  }
  elsif ($header) {                                #If the line is in the header part, then...
    if ($line =~ /^Message-ID:\s*\Q<$message_id>\E/i) {  #If the Message-ID matches, then...
      $this_is_the_message = "yes";                #We are in the message that contains the attachment.
    }
    if ($line =~ /^Content-Type:\s*multipart/i) {  #If this the first line of a "multipart" header, then...
      $multipart_header = "yes";                   #This is a "multipart" header (one or two lines).
    }
    if ($multipart_header) {                       #If first or second line of "multipart" header, then...
      if ($line =~ /boundary\=\"(.+)\"/i) {        #If boundary, then...
        $boundary = $1;                            #We get the boundary from the "multipart" header.
        $multipart_header = "";                    #The "multipart" header ends.
      }
    }
    if (!$line) {                                  #If empty line, then...
      $header = "";                                #This is the end of the header part.
      $body = "yes";                               #The body begins.
    }
  }
  elsif ($this_is_the_message && $body) {          #If this is the message, and the line is in the body, then...
    if (($line =~ /--$boundary/)) {                #If boundary delimiter, then...
      $this_is_the_attachment = "";                #If it was the attachment, it ends here.
      if (($line !~ /--$boundary--/)) {            #If it's not the last boundary delimiter of the message, then...
        $header_of_part = "$line";                 #We store the line in a buffer.
      }
    }
    elsif ($header_of_part) {                      #If we are in the header of a part, then...
      $header_of_part .= "\n$line";                #We add the line to the buffer.
      if ($line =~ /Content-Type\:\s*(.+)\;/i) {   #If we are in the Content-Type header, then...
        $content_type = $1;                        #We get the Content-Type of the attachment.
      }
      if ($line =~ /\Qname="$attachment_name"\E/i) {  #If the name of the attachment matches, then...
        $this_is_the_attachment = "yes";           #We are in the header of the attachment.
      }
      if (!$line) {                                #The header of the part ends with an empty line; then...
        if ($this_is_the_attachment) {             #If this is the attachment, then...
          print NEWMAILBOX qq|--$boundary\n|;      #We write the new part for the deleted attachment.
          print NEWMAILBOX qq|Content-Type: text/html; charset="$note_character_set"\n|;
          print NEWMAILBOX qq|Content-transfer-encoding: $note_transfer_encoding\n\n|;
          print NEWMAILBOX qq|<html><body><center>\n|;
          print NEWMAILBOX qq|$deletion_note:<br>\n|;
          print NEWMAILBOX qq|$attachment_name<br>\n|;
          print NEWMAILBOX qq|($content_type)\n|;
          print NEWMAILBOX qq|</center></body></html>\n\n|;


##To replace the attachment, the following MIME types can be used instead of the note,
##when supported by Mozilla (message/external-body is standard, and x-deleted-attachment
##is a possible example of private header, allowed for internal use by MIME RFCs):
#          print NEWMAILBOX qq|--$boundary\n|;
#          print NEWMAILBOX qq|Content-Type: message/external-body; access-type=x-deleted-attachment\n|;
#          print NEWMAILBOX qq|Content-Type: $content_type; name="$attachment_name"\n\n|;


        }
        else {                                     #If this isn't the attachment, then...
          print NEWMAILBOX "$header_of_part";      #We write the original header of this part.
        }
        $header_of_part = "";                      #The empty line is the end of the header of the part.
      }
    }
  }
  unless ($this_is_the_attachment || $header_of_part) {  #If we are not in the attachment or using the buffer, then...
    print NEWMAILBOX "$line\n";                    #We write the line in the new mailbox.
  }
}

close OLDMAILBOX;                                  #And we close the old and new mailbox files.
close NEWMAILBOX;

#End of script.
