mtimeout.1: Use correct dash for number ranges.
[misc] / unfwd
CommitLineData
8d769cc9 1#! /usr/bin/perl
2
3use MIME::Parser;
4use MIME::Entity;
5use MIME::Head;
6use MIME::Body;
7
8sub bounce {
9 print STDERR "$0: ", @_, "\n";
10 exit 100;
11}
12
13sub retry {
14 print STDERR "$0: ", @_, "\n";
15 exit 111;
16}
17
18$DONE = 0;
19$FAIL = 0;
20
21sub fail {
22 print STDERR "$0: ", @_, "\n";
23 $FAIL = 100;
24}
25
26sub 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
47sub 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";
57my $pp = MIME::Parser->new();
58$pp->output_to_core(ALL);
59$pp->extract_nested_messages(0);
60my $top = $pp->parse(\*STDIN);
61if ($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}
72if (!$DONE) { bounce "no forwarded message or digest"; }
73exit $FAIL;