Commit initial
[perso/Immae/Projets/Scripts/Public.git] / 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