Master to 4.2.8
[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(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 %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     return %res;
951 }
952
953 1;