1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use File::Temp;

     7 use GnuPG;

     8 use autodie qw(:all);

     9 

    10 use blib;

    11 use Message::2822;

    12 

    13 umask(077);

    14 my $dir = File::Temp->newdir();

    15 

    16 my $signed = Message::2822->new(file => shift // "ex/mails/signed");

    17 

    18 # output the original message if not 'multipart/sign'

    19 my ($content_type) = ($signed->header_lines(qr/^content-type/i) =~ /\s+(\S+)/i);

    20 unless ($content_type =~ /multipart\/signed/i) {

    21     print $signed->header_lines, "\n";

    22     print $signed->orig_body;

    23     exit 0;

    24 }

    25 

    26 my ($boundary) =

    27   ($signed->header_lines(qr/^content-type/i) =~ /boundary=['"](.*?)['"]/);

    28 

    29 open(my $body, "+>$dir/body");

    30 print {$body} $signed->orig_body;

    31 seek($body, 0, 0);

    32 

    33 # cut the message

    34 open(my $message, "+>$dir/message");

    35 my $last_line = "";

    36 while (<$body>) {

    37     last if ($last_line =~ /^\s+$/ and /^--\Q$boundary\E/);

    38     next if (/^--\Q$boundary\E/);

    39     s/\r?\n/\r\n/g;

    40     print {$message} $last_line;

    41     $last_line = $_;

    42 }

    43 

    44 # cut the signature

    45 open(my $signature, "+>$dir/message.sig");

    46 my $in_sign = 0;

    47 while (<$body>) {

    48     if (/^-----BEGIN\s+PGP\s+SIGNATURE-----$/ or $in_sign) {

    49         if (/^-----END\s+PGP\s+SIGNATURE-----$/) {

    50             $in_sign = 0;

    51             print {$signature} $_;

    52         }

    53         else {

    54             $in_sign = 1;

    55             print {$signature} $_;

    56         }

    57     }

    58 }

    59 

    60 seek($message,   0, 0);

    61 seek($signature, 0, 0);

    62 

    63 # ask GPG to verify it…

    64 my $gpg = new GnuPG(homedir => "ex/gpg");

    65 my $sign;

    66 eval {

    67     $sign =

    68       ($gpg->verify(signature => "$dir/message.sig", file => "$dir/message"));

    69 };

    70 if ($@) {

    71     $signed->add_header_line("\nX-GPGate-Sign: bad signature\n");

    72     print $signed->header_lines, "\n";

    73     print $signed->orig_body;

    74     exit 0;

    75 }

    76 

    77 $signed->add_header_line("\nX-GPGate-Sign: good signature\n");

    78 $signed->add_header_line("X-GPGate-SignUser: $sign->{user}\n");

    79 $signed->add_header_line("X-GPGate-KeyId: $sign->{keyid}\n");

    80 

    81 print $signed->header_lines, "\n";

    82 print $signed->orig_body;