Master to 4.2.8
[usit-rt.git] / lib / RT / Crypt / SMIME.pm
CommitLineData
af59614d
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
af59614d
MKG
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
49use strict;
50use warnings;
51use 5.010;
52
53package RT::Crypt::SMIME;
54
55use Role::Basic 'with';
56with 'RT::Crypt::Role';
57
58use RT::Crypt;
59use File::Which qw();
60use IPC::Run3 0.036 'run3';
61use RT::Util 'safe_run_child';
62use Crypt::X509;
63use String::ShellQuote 'shell_quote';
64
65=head1 NAME
66
67RT::Crypt::SMIME - encrypt/decrypt and sign/verify email messages with the SMIME
68
69=head1 CONFIGURATION
70
71You 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
88Path to openssl executable.
89
90=head3 Keyring
91
92Path to directory with keys and certificates for queues. Key and
93certificates should be stored in a PEM file named, e.g.,
94F<email.address@example.com.pem>. See L</Keyring configuration>.
95
96=head3 CAPath
97
98C<CAPath> should be set to either a PEM-formatted certificate of a
99single signing certificate authority, or a directory of such (including
100hash symlinks as created by the openssl tool C<c_rehash>). Only SMIME
101certificates signed by these certificate authorities will be treated as
102valid signatures. If left unset (and C<AcceptUntrustedCAs> is unset, as
103it is by default), no signatures will be marked as valid!
104
105=head3 AcceptUntrustedCAs
106
107Allows arbitrary SMIME certificates, no matter their signing entities.
108Such mails will be marked as untrusted, but signed; C<CAPath> will be
109used to mark which mails are signed by trusted certificate authorities.
110This configuration is generally insecure, as it allows the possibility
111of accepting forged mail signed by an untrusted certificate authority.
112
113Setting this option also allows encryption to users with certificates
114created by untrusted CAs.
115
116=head3 Passphrase
117
118C<Passphrase> may be set to a scalar (to use for all keys), an anonymous
119function, 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
124RT looks for keys in the directory configured in the L</Keyring> option
125of the L<RT_Config/%SMIME>. While public certificates are also stored
126on users, private SSL keys are only loaded from disk. Keys and
127certificates should be concatenated, in in PEM format, in files named
128C<email.address@example.com.pem>, for example.
129
130These files need be readable by the web server user which is running
131RT's web interface; however, if you are running cronjobs or other
132utilities that access RT directly via API, and may generate
133encrypted/signed notifications, then the users you execute these scripts
134under must have access too.
135
136The keyring on disk will be checked before the user with the email
137address is examined. If the file exists, it will be used in preference
138to the certificate on the user.
139
140=cut
141
142sub OpenSSLPath {
143 state $cache = RT->Config->Get('SMIME')->{'OpenSSL'};
144 $cache = $_[1] if @_ > 1;
145 return $cache;
146}
147
148sub 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 {
320f0092
MKG
166 local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin'
167 unless defined $ENV{PATH};
af59614d
MKG
168 my $path = File::Which::which( $bin );
169 unless ($path) {
170 $RT::Logger->warning(
320f0092
MKG
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");
af59614d
MKG
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
203sub 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'} = [
c33a4027 223 grep !$seen{$_}++, map $_->address, map Email::Address->parse(Encode::decode("UTF-8",$_)),
af59614d
MKG
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
255sub 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
267sub _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
c33a4027 330 my @commands;
af59614d
MKG
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
c33a4027 346 push @commands, [
af59614d
MKG
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 : (),
c33a4027 353 ];
af59614d
MKG
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 }
c33a4027 362 push @commands, [
af59614d
MKG
363 $self->OpenSSLPath, qw(smime -encrypt -des3),
364 map { $_->filename } @keys
c33a4027 365 ];
af59614d
MKG
366 }
367
c33a4027
MKG
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;
af59614d 387 }
af59614d
MKG
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
403sub 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
420sub 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
518sub 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
548sub 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
560sub _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
633sub 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
648sub 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
667sub _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
687sub FindScatteredParts { return () }
688
689sub 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;
c33a4027
MKG
754 $res{'Recipients'} = [map {Encode::decode("UTF-8", $_)}
755 grep defined && length, map $top->get($_), 'To', 'Cc'];
af59614d
MKG
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
789sub GetKeysForEncryption {
790 my $self = shift;
791 my %args = (Recipient => undef, @_);
792 return $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
793}
794
795sub GetKeysForSigning {
796 my $self = shift;
797 my %args = (Signer => undef, @_);
798 return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
799}
800
801sub 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
821sub 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
840sub 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
855sub 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
9531;