]>
git.immae.eu Git - perso/Immae/Projets/Scripts/Public.git/blob - remove_attachements
2 # Inspired by Aaron . Ciuffo (at gmail)
4 # The MIT License (MIT)
6 # Copyright (c) 2011-2015 Ismaƫl Bouya http://www.normalesup.org/~bouya/
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:
15 # The above copyright notice and this permission notice shall be included in
16 # all copies or substantial portions of the Software.
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
27 # Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping
34 use Digest
::MD5
qw(md5_hex);
37 $filter_attachments_file
46 @new_email_parts = ();
47 $mail_was_modified = 0;
53 if($ligne =~ m/^From/ && $premiere) {
54 $premiere_ligne = $ligne;
58 if($ligne =~ m/^Content-Disposition: attachment; filename/) {
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;
66 $ligne =~ s/filename\*.*''([^ \n\r\t]*)/filename="$fichier"/;
69 $fichier =~ s/^.*filename="?(.*[^"])"?.*$/\1/;
71 $fichier =~ s/[^-a-zA-Z0-9_.]/_/g;
72 $ligne =~ s/filename=.*$/filename="$fichier"/;
77 $email = join( '',@mailr );
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)."/" ;
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;
88 my @parts = $email_parsed->parts;
89 my $extension = "text/";
90 $email_parsed->walk_parts(sub {
92 if ($part->content_type =~m
[text
/plain
]i
){
93 $extension = "text/plain";
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);
103 elsif ($part->content_type =~ m
[multipart
/mixed
]i
) {
104 foreach( $part->subparts ) {
109 if(length($part->body) == 0) {
112 if(!$mail_was_modified) {
113 mkdir $filter_attachments_file;
114 $mail_was_modified = 1;
115 push( @removed_files, "keepdir://".$filter_attachments_file);
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;
125 foreach( $email_parsed->subparts ) {
129 if ($mail_was_modified)
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(
136 content_type
=> "text/plain",
137 disposition
=> "attachment",
138 charset
=> "US-ASCII",
139 filename
=> "removed_attachments.txt"
141 body
=> $remove_string,
143 $email_parsed->parts_set( \
@new_email_parts );
144 $email_parsed->content_type_set( 'multipart/mixed' );
145 $email = $email_parsed->as_string;
149 print STDOUT
$premiere_ligne;