60 while (<$m>) { |
60 while (<$m>) { |
61 print; |
61 print; |
62 last if $arg{to} and /^--\Q$arg{to}\E/; |
62 last if $arg{to} and /^--\Q$arg{to}\E/; |
63 } |
63 } |
64 } |
64 } |
|
65 my $vips; |
65 |
66 |
66 sub process(*;@) { |
67 sub process(*;@) { |
67 my ($m, %arg) = @_; |
68 my ($m, %arg) = @_; |
68 my ($header, %header) = read_header($m); |
69 my ($header, %header) = read_header($m); |
69 my ($type, $boundary); |
70 my ($type, $boundary); |
|
71 |
|
72 if (!$vips) { |
|
73 |
|
74 open(my $fh, "<$CONFDIR/vips.conf") |
|
75 or die "can't read $CONFDIR/vips.conf!\n"; |
|
76 $vips = qr{@{[join "|", map { chomp; "(?:".quotemeta($_).")" } grep !/(?:^\s*#|^\s*$)/, <$fh>]}}; |
|
77 |
|
78 foreach my $h (qw(from to cc bcc)) { |
|
79 if ($header{$h}) { |
|
80 if ($header{$h} =~ /$vips/) { |
|
81 print $header; |
|
82 local $/ = \10240; |
|
83 print while <$m>; |
|
84 return; |
|
85 } |
|
86 } |
|
87 } |
|
88 } |
70 |
89 |
71 if ($header{"content-type"}) { |
90 if ($header{"content-type"}) { |
72 ($type) = ($header{"content-type"} =~ /^([^;]*)/); |
91 ($type) = ($header{"content-type"} =~ /^([^;]*)/); |
73 (undef, $boundary) |
92 (undef, $boundary) |
74 = ($header{"content-type"} =~ /boundary=(['"])(.*?)\1/); |
93 = ($header{"content-type"} =~ /boundary=(['"])(.*?)\1/); |
75 ### h{content-type}: $header{"content-type"} |
94 ### h{content-type}: $header{"content-type"} |
76 ### type: $type |
95 ### type: $type |
77 ### bound: $boundary |
96 ### bound: $boundary |
78 } |
97 } |
|
98 $boundary ||= $arg{boundary}; |
|
99 if (not $type or pass_mime($type)) { |
|
100 #warn "passing: " . ($type ? $type : "no mime type") . "\n"; |
|
101 print $header; |
|
102 print_message($m, to => $boundary); |
|
103 return; |
|
104 } |
|
105 if ($type =~ m{^multipart/}) { |
|
106 #warn "forward to next multipart boundary: $boundary\n"; |
|
107 print $header; |
|
108 print_message($m, to => $boundary); |
|
109 while (not eof($m)) { |
|
110 process($m, boundary => $boundary); |
|
111 } |
|
112 return; |
|
113 } |
79 |
114 |
80 $boundary ||= $arg{boundary}; |
115 #warn "removed: $type\n"; |
81 |
116 |
82 if (not $type or pass_mime($type)) { |
117 my ($eol) = ($header =~ /(\s*)$/); |
|
118 $header =~ s/\s*$//; |
|
119 $header =~ s/^/-- /gm; |
83 |
120 |
84 #warn "passing: " . ($type ? $type : "no mime type") . "\n"; |
121 print "Content-Type: text/plain" |
85 print $header; |
122 . $eol x 2 |
86 print_message($m, to => $boundary); |
123 . "Content removed (" |
87 return; |
124 . localtime() . ")$eol" |
88 } |
125 . $header |
|
126 . $eol; |
89 |
127 |
90 if ($type =~ m{^multipart/}) { |
128 while (<$m>) { |
91 |
129 if (/^--\Q$boundary\E/) { |
92 #warn "forward to next multipart boundary: $boundary\n"; |
130 print; |
93 print $header; |
131 last; |
94 print_message($m, to => $boundary); |
132 } |
95 |
133 } |
96 while (not eof($m)) { |
|
97 process($m, boundary => $boundary); |
|
98 } |
|
99 |
|
100 return; |
|
101 } |
|
102 |
|
103 #warn "removed: $type\n"; |
|
104 |
|
105 my ($eol) = ($header =~ /(\s*)$/); |
|
106 $header =~ s/\s*$//; |
|
107 $header =~ s/^/-- /gm; |
|
108 |
|
109 print "Content-Type: text/plain" |
|
110 . $eol x 2 |
|
111 . "Content removed (" |
|
112 . localtime() . ")$eol" |
|
113 . $header |
|
114 . $eol; |
|
115 |
|
116 while (<$m>) { |
|
117 if (/^--\Q$boundary\E/) { |
|
118 print; |
|
119 last; |
|
120 } |
|
121 } |
|
122 |
|
123 } |
134 } |
124 |
135 |
125 { |
136 { |
126 my $re; |
137 my $re; |
127 |
138 |