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