1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use File::Temp;

     7 use Digest::MD5 qw(md5_hex);

     8 use GnuPG;

     9 use autodie qw(:all);

    10 

    11 use blib;

    12 use Message::2822;

    13 

    14 umask(077);

    15 my $dir = File::Temp->newdir();

    16 

    17 my $encrypted =

    18   Message::2822->new(file => shift // "ex/mails/signed-encrypted");

    19 

    20 # output the original message if not 'multipart/encrypted'

    21 my ($content_type) =

    22   ($encrypted->header_lines(qr/^content-type/i) =~ /\s+(\S+)/i);

    23 unless ($content_type =~ /multipart\/encrypted/i) {

    24     print $encrypted->header_lines, "\n";

    25     print $encrypted->orig_body;

    26     exit 0;

    27 }

    28 

    29 my $boundary = md5_hex(time);

    30 

    31 open(my $body, "+>$dir/body");

    32 print {$body} $encrypted->orig_body;

    33 seek($body, 0, 0);

    34 

    35 # ask GPG to decrypt it…

    36 my $gpg = new GnuPG(homedir => "ex/gpg");

    37 my $sign;

    38 eval {

    39     $sign =

    40       ($gpg->decrypt(ciphertext => "$dir/body", output => "$dir/message"));

    41 };

    42 if ($@) {

    43     $encrypted->add_header_line("\nX-GPGate-decrypted: not\n");

    44     print $encrypted->header_lines, "\n";

    45     print $encrypted->orig_body;

    46     exit 0;

    47 }

    48 

    49 # now remove the unwanted content- header lines and add new ones

    50 $encrypted->remove_header_lines(qr/^content-.*?:/im);

    51 

    52 $encrypted->add_header_line(

    53     "Content-Type: multipart/mixed; boundary=\"$boundary\"");

    54 $encrypted->add_header_line("Content-Disposition: inline\n");

    55 $encrypted->add_header_line("X-GPGate-Sign: good signature\n");

    56 $encrypted->add_header_line("X-GPGate-SignUser: $sign->{user}\n");

    57 $encrypted->add_header_line("X-GPGate-KeyId: $sign->{keyid}\n");

    58 $encrypted->add_header_line("X-GPGate-Decrypted: yes\n");

    59 print $encrypted->header_lines, "\n";

    60 

    61 open(my $message, "<$dir/message");

    62 say "--${boundary}";

    63 print <$message>;

    64 say "--${boundary}--";