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