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 use strict;
  28
  29 use Email::MIME;
  30 use DateTime;
  31 use Digest::MD5 qw(md5_hex);
  32
  33 use vars qw(
  34   $filter_attachments_file
  35   $email $email_parsed
  36   @email_parts
  37   @new_email_parts
  38   $mail_was_modified
  39   @removed_files
  40 );
  41
  42 @removed_files = ();
  43 @new_email_parts = ();
  44 $mail_was_modified = 0;
  45 my @mailr = ();
  46 my $premiere = 1;
  47 my $premiere_ligne;
  48 foreach( <STDIN> ) {
  49     my $ligne = $_;
  50     if($ligne =~ m/^From/ && $premiere) {
  51         $premiere_ligne = $ligne;
  52         next;
  53     }
  54     $premiere = 0;
  55     if($ligne =~ m/^Content-Disposition: attachment; filename/) {
  56         my $fichier = $ligne;
  57         chomp($fichier);
  58         if($ligne =~ m/^Content-Disposition: attachment; filename\*/) {
  59             $fichier =~ s/^.*filename\*.*''([^\s]*)\s?.*$/\1/;
  60             $fichier =~ s/%2E/./g;
  61             $fichier =~ s/%20/_/g;
  62             $fichier =~ s/%//g;
  63             $ligne =~ s/filename\*.*''([^ \n\r\t]*)/filename="$fichier"/;
  64         }
  65         else {
  66             $fichier =~ s/^.*filename="?(.*[^"])"?.*$/\1/;
  67             $fichier =~ s/ /_/g;
  68             $fichier =~ s/[^-a-zA-Z0-9_.]/_/g;
  69             $ligne =~ s/filename=.*$/filename="$fichier"/;
  70         }
  71     }
  72     push(@mailr,$ligne);
  73 }
  74 $email = join( '',@mailr );
  75
  76 $filter_attachments_file = $ENV{HOME}."/.attachements/".DateTime->now(time_zone => 'local')->strftime('%Y%m%d_%H%M%S')."_".substr(md5_hex($email),0,5)."/" ;
  77
  78 $email_parsed = Email::MIME->new( $email );
  79 if($email_parsed->content_type =~m[^multipart/encrypted]) {
  80     print STDOUT $premiere_ligne;
  81     print STDOUT $email_parsed->as_string;
  82     exit;
  83 }
  84
  85 my @parts = $email_parsed->parts;
  86 my $extension = "text/";
  87 $email_parsed->walk_parts(sub {
  88     my ($part) = @_;
  89     if ($part->content_type =~m[text/plain]i){
  90         $extension = "text/plain";
  91         return;
  92     }
  93 });
  94
  95 sub parse_parts {
  96   my ($part) = @_;
  97   if($part->content_type =~ m[$extension]i or $part->content_type =~ m[application/pgp-signature]i or !$part->content_type) {
  98     push( @new_email_parts, $part);
  99   }
 100   elsif ($part->content_type =~ m[multipart/mixed]i) {
 101     foreach( $part->subparts ) {
 102       parse_parts($_);
 103     }
 104   }
 105   else {
 106         if(length($part->body) == 0) {
 107                 return;
 108         }
 109         if(!$mail_was_modified) {
 110             mkdir $filter_attachments_file;
 111             $mail_was_modified = 1;
 112             push( @removed_files, "keepdir://".$filter_attachments_file);
 113         }
 114         my $fichier = $part->filename(1);
 115         $fichier =~ s/ /\\ /g;
 116         push( @removed_files, "file://".$filter_attachments_file.$fichier." ".$part->content_type );
 117         open(my $out, '>:raw', $filter_attachments_file.$part->filename(1));
 118         print $out $part->body;
 119         close($out);
 120   }
 121 }
 122 foreach( $email_parsed->subparts ) {
 123   parse_parts($_);
 124 }
 125
 126 if ($mail_was_modified)
 127 {
 128    my $remove_string = "The following attachments were removed:";
 129    $remove_string = $remove_string."\n".$_ foreach (@removed_files);
 130    $remove_string = $email_parsed->debug_structure."\n".$remove_string;
 131    push (@new_email_parts, Email::MIME->create(
 132    attributes => {
 133        content_type => "text/plain",
 134        disposition => "attachment",
 135        charset => "US-ASCII",
 136        filename => "removed_attachments.txt"
 137              },
 138              body => $remove_string,
 139          ) );
 140    $email_parsed->parts_set( \@new_email_parts );
 141    $email_parsed->content_type_set( 'multipart/mixed' );
 142    $email = $email_parsed->as_string;
 143
 144 }
 145
 146 print STDOUT $premiere_ligne;
 147 print STDOUT $email;
 148
 149