4 |
4 |
5 use Fatal qw(:void select); |
5 use Fatal qw(:void select); |
6 use File::Temp qw(tempfile); |
6 use File::Temp qw(tempfile); |
7 use Smart::Comments; |
7 use Smart::Comments; |
8 |
8 |
|
9 sub print_message(*$); |
9 sub read_message(); |
10 sub read_message(); |
10 sub parse(*); |
|
11 sub pass_mime($); |
11 sub pass_mime($); |
12 sub forward_to_boundary($*); |
12 sub forward_to_boundary($*); |
13 sub read_header(*); |
13 sub read_header(*); |
14 sub process(*); |
14 sub process(*$); |
15 |
15 |
16 MAIN: { |
16 MAIN: { |
17 my $message = read_message(); |
17 my $message = read_message(); |
18 my $tmpout = tempfile(); |
18 my $tmpout = tempfile(); |
19 my $stdout = select $tmpout; |
19 my $stdout = select $tmpout; |
20 |
20 |
21 seek($message, 0, 0); |
21 seek($message, 0, 0); |
22 process($message); |
22 process($message, undef); |
23 |
23 |
24 # spit out everthing |
24 # spit out everthing |
25 select $stdout; |
25 select $stdout; |
26 seek($tmpout, 0, 0); |
26 seek($tmpout, 0, 0); |
27 |
27 |
31 print while <$tmpout>; |
31 print while <$tmpout>; |
32 print while <$message>; |
32 print while <$message>; |
33 } |
33 } |
34 } |
34 } |
35 |
35 |
36 sub process(*) { |
36 sub print_message(*$) { |
37 my $m = shift; |
37 my ($m, $b) = @_; |
38 my ($header, %header) = read_header($m); |
|
39 |
38 |
40 if ( !$header{"mime-version"} |
39 if (not defined $b) { |
41 or !$header{"content-type"}) |
40 return print while <$m>; |
|
41 } |
|
42 |
|
43 while (<$m>) { |
|
44 print; |
|
45 last if /^--$b--\s*/; |
|
46 } |
|
47 } |
|
48 |
|
49 sub process(*$) { |
|
50 my ($m, $boundary) = shift; |
|
51 my ($header, %header) = read_header($m); |
|
52 my $mime; |
|
53 |
|
54 if ( $header{"mime-version"} |
|
55 and $header{"content-type"}) |
42 { |
56 { |
|
57 ($mime, undef, $boundary) = ( |
|
58 $header{"content-type"} =~ /^(.*?); # mime type |
|
59 (?:.*(?:boundary=(['"])(.*?)\2))? # eventuell noch mehr |
|
60 /x |
|
61 ); |
|
62 } |
|
63 |
|
64 if (!$mime or pass_mime($mime)) { |
43 print $header; |
65 print $header; |
|
66 print_message($m, $boundary); |
44 return; |
67 return; |
45 } |
68 } |
46 |
69 |
47 if (my $boundary = pass_mime($header{"content-type"})) { |
|
48 warn "passing ", ($header{"content-type"} =~ /^(.*?);/)[0], "\n"; |
|
49 print $header; |
|
50 while (<$m>) { print; last if /^--\Q$boundary\E--\s*/ } |
|
51 } |
|
52 |
70 |
53 |
|
54 #my $boundary; |
|
55 #$boundary = $2 |
|
56 # if ($header{"content-type"} =~ m{boundary=(['"])(.*?)\1}); |
|
57 |
|
58 } |
|
59 |
|
60 sub forward_to_boundary($*) { |
|
61 my ($b, $fh) = @_; |
|
62 while (<$fh>) { |
|
63 print; |
|
64 return if /^--$b/; |
|
65 } |
|
66 } |
71 } |
67 |
72 |
68 sub pass_mime($) { |
73 sub pass_mime($) { |
69 return $_[0] =~ m{/signed}; |
74 return $_[0] =~ m{/signed}; |
70 } |
75 } |