#!/usr/local/bin/perl -w
use strict;
use vars qw($mailbox_path_with_name $message_id $attachment_name);


#########################################################################
#
# Experimental Perl script to delete attachments in Mozilla mailboxes
# (mbox format, text files).
#
# Version 2 (January 26, 2003):
# Introducing full functionality (permanent attachment deletion).
#
# File name: delete-attachment.pl
#
#########################################################################
#
# Contents:
#
# 1. Notes
# 
# 2. Data input and use instructions
#
# 3. Optional command line arguments
#
# 4. Troubleshooting for the testing stage
#
# 5. Integration of a "delete attachment" function into Mozilla
#
# 6. Source code
#
#########################################################################
#
# 1. Notes
#
# The purpose of this Perl script is to facilitate an starting point for
# testing and a later development of possible Mozilla patches in C++ to
# fix the following bug or enhancement:
#
# Bug 2920 - Delete attachment from msg in folder
# http://bugzilla.mozilla.org/show_bug.cgi?id=2920
#
# This second version has advanced to delete attachments directly from
# the specified mailbox, instead of from a copy (the testing way of the
# first version).
#
# Therefore, the full functionality can be used now to delete any number
# of attachments, one by one, given that all deletions are permanent.
#
# But, as any script with testing purposes, this one also ahould be
# tested with copies and not with original data, or at least a backup
# copy should be made, specially after modifications of the script source
# code.
#
# The script has been revised for extra safety, even redundant, to
# carefully protect the mailbox data making sure that strictly only the
# specific attachment can be deleted, even in the cases of different or
# erroneous mbox formats.
#
# About the internal procedure, to delete an attachment in a mailbox
# called for example "Detach-test", the script copies the mailbox in a
# temporary file *-temp (called in this example Detach-test-temp) but
# replacing the MIME part of the specified attachment, with another MIME
# part that appears in the message window of Mozilla Mail as a short
# reference about the deleted attachment (name and file type).
#
# For instance:
#
# * Deleted attachment: one-megabyte-photo.jpg (image/jpeg)
#
# Then, only if the attachment is found and deleted correctly, the
# original mailbox is replaced by the new one, renaming to keep the
# previous name. If the attachment is not found or there was an error
# in the mailbox like bad MIME format for the attachment, in this case
# the original mailbox is preserved.
#
# If there are several copies of the attachment in the mailbox (this can
# happen if for instance messages are copied between folders, or if the
# folder is not compacted), in this case the attachment is deleted from
# all the copies of the same message in the specified mailbox. The script
# preserves the old mailbox until all the copies of the attachment are
# deleted correctly.
#
# This script delete attachments from any mailbox excepting the unsent
# messages in the Drafts folder, because there aren't Message-IDs in
# Drafts, and anyhow Mozilla Mail has already a procedure to delete
# attachments from Drafts.
#
# There is an additional discussion on this enhancement or bug fix at
# the Mozilla Mail newsgroup, with the thread subject "[Bug 2920]
# Discussion about deleting attachments".
#
# Newsgroup:
# news://news.mozilla.org/netscape.public.mozilla.mail-news
#
# Web archive:
# http://groups.google.com/groups?group=netscape.public.mozilla.mail-news
#
# This Perl script is open source, as a project to facilitate the
# development of a Mozilla C++ patch.
#
# (Versions 1 and 2 of this script, developed by Juan M. Gonzalez; other
# testers have helped with useful suggestions).
#
#########################################################################
#
# 2. Data input and use instructions
#
# To test attachment deletion, it is suggested to create in Mozilla Mail
# a new mailbox called for example "Detach-test" (with "New Folder...").
# Any messages with attachments to delete can be copied (rather than
# moved when testing) into this experimental folder.
#
# Before running this script, please write the following 3 details about
# mailbox, message, and attachment to be deleted between ' and '. After a
# possible integration in Mozilla, these data would pass automatically.
#
# - Mailbox:
#
# The script needs the mailbox path, including directories and file name.
# For example, $mailbox_path_with_name = '/Test/Detach-test', or in
# Windows 'C:\Test\Detach-test', or just 'Detach-test' if the script and
# the mailbox (Detach-test in this example) are in the same directory.

    $mailbox_path_with_name = 'Detach-test';

# - Message:
#
# Also the Message-ID value is needed, without "<" or ">". For example,
# $message_id = '3E3037A1.3090503@host.com'. (You can see this data in
# Mozilla Mail with the menu View / Message Source, or Ctrl+U).

    $message_id = '';

