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 use Message::2822;

    10 

    11 umask(077);

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

    13 

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

    15 

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

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

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

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

    20     print $signed->orig_body;

    21     exit 0;

    22 }

    23 

    24 my ($boundary) =

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

    26 

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

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

    29 seek($body, 0, 0);

    30 

    31 # cut the message

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

    33 my $last_line = "";

    34 while (<$body>) {

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

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

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

    38     print {$message} $last_line;

    39     $last_line = $_;

    40 }

    41 

    42 # cut the signature

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

    44 my $in_sign = 0;

    45 while (<$body>) {

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

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

    48             $in_sign = 0;

    49             print {$signature} $_;

    50         }

    51         else {

    52             $in_sign = 1;

    53             print {$signature} $_;

    54         }

    55     }

    56 }

    57 

    58 seek($message,   0, 0);

    59 seek($signature, 0, 0);

    60 

    61 # ask GPG to verify it…

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

    63 my $sign;

    64 eval {

    65     $sign =

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

    67 };

    68 if ($@) {

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

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

    71     print $signed->orig_body;

    72     exit 0;

    73 }

    74 

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

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

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

    78 

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

    80 print $signed->orig_body;