It's more complicated than stripping the signature. Just deleting the signature block produces a malformed message - and one that a good MUA will flag since it says it's signed, but no signature block is present. A regex isn't the problem - I can easily write those. The problem is that signing an e-mail takes headers (e.g. content-*) from the main body of the message and pushes them into a message/signed part - with a new boundary. Then the signature block is added, and the headers for the message/signed part replace those in the main body. I think that in theory, one message can have multiple signatures. To undo this requires finding the message/signed part, extracting its headers, deleting its headers & boundaries, deleting the signature block(s), and putting the headers back into the main message. The Content-type ;protocol field contains the MIME type for the signature. And, it can be necessary to do this recursively, since a message can consist of multiple signed parts (e.g. when a message contains several signed attached e-mails. Note that one can have pgp-signed attachments to an S/MIME-signed message. And vice-versa.) gpg delsig probably does the right thing for one level of PGP(I'm not a PGP user) - thanks for that suggestion. But will it handle a mix of PGP and S/MIME? And attachments (without detaching them?) S/MIME has the same issue, but I haven't found a tool for that. Anyhow, while I appreciate the suggestion, it doesn't solve the generic problem.

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]