# - Attachment:
#
# And finally, the exact file name of the attachment to delete. For
# example, $attachment_name = 'one-megabyte-photo.jpg'. Spaces are
# allowed in the name of the attached file: 'one megabyte photo.jpg'.

    $attachment_name = '';

# That's all. No more data input is necessary. (There is optional
# language localization at the start of the source code).
#
# You can run the script from the command line with:
#
# perl delete-attachment.pl
#
# if for example you have this script in a text file with the name
# "delete-attachment.pl" in the current directory, and you have Perl
# installed in your system, and in the path.
#
# If you wish to run Perl scripts on almost any operating system (such
# as Windows, Mac, Unix, Linux, etc.), there is a long directory of
# different possibilities at:
#
# CPAN: Perl Ports (Binary Distributions)
# http://www.cpan.org/ports
#
#########################################################################
#
# 3. Optional command line arguments
#
# The data input may also be done with command line arguments, after
# perl delete-attachment.pl. Some possible examples (-ma, -me, -at):
#
# Mailbox path: -ma /Test/Detach-test
# Message ID: -me 3E3037A1.3090503@host.com
# Attachment: -at "one megabyte photo.jpg"
# 
# For the deletion reference note (-ch, -tr, -de), the defaults are:
#
# Character set: -ch us-ascii
# Transfer encoding: -tr 7bit
# Deletion note: -de "Deleted attachment"
#
# (Use "" to include spaces in command line arguments).
#
# The command line arguments supersede the values written in the script.
#
#########################################################################
#
# 4. Troubleshooting for the testing stage
#
# There is, under some circumstances, a display glitch just after the
# deletion of an attachment, until Mozilla can find again the messages
# in the suddenly smaller mailbox.
#
# This happens because this script is an external program, and it can be
# easily fixed with the possible integration of a "delete attachment"
# function into Mozilla's code.
#
# If this display problem happens during the testing stage, you can fix
# it by simply clicking on another mailbox, like Inbox, and then coming
# back to the test mailbox, where everything should be OK from now. There
# should be no need to restart the Mozilla program.
#
# The complete solution is probably to delete the "mail summary file"
# (*.msf) of the mailbox after every attachment deletion (procedure
# (used sometimes to force a reindex and solve different problems). See
# this option at the end of the script.
#
# Even deleting the *.msf files, labelling information is preserved in
# the message headers X-Mozilla-Status and X-Mozilla-Status2, in the
# mailbox main file.
#
# An external script like this one can delete or modify the *.msf files
# only when Mozilla is not using them. Differently to *.msf files, the
# mailboxes can be modified at any time, without "access denied" errors.
#
# It seems that the intended integration into Mozilla would be the best
# solution to fix this momentary display glitch.
#
#########################################################################
#
# 5. Integration of a "delete attachment" function into Mozilla
#
# Several possibilities:
#
# A) Translation of the Perl subroutine "sub delete_attachment" of this
# script into a C++ function, adjusting it to be used as a Mozilla patch.
# (For instance without the current test messages of the script like
# "attachment found", etc.). This translation into C++ would be an
# excellent solution at this stage.
#
# From this working point as a C++ patch, better integration into the
# Mozilla source code can be implemented gradually.
#
# B) Before the translation can be done, a temporary solution could be to
# embed the Perl subroutine into a C++ function, for example with the use
# of perl_call_argv or other perl_call_* functions, available in Perl for
# C and I think also for C++.
#
# Documents on this matter:
#
# perlembed - How to embed perl in your C program
# http://www.perl.com/doc/manual/html/pod/perlembed.html
#
# perlcall - Perl calling conventions from C
# http://www.perl.com/doc/manual/html/pod/perlcall.html
#
# C) An easy procedure is to convert the perl script to an *.exe file,
# and use it with command line arguments, maybe from Mozilla, with an
# utility like Perl2Exe. It converts for example this Perl script from
# "delete-attachment.pl" into "delete-attachment.exe", file executable
# without Perl installed. Perl is only required at the moment of the
# conversion into *.exe. (Perl2Exe and Perl itself, as IndigoPerl, are
# both available at http://www.indigostar.com).
#
# D) With this script working as a temporary solution, other ways can be
# researched for a greater integration of a "delete attachment" function
# into Mozilla, like adapting some of the Drafts procedures. This can
# take time (mimedrft.cpp has 2148 lines of code currently).
#
# E) Other promising possibility would be to look into the way that
# Mozilla uses already to keep the labelling information in message
# headers (X-Mozilla-Status, X-Mozilla-Status2), modifying the main file
# of the mailbox. In my opinion, probably the complete solution will be
# related to this mailbox modification already made by Mozilla, perhaps
# mixing it with the attachment deletion procedure of this script or
# using another more integrated way.
#
# Therefore, this script is just a temporary step towards a more complete
# and integrated solution to delete and/or file attachments.
#
#########################################################################
#
# 6. Source code
#
# (Any lines without # are part of the source code, above and below).
#

