scratch/sign
changeset 12 9f127fcfdf6d
parent 11 15a5ac599b95
child 14 4f50e6aa028b
child 15 7c3215a97e4b
--- 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
 
+___