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;
}
[download]