# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1325686255 -3600 # Node ID 4ba3303aae86edd3b2325762b38d984f8538cc92 # Parent e65ad1481966348945cfd6d49b249d86385e858b moved the scripts diff -r e65ad1481966 -r 4ba3303aae86 Build.PL --- 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", diff -r e65ad1481966 -r 4ba3303aae86 bin/decrypt --- /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}--"; diff -r e65ad1481966 -r 4ba3303aae86 bin/sign --- /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 + +___ diff -r e65ad1481966 -r 4ba3303aae86 bin/verify --- /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; diff -r e65ad1481966 -r 4ba3303aae86 scratch/decrypt --- 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}--"; diff -r e65ad1481966 -r 4ba3303aae86 scratch/sign --- 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 - -___ diff -r e65ad1481966 -r 4ba3303aae86 scratch/verify --- 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;