8d769cc9 |
1 | #! /usr/bin/perl |
2 | |
3 | use MIME::Parser; |
4 | use MIME::Entity; |
5 | use MIME::Head; |
6 | use MIME::Body; |
7 | |
8 | sub bounce { |
9 | print STDERR "$0: ", @_, "\n"; |
10 | exit 100; |
11 | } |
12 | |
13 | sub retry { |
14 | print STDERR "$0: ", @_, "\n"; |
15 | exit 111; |
16 | } |
17 | |
18 | $DONE = 0; |
19 | $FAIL = 0; |
20 | |
21 | sub fail { |
22 | print STDERR "$0: ", @_, "\n"; |
23 | $FAIL = 100; |
24 | } |
25 | |
26 | sub msg { |
27 | my ($body) = @_; |
28 | $DONE = 1; |
29 | pipe(IN, OUT); |
30 | my $kid = fork(); |
31 | defined($kid) or retry("couldn't fork: $!"); |
32 | if (!$kid) { |
33 | open(STDIN, "<&IN"); |
34 | close(OUT); |
35 | close(IN); |
36 | exec @ARGV; |
37 | print STDERR "$0: exec `", join(" ", @ARGV), "' failed: $!\n"; |
38 | exit 100; |
39 | } |
40 | close(IN); |
41 | $body->print(\*OUT) or fail "print failed: $!", last; |
42 | close(OUT) or fail "close failed: $!"; |
43 | waitpid($kid, 0) or fail "waitpid failed: $!"; |
44 | $? and fail "program `", join(" ", @ARGV), "' exited with status $?"; |
45 | } |
46 | |
47 | sub digest { |
48 | my ($e) = @_; |
49 | foreach my $i ($e->parts()) { |
50 | msg($i->bodyhandle()); |
51 | } |
52 | } |
53 | |
54 | $SIG{__DIE__} = sub { retry "DEAD: ", @_, "!" }; |
55 | $SIG{PIPE} = IGN; |
56 | @ARGV or retry "$0: no command given"; |
57 | my $pp = MIME::Parser->new(); |
58 | $pp->output_to_core(ALL); |
59 | $pp->extract_nested_messages(0); |
60 | my $top = $pp->parse(\*STDIN); |
61 | if ($top->effective_type =~ m'multipart/mixed'i) { |
62 | foreach my $i ($top->parts()) { |
63 | if ($i->effective_type =~ m'message/rfc822'i) { |
64 | msg($i->bodyhandle()); |
65 | } elsif ($i->effective_type =~ m'multipart/digest'i) { |
66 | digest($i); |
67 | } |
68 | } |
69 | } elsif ($top->effective_type =~ m'multipart/digest'i) { |
70 | digest($top); |
71 | } |
72 | if (!$DONE) { bounce "no forwarded message or digest"; } |
73 | exit $FAIL; |