--- a/scratch/sign Mon Dec 12 13:30:04 2011 +0100
+++ b/scratch/sign Wed Jan 04 09:21:35 2012 +0100
@@ -4,6 +4,7 @@
use strict;
use warnings;
use File::Temp;
+use GnuPG;
use autodie qw(:all);
use Digest::MD5 qw(md5_hex);
@@ -13,45 +14,71 @@
umask(077);
my $boundary = md5_hex(time);
-my $dir = File::Temp->newdir();
+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");
-my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned");
-
+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";
-# 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;
+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\"");
+ . "multipart/signed; micalg=pgp-sha1;\n"
+ . "\tprotocol=\"application/pgp-signature\"; boundary=\"$boundary\"");
$unsigned->add_header_line("Content-Disposition: inline");
-
-# ask GPG to sign it…
-system("gpg",
- "--rfc1991",
- "--detach-sign",
- "--homedir" => "ex/gpg",
- "--armor" => "$dir/message");
-
-open(my $sig, "$dir/message.asc");
-
+$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>, "\n--${boundary}--\n";
+ <$message>, "\n",
+ "--${boundary}\n",
+ <<___, <$sig>, "--${boundary}--\n";
Content-Type: application/pgp-signature; name="signature.asc"
Content-Description: Digital Signature
Content-Disposition: inline