5351dba82ac5428b483f7355e976fc190b5015f2
[usit-rt.git] / 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;