scratch/decrypt
changeset 14 4f50e6aa028b
--- /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}--";