rt/lib/RT/Crypt/SMIME.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2015 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(Encode::decode("UTF-8",$_)),
 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 @commands;
 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 (undef, %res);
 342         }
 343         $args{'Passphrase'} = $self->GetPassphrase( Address => $args{'Signer'} )
 344             unless defined $args{'Passphrase'};
 345
 346         push @commands, [
 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 @commands, [
 363             $self->OpenSSLPath, qw(smime -encrypt -des3),
 364             map { $_->filename } @keys
 365         ];
 366     }
 367
 368     my $buf = ${ $args{'Content'} };
 369     for my $command (@commands) {
 370         my ($out, $err) = ('', '');
 371         {
 372             local $ENV{'SMIME_PASS'} = $args{'Passphrase'};
 373             local $SIG{'CHLD'} = 'DEFAULT';
 374             safe_run_child { run3(
 375                 $command,
 376                 \$buf,
 377                 \$out, \$err
 378             ) };
 379         }
 380
 381         $RT::Logger->debug( "openssl stderr: " . $err ) if length $err;
 382
 383         # copy output from the first command to the second command
 384         # similar to the pipe we used to use to pipe signing -> encryption
 385         # Using the pipe forced us to invoke the shell, this avoids any use of shell.
 386         $buf = $out;
 387     }
 388
 389     if ($buf) {
 390         $res{'status'} .= $self->FormatStatus({
 391             Operation => "Sign", Status => "DONE",
 392             Message => "Signed message",
 393         }) if $args{'Sign'};
 394         $res{'status'} .= $self->FormatStatus({
 395             Operation => "Encrypt", Status => "DONE",
 396             Message => "Data has been encrypted",
 397         }) if $args{'Encrypt'};
 398     }
 399
 400     return (\$buf, %res);
 401 }
 402
 403 sub VerifyDecrypt {
 404     my $self = shift;
 405     my %args = ( Info => undef, @_ );
 406
 407     my %res;
 408     my $item = $args{'Info'};
 409     if ( $item->{'Type'} eq 'signed' ) {
 410         %res = $self->Verify( %$item );
 411     } elsif ( $item->{'Type'} eq 'encrypted' ) {
 412         %res = $self->Decrypt( %args, %$item );
 413     } else {
 414         die "Unknown type '". $item->{'Type'} ."' of protected item";
 415     }
 416
 417     return (%res, status_on => $item->{'Data'});
 418 }
 419
 420 sub Verify {
 421     my $self = shift;
 422     my %args = (Data => undef, @_ );
 423
 424     my $msg = $args{'Data'}->as_string;
 425
 426     my %res;
 427     my $buf;
 428     my $keyfh = File::Temp->new;
 429     {
 430         local $SIG{CHLD} = 'DEFAULT';
 431         my $cmd = [
 432             $self->OpenSSLPath, qw(smime -verify -noverify),
 433             '-signer', $keyfh->filename,
 434         ];
 435         safe_run_child { run3( $cmd, \$msg, \$buf, \$res{'stderr'} ) };
 436         $res{'exit_code'} = $?;
 437     }
 438     if ( $res{'exit_code'} ) {
 439         if ($res{stderr} =~ /(signature|digest) failure/) {
 440             $res{'message'} = "Validation failed";
 441             $res{'status'} = $self->FormatStatus({
 442                 Operation => "Verify", Status => "BAD",
 443                 Message => "The signature did not verify",
 444             });
 445         } else {
 446             $res{'message'} = "openssl exited with error code ". ($? >> 8)
 447                 ." and error: $res{stderr}";
 448             $res{'status'} = $self->FormatStatus({
 449                 Operation => "Verify", Status => "ERROR",
 450                 Message => "There was an error verifying: $res{stderr}",
 451             });
 452             $RT::Logger->error($res{'message'});
 453         }
 454         return %res;
 455     }
 456
 457     my $signer;
 458     if ( my $key = do { $keyfh->seek(0, 0); local $/; readline $keyfh } ) {{
 459         my %info = $self->GetCertificateInfo( Certificate => $key );
 460
 461         $signer = $info{info}[0];
 462         last unless $signer and $signer->{User}[0]{String};
 463
 464         unless ( $info{info}[0]{TrustLevel} > 0 or RT->Config->Get('SMIME')->{AcceptUntrustedCAs}) {
 465             # We don't trust it; give it the finger
 466             $res{exit_code} = 1;
 467             $res{'message'} = "Validation failed";
 468             $res{'status'} = $self->FormatStatus({
 469                 Operation => "Verify", Status => "BAD",
 470                 Message => "The signing CA was not trusted",
 471                 UserString => $signer->{User}[0]{String},
 472                 Trust => "NONE",
 473             });
 474             return %res;
 475         }
 476
 477         my $user = RT::User->new( $RT::SystemUser );
 478         $user->LoadOrCreateByEmail( $signer->{User}[0]{String} );
 479         my $current_key = $user->SMIMECertificate;
 480         last if $current_key && $current_key eq $key;
 481
 482         # Never over-write existing keys with untrusted ones.
 483         last if $current_key and not $info{info}[0]{TrustLevel} > 0;
 484
 485         my ($status, $msg) = $user->SetSMIMECertificate( $key );
 486         $RT::Logger->error("Couldn't set SMIME certificate for user #". $user->id .": $msg")
 487             unless $status;
 488     }}
 489
 490     my $res_entity = _extract_msg_from_buf( \$buf );
 491     unless ( $res_entity ) {
 492         $res{'exit_code'} = 1;
 493         $res{'message'} = "verified message, but couldn't parse result";
 494         $res{'status'} = $self->FormatStatus({
 495             Operation => "Verify", Status => "DONE",
 496             Message => "The signature is good, unknown signer",
 497             Trust => "UNKNOWN",
 498         });
 499         return %res;
 500     }
 501
 502     $res_entity->make_multipart( 'mixed', Force => 1 );
 503
 504     $args{'Data'}->make_multipart( 'mixed', Force => 1 );
 505     $args{'Data'}->parts([ $res_entity->parts ]);
 506     $args{'Data'}->make_singlepart;
 507
 508     $res{'status'} = $self->FormatStatus({
 509         Operation => "Verify", Status => "DONE",
 510         Message => "The signature is good, signed by ".$signer->{User}[0]{String}.", trust is ".$signer->{TrustTerse},
 511         UserString => $signer->{User}[0]{String},
 512         Trust => uc($signer->{TrustTerse}),
 513     });
 514
 515     return %res;
 516 }
 517
 518 sub Decrypt {
 519     my $self = shift;
 520     my %args = (Data => undef, Queue => undef, @_ );
 521
 522     my $msg = $args{'Data'}->as_string;
 523
 524     push @{ $args{'Recipients'} ||= [] },
 525         $args{'Queue'}->CorrespondAddress, RT->Config->Get('CorrespondAddress'),
 526         $args{'Queue'}->CommentAddress, RT->Config->Get('CommentAddress')
 527     ;
 528
 529     my ($buf, %res) = $self->_Decrypt( %args, Content => \$args{'Data'}->as_string );
 530     return %res unless $buf;
 531
 532     my $res_entity = _extract_msg_from_buf( $buf );
 533     $res_entity->make_multipart( 'mixed', Force => 1 );
 534
 535     # Work around https://rt.cpan.org/Public/Bug/Display.html?id=87835
 536     for my $part (grep {$_->is_multipart and $_->preamble and @{$_->preamble}} $res_entity->parts_DFS) {
 537         $part->preamble->[-1] .= "\n"
 538             if $part->preamble->[-1] =~ /\r$/;
 539     }
 540
 541     $args{'Data'}->make_multipart( 'mixed', Force => 1 );
 542     $args{'Data'}->parts([ $res_entity->parts ]);
 543     $args{'Data'}->make_singlepart;
 544
 545     return %res;
 546 }
 547
 548 sub DecryptContent {
 549     my $self = shift;
 550     my %args = (
 551         Content => undef,
 552         @_
 553     );
 554
 555     my ($buf, %res) = $self->_Decrypt( %args );
 556     ${ $args{'Content'} } = $$buf if $buf;
 557     return %res;
 558 }
 559
 560 sub _Decrypt {
 561     my $self = shift;
 562     my %args = (Content => undef, @_ );
 563
 564     my %seen;
 565     my @addresses =
 566         grep !$seen{lc $_}++, map $_->address, map Email::Address->parse($_),
 567         grep length && defined, @{$args{'Recipients'}};
 568
 569     my ($buf, $encrypted_to, %res);
 570
 571     foreach my $address ( @addresses ) {
 572         my $file = $self->CheckKeyring( Key => $address );
 573         unless ( $file ) {
 574             my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
 575             $RT::Logger->debug("No key found for $address in $keyring directory");
 576             next;
 577         }
 578
 579         local $ENV{SMIME_PASS} = $self->GetPassphrase( Address => $address );
 580         local $SIG{CHLD} = 'DEFAULT';
 581         my $cmd = [
 582             $self->OpenSSLPath,
 583             qw(smime -decrypt),
 584             -recip => $file,
 585             (defined $ENV{'SMIME_PASS'} && length $ENV{'SMIME_PASS'})
 586                 ? (qw(-passin env:SMIME_PASS))
 587                 : (),
 588         ];
 589         safe_run_child { run3( $cmd, $args{'Content'}, \$buf, \$res{'stderr'} ) };
 590         unless ( $? ) {
 591             $encrypted_to = $address;
 592             $RT::Logger->debug("Message encrypted for $encrypted_to");
 593             last;
 594         }
 595
 596         if ( index($res{'stderr'}, 'no recipient matches key') >= 0 ) {
 597             $RT::Logger->debug("Although we have a key for $address, it is not the one that encrypted this message");
 598             next;
 599         }
 600
 601         $res{'exit_code'} = $?;
 602         $res{'message'} = "openssl exited with error code ". ($? >> 8)
 603             ." and error: $res{stderr}";
 604         $RT::Logger->error( $res{'message'} );
 605         $res{'status'} = $self->FormatStatus({
 606             Operation => 'Decrypt', Status => 'ERROR',
 607             Message => 'Decryption failed',
 608             EncryptedTo => $address,
 609         });
 610         return (undef, %res);
 611     }
 612     unless ( $encrypted_to ) {
 613         $RT::Logger->error("Couldn't find SMIME key for addresses: ". join ', ', @addresses);
 614         $res{'exit_code'} = 1;
 615         $res{'status'} = $self->FormatStatus({
 616             Operation => 'KeyCheck',
 617             Status    => 'MISSING',
 618             Message   => "Secret key is not available",
 619             KeyType   => 'secret',
 620         });
 621         return (undef, %res);
 622     }
 623
 624     $res{'status'} = $self->FormatStatus({
 625         Operation => 'Decrypt', Status => 'DONE',
 626         Message => 'Decryption process succeeded',
 627         EncryptedTo => $encrypted_to,
 628     });
 629
 630     return (\$buf, %res);
 631 }
 632
 633 sub FormatStatus {
 634     my $self = shift;
 635     my @status = @_;
 636
 637     my $res = '';
 638     foreach ( @status ) {
 639         while ( my ($k, $v) = each %$_ ) {
 640             $res .= "[SMIME:]". $k .": ". $v ."\n";
 641         }
 642         $res .= "[SMIME:]\n";
 643     }
 644
 645     return $res;
 646 }
 647
 648 sub ParseStatus {
 649     my $self = shift;
 650     my $status = shift;
 651     return () unless $status;
 652
 653     my @status = split /\s*(?:\[SMIME:\]\s*){2}/, $status;
 654     foreach my $block ( grep length, @status ) {
 655         chomp $block;
 656         $block = { map { s/^\s+//; s/\s+$//; $_ } map split(/:/, $_, 2), split /\s*\[SMIME:\]/, $block };
 657     }
 658     foreach my $block ( grep $_->{'EncryptedTo'}, @status ) {
 659         $block->{'EncryptedTo'} = [{
 660             EmailAddress => $block->{'EncryptedTo'},
 661         }];
 662     }
 663
 664     return @status;
 665 }
 666
 667 sub _extract_msg_from_buf {
 668     my $buf = shift;
 669     my $rtparser = RT::EmailParser->new();
 670     my $parser   = MIME::Parser->new();
 671     $rtparser->_SetupMIMEParser($parser);
 672     $parser->decode_bodies(0);
 673     $parser->output_to_core(1);
 674     unless ( $rtparser->{'entity'} = $parser->parse_data($$buf) ) {
 675         $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages");
 676
 677         # Try again, this time without extracting nested messages
 678         $parser->extract_nested_messages(0);
 679         unless ( $rtparser->{'entity'} = $parser->parse_data($$buf) ) {
 680             $RT::Logger->crit("couldn't parse MIME stream");
 681             return (undef);
 682         }
 683     }
 684     return $rtparser->Entity;
 685 }
 686
 687 sub FindScatteredParts { return () }
 688
 689 sub CheckIfProtected {
 690     my $self = shift;
 691     my %args = ( Entity => undef, @_ );
 692
 693     my $entity = $args{'Entity'};
 694
 695     my $type = $entity->effective_type;
 696     if ( $type =~ m{^application/(?:x-)?pkcs7-mime$} || $type eq 'application/octet-stream' ) {
 697         # RFC3851 ch.3.9 variant 1 and 3
 698
 699         my $security_type;
 700
 701         my $smime_type = $entity->head->mime_attr('Content-Type.smime-type');
 702         if ( $smime_type ) { # it's optional according to RFC3851
 703             if ( $smime_type eq 'enveloped-data' ) {
 704                 $security_type = 'encrypted';
 705             }
 706             elsif ( $smime_type eq 'signed-data' ) {
 707                 $security_type = 'signed';
 708             }
 709             elsif ( $smime_type eq 'certs-only' ) {
 710                 $security_type = 'certificate management';
 711             }
 712             elsif ( $smime_type eq 'compressed-data' ) {
 713                 $security_type = 'compressed';
 714             }
 715             else {
 716                 $security_type = $smime_type;
 717             }
 718         }
 719
 720         unless ( $security_type ) {
 721             my $fname = $entity->head->recommended_filename || '';
 722             if ( $fname =~ /\.p7([czsm])$/ ) {
 723                 my $type_char = $1;
 724                 if ( $type_char eq 'm' ) {
 725                     # RFC3851, ch3.4.2
 726                     # it can be both encrypted and signed
 727                     $security_type = 'encrypted';
 728                 }
 729                 elsif ( $type_char eq 's' ) {
 730                     # RFC3851, ch3.4.3, multipart/signed, XXX we should never be here
 731                     # unless message is changed by some gateway
 732                     $security_type = 'signed';
 733                 }
 734                 elsif ( $type_char eq 'c' ) {
 735                     # RFC3851, ch3.7
 736                     $security_type = 'certificate management';
 737                 }
 738                 elsif ( $type_char eq 'z' ) {
 739                     # RFC3851, ch3.5
 740                     $security_type = 'compressed';
 741                 }
 742             }
 743         }
 744         return () unless $security_type;
 745
 746         my %res = (
 747             Type   => $security_type,
 748             Format => 'RFC3851',
 749             Data   => $entity,
 750         );
 751
 752         if ( $security_type eq 'encrypted' ) {
 753             my $top = $args{'TopEntity'}->head;
 754             $res{'Recipients'} = [map {Encode::decode("UTF-8", $_)}
 755                                       grep defined && length, map $top->get($_), 'To', 'Cc'];
 756         }
 757
 758         return %res;
 759     }
 760     elsif ( $type eq 'multipart/signed' ) {
 761         # RFC3156, multipart/signed
 762         # RFC3851, ch.3.9 variant 2
 763
 764         unless ( $entity->parts == 2 ) {
 765             $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
 766             return ();
 767         }
 768
 769         my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
 770         unless ( $protocol ) {
 771             $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
 772             return ();
 773         }
 774
 775         unless ( $protocol =~ m{^application/(x-)?pkcs7-signature$} ) {
 776             $RT::Logger->info( "Skipping protocol '$protocol', only 'application/x-pkcs7-signature' is supported" );
 777             return ();
 778         }
 779         $RT::Logger->debug("Found part signed according to RFC3156");
 780         return (
 781             Type      => 'signed',
 782             Format    => 'RFC3156',
 783             Data      => $entity,
 784         );
 785     }
 786     return ();
 787 }
 788
 789 sub GetKeysForEncryption {
 790     my $self = shift;
 791     my %args = (Recipient => undef, @_);
 792     return $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
 793 }
 794
 795 sub GetKeysForSigning {
 796     my $self = shift;
 797     my %args = (Signer => undef, @_);
 798     return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
 799 }
 800
 801 sub GetKeysInfo {
 802     my $self = shift;
 803     my %args = (
 804         Key   => undef,
 805         Type  => 'public',
 806         Force => 0,
 807         @_
 808     );
 809
 810     my $email = $args{'Key'};
 811     unless ( $email ) {
 812         return (exit_code => 0); # unless $args{'Force'};
 813     }
 814
 815     my $key = $self->GetKeyContent( %args );
 816     return (exit_code => 0) unless $key;
 817
 818     return $self->GetCertificateInfo( Certificate => $key );
 819 }
 820
 821 sub GetKeyContent {
 822     my $self = shift;
 823     my %args = ( Key => undef, @_ );
 824
 825     my $key;
 826     if ( my $file = $self->CheckKeyring( %args ) ) {
 827         open my $fh, '<:raw', $file
 828             or die "Couldn't open file '$file': $!";
 829         $key = do { local $/; readline $fh };
 830         close $fh;
 831     }
 832     else {
 833         my $user = RT::User->new( RT->SystemUser );
 834         $user->LoadByEmail( $args{'Key'} );
 835         $key = $user->SMIMECertificate if $user->id;
 836     }
 837     return $key;
 838 }
 839
 840 sub CheckKeyring {
 841     my $self = shift;
 842     my %args = (
 843         Key => undef,
 844         @_,
 845     );
 846     my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
 847     return undef unless $keyring;
 848
 849     my $file = File::Spec->catfile( $keyring, $args{'Key'} .'.pem' );
 850     return undef unless -f $file;
 851
 852     return $file;
 853 }
 854
 855 sub GetCertificateInfo {
 856     my $self = shift;
 857     my %args = (
 858         Certificate => undef,
 859         @_,
 860     );
 861
 862     if ($args{Certificate} =~ /^-----BEGIN \s+ CERTIFICATE----- \s* $
 863                                 (.*?)
 864                                ^-----END \s+ CERTIFICATE----- \s* $/smx) {
 865         $args{Certificate} = MIME::Base64::decode_base64($1);
 866     }
 867
 868     my $cert = Crypt::X509->new( cert => $args{Certificate} );
 869     return ( exit_code => 1, stderr => $cert->error ) if $cert->error;
 870
 871     my %USER_MAP = (
 872         Country          => 'country',
 873         StateOrProvince  => 'state',
 874         Organization     => 'org',
 875         OrganizationUnit => 'ou',
 876         Name             => 'cn',
 877         EmailAddress     => 'email',
 878     );
 879     my $canonicalize = sub {
 880         my $type = shift;
 881         my %data;
 882         for (keys %USER_MAP) {
 883             my $method = $type . "_" . $USER_MAP{$_};
 884             $data{$_} = $cert->$method if $cert->can($method);
 885         }
 886         $data{String} = Email::Address->new( @data{'Name', 'EmailAddress'} )->format
 887             if $data{EmailAddress};
 888         return \%data;
 889     };
 890
 891     my $PEM = "-----BEGIN CERTIFICATE-----\n"
 892         . MIME::Base64::encode_base64( $args{Certificate} )
 893         . "-----END CERTIFICATE-----\n";
 894
 895     my %res = (
 896         exit_code => 0,
 897         info => [ {
 898             Content         => $PEM,
 899             Fingerprint     => Digest::SHA::sha1_hex($args{Certificate}),
 900             'Serial Number' => $cert->serial,
 901             Created         => $self->ParseDate( $cert->not_before ),
 902             Expire          => $self->ParseDate( $cert->not_after ),
 903             Version         => sprintf("%d (0x%x)",hex($cert->version || 0)+1, hex($cert->version || 0)),
 904             Issuer          => [ $canonicalize->( 'issuer' ) ],
 905             User            => [ $canonicalize->( 'subject' ) ],
 906         } ],
 907         stderr => ''
 908     );
 909
 910     # Check the validity
 911     my $ca = RT->Config->Get('SMIME')->{'CAPath'};
 912     if ($ca) {
 913         my @ca_verify;
 914         if (-d $ca) {
 915             @ca_verify = ('-CApath', $ca);
 916         } elsif (-f $ca) {
 917             @ca_verify = ('-CAfile', $ca);
 918         }
 919
 920         local $SIG{CHLD} = 'DEFAULT';
 921         my $cmd = [
 922             $self->OpenSSLPath,
 923             'verify', @ca_verify,
 924         ];
 925         my $buf = '';
 926         safe_run_child { run3( $cmd, \$PEM, \$buf, \$res{stderr} ) };
 927
 928         if ($buf =~ /^stdin: OK$/) {
 929             $res{info}[0]{Trust} = "Signed by trusted CA $res{info}[0]{Issuer}[0]{String}";
 930             $res{info}[0]{TrustTerse} = "full";
 931             $res{info}[0]{TrustLevel} = 2;
 932         } elsif ($? == 0 or ($? >> 8) == 2) {
 933             $res{info}[0]{Trust} = "UNTRUSTED signing CA $res{info}[0]{Issuer}[0]{String}";
 934             $res{info}[0]{TrustTerse} = "none";
 935             $res{info}[0]{TrustLevel} = -1;
 936         } else {
 937             $res{exit_code} = $?;
 938             $res{message} = "openssl exited with error code ". ($? >> 8)
 939                 ." and stout: $buf";
 940             $res{info}[0]{Trust} = "unknown (openssl failed)";
 941             $res{info}[0]{TrustTerse} = "unknown";
 942             $res{info}[0]{TrustLevel} = 0;
 943         }
 944     } else {
 945         $res{info}[0]{Trust} = "unknown (no CAPath set)";
 946         $res{info}[0]{TrustTerse} = "unknown";
 947         $res{info}[0]{TrustLevel} = 0;
 948     }
 949
 950     $res{info}[0]{Formatted} = $res{info}[0]{User}[0]{String}
 951         . " (issued by $res{info}[0]{Issuer}[0]{String})";
 952
 953     return %res;
 954 }
 955
 956 1;