use vars qw($note_character_set $note_transfer_encoding $deletion_note $argument);

# Localization for the English version:

$note_character_set = "us-ascii";
$note_transfer_encoding = "7bit";
$deletion_note = "Deleted attachment";

# The data input may also be done with command line arguments. For instance:
# perl delete-attachment.pl -ma /Test/Detach-test -me 3E3037A1.3090503@host.com -at "one megabyte photo.jpg"

foreach $argument (1 .. $#ARGV) {
    if ($ARGV[$argument - 1] eq "-ma") {
        $mailbox_path_with_name = $ARGV[$argument];
    }
    elsif ($ARGV[$argument - 1] eq "-me") {
        $message_id = $ARGV[$argument];
    }
    elsif ($ARGV[$argument - 1] eq "-at") {
        $attachment_name = $ARGV[$argument];
    }
    elsif ($ARGV[$argument - 1] eq "-ch") {
        $note_character_set = $ARGV[$argument];
    }
    elsif ($ARGV[$argument - 1] eq "-tr") {
        $note_transfer_encoding = $ARGV[$argument];
    }
    elsif ($ARGV[$argument - 1] eq "-de") {
        $deletion_note = $ARGV[$argument];
    }
}

## Option to display errors when running through server/browser
## (unnecessary when running from the command line):
#
# print "Content-type: text/plain\n\n";

# We run the subroutine "delete_attachment", trap any fatal error, and finish the script:

eval { &delete_attachment($mailbox_path_with_name, $message_id, $attachment_name, $note_character_set, $note_transfer_encoding, $deletion_note); };
if ($@) { print "Error: $@\n"; }
exit;

# From here down to the end of the script, the subroutine "delete_attachment" that does everything:

