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