scratch/sign
changeset 15 7c3215a97e4b
parent 12 9f127fcfdf6d
child 17 e65ad1481966
equal deleted inserted replaced
12:9f127fcfdf6d 15:7c3215a97e4b
    15 my $boundary = md5_hex(time);
    15 my $boundary = md5_hex(time);
    16 my $dir = File::Temp->newdir();
    16 my $dir = File::Temp->newdir();
    17 
    17 
    18 my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned");
    18 my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned");
    19 
    19 
       
    20 die join " ", $unsigned->header_contents("Subject");
    20 
    21 
    21 # copy the body into a tmp file and copy there the content-
    22 # copy the body into a tmp file and copy there the content-
    22 # header lines
    23 # header lines
    23 open(my $message, "+>$dir/message");
    24 open(my $message, "+>$dir/message");
    24 print {$message}
    25 print {$message}
    25     $unsigned->header_lines(qr/^content-/i), "\n",
    26     $unsigned->header_lines("content-"), "\n",
    26     $unsigned->orig_body;
    27     $unsigned->orig_body;
    27 $message->flush();
    28 $message->flush();
    28 
    29 
    29 # now remove the unwanted content- header lines and add new ones
    30 # now remove the unwanted content- header lines and add new ones
    30 $unsigned->remove_header_lines(qr/^content-.*?:/im);
    31 $unsigned->remove_header_lines(qr/^content-.*?:/im);
    35 $unsigned->add_header_line("Content-Disposition: inline");
    36 $unsigned->add_header_line("Content-Disposition: inline");
    36 
    37 
    37 
    38 
    38 # ask GPG to sign it…
    39 # ask GPG to sign it…
    39 system("gpg",
    40 system("gpg",
    40     "--rfc1991",
       
    41     "--detach-sign",
    41     "--detach-sign",
    42     "--homedir" => "ex/gpg",
    42     "--homedir" => "ex/gpg",
    43     "--armor" => "$dir/message");
    43     "--armor" => "$dir/message");
    44 
    44 
    45 open(my $sig, "$dir/message.asc");
    45 open(my $sig, "$dir/message.asc");
    47 print $unsigned->header_lines, "\n";
    47 print $unsigned->header_lines, "\n";
    48 
    48 
    49 seek($message, 0, 0);
    49 seek($message, 0, 0);
    50 
    50 
    51 print "--${boundary}\n",
    51 print "--${boundary}\n",
    52       <$message>, "\n",
    52       <$message>,
    53       "--${boundary}\n",
    53       "--${boundary}\n",
    54       <<___, <$sig>, "\n--${boundary}--\n";
    54       <<___, <$sig>, "\n--${boundary}--\n";
    55 Content-Type: application/pgp-signature; name="signature.asc"
    55 Content-Type: application/pgp-signature; name="signature.asc"
    56 Content-Description: Digital Signature
    56 Content-Description: Digital Signature
    57 Content-Disposition: inline
    57 Content-Disposition: inline