1 #! /usr/bin/perl |
1 #! /usr/bin/perl |
|
2 |
2 use strict; |
3 use strict; |
3 use warnings; |
4 use warnings; |
4 |
5 |
5 use Fatal qw(:void select); |
6 use Fatal qw(:void select); |
6 use File::Temp qw(tempfile); |
7 use File::Temp qw(tempfile); |
7 use Smart::Comments; |
8 use if $ENV{DEBUG} => "Smart::Comments"; |
8 |
9 |
9 sub print_message(*$); |
10 sub print_message(*$); |
10 sub read_message(); |
11 sub read_message(); |
11 sub pass_mime($); |
12 sub pass_mime($); |
12 sub forward_to_boundary($*); |
13 sub forward_to_boundary($*); |
13 sub read_header(*); |
14 sub read_header(*$); |
14 sub process(*$); |
15 sub process(*$$); |
15 |
16 |
16 MAIN: { |
17 MAIN: { |
17 my $message = read_message(); |
18 my $message = read_message(); |
18 my $tmpout = tempfile(); |
19 my $tmpout = tempfile(); |
19 my $stdout = select $tmpout; |
20 my $stdout = select $tmpout; # print ab jetzt ins tmpout |
20 |
21 |
21 seek($message, 0, 0); |
22 seek($message, 0, 0); |
22 process($message, undef); |
23 process($message, undef, undef); |
23 |
24 |
24 # spit out everthing |
25 # spit out everthing |
25 select $stdout; |
26 select $stdout; |
26 seek($tmpout, 0, 0); |
27 seek($tmpout, 0, 0); |
27 |
28 |
28 { # the tmpout may contain only parts of the message |
29 # now output the stuff collected in tmpout |
29 # to avoid unnessesary copy actioins |
30 # and the rest of the message |
|
31 { |
30 local $/ = \10240; |
32 local $/ = \10240; |
31 print while <$tmpout>; |
33 print while <$tmpout>; |
32 print while <$message>; |
34 print while <$message>; |
33 } |
35 } |
|
36 |
|
37 exit 0; |
34 } |
38 } |
35 |
39 |
36 sub print_message(*$) { |
40 sub print_message(*$) { |
37 my ($m, $b) = @_; |
41 my ($m, $b) = @_; |
38 |
42 |
44 print; |
48 print; |
45 last if /^--$b--\s*/; |
49 last if /^--$b--\s*/; |
46 } |
50 } |
47 } |
51 } |
48 |
52 |
49 sub process(*$) { |
53 sub process(*$$) { |
50 my ($m, $boundary) = shift; |
54 my ($m, $boundary, $mime_version) = @_; |
51 my ($header, %header) = read_header($m); |
55 my ($header, %header) = read_header($m, $boundary); |
52 my $mime; |
56 my $mime_type; |
53 |
57 |
54 if ( $header{"mime-version"} |
58 $mime_version ||= $header{"mime-version"}; |
|
59 |
|
60 ### $header |
|
61 |
|
62 if ( $mime_version |
55 and $header{"content-type"}) |
63 and $header{"content-type"}) |
56 { |
64 { |
57 ($mime, undef, $boundary) = ( |
65 ($mime_type, undef, $boundary) = ( |
58 $header{"content-type"} =~ /^(.*?); # mime type |
66 $header{"content-type"} =~ /^(.*?); # mime type |
59 (?:.*(?:boundary=(['"])(.*?)\2))? # eventuell noch mehr |
67 (?:.*(?:boundary=(['"])(.*?)\2))? # eventuell noch mehr |
60 /x |
68 /x |
61 ); |
69 ); |
62 } |
70 } |
63 |
71 |
64 if (!$mime or pass_mime($mime)) { |
72 if (not $mime_type or pass_mime($mime_type)) { |
|
73 warn "passing: " . ($mime_type ? $mime_type : "no mime_type") . "\n"; |
65 print $header; |
74 print $header; |
66 print_message($m, $boundary); |
75 print_message($m, $boundary); |
67 return; |
76 return; |
68 } |
77 } |
|
78 else { |
|
79 warn "not just passing: $mime_type\n"; |
|
80 } |
69 |
81 |
|
82 process($m, $boundary, $mime_version); |
70 |
83 |
71 } |
84 } |
72 |
85 |
73 sub pass_mime($) { |
86 sub pass_mime($) { |
74 return $_[0] =~ m{/signed}; |
87 return $_[0] =~ m{/signed}; |
84 return $tmp; |
97 return $tmp; |
85 } |
98 } |
86 |
99 |
87 # in: current message file handle |
100 # in: current message file handle |
88 # out: ($orignal_header, %parsed_header) |
101 # out: ($orignal_header, %parsed_header) |
89 sub read_header(*) { |
102 sub read_header(*$) { |
90 my $msg = shift; |
103 my ($msg, $start) = @_; |
91 my ($from, $h); |
104 my $h = ""; |
92 |
105 |
93 local $_ = <$msg>; |
106 if (defined $start) { |
94 $from = /^from\s/i ? $_ : ""; |
107 while (<$msg>) { |
|
108 $h .= $_; |
|
109 last if /^--$start\s*$/; |
|
110 } |
|
111 } |
95 |
112 |
96 while (<$msg>) { $h .= $_; last if /^\s*$/ } |
113 while (<$msg>) { |
97 $_ = $h; |
114 $h .= $_; |
|
115 last if /^\s*$/; |
|
116 } |
|
117 |
|
118 $_ = $h; # unmodified header (excl. $from) |
98 |
119 |
99 s/\r?\n\s+(?=\S)/ /gm; # continuation lines |
120 s/\r?\n\s+(?=\S)/ /gm; # continuation lines |
100 s/^(\S+):/\L$1:/gm; # header fields to lower case |
121 s/^(\S+):/\L$1:/gm; # header fields to lower case |
101 |
122 |
102 return ("$from$h", ":unix_from:" => split(/^(\S+):\s*/m, "$from$_")); |
123 return ($h, ":unix_from:" => split(/^(\S+):\s*/m, $_)); |
103 } |
124 } |
104 __END__ |
125 __END__ |