1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use File::Temp;

     7 use GnuPG;

     8 use autodie qw(:all);

     9 

    10 use Digest::MD5 qw(md5_hex);

    11 

    12 use blib;

    13 use Message::2822;

    14 

    15 umask(077);

    16 my $boundary = md5_hex(time);

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

    18 

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

    20 

    21 # copy the changed body into a tmp file and copy there the

    22 # changed content-header lines

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

    24 

    25 open(my $header, "+>$dir/header");

    26 print {$header} $unsigned->header_lines(qr/^content-/i);

    27 seek($header, 0, 0);

    28 while (<$header>) {

    29     s/\r?\n/\r\n/g;

    30     print {$message} $_;

    31 }

    32 print {$message} "\r\n";

    33 

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

    35 print {$body} $unsigned->orig_body;

    36 seek($body, 0, 0);

    37 while (<$body>) {

    38     s/\r?\n/\r\n/g;

    39     print {$message} $_;

    40 }

    41 

    42 $message->flush();

    43 

    44 # ask GPG to sign it…

    45 open(my $sig, "+>$dir/signature.asc");

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

    47 seek($message, 0, 0);

    48 eval {

    49     $gpg->sign(

    50         plaintext     => $message,

    51         'detach-sign' => 1,

    52         armor         => 1,

    53         output        => $sig

    54     );

    55 };

    56 

    57 if ($@) {

    58     $unsigned->add_header_line("X-GPGate-signed: not\n");

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

    60     print $unsigned->orig_body;

    61     exit 0;

    62 }

    63 

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

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

    66 

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

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

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

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

    71 

    72 $unsigned->add_header_line("X-GPGate-signed: yes\n");

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

    74 

    75 seek($message, 0, 0);

    76 seek($sig,     0, 0);

    77 

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

    79   <$message>, "\n",

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

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

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

    83 Content-Description: Digital Signature

    84 Content-Disposition: inline

    85 

    86 ___