path: root/remove_attachements

#!/usr/bin/env perl
# Inspired by Aaron . Ciuffo (at gmail)

# The MIT License (MIT)
# 
# Copyright (c) 2011-2015 Ismaël Bouya http://www.normalesup.org/~bouya/
# 
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.


# Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping


use strict;

use Email::MIME;
use DateTime;
use Digest::MD5 qw(md5_hex);

use vars qw(
  $filter_attachments_file
  $email $email_parsed
  @email_parts
  @new_email_parts
  $mail_was_modified
  @removed_files
);

@removed_files = ();
@new_email_parts = ();
$mail_was_modified = 0;
my @mailr = ();
my $premiere = 1;
my $premiere_ligne;
foreach( <STDIN> ) {
    my $ligne = $_;
    if($ligne =~ m/^From/ && $premiere) {
	$premiere_ligne = $ligne;
	next;
    }
    $premiere = 0;
    if($ligne =~ m/^Content-Disposition: attachment; filename/) {
	my $fichier = $ligne;
	chomp($fichier);
	if($ligne =~ m/^Content-Disposition: attachment; filename\*/) {
	    $fichier =~ s/^.*filename\*.*''([^\s]*)\s?.*$/\1/;
	    $fichier =~ s/%2E/./g;
	    $fichier =~ s/%20/_/g;
	    $fichier =~ s/%//g;
	    $ligne =~ s/filename\*.*''([^ \n\r\t]*)/filename="$fichier"/;
	}
	else {
	    $fichier =~ s/^.*filename="?(.*[^"])"?.*$/\1/;
	    $fichier =~ s/ /_/g;
	    $fichier =~ s/[^-a-zA-Z0-9_.]/_/g;
	    $ligne =~ s/filename=.*$/filename="$fichier"/;
	}
    }
    push(@mailr,$ligne);
}
$email = join( '',@mailr );

$filter_attachments_file = $ENV{HOME}."/.attachements/".DateTime->now(time_zone => 'local')->strftime('%Y%m%d_%H%M%S')."_".substr(md5_hex($email),0,5)."/" ;

$email_parsed = Email::MIME->new( $email );
if($email_parsed->content_type =~m[^multipart/encrypted]) {
    print STDOUT $premiere_ligne;
    print STDOUT $email_parsed->as_string;
    exit;
}

my @parts = $email_parsed->parts;
my $extension = "text/";
$email_parsed->walk_parts(sub {
    my ($part) = @_;
    if ($part->content_type =~m[text/plain]i){
	$extension = "text/plain";
	return;
    }
});

sub parse_parts {
  my ($part) = @_;
  if($part->content_type =~ m[$extension]i or $part->content_type =~ m[application/pgp-signature]i or !$part->content_type) {
    push( @new_email_parts, $part);
  }
  elsif ($part->content_type =~ m[multipart/mixed]i) {
    foreach( $part->subparts ) {
      parse_parts($_);
    }
  }
  else {
	if(length($part->body) == 0) {
		return;
	}
	if(!$mail_was_modified) {
	    mkdir $filter_attachments_file;
	    $mail_was_modified = 1;
	    push( @removed_files, "keepdir://".$filter_attachments_file);
	}
	my $fichier = $part->filename(1);
	$fichier =~ s/ /\\ /g;
	push( @removed_files, "file://".$filter_attachments_file.$fichier." ".$part->content_type );
	open(my $out, '>:raw', $filter_attachments_file.$part->filename(1));
	print $out $part->body;
	close($out);
  }
}
foreach( $email_parsed->subparts ) {
  parse_parts($_);
}

if ($mail_was_modified)
{
   my $remove_string = "The following attachments were removed:";
   $remove_string = $remove_string."\n".$_ foreach (@removed_files);
   $remove_string = $email_parsed->debug_structure."\n".$remove_string;
   push (@new_email_parts, Email::MIME->create(
   attributes => {
       content_type => "text/plain",
       disposition => "attachment",
       charset => "US-ASCII",
       filename => "removed_attachments.txt"
	     },
	     body => $remove_string,
	 ) );
   $email_parsed->parts_set( \@new_email_parts );
   $email_parsed->content_type_set( 'multipart/mixed' );
   $email = $email_parsed->as_string;   

}

print STDOUT $premiere_ligne;
print STDOUT $email;