This seems to work for top-level signed messages.
It should be extendable to nested messages, but that's for another day.
I hope it helps someone else.
use warnings;
use strict;
use MIME::Parser;
my $par = MIME::Parser->new;
$par->output_to_core(1);
$par->tmp_to_core(1);
my $msg = eval { $par->parse( \*STDIN ) };
if( $msg ) {
$msg->make_multipart;
if( $msg->mime_type eq 'multipart/signed' ) {
my $sigtype = $msg->head->mime_attr('content-type.protocol');
foreach my $tag ( grep { /^Content-/i } $msg->head->tags ) {
$msg->head->delete( $tag );
}
$msg->parts( [ grep { $_->head->mime_attr('content-type') ne $
+sigtype } $msg->parts ] );
my $top = ($msg->parts)[0];
foreach my $tag ( grep { /^Content-/i } $top->head->tags ) {
$msg->head->add( $tag, $top->head->get( $tag, 0 ) );
$top->head->delete( $tag );
}
$msg->parts( [ $top->parts ] );
$msg->preamble( $top->preamble );
$msg->epilogue( $top->epilogue );
}
$msg->print;
} else {
print STDERR ( "Unable to parse message: " . ($@ || $par->last_err
+or) . "\n" );
exit 1;
}