]>
Commit | Line | Data |
---|---|---|
5172ecf8 IB |
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 |