]>
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 | ||
2d8938f6 IB |
27 | # Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping |
28 | ||
29 | ||
5172ecf8 IB |
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 |