equal
deleted
inserted
replaced
58 sub print_message(*@) { |
58 sub print_message(*@) { |
59 my ($m, %arg) = @_; |
59 my ($m, %arg) = @_; |
60 |
60 |
61 while (<$m>) { |
61 while (<$m>) { |
62 print; |
62 print; |
63 last if $arg{to} and /$arg{to}/; |
63 last if $arg{to} and /^--\Q$arg{to}\E/; |
64 } |
64 } |
65 } |
65 } |
66 |
66 |
67 sub process(*;@) { |
67 sub process(*;@) { |
68 my ($m, %arg) = @_; |
68 my ($m, %arg) = @_; |
81 $boundary ||= $arg{boundary}; |
81 $boundary ||= $arg{boundary}; |
82 |
82 |
83 if (not $type or pass_mime($type)) { |
83 if (not $type or pass_mime($type)) { |
84 warn "passing: " . ($type ? $type : "no mime type") . "\n"; |
84 warn "passing: " . ($type ? $type : "no mime type") . "\n"; |
85 print $header; |
85 print $header; |
86 print_message($m, to => $boundary ? "^--$boundary" : undef); |
86 print_message($m, to => $boundary); |
87 return; |
87 return; |
88 } |
88 } |
89 |
89 |
90 if ($type =~ m{^multipart/}) { |
90 if ($type =~ m{^multipart/}) { |
91 warn "forward to next multipart boundary: $boundary\n"; |
91 warn "forward to next multipart boundary: $boundary\n"; |
92 print $header; |
92 print $header; |
93 print_message($m, to => "^--$boundary"); |
93 print_message($m, to => $boundary); |
94 |
94 |
95 while (not eof($m)) { |
95 while (not eof($m)) { |
96 process($m, boundary => $boundary); |
96 process($m, boundary => $boundary); |
97 } |
97 } |
98 |
98 |
109 . "Content removed (" . localtime() . ")$eol" |
109 . "Content removed (" . localtime() . ")$eol" |
110 . $header |
110 . $header |
111 . $eol; |
111 . $eol; |
112 |
112 |
113 while (<$m>) { |
113 while (<$m>) { |
114 if (/^--$boundary/) { |
114 if (/^--\Q$boundary\E/) { |
115 print; |
115 print; |
116 last; |
116 last; |
117 } |
117 } |
118 } |
118 } |
119 |
119 |