sub delete_attachment {

    # Getting the data on mailbox, message and attachment:

    my ($mailbox_path_with_name, $message_id, $attachment_name, $note_character_set, $note_transfer_encoding, $deletion_note) = @_;

    # Some internal variables of the subroutine:

    my ($line, $header, $body, $this_is_the_message, $multipart_header, $boundary, $content_type);
    my $header_of_part = "";
    my $this_is_the_attachment = "";
    my $success = "";

    # The following screen messages are just for testing. Their
    # "print" commands would be deleted for integration into Mozilla.

    my $error_no_input = "Experimental Perl script to delete attachments in Mozilla mailboxes (version 2)\n\nPlease write the mailbox path, Message-ID and attachment name\n(See instructions in the script)\n\nInfo at: http://bugzilla.mozilla.org/show_bug.cgi?id=2920";
    my $error_old_mailbox = "Unable to open old mailbox. Reason:";
    my $error_new_mailbox = "Unable to open new mailbox. Make sure dir is chmod 777 temporarily. Reason:";

    my $text_message_found = "Message found";
    my $text_message_not_found = "Message not found";
    my $text_attachment_found = "Attachment found";
    my $text_attachment_not_found = "Attachment not found";
    my $text_attachment_deleted = "Attachment deleted";
    my $text_done = "Done";
    my $text_no_changes_in_mailbox = "No changes in mailbox";
    my $text_message_count_1 = "Same message found";
    my $text_message_count_2 = "times; you may compact the folder to save some space";

    # Three variables for screen messages (only for the testing stage):

    my $message_found = "";
    my $attachment_found = "";
    my $message_count = "0";

    # First, let's see if we have the necessary data.

    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 "...-temp") to write.
    # The screen messages are just for testing. Their "print" commands would be deleted for integration
    # into Mozilla.

    open (OLDMAILBOX, "<$mailbox_path_with_name") or print "$error_old_mailbox $!\n" and exit;
    open (NEWMAILBOX, ">$mailbox_path_with_name-temp") or print "$error_new_mailbox $!\n" 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.
        }

        # The following four lines for extra safety protect completely every message
        # from accidental deletion, even if the mailbox included any bad format errors
        # in previous messages or in the mbox "From_" line of start of this message.
        # These two variables should be already empty before this point.

        if ($line =~ /^From\s/) {
            $header_of_part = "";                           # Empty buffer for header of part. Line for extra safety.
            $this_is_the_attachment = "";                   # We are not in the attachment. Line for extra safety.
        }

        if ($line =~ /^From\s.+\s\D{3}\s\D{3}\s{1,2}\d{1,2}\s\d{2}\:\d{2}.*\s\d{4}/) {
                                                            # 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.
        }
        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.

                $message_found = "yes";                          # This is for screen test messages at the end.
                $message_count++;                                # Also for screen test messages at the end.
                print "$text_message_found\n";                   # Screen message, only for the testing stage.

            }
            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...
                if ($this_is_the_attachment) {              # If it was the attachment, then...
                    $this_is_the_attachment = "";           # The attachment ends here.
                    $success = "yes";                       # For success, the attachment must begin and end correctly.

                    print "$text_attachment_deleted\n";     # Screen message, only for the testing stage.

                }
                if (($line !~ /--$boundary--/)) {           # If it's not the last boundary delimiter, 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...

                    unless ($this_is_the_attachment) {      # Condition to avoid duplicate screen test messages.
                        $attachment_found = "yes";          # This is for screen test messages at the end.
                        print "$text_attachment_found\n";   # Screen message, only for the testing stage.
                    }

                    $this_is_the_attachment = "yes";        # We are in the header of the attachment.
                    $success = "";                          # No success until this attachment will end correctly.
                }
                if (!$line) {                               # The header of the part ends with an empty line; then...
                    if ($this_is_the_attachment) {          # If this is the attachment, then...

                        # We write the new part for the deleted attachment.
                        # (A character like * or a space should be added
                        # at start of line to avoid any possible fake mbox
                        # "From_" line of start of message in a localized
                        # deletion note).

                        print NEWMAILBOX qq|--$boundary\n|;
                        print NEWMAILBOX qq|Content-Type: text/plain; charset="$note_character_set"\n|;
                        print NEWMAILBOX qq|Content-transfer-encoding: $note_transfer_encoding\n\n|;
                        print NEWMAILBOX qq|\* $deletion_note:|;  # Character * for extra safety against fake From_ lines.
                        print NEWMAILBOX qq| $attachment_name|;
                        print NEWMAILBOX qq| ($content_type)| if $content_type;
                        print NEWMAILBOX qq|\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.
                    $content_type = "";
                }
            }
        }
        unless ($this_is_the_attachment || $header_of_part) {  # After examining each line, if we are not in the
                                                               # attachment to delete, or using the buffer, then...
            print NEWMAILBOX "$line\n";                        # We write the line in the new mailbox.
        }
    }
    close OLDMAILBOX;                                       # After the last line, we close the old and new mailbox files.
    close NEWMAILBOX;

    # For extra safety, only if the attachment was found and deleted, and it began and ended correctly,
    # in this case the original mailbox is replaced by the new one, renaming to keep the previous name.
    # If the attachment is not found or there was an error in the mailbox like bad MIME format for the
    # attachment, in this case the original mailbox is preserved. If there are several copies of the
    # same attachment, all must be correctly deleted.

    if ($success) {                                         # If there was success, then...
        unlink ("$mailbox_path_with_name");                 # The old mailbox is deleted.
        rename ("$mailbox_path_with_name-temp", "$mailbox_path_with_name");  # And the new mailbox replaces the old.

        ## Optional line for the probable solution to fix the momentary display glitch.
        ## An external script like this one can delete or modify the "mail summary files"
        ## (*.msf) only when Mozilla is not using them. Therefore, this optional line is
        ## more useful for a possible integration of this function into Mozilla.
        #
        # unlink ("$mailbox_path_with_name\.msf");          # The *.msf file of the mailbox is deleted to force a reindex.

        print "\n$text_done\n";                             # Screen message, only for the testing stage.

    }
    else {                                                  # If there was no success, then...
        unlink ("$mailbox_path_with_name-temp");            # The temporary file is deleted, and the old mailbox preserved.

        unless ($message_found) {
            print "$text_message_not_found\n"               # Screen message, only for the testing stage.
        }
        unless ($attachment_found) {
            print "\n" if $message_found;
            print "$text_attachment_not_found\n";           # Screen message, only for the testing stage.
        }
        print "\n$text_no_changes_in_mailbox\n";            # Screen message, only for the testing stage.

    }

    if ($message_count > 1) {                               # Screen message, only for the testing stage.
        print "\n$text_message_count_1 $message_count $text_message_count_2\n";
    }

}                                                           # End of the subroutine "delete_attachment".

# End of script.
