1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use File::Temp;

     7 use autodie qw(:all);

     8 

     9 use Digest::MD5 qw(md5_hex);

    10 

    11 use blib;

    12 use Message::2822;

    13 

    14 umask(077);

    15 my $boundary = md5_hex(time);

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

    17 

    18 my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned");

    19 

    20 die join " ", $unsigned->header_contents("Subject");

    21 

    22 # copy the body into a tmp file and copy there the content-

    23 # header lines

    24 open(my $message, "+>$dir/message");

    25 print {$message}

    26     $unsigned->header_lines("content-"), "\n",

    27     $unsigned->orig_body;

    28 $message->flush();

    29 

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

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

    32 

    33 $unsigned->add_header_line("Content-Type: "

    34     . "multipart/signed; micalg=pgp-sha1;\n"

    35     . "\tprotocol=\"application/pgp-signature\"; boundary=\"$boundary\"");

    36 $unsigned->add_header_line("Content-Disposition: inline");

    37 

    38 

    39 # ask GPG to sign it…

    40 system("gpg",

    41     "--detach-sign",

    42     "--homedir" => "ex/gpg",

    43     "--armor" => "$dir/message");

    44 

    45 open(my $sig, "$dir/message.asc");

    46 

    47 print $unsigned->header_lines, "\n";

    48 

    49 seek($message, 0, 0);

    50 

    51 print "--${boundary}\n",

    52       <$message>,

    53       "--${boundary}\n",

    54       <<___, <$sig>, "\n--${boundary}--\n";

    55 Content-Type: application/pgp-signature; name="signature.asc"

    56 Content-Description: Digital Signature

    57 Content-Disposition: inline

    58 

    59 ___