--- a/scratch/sign Thu Nov 10 16:18:38 2011 +0100
+++ b/scratch/sign Fri Nov 11 11:22:50 2011 +0100
@@ -3,19 +3,57 @@
use 5.010;
use strict;
use warnings;
+use File::Temp;
+use autodie qw(:all);
+
+use Digest::MD5 qw(md5_hex);
use blib;
use Message::2822;
-my $message = Message::2822->new(file => shift//"ex/mails/unsigned");
+umask(077);
+my $boundary = md5_hex(time);
+my $dir = File::Temp->newdir();
+
+my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned");
+
-say $message->header_content("received:");
-say $message->header_content("to:");
+# copy the body into a tmp file and copy there the content-
+# header lines
+open(my $message, "+>$dir/message");
+print {$message}
+ $unsigned->header_lines(qr/^content-/i), "\n",
+ $unsigned->orig_body;
+$message->flush();
+
+# 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");
-exit;
+
+# ask GPG to sign it…
+system("gpg",
+ "--rfc1991",
+ "--detach-sign",
+ "--homedir" => "ex/gpg",
+ "--armor" => "$dir/message");
+
+open(my $sig, "$dir/message.asc");
+
+print $unsigned->header_lines, "\n";
-say $message->orig_header();
-say $message->orig_body();
+seek($message, 0, 0);
-#say map { ">> '$_'\n" } $message->header_fields();
+print "--${boundary}\n",
+ <$message>, "\n",
+ "--${boundary}\n",
+ <<___, <$sig>, "\n--${boundary}--\n";
+Content-Type: application/pgp-signature; name="signature.asc"
+Content-Description: Digital Signature
+Content-Disposition: inline
+___