rt/lib/RT/Crypt/SMIME.pm

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