#!/usr/bin/perl
=head1 README

extract-rfc822-attachment - extract a "mail/rfc822" attachment from a mail.

=head1 SYNOPSIS

	extract-rfc822-attachment < msg > newmsg

=head1 EXIT STATUS

Exit status will be 0 if there was an attachment and the attachment was
extracted successfully, 1 if there was no attachment found.  The remaining
non-zero exit statuses are reserved for other failure modes.

=head1 NOTE

Quoted-printable or base64-encoded attachments are not currently
supported.

=head1 VERSION

Feb 21 2003 jm

=cut

my $hdrs = '';
while (<STDIN>) {
  /^$/ and last;
  $hdrs .= $_;
}
$hdrs =~ s/\n[ \t]+/ /gs;

if ($hdrs !~ /^Content-Type: multipart\/mixed\;\s+boundary=\"(\S+)\"$/m) {
  exit 1;
}
my $tophdrs = $hdrs;
my $bound = $1;

##warn "found MIME boundary $bound\n";

while (1) {
  while (<STDIN>) {
    /^\Q--${bound}\E$/ and last;
  }
  exit 1 if eof(STDIN);

  my $hdrs = '';
  while (<STDIN>) {
    /^$/ and last;
    $hdrs .= $_;
  }
  $hdrs =~ s/\n[ \t]+/ /gs;

  if ($hdrs !~ /^Content-Type: message\/rfc822(?:\;|$)/m) {
    ##warn "skipped part: $hdrs\n";
    next;
  }

  ##warn "found message/rfc822 part: $hdrs\n";
  while (<STDIN>) {
    /^\Q--${bound}--\E$/ and exit 0;
    /^\Q--${bound}\E$/ and last;
    print;
  }
  exit 0;
}

exit 1;