--- a/Build.PL Wed Jan 04 14:15:39 2012 +0100
+++ b/Build.PL Wed Jan 04 15:10:55 2012 +0100
@@ -7,7 +7,9 @@
dist_version => "0",
requires => {
"perl" => "5.10.0",
+ "GnuPG" => "0.17",
},
+ script_files => [ glob "bin/*" ],
build_requires => {
"Test::More" => "0.92",
"Test::Pod::Coverage" => "1.08",
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/decrypt Wed Jan 04 15:10:55 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}--";
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/sign Wed Jan 04 15:10:55 2012 +0100
@@ -0,0 +1,86 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use File::Temp;
+use GnuPG;
+use autodie qw(:all);
+
+use Digest::MD5 qw(md5_hex);
+
+use blib;
+use Message::2822;
+
+umask(077);
+my $boundary = md5_hex(time);
+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");
+
+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";
+
+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\"");
+$unsigned->add_header_line("Content-Disposition: inline");
+
+$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>, "--${boundary}--\n";
+Content-Type: application/pgp-signature; name="signature.asc"
+Content-Description: Digital Signature
+Content-Disposition: inline
+
+___
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/verify Wed Jan 04 15:10:55 2012 +0100
@@ -0,0 +1,80 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use File::Temp;
+use GnuPG;
+use autodie qw(:all);
+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;
--- a/scratch/decrypt Wed Jan 04 14:15:39 2012 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,64 +0,0 @@
-#! /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}--";
--- a/scratch/sign Wed Jan 04 14:15:39 2012 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,59 +0,0 @@
-#! /usr/bin/perl
-
-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;
-
-umask(077);
-my $boundary = md5_hex(time);
-my $dir = File::Temp->newdir();
-
-my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned");
-
-die join " ", $unsigned->header_contents("Subject");
-
-# copy the body into a tmp file and copy there the content-
-# header lines
-open(my $message, "+>$dir/message");
-print {$message}
- $unsigned->header_lines("content-"), "\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");
-
-
-# ask GPG to sign it…
-system("gpg",
- "--detach-sign",
- "--homedir" => "ex/gpg",
- "--armor" => "$dir/message");
-
-open(my $sig, "$dir/message.asc");
-
-print $unsigned->header_lines, "\n";
-
-seek($message, 0, 0);
-
-print "--${boundary}\n",
- <$message>,
- "--${boundary}\n",
- <<___, <$sig>, "\n--${boundary}--\n";
-Content-Type: application/pgp-signature; name="signature.asc"
-Content-Description: Digital Signature
-Content-Disposition: inline
-
-___
--- a/scratch/verify Wed Jan 04 14:15:39 2012 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,82 +0,0 @@
-#! /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;