lib/RT/Crypt/SMIME.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 use strict;
  50 use warnings;
  51 use 5.010;
  52
  53 package RT::Crypt::SMIME;
  54
  55 use Role::Basic 'with';
  56 with 'RT::Crypt::Role';
  57
  58 use RT::Crypt;
  59 use File::Which qw();
  60 use IPC::Run3 0.036 'run3';
  61 use RT::Util 'safe_run_child';
  62 use Crypt::X509;
  63 use String::ShellQuote 'shell_quote';
  64
  65 =head1 NAME
  66
  67 RT::Crypt::SMIME - encrypt/decrypt and sign/verify email messages with the SMIME
  68
  69 =head1 CONFIGURATION
  70
  71 You should start from reading L<RT::Crypt>.
  72
  73 =head2 %SMIME
  74
  75     Set( %SMIME,
  76         Enable => 1,
  77         OpenSSL => '/usr/bin/openssl',
  78         Keyring => '/opt/rt4/var/data/smime',
  79         CAPath  => '/opt/rt4/var/data/smime/signing-ca.pem',
  80         Passphrase => {
  81             'queue.address@example.com' => 'passphrase',
  82             '' => 'fallback',
  83         },
  84     );
  85
  86 =head3 OpenSSL
  87
  88 Path to openssl executable.
  89
  90 =head3 Keyring
  91
  92 Path to directory with keys and certificates for queues. Key and
  93 certificates should be stored in a PEM file named, e.g.,
  94 F<email.address@example.com.pem>.  See L</Keyring configuration>.
  95
  96 =head3 CAPath
  97
  98 C<CAPath> should be set to either a PEM-formatted certificate of a
  99 single signing certificate authority, or a directory of such (including
 100 hash symlinks as created by the openssl tool C<c_rehash>).  Only SMIME
 101 certificates signed by these certificate authorities will be treated as
 102 valid signatures.  If left unset (and C<AcceptUntrustedCAs> is unset, as
 103 it is by default), no signatures will be marked as valid!
 104
 105 =head3 AcceptUntrustedCAs
 106
 107 Allows arbitrary SMIME certificates, no matter their signing entities.
 108 Such mails will be marked as untrusted, but signed; C<CAPath> will be
 109 used to mark which mails are signed by trusted certificate authorities.
 110 This configuration is generally insecure, as it allows the possibility
 111 of accepting forged mail signed by an untrusted certificate authority.
 112
 113 Setting this option also allows encryption to users with certificates
 114 created by untrusted CAs.
 115
 116 =head3 Passphrase
 117
 118 C<Passphrase> may be set to a scalar (to use for all keys), an anonymous
 119 function, or a hash (to look up by address).  If the hash is used, the
 120 '' key is used as a default.
 121
 122 =head2 Keyring configuration
 123
 124 RT looks for keys in the directory configured in the L</Keyring> option
 125 of the L<RT_Config/%SMIME>.  While public certificates are also stored
 126 on users, private SSL keys are only loaded from disk.  Keys and
 127 certificates should be concatenated, in in PEM format, in files named
 128 C<email.address@example.com.pem>, for example.
 129
 130 These files need be readable by the web server user which is running
 131 RT's web interface; however, if you are running cronjobs or other
 132 utilities that access RT directly via API, and may generate
 133 encrypted/signed notifications, then the users you execute these scripts
 134 under must have access too.
 135
 136 The keyring on disk will be checked before the user with the email
 137 address is examined.  If the file exists, it will be used in preference
 138 to the certificate on the user.
 139
 140 =cut
 141
 142 sub OpenSSLPath {
 143     state $cache = RT->Config->Get('SMIME')->{'OpenSSL'};
 144     $cache = $_[1] if @_ > 1;
 145     return $cache;
 146 }
 147
 148 sub Probe {
 149     my $self = shift;
 150     my $bin = $self->OpenSSLPath();
 151     unless ($bin) {
 152         $RT::Logger->warning(
 153             "No openssl path set; SMIME support has been disabled.  ".
 154             "Check the 'OpenSSL' configuration in %OpenSSL");
 155         return 0;
 156     }
 157
 158     if ($bin =~ m{^/}) {
 159         unless (-f $bin and -x _) {
 160             $RT::Logger->warning(
 161                 "Invalid openssl path $bin; SMIME support has been disabled.  ".
 162                 "Check the 'OpenSSL' configuration in %OpenSSL");
 163             return 0;
 164         }
 165     } else {
 166         local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin'
 167             unless defined $ENV{PATH};
 168         my $path = File::Which::which( $bin );
 169         unless ($path) {
 170             $RT::Logger->warning(
 171                 "Can't find openssl binary '$bin' in PATH ($ENV{PATH}); SMIME support has been disabled.  ".
 172                 "You may need to specify a full path to opensssl via the 'OpenSSL' configuration in %OpenSSL");
 173             return 0;
 174         }
 175         $self->OpenSSLPath( $bin = $path );
 176     }
 177
 178     {
 179         my ($buf, $err) = ('', '');
 180
 181         local $SIG{'CHLD'} = 'DEFAULT';
 182         safe_run_child { run3( [$bin, "list-standard-commands"],
 183             \undef,
 184             \$buf, \$err
 185         ) };
 186
 187         if ($? or $err) {
 188             $RT::Logger->warning(
 189                 "RT's SMIME libraries couldn't successfully execute openssl.".
 190                     " SMIME support has been disabled") ;
 191             return;
 192         } elsif ($buf !~ /\bsmime\b/) {
 193             $RT::Logger->warning(
 194                 "openssl does not include smime support.".
 195                     " SMIME support has been disabled");
 196             return;
 197         } else {
 198             return 1;
 199         }
 200     }
 201 }
 202
 203 sub SignEncrypt {
 204     my $self = shift;
 205     my %args = (
 206         Entity => undef,
 207
 208         Sign => 1,
 209         Signer => undef,
 210         Passphrase => undef,
 211
 212         Encrypt => 1,
 213         Recipients => undef,
 214
 215         @_
 216     );
 217
 218     my $entity = $args{'Entity'};
 219
 220     if ( $args{'Encrypt'} ) {
 221         my %seen;
 222         $args{'Recipients'} = [
 223             grep !$seen{$_}++, map $_->address, map Email::Address->parse($_),
 224             grep defined && length, map $entity->head->get($_), qw(To Cc Bcc)
 225         ];
 226     }
 227
 228     $entity->make_multipart('mixed', Force => 1);
 229     my ($buf, %res) = $self->_SignEncrypt(
 230         %args,
 231         Content => \$entity->parts(0)->stringify,
 232     );
 233     unless ( $buf ) {
 234         $entity->make_singlepart;
 235         return %res;
 236     }
 237
 238     my $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
 239     my $parser = MIME::Parser->new();
 240     $parser->output_dir($tmpdir);
 241     my $newmime = $parser->parse_data($$buf);
 242
 243     # Work around https://rt.cpan.org/Public/Bug/Display.html?id=87835
 244     for my $part (grep {$_->is_multipart and $_->preamble and @{$_->preamble}} $newmime->parts_DFS) {
 245         $part->preamble->[-1] .= "\n"
 246             if $part->preamble->[-1] =~ /\r$/;
 247     }
 248
 249     $entity->parts([$newmime]);
 250     $entity->make_singlepart;
 251
 252     return %res;
 253 }
 254
 255 sub SignEncryptContent {
 256     my $self = shift;
 257     my %args = (
 258         Content => undef,
 259         @_
 260     );
 261
 262     my ($buf, %res) = $self->_SignEncrypt(%args);
 263     ${ $args{'Content'} } = $$buf if $buf;
 264     return %res;
 265 }
 266
 267 sub _SignEncrypt {
 268     my $self = shift;
 269     my %args = (
 270         Content => undef,
 271
 272         Sign => 1,
 273         Signer => undef,
 274         Passphrase => undef,
 275
 276         Encrypt => 1,
 277         Recipients => [],
 278
 279         @_
 280     );
 281
 282     my %res = (exit_code => 0, status => '');
 283
 284     my @keys;
 285     if ( $args{'Encrypt'} ) {
 286         my @addresses = @{ $args{'Recipients'} };
 287
 288         foreach my $address ( @addresses ) {
 289             $RT::Logger->debug( "Considering encrypting message to " . $address );
 290
 291             my %key_info = $self->GetKeysInfo( Key => $address );
 292             unless ( defined $key_info{'info'} ) {
 293                 $res{'exit_code'} = 1;
 294                 my $reason = 'Key not found';
 295                 $res{'status'} .= $self->FormatStatus({
 296                     Operation => "RecipientsCheck", Status => "ERROR",
 297                     Message => "Recipient '$address' is unusable, the reason is '$reason'",
 298                     Recipient => $address,
 299                     Reason => $reason,
 300                 });
 301                 next;
 302             }
 303
 304             if ( not $key_info{'info'}[0]{'Expire'} ) {
 305                 # we continue here as it's most probably a problem with the key,
 306                 # so later during encryption we'll get verbose errors
 307                 $RT::Logger->error(
 308                     "Trying to send an encrypted message to ". $address
 309                     .", but we couldn't get expiration date of the key."
 310                 );
 311             }
 312             elsif ( $key_info{'info'}[0]{'Expire'}->Diff( time ) < 0 ) {
 313                 $res{'exit_code'} = 1;
 314                 my $reason = 'Key expired';
 315                 $res{'status'} .= $self->FormatStatus({
 316                     Operation => "RecipientsCheck", Status => "ERROR",
 317                     Message => "Recipient '$address' is unusable, the reason is '$reason'",
 318                     Recipient => $address,
 319                     Reason => $reason,
 320                 });
 321                 next;
 322             }
 323             push @keys, $key_info{'info'}[0]{'Content'};
 324         }
 325     }
 326     return (undef, %res) if $res{'exit_code'};
 327
 328     my $opts = RT->Config->Get('SMIME');
 329
 330     my @command;
 331     if ( $args{'Sign'} ) {
 332         my $file = $self->CheckKeyring( Key => $args{'Signer'} );
 333         unless ($file) {
 334             $res{'status'} .= $self->FormatStatus({
 335                 Operation => "KeyCheck", Status => "MISSING",
 336                 Message   => "Secret key for $args{Signer} is not available",
 337                 Key       => $args{Signer},
 338                 KeyType   => "secret",
 339             });
 340             $res{exit_code} = 1;
 341             return %res;
 342         }
 343         $args{'Passphrase'} = $self->GetPassphrase( Address => $args{'Signer'} )
 344             unless defined $args{'Passphrase'};
 345
 346         push @command, join ' ', shell_quote(
 347             $self->OpenSSLPath, qw(smime -sign),
 348             -signer => $file,
 349             -inkey  => $file,
 350             (defined $args{'Passphrase'} && length $args{'Passphrase'})
 351                 ? (qw(-passin env:SMIME_PASS))
 352                 : (),
 353         );
 354     }
 355     if ( $args{'Encrypt'} ) {
 356         foreach my $key ( @keys ) {
 357             my $key_file = File::Temp->new;
 358             print $key_file $key;
 359             close $key_file;
 360             $key = $key_file;
 361         }
 362         push @command, join ' ', shell_quote(
 363             $self->OpenSSLPath, qw(smime -encrypt -des3),
 364             map { $_->filename } @keys
 365         );
 366     }
 367
 368     my ($buf, $err) = ('', '');
 369     {
 370         local $ENV{'SMIME_PASS'} = $args{'Passphrase'};
 371         local $SIG{'CHLD'} = 'DEFAULT';
 372         safe_run_child { run3(
 373             join( ' | ', @command ),
 374             $args{'Content'},
 375             \$buf, \$err
 376         ) };
 377     }
 378     $RT::Logger->debug( "openssl stderr: " . $err ) if length $err;
 379
 380     if ($buf) {
 381         $res{'status'} .= $self->FormatStatus({
 382             Operation => "Sign", Status => "DONE",
 383             Message => "Signed message",
 384         }) if $args{'Sign'};
 385         $res{'status'} .= $self->FormatStatus({
 386             Operation => "Encrypt", Status => "DONE",
 387             Message => "Data has been encrypted",
 388         }) if $args{'Encrypt'};
 389     }
 390
 391     return (\$buf, %res);
 392 }
 393
 394 sub VerifyDecrypt {
 395     my $self = shift;
 396     my %args = ( Info => undef, @_ );
 397
 398     my %res;
 399     my $item = $args{'Info'};
 400     if ( $item->{'Type'} eq 'signed' ) {
 401         %res = $self->Verify( %$item );
 402     } elsif ( $item->{'Type'} eq 'encrypted' ) {
 403         %res = $self->Decrypt( %args, %$item );
 404     } else {
 405         die "Unknown type '". $item->{'Type'} ."' of protected item";
 406     }
 407
 408     return (%res, status_on => $item->{'Data'});
 409 }
 410
 411 sub Verify {
 412     my $self = shift;
 413     my %args = (Data => undef, @_ );
 414
 415     my $msg = $args{'Data'}->as_string;
 416
 417     my %res;
 418     my $buf;
 419     my $keyfh = File::Temp->new;
 420     {
 421         local $SIG{CHLD} = 'DEFAULT';
 422         my $cmd = [
 423             $self->OpenSSLPath, qw(smime -verify -noverify),
 424             '-signer', $keyfh->filename,
 425         ];
 426         safe_run_child { run3( $cmd, \$msg, \$buf, \$res{'stderr'} ) };
 427         $res{'exit_code'} = $?;
 428     }
 429     if ( $res{'exit_code'} ) {
 430         if ($res{stderr} =~ /(signature|digest) failure/) {
 431             $res{'message'} = "Validation failed";
 432             $res{'status'} = $self->FormatStatus({
 433                 Operation => "Verify", Status => "BAD",
 434                 Message => "The signature did not verify",
 435             });
 436         } else {
 437             $res{'message'} = "openssl exited with error code ". ($? >> 8)
 438                 ." and error: $res{stderr}";
 439             $res{'status'} = $self->FormatStatus({
 440                 Operation => "Verify", Status => "ERROR",
 441                 Message => "There was an error verifying: $res{stderr}",
 442             });
 443             $RT::Logger->error($res{'message'});
 444         }
 445         return %res;
 446     }
 447
 448     my $signer;
 449     if ( my $key = do { $keyfh->seek(0, 0); local $/; readline $keyfh } ) {{
 450         my %info = $self->GetCertificateInfo( Certificate => $key );
 451
 452         $signer = $info{info}[0];
 453         last unless $signer and $signer->{User}[0]{String};
 454
 455         unless ( $info{info}[0]{TrustLevel} > 0 or RT->Config->Get('SMIME')->{AcceptUntrustedCAs}) {
 456             # We don't trust it; give it the finger
 457             $res{exit_code} = 1;
 458             $res{'message'} = "Validation failed";
 459             $res{'status'} = $self->FormatStatus({
 460                 Operation => "Verify", Status => "BAD",
 461                 Message => "The signing CA was not trusted",
 462                 UserString => $signer->{User}[0]{String},
 463                 Trust => "NONE",
 464             });
 465             return %res;
 466         }
 467
 468         my $user = RT::User->new( $RT::SystemUser );
 469         $user->LoadOrCreateByEmail( $signer->{User}[0]{String} );
 470         my $current_key = $user->SMIMECertificate;
 471         last if $current_key && $current_key eq $key;
 472
 473         # Never over-write existing keys with untrusted ones.
 474         last if $current_key and not $info{info}[0]{TrustLevel} > 0;
 475
 476         my ($status, $msg) = $user->SetSMIMECertificate( $key );
 477         $RT::Logger->error("Couldn't set SMIME certificate for user #". $user->id .": $msg")
 478             unless $status;
 479     }}
 480
 481     my $res_entity = _extract_msg_from_buf( \$buf );
 482     unless ( $res_entity ) {
 483         $res{'exit_code'} = 1;
 484         $res{'message'} = "verified message, but couldn't parse result";
 485         $res{'status'} = $self->FormatStatus({
 486             Operation => "Verify", Status => "DONE",
 487             Message => "The signature is good, unknown signer",
 488             Trust => "UNKNOWN",
 489         });
 490         return %res;
 491     }
 492
 493     $res_entity->make_multipart( 'mixed', Force => 1 );
 494
 495     $args{'Data'}->make_multipart( 'mixed', Force => 1 );
 496     $args{'Data'}->parts([ $res_entity->parts ]);
 497     $args{'Data'}->make_singlepart;
 498
 499     $res{'status'} = $self->FormatStatus({
 500         Operation => "Verify", Status => "DONE",
 501         Message => "The signature is good, signed by ".$signer->{User}[0]{String}.", trust is ".$signer->{TrustTerse},
 502         UserString => $signer->{User}[0]{String},
 503         Trust => uc($signer->{TrustTerse}),
 504     });
 505
 506     return %res;
 507 }
 508
 509 sub Decrypt {
 510     my $self = shift;
 511     my %args = (Data => undef, Queue => undef, @_ );
 512
 513     my $msg = $args{'Data'}->as_string;
 514
 515     push @{ $args{'Recipients'} ||= [] },
 516         $args{'Queue'}->CorrespondAddress, RT->Config->Get('CorrespondAddress'),
 517         $args{'Queue'}->CommentAddress, RT->Config->Get('CommentAddress')
 518     ;
 519
 520     my ($buf, %res) = $self->_Decrypt( %args, Content => \$args{'Data'}->as_string );
 521     return %res unless $buf;
 522
 523     my $res_entity = _extract_msg_from_buf( $buf );
 524     $res_entity->make_multipart( 'mixed', Force => 1 );
 525
 526     # Work around https://rt.cpan.org/Public/Bug/Display.html?id=87835
 527     for my $part (grep {$_->is_multipart and $_->preamble and @{$_->preamble}} $res_entity->parts_DFS) {
 528         $part->preamble->[-1] .= "\n"
 529             if $part->preamble->[-1] =~ /\r$/;
 530     }
 531
 532     $args{'Data'}->make_multipart( 'mixed', Force => 1 );
 533     $args{'Data'}->parts([ $res_entity->parts ]);
 534     $args{'Data'}->make_singlepart;
 535
 536     return %res;
 537 }
 538
 539 sub DecryptContent {
 540     my $self = shift;
 541     my %args = (
 542         Content => undef,
 543         @_
 544     );
 545
 546     my ($buf, %res) = $self->_Decrypt( %args );
 547     ${ $args{'Content'} } = $$buf if $buf;
 548     return %res;
 549 }
 550
 551 sub _Decrypt {
 552     my $self = shift;
 553     my %args = (Content => undef, @_ );
 554
 555     my %seen;
 556     my @addresses =
 557         grep !$seen{lc $_}++, map $_->address, map Email::Address->parse($_),
 558         grep length && defined, @{$args{'Recipients'}};
 559
 560     my ($buf, $encrypted_to, %res);
 561
 562     foreach my $address ( @addresses ) {
 563         my $file = $self->CheckKeyring( Key => $address );
 564         unless ( $file ) {
 565             my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
 566             $RT::Logger->debug("No key found for $address in $keyring directory");
 567             next;
 568         }
 569
 570         local $ENV{SMIME_PASS} = $self->GetPassphrase( Address => $address );
 571         local $SIG{CHLD} = 'DEFAULT';
 572         my $cmd = [
 573             $self->OpenSSLPath,
 574             qw(smime -decrypt),
 575             -recip => $file,
 576             (defined $ENV{'SMIME_PASS'} && length $ENV{'SMIME_PASS'})
 577                 ? (qw(-passin env:SMIME_PASS))
 578                 : (),
 579         ];
 580         safe_run_child { run3( $cmd, $args{'Content'}, \$buf, \$res{'stderr'} ) };
 581         unless ( $? ) {
 582             $encrypted_to = $address;
 583             $RT::Logger->debug("Message encrypted for $encrypted_to");
 584             last;
 585         }
 586
 587         if ( index($res{'stderr'}, 'no recipient matches key') >= 0 ) {
 588             $RT::Logger->debug("Although we have a key for $address, it is not the one that encrypted this message");
 589             next;
 590         }
 591
 592         $res{'exit_code'} = $?;
 593         $res{'message'} = "openssl exited with error code ". ($? >> 8)
 594             ." and error: $res{stderr}";
 595         $RT::Logger->error( $res{'message'} );
 596         $res{'status'} = $self->FormatStatus({
 597             Operation => 'Decrypt', Status => 'ERROR',
 598             Message => 'Decryption failed',
 599             EncryptedTo => $address,
 600         });
 601         return (undef, %res);
 602     }
 603     unless ( $encrypted_to ) {
 604         $RT::Logger->error("Couldn't find SMIME key for addresses: ". join ', ', @addresses);
 605         $res{'exit_code'} = 1;
 606         $res{'status'} = $self->FormatStatus({
 607             Operation => 'KeyCheck',
 608             Status    => 'MISSING',
 609             Message   => "Secret key is not available",
 610             KeyType   => 'secret',
 611         });
 612         return (undef, %res);
 613     }
 614
 615     $res{'status'} = $self->FormatStatus({
 616         Operation => 'Decrypt', Status => 'DONE',
 617         Message => 'Decryption process succeeded',
 618         EncryptedTo => $encrypted_to,
 619     });
 620
 621     return (\$buf, %res);
 622 }
 623
 624 sub FormatStatus {
 625     my $self = shift;
 626     my @status = @_;
 627
 628     my $res = '';
 629     foreach ( @status ) {
 630         while ( my ($k, $v) = each %$_ ) {
 631             $res .= "[SMIME:]". $k .": ". $v ."\n";
 632         }
 633         $res .= "[SMIME:]\n";
 634     }
 635
 636     return $res;
 637 }
 638
 639 sub ParseStatus {
 640     my $self = shift;
 641     my $status = shift;
 642     return () unless $status;
 643
 644     my @status = split /\s*(?:\[SMIME:\]\s*){2}/, $status;
 645     foreach my $block ( grep length, @status ) {
 646         chomp $block;
 647         $block = { map { s/^\s+//; s/\s+$//; $_ } map split(/:/, $_, 2), split /\s*\[SMIME:\]/, $block };
 648     }
 649     foreach my $block ( grep $_->{'EncryptedTo'}, @status ) {
 650         $block->{'EncryptedTo'} = [{
 651             EmailAddress => $block->{'EncryptedTo'},
 652         }];
 653     }
 654
 655     return @status;
 656 }
 657
 658 sub _extract_msg_from_buf {
 659     my $buf = shift;
 660     my $rtparser = RT::EmailParser->new();
 661     my $parser   = MIME::Parser->new();
 662     $rtparser->_SetupMIMEParser($parser);
 663     $parser->decode_bodies(0);
 664     $parser->output_to_core(1);
 665     unless ( $rtparser->{'entity'} = $parser->parse_data($$buf) ) {
 666         $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages");
 667
 668         # Try again, this time without extracting nested messages
 669         $parser->extract_nested_messages(0);
 670         unless ( $rtparser->{'entity'} = $parser->parse_data($$buf) ) {
 671             $RT::Logger->crit("couldn't parse MIME stream");
 672             return (undef);
 673         }
 674     }
 675     return $rtparser->Entity;
 676 }
 677
 678 sub FindScatteredParts { return () }
 679
 680 sub CheckIfProtected {
 681     my $self = shift;
 682     my %args = ( Entity => undef, @_ );
 683
 684     my $entity = $args{'Entity'};
 685
 686     my $type = $entity->effective_type;
 687     if ( $type =~ m{^application/(?:x-)?pkcs7-mime$} || $type eq 'application/octet-stream' ) {
 688         # RFC3851 ch.3.9 variant 1 and 3
 689
 690         my $security_type;
 691
 692         my $smime_type = $entity->head->mime_attr('Content-Type.smime-type');
 693         if ( $smime_type ) { # it's optional according to RFC3851
 694             if ( $smime_type eq 'enveloped-data' ) {
 695                 $security_type = 'encrypted';
 696             }
 697             elsif ( $smime_type eq 'signed-data' ) {
 698                 $security_type = 'signed';
 699             }
 700             elsif ( $smime_type eq 'certs-only' ) {
 701                 $security_type = 'certificate management';
 702             }
 703             elsif ( $smime_type eq 'compressed-data' ) {
 704                 $security_type = 'compressed';
 705             }
 706             else {
 707                 $security_type = $smime_type;
 708             }
 709         }
 710
 711         unless ( $security_type ) {
 712             my $fname = $entity->head->recommended_filename || '';
 713             if ( $fname =~ /\.p7([czsm])$/ ) {
 714                 my $type_char = $1;
 715                 if ( $type_char eq 'm' ) {
 716                     # RFC3851, ch3.4.2
 717                     # it can be both encrypted and signed
 718                     $security_type = 'encrypted';
 719                 }
 720                 elsif ( $type_char eq 's' ) {
 721                     # RFC3851, ch3.4.3, multipart/signed, XXX we should never be here
 722                     # unless message is changed by some gateway
 723                     $security_type = 'signed';
 724                 }
 725                 elsif ( $type_char eq 'c' ) {
 726                     # RFC3851, ch3.7
 727                     $security_type = 'certificate management';
 728                 }
 729                 elsif ( $type_char eq 'z' ) {
 730                     # RFC3851, ch3.5
 731                     $security_type = 'compressed';
 732                 }
 733             }
 734         }
 735         return () unless $security_type;
 736
 737         my %res = (
 738             Type   => $security_type,
 739             Format => 'RFC3851',
 740             Data   => $entity,
 741         );
 742
 743         if ( $security_type eq 'encrypted' ) {
 744             my $top = $args{'TopEntity'}->head;
 745             $res{'Recipients'} = [grep defined && length, map $top->get($_), 'To', 'Cc'];
 746         }
 747
 748         return %res;
 749     }
 750     elsif ( $type eq 'multipart/signed' ) {
 751         # RFC3156, multipart/signed
 752         # RFC3851, ch.3.9 variant 2
 753
 754         unless ( $entity->parts == 2 ) {
 755             $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
 756             return ();
 757         }
 758
 759         my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
 760         unless ( $protocol ) {
 761             $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
 762             return ();
 763         }
 764
 765         unless ( $protocol =~ m{^application/(x-)?pkcs7-signature$} ) {
 766             $RT::Logger->info( "Skipping protocol '$protocol', only 'application/x-pkcs7-signature' is supported" );
 767             return ();
 768         }
 769         $RT::Logger->debug("Found part signed according to RFC3156");
 770         return (
 771             Type      => 'signed',
 772             Format    => 'RFC3156',
 773             Data      => $entity,
 774         );
 775     }
 776     return ();
 777 }
 778
 779 sub GetKeysForEncryption {
 780     my $self = shift;
 781     my %args = (Recipient => undef, @_);
 782     return $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
 783 }
 784
 785 sub GetKeysForSigning {
 786     my $self = shift;
 787     my %args = (Signer => undef, @_);
 788     return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
 789 }
 790
 791 sub GetKeysInfo {
 792     my $self = shift;
 793     my %args = (
 794         Key   => undef,
 795         Type  => 'public',
 796         Force => 0,
 797         @_
 798     );
 799
 800     my $email = $args{'Key'};
 801     unless ( $email ) {
 802         return (exit_code => 0); # unless $args{'Force'};
 803     }
 804
 805     my $key = $self->GetKeyContent( %args );
 806     return (exit_code => 0) unless $key;
 807
 808     return $self->GetCertificateInfo( Certificate => $key );
 809 }
 810
 811 sub GetKeyContent {
 812     my $self = shift;
 813     my %args = ( Key => undef, @_ );
 814
 815     my $key;
 816     if ( my $file = $self->CheckKeyring( %args ) ) {
 817         open my $fh, '<:raw', $file
 818             or die "Couldn't open file '$file': $!";
 819         $key = do { local $/; readline $fh };
 820         close $fh;
 821     }
 822     else {
 823         my $user = RT::User->new( RT->SystemUser );
 824         $user->LoadByEmail( $args{'Key'} );
 825         $key = $user->SMIMECertificate if $user->id;
 826     }
 827     return $key;
 828 }
 829
 830 sub CheckKeyring {
 831     my $self = shift;
 832     my %args = (
 833         Key => undef,
 834         @_,
 835     );
 836     my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
 837     return undef unless $keyring;
 838
 839     my $file = File::Spec->catfile( $keyring, $args{'Key'} .'.pem' );
 840     return undef unless -f $file;
 841
 842     return $file;
 843 }
 844
 845 sub GetCertificateInfo {
 846     my $self = shift;
 847     my %args = (
 848         Certificate => undef,
 849         @_,
 850     );
 851
 852     if ($args{Certificate} =~ /^-----BEGIN \s+ CERTIFICATE----- \s* $
 853                                 (.*?)
 854                                ^-----END \s+ CERTIFICATE----- \s* $/smx) {
 855         $args{Certificate} = MIME::Base64::decode_base64($1);
 856     }
 857
 858     my $cert = Crypt::X509->new( cert => $args{Certificate} );
 859     return ( exit_code => 1, stderr => $cert->error ) if $cert->error;
 860
 861     my %USER_MAP = (
 862         Country          => 'country',
 863         StateOrProvince  => 'state',
 864         Organization     => 'org',
 865         OrganizationUnit => 'ou',
 866         Name             => 'cn',
 867         EmailAddress     => 'email',
 868     );
 869     my $canonicalize = sub {
 870         my $type = shift;
 871         my %data;
 872         for (keys %USER_MAP) {
 873             my $method = $type . "_" . $USER_MAP{$_};
 874             $data{$_} = $cert->$method if $cert->can($method);
 875         }
 876         $data{String} = Email::Address->new( @data{'Name', 'EmailAddress'} )->format
 877             if $data{EmailAddress};
 878         return \%data;
 879     };
 880
 881     my $PEM = "-----BEGIN CERTIFICATE-----\n"
 882         . MIME::Base64::encode_base64( $args{Certificate} )
 883         . "-----END CERTIFICATE-----\n";
 884
 885     my %res = (
 886         exit_code => 0,
 887         info => [ {
 888             Content         => $PEM,
 889             Fingerprint     => Digest::SHA::sha1_hex($args{Certificate}),
 890             'Serial Number' => $cert->serial,
 891             Created         => $self->ParseDate( $cert->not_before ),
 892             Expire          => $self->ParseDate( $cert->not_after ),
 893             Version         => sprintf("%d (0x%x)",hex($cert->version || 0)+1, hex($cert->version || 0)),
 894             Issuer          => [ $canonicalize->( 'issuer' ) ],
 895             User            => [ $canonicalize->( 'subject' ) ],
 896         } ],
 897         stderr => ''
 898     );
 899
 900     # Check the validity
 901     my $ca = RT->Config->Get('SMIME')->{'CAPath'};
 902     if ($ca) {
 903         my @ca_verify;
 904         if (-d $ca) {
 905             @ca_verify = ('-CApath', $ca);
 906         } elsif (-f $ca) {
 907             @ca_verify = ('-CAfile', $ca);
 908         }
 909
 910         local $SIG{CHLD} = 'DEFAULT';
 911         my $cmd = [
 912             $self->OpenSSLPath,
 913             'verify', @ca_verify,
 914         ];
 915         my $buf = '';
 916         safe_run_child { run3( $cmd, \$PEM, \$buf, \$res{stderr} ) };
 917
 918         if ($buf =~ /^stdin: OK$/) {
 919             $res{info}[0]{Trust} = "Signed by trusted CA $res{info}[0]{Issuer}[0]{String}";
 920             $res{info}[0]{TrustTerse} = "full";
 921             $res{info}[0]{TrustLevel} = 2;
 922         } elsif ($? == 0 or ($? >> 8) == 2) {
 923             $res{info}[0]{Trust} = "UNTRUSTED signing CA $res{info}[0]{Issuer}[0]{String}";
 924             $res{info}[0]{TrustTerse} = "none";
 925             $res{info}[0]{TrustLevel} = -1;
 926         } else {
 927             $res{exit_code} = $?;
 928             $res{message} = "openssl exited with error code ". ($? >> 8)
 929                 ." and stout: $buf";
 930             $res{info}[0]{Trust} = "unknown (openssl failed)";
 931             $res{info}[0]{TrustTerse} = "unknown";
 932             $res{info}[0]{TrustLevel} = 0;
 933         }
 934     } else {
 935         $res{info}[0]{Trust} = "unknown (no CAPath set)";
 936         $res{info}[0]{TrustTerse} = "unknown";
 937         $res{info}[0]{TrustLevel} = 0;
 938     }
 939
 940     return %res;
 941 }
 942
 943 1;