diff -r 15a5ac599b95 -r 9f127fcfdf6d scratch/sign --- a/scratch/sign Thu Nov 10 16:18:38 2011 +0100 +++ b/scratch/sign Fri Nov 11 11:22:50 2011 +0100 @@ -3,19 +3,57 @@ 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; -my $message = Message::2822->new(file => shift//"ex/mails/unsigned"); +umask(077); +my $boundary = md5_hex(time); +my $dir = File::Temp->newdir(); + +my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned"); + -say $message->header_content("received:"); -say $message->header_content("to:"); +# 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; +$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"); -exit; + +# ask GPG to sign it… +system("gpg", + "--rfc1991", + "--detach-sign", + "--homedir" => "ex/gpg", + "--armor" => "$dir/message"); + +open(my $sig, "$dir/message.asc"); + +print $unsigned->header_lines, "\n"; -say $message->orig_header(); -say $message->orig_body(); +seek($message, 0, 0); -#say map { ">> '$_'\n" } $message->header_fields(); +print "--${boundary}\n", + <$message>, "\n", + "--${boundary}\n", + <<___, <$sig>, "\n--${boundary}--\n"; +Content-Type: application/pgp-signature; name="signature.asc" +Content-Description: Digital Signature +Content-Disposition: inline +___