remove_attachements

   1 #!/usr/bin/env perl
   2 # Inspired by Aaron . Ciuffo (at gmail)
   3
   4 # The MIT License (MIT)
   5 #
   6 # Copyright (c) 2011-2015 Ismaël Bouya http://www.normalesup.org/~bouya/
   7 #
   8 # Permission is hereby granted, free of charge, to any person obtaining a copy
   9 # of this software and associated documentation files (the "Software"), to deal
  10 # in the Software without restriction, including without limitation the rights
  11 # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  12 # copies of the Software, and to permit persons to whom the Software is
  13 # furnished to do so, subject to the following conditions:
  14 #
  15 # The above copyright notice and this permission notice shall be included in
  16 # all copies or substantial portions of the Software.
  17 #
  18 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  19 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  20 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  21 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  22 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  23 # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  24 # THE SOFTWARE.
  25
  26
  27 # Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping
  28
  29
  30 use strict;
  31
  32 use Email::MIME;
  33 use DateTime;
  34 use Digest::MD5 qw(md5_hex);
  35
  36 use vars qw(
  37   $filter_attachments_file
  38   $email $email_parsed
  39   @email_parts
  40   @new_email_parts
  41   $mail_was_modified
  42   @removed_files
  43 );
  44
  45 @removed_files = ();
  46 @new_email_parts = ();
  47 $mail_was_modified = 0;
  48 my @mailr = ();
  49 my $premiere = 1;
  50 my $premiere_ligne;
  51 foreach( <STDIN> ) {
  52     my $ligne = $_;
  53     if($ligne =~ m/^From/ && $premiere) {
  54         $premiere_ligne = $ligne;
  55         next;
  56     }
  57     $premiere = 0;
  58     if($ligne =~ m/^Content-Disposition: attachment; filename/) {
  59         my $fichier = $ligne;
  60         chomp($fichier);
  61         if($ligne =~ m/^Content-Disposition: attachment; filename\*/) {
  62             $fichier =~ s/^.*filename\*.*''([^\s]*)\s?.*$/\1/;
  63             $fichier =~ s/%2E/./g;
  64             $fichier =~ s/%20/_/g;
  65             $fichier =~ s/%//g;
  66             $ligne =~ s/filename\*.*''([^ \n\r\t]*)/filename="$fichier"/;
  67         }
  68         else {
  69             $fichier =~ s/^.*filename="?(.*[^"])"?.*$/\1/;
  70             $fichier =~ s/ /_/g;
  71             $fichier =~ s/[^-a-zA-Z0-9_.]/_/g;
  72             $ligne =~ s/filename=.*$/filename="$fichier"/;
  73         }
  74     }
  75     push(@mailr,$ligne);
  76 }
  77 $email = join( '',@mailr );
  78
  79 $filter_attachments_file = $ENV{HOME}."/.attachements/".DateTime->now(time_zone => 'local')->strftime('%Y%m%d_%H%M%S')."_".substr(md5_hex($email),0,5)."/" ;
  80
  81 $email_parsed = Email::MIME->new( $email );
  82 if($email_parsed->content_type =~m[^multipart/encrypted]) {
  83     print STDOUT $premiere_ligne;
  84     print STDOUT $email_parsed->as_string;
  85     exit;
  86 }
  87
  88 my @parts = $email_parsed->parts;
  89 my $extension = "text/";
  90 $email_parsed->walk_parts(sub {
  91     my ($part) = @_;
  92     if ($part->content_type =~m[text/plain]i){
  93         $extension = "text/plain";
  94         return;
  95     }
  96 });
  97
  98 sub parse_parts {
  99   my ($part) = @_;
 100   if($part->content_type =~ m[$extension]i or $part->content_type =~ m[application/pgp-signature]i or !$part->content_type) {
 101     push( @new_email_parts, $part);
 102   }
 103   elsif ($part->content_type =~ m[multipart/mixed]i) {
 104     foreach( $part->subparts ) {
 105       parse_parts($_);
 106     }
 107   }
 108   else {
 109         if(length($part->body) == 0) {
 110                 return;
 111         }
 112         if(!$mail_was_modified) {
 113             mkdir $filter_attachments_file;
 114             $mail_was_modified = 1;
 115             push( @removed_files, "keepdir://".$filter_attachments_file);
 116         }
 117         my $fichier = $part->filename(1);
 118         $fichier =~ s/ /\\ /g;
 119         push( @removed_files, "file://".$filter_attachments_file.$fichier." ".$part->content_type );
 120         open(my $out, '>:raw', $filter_attachments_file.$part->filename(1));
 121         print $out $part->body;
 122         close($out);
 123   }
 124 }
 125 foreach( $email_parsed->subparts ) {
 126   parse_parts($_);
 127 }
 128
 129 if ($mail_was_modified)
 130 {
 131    my $remove_string = "The following attachments were removed:";
 132    $remove_string = $remove_string."\n".$_ foreach (@removed_files);
 133    $remove_string = $email_parsed->debug_structure."\n".$remove_string;
 134    push (@new_email_parts, Email::MIME->create(
 135    attributes => {
 136        content_type => "text/plain",
 137        disposition => "attachment",
 138        charset => "US-ASCII",
 139        filename => "removed_attachments.txt"
 140              },
 141              body => $remove_string,
 142          ) );
 143    $email_parsed->parts_set( \@new_email_parts );
 144    $email_parsed->content_type_set( 'multipart/mixed' );
 145    $email = $email_parsed->as_string;
 146
 147 }
 148
 149 print STDOUT $premiere_ligne;
 150 print STDOUT $email;
 151
 152