#! /usr/bin/perl

use MIME::Parser;
use MIME::Entity;
use MIME::Head;
use MIME::Body;

sub bounce {
  print STDERR "$0: ", @_, "\n";
  exit 100;
}

sub retry {
  print STDERR "$0: ", @_, "\n";
  exit 111;
}

$DONE = 0;
$FAIL = 0;

sub fail {
  print STDERR "$0: ", @_, "\n";
  $FAIL = 100;
}

sub msg {
  my ($body) = @_;
  $DONE = 1;
  pipe(IN, OUT);
  my $kid = fork();
  defined($kid) or retry("couldn't fork: $!");
  if (!$kid) {
    open(STDIN, "<&IN");
    close(OUT);
    close(IN);
    exec @ARGV;
    print STDERR "$0: exec `", join(" ", @ARGV), "' failed: $!\n";
    exit 100;
  }
  close(IN);
  $body->print(\*OUT) or fail "print failed: $!", last;
  close(OUT) or fail "close failed: $!";
  waitpid($kid, 0) or fail "waitpid failed: $!";
  $? and fail "program `", join(" ", @ARGV), "' exited with status $?";
}

sub digest {
  my ($e) = @_;
  foreach my $i ($e->parts()) {
    msg($i->bodyhandle());
  }
}

$SIG{__DIE__} = sub { retry "DEAD: ", @_, "!" };
$SIG{PIPE} = IGN;
@ARGV or retry "$0: no command given";
my $pp = MIME::Parser->new();
$pp->output_to_core(ALL);
$pp->extract_nested_messages(0);
my $top = $pp->parse(\*STDIN);
if ($top->effective_type =~ m'multipart/mixed'i) {
  foreach my $i ($top->parts()) {
    if ($i->effective_type =~ m'message/rfc822'i) {
      msg($i->bodyhandle());
    } elsif ($i->effective_type =~ m'multipart/digest'i) {
      digest($i);
    }
  }
} elsif ($top->effective_type =~ m'multipart/digest'i) {
  digest($top);
}
if (!$DONE) { bounce "no forwarded message or digest"; }
exit $FAIL;