# HG changeset patch
# User Christian Arnold <arnold@schlittermann.de>
# Date 1325665295 -3600
# Node ID 4f50e6aa028b0d7f3bd9cd128f74830951078a61
# Parent  236696558ccbd2fb100e6cd984f94d57ee2490d2
sign should work now, added verify and decrypt scripts

diff -r 236696558ccb -r 4f50e6aa028b scratch/decrypt
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scratch/decrypt	Wed Jan 04 09:21:35 2012 +0100
@@ -0,0 +1,64 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use File::Temp;
+use Digest::MD5 qw(md5_hex);
+use GnuPG;
+use autodie qw(:all);
+
+use blib;
+use Message::2822;
+
+umask(077);
+my $dir = File::Temp->newdir();
+
+my $encrypted =
+  Message::2822->new(file => shift // "ex/mails/signed-encrypted");
+
+# output the original message if not 'multipart/encrypted'
+my ($content_type) =
+  ($encrypted->header_lines(qr/^content-type/i) =~ /\s+(\S+)/i);
+unless ($content_type =~ /multipart\/encrypted/i) {
+    print $encrypted->header_lines, "\n";
+    print $encrypted->orig_body;
+    exit 0;
+}
+
+my $boundary = md5_hex(time);
+
+open(my $body, "+>$dir/body");
+print {$body} $encrypted->orig_body;
+seek($body, 0, 0);
+
+# ask GPG to decrypt it…
+my $gpg = new GnuPG(homedir => "ex/gpg");
+my $sign;
+eval {
+    $sign =
+      ($gpg->decrypt(ciphertext => "$dir/body", output => "$dir/message"));
+};
+if ($@) {
+    $encrypted->add_header_line("\nX-GPGate-decrypted: not\n");
+    print $encrypted->header_lines, "\n";
+    print $encrypted->orig_body;
+    exit 0;
+}
+
+# now remove the unwanted content- header lines and add new ones
+$encrypted->remove_header_lines(qr/^content-.*?:/im);
+
+$encrypted->add_header_line(
+    "Content-Type: multipart/mixed; boundary=\"$boundary\"");
+$encrypted->add_header_line("Content-Disposition: inline\n");
+$encrypted->add_header_line("X-GPGate-Sign: good signature\n");
+$encrypted->add_header_line("X-GPGate-SignUser: $sign->{user}\n");
+$encrypted->add_header_line("X-GPGate-KeyId: $sign->{keyid}\n");
+$encrypted->add_header_line("X-GPGate-Decrypted: yes\n");
+print $encrypted->header_lines, "\n";
+
+open(my $message, "<$dir/message");
+say "--${boundary}";
+print <$message>;
+say "--${boundary}--";
diff -r 236696558ccb -r 4f50e6aa028b scratch/sign
--- 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
diff -r 236696558ccb -r 4f50e6aa028b scratch/verify
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scratch/verify	Wed Jan 04 09:21:35 2012 +0100
@@ -0,0 +1,82 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use File::Temp;
+use GnuPG;
+use autodie qw(:all);
+
+use blib;
+use Message::2822;
+
+umask(077);
+my $dir = File::Temp->newdir();
+
+my $signed = Message::2822->new(file => shift // "ex/mails/signed");
+
+# output the original message if not 'multipart/sign'
+my ($content_type) = ($signed->header_lines(qr/^content-type/i) =~ /\s+(\S+)/i);
+unless ($content_type =~ /multipart\/signed/i) {
+    print $signed->header_lines, "\n";
+    print $signed->orig_body;
+    exit 0;
+}
+
+my ($boundary) =
+  ($signed->header_lines(qr/^content-type/i) =~ /boundary=['"](.*?)['"]/);
+
+open(my $body, "+>$dir/body");
+print {$body} $signed->orig_body;
+seek($body, 0, 0);
+
+# cut the message
+open(my $message, "+>$dir/message");
+my $last_line = "";
+while (<$body>) {
+    last if ($last_line =~ /^\s+$/ and /^--\Q$boundary\E/);
+    next if (/^--\Q$boundary\E/);
+    s/\r?\n/\r\n/g;
+    print {$message} $last_line;
+    $last_line = $_;
+}
+
+# cut the signature
+open(my $signature, "+>$dir/message.sig");
+my $in_sign = 0;
+while (<$body>) {
+    if (/^-----BEGIN\s+PGP\s+SIGNATURE-----$/ or $in_sign) {
+        if (/^-----END\s+PGP\s+SIGNATURE-----$/) {
+            $in_sign = 0;
+            print {$signature} $_;
+        }
+        else {
+            $in_sign = 1;
+            print {$signature} $_;
+        }
+    }
+}
+
+seek($message,   0, 0);
+seek($signature, 0, 0);
+
+# ask GPG to verify it…
+my $gpg = new GnuPG(homedir => "ex/gpg");
+my $sign;
+eval {
+    $sign =
+      ($gpg->verify(signature => "$dir/message.sig", file => "$dir/message"));
+};
+if ($@) {
+    $signed->add_header_line("\nX-GPGate-Sign: bad signature\n");
+    print $signed->header_lines, "\n";
+    print $signed->orig_body;
+    exit 0;
+}
+
+$signed->add_header_line("\nX-GPGate-Sign: good signature\n");
+$signed->add_header_line("X-GPGate-SignUser: $sign->{user}\n");
+$signed->add_header_line("X-GPGate-KeyId: $sign->{keyid}\n");
+
+print $signed->header_lines, "\n";
+print $signed->orig_body;