]> git.immae.eu Git - perso/Immae/Projets/Scripts/Public.git/blame - remove_attachements
Fix some arguments in git backup
[perso/Immae/Projets/Scripts/Public.git] / remove_attachements
CommitLineData
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
30use strict;
31
32use Email::MIME;
33use DateTime;
34use Digest::MD5 qw(md5_hex);
35
36use 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;
48my @mailr = ();
49my $premiere = 1;
50my $premiere_ligne;
51foreach( <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 );
82if($email_parsed->content_type =~m[^multipart/encrypted]) {
83 print STDOUT $premiere_ligne;
84 print STDOUT $email_parsed->as_string;
85 exit;
86}
87
88my @parts = $email_parsed->parts;
89my $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
98sub 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}
125foreach( $email_parsed->subparts ) {
126 parse_parts($_);
127}
128
129if ($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
149print STDOUT $premiere_ligne;
150print STDOUT $email;
151
152