#! /usr/bin/perl

use 5.010;
use strict;
use warnings;
use File::Temp;
use GnuPG;
use autodie qw(:all);

use Digest::MD5 qw(md5_hex);

use blib;
use Message::2822;

umask(077);
my $boundary = md5_hex(time);
my $dir      = File::Temp->newdir();

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

# copy the changed body into a tmp file and copy there the
# changed content-header lines
open(my $message, "+>$dir/message");

open(my $header, "+>$dir/header");
print {$header} $unsigned->header_lines(qr/^content-/i);
seek($header, 0, 0);
while (<$header>) {
    s/\r?\n/\r\n/g;
    print {$message} $_;
}
print {$message} "\r\n";

open(my $body, "+>$dir/body");
print {$body} $unsigned->orig_body;
seek($body, 0, 0);
while (<$body>) {
    s/\r?\n/\r\n/g;
    print {$message} $_;
}

$message->flush();

# ask GPG to sign it…
open(my $sig, "+>$dir/signature.asc");
my $gpg = new GnuPG(homedir => "ex/gpg");
seek($message, 0, 0);
eval {
    $gpg->sign(
        plaintext     => $message,
        'detach-sign' => 1,
        armor         => 1,
        output        => $sig
    );
};

if ($@) {
    $unsigned->add_header_line("X-GPGate-signed: not\n");
    print $unsigned->header_lines, "\n";
    print $unsigned->orig_body;
    exit 0;
}

# now remove the unwanted content- header lines and add new ones
$unsigned->remove_header_lines(qr/^content-.*?:/im);

$unsigned->add_header_line("Content-Type: "
      . "multipart/signed; micalg=pgp-sha1;\n"
      . "\tprotocol=\"application/pgp-signature\"; boundary=\"$boundary\"");
$unsigned->add_header_line("Content-Disposition: inline");

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

seek($message, 0, 0);
seek($sig,     0, 0);

print "--${boundary}\n",
  <$message>, "\n",
  "--${boundary}\n",
  <<___, <$sig>, "--${boundary}--\n";
Content-Type: application/pgp-signature; name="signature.asc"
Content-Description: Digital Signature
Content-Disposition: inline

___
