tlhackque has asked for the wisdom of the Perl Monks concerning the following question:

There are Perl modules for signing & verifying S/MIME - signed (and PGP -signed) e-mail.

I have the inverse problem: A mailing list filter that wants to unwrap signed messages (that is, remove the multipart/signed wrapper & corresponding signature, but retain the rest of the MIME structure). Verification is optional.

This turns out to be involved because headers have to move between the main message body and the sub parts, and there can be signed parts of a multipart (e.g. multipart/mixed or multipart/digest) message.

Before I undertake the chore of figuring this out: Has anyone done this or know of an existing module (or command)? FWIW: The messages have already been parsed by MIME::Parser (from MIME::Tools), but while adding parts to MIME::Entities is documented/discoverable, unwrapping doesn't seem to have been contemplated...

In case you're wondering, besides being big, signatures are invalidated by the filter, which modifies the messages - it removes certain content in the text sections and may even add attachments.

Also: These are cryptographic signatures, not the "signature" referred to in MIME::Tools.

Thanks in advance for any hints/pointers/code

Replies are listed 'Best First'.
Re: Email: remove S/MIME or PGP signature?
by zentara (Cardinal) on Apr 08, 2017 at 19:31 UTC
    Hi, can't you just run gpg's delsig command on them? Also procmail can do it in it's processing. See filtering mail . Search that page for X-PGP, it shows how to strip it with sed. You could emulate that sed program with Perl. Maybe show a sample mail with sig, and someone can give you a good regex.
    I'm not really a human, but I play one on earth. ..... an animated JAPH
[reply]
      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.
[reply]
Email: remove S/MIME or PGP signature? (Partial solution)
by tlhackque (Beadle) on Apr 09, 2017 at 14:35 UTC
    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]
[reply]
[d/l]

Back to Seekers of Perl Wisdom