1# -- 2# Copyright (C) 2001-2020 OTRS AG, https://otrs.com/ 3# -- 4# This software comes with ABSOLUTELY NO WARRANTY. For details, see 5# the enclosed file COPYING for license information (GPL). If you 6# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt. 7# -- 8 9package Kernel::Output::HTML::ArticleCheck::SMIME; 10 11use strict; 12use warnings; 13 14use Kernel::System::EmailParser; 15use Kernel::Language qw(Translatable); 16 17our @ObjectDependencies = ( 18 'Kernel::Config', 19 'Kernel::System::Crypt::SMIME', 20 'Kernel::System::Log', 21 'Kernel::System::Ticket::Article', 22 'Kernel::Output::HTML::Layout', 23); 24 25sub new { 26 my ( $Type, %Param ) = @_; 27 28 my $Self = {}; 29 bless( $Self, $Type ); 30 31 for my $Needed (qw(UserID ArticleID)) { 32 if ( $Param{$Needed} ) { 33 $Self->{$Needed} = $Param{$Needed}; 34 } 35 else { 36 $Kernel::OM->Get('Kernel::System::Log')->Log( 37 Priority => 'error', 38 Message => "Need $Needed!" 39 ); 40 } 41 } 42 43 return $Self; 44} 45 46sub Check { 47 my ( $Self, %Param ) = @_; 48 49 my %SignCheck; 50 my @Return; 51 52 my $ConfigObject = $Param{ConfigObject} || $Kernel::OM->Get('Kernel::Config'); 53 my $LayoutObject = $Param{LayoutObject} || $Kernel::OM->Get('Kernel::Output::HTML::Layout'); 54 55 my $UserType = $LayoutObject->{UserType} // ''; 56 my $ChangeUserID = $UserType eq 'Customer' ? $ConfigObject->Get('CustomerPanelUserID') : $Self->{UserID}; 57 58 # check if smime is enabled 59 return if !$ConfigObject->Get('SMIME'); 60 61 # check if article is an email 62 my $ArticleBackendObject 63 = $Kernel::OM->Get('Kernel::System::Ticket::Article')->BackendForArticle( %{ $Param{Article} // {} } ); 64 return if $ArticleBackendObject->ChannelNameGet() ne 'Email'; 65 66 my $SMIMEObject = $Kernel::OM->Get('Kernel::System::Crypt::SMIME'); 67 68 # check inline smime 69 if ( $Param{Article}->{Body} && $Param{Article}->{Body} =~ /^-----BEGIN PKCS7-----/ ) { 70 %SignCheck = $SMIMEObject->Verify( Message => $Param{Article}->{Body} ); 71 if (%SignCheck) { 72 73 # remember to result 74 $Self->{Result} = \%SignCheck; 75 } 76 else { 77 78 # return with error 79 push( 80 @Return, 81 { 82 Key => Translatable('Signed'), 83 Value => Translatable('"S/MIME SIGNED MESSAGE" header found, but invalid!'), 84 } 85 ); 86 } 87 } 88 89 # check smime 90 else { 91 92 # get email from fs 93 my $Message = $ArticleBackendObject->ArticlePlain( 94 TicketID => $Param{Article}->{TicketID}, 95 ArticleID => $Self->{ArticleID}, 96 UserID => $Self->{UserID}, 97 ); 98 return if !$Message; 99 100 my @Email = (); 101 my @Lines = split( /\n/, $Message ); 102 for my $Line (@Lines) { 103 push( @Email, $Line . "\n" ); 104 } 105 106 my $ParserObject = Kernel::System::EmailParser->new( 107 Email => \@Email, 108 ); 109 110 use MIME::Parser; 111 my $Parser = MIME::Parser->new(); 112 $Parser->decode_headers(0); 113 $Parser->extract_nested_messages(0); 114 $Parser->output_to_core("ALL"); 115 my $Entity = $Parser->parse_data($Message); 116 my $Head = $Entity->head(); 117 $Head->unfold(); 118 $Head->combine('Content-Type'); 119 my $ContentType = $Head->get('Content-Type'); 120 121 if ( 122 $ContentType 123 && $ContentType =~ /application\/(x-pkcs7|pkcs7)-mime/i 124 && $ContentType !~ /signed/i 125 ) 126 { 127 128 # check if article is already decrypted 129 if ( $Param{Article}->{Body} && $Param{Article}->{Body} ne '- no text message => see attachment -' ) { 130 push( 131 @Return, 132 { 133 Key => Translatable('Crypted'), 134 Value => Translatable('Ticket decrypted before'), 135 Successful => 1, 136 } 137 ); 138 } 139 140 # check sender (don't decrypt sent emails) 141 if ( $Param{Article}->{SenderType} && $Param{Article}->{SenderType} =~ /(agent|system)/i ) { 142 143 # return info 144 return ( 145 { 146 Key => Translatable('Crypted'), 147 Value => Translatable('Sent message encrypted to recipient!'), 148 Successful => 1, 149 } 150 ); 151 } 152 153 # get all email addresses on article 154 my %EmailsToSearch; 155 for my $Email (qw(Resent-To Envelope-To To Cc Delivered-To X-Original-To)) { 156 157 my @EmailAddressOnField = $ParserObject->SplitAddressLine( 158 Line => $ParserObject->GetParam( WHAT => $Email ), 159 ); 160 161 # filter email addresses avoiding repeated and save on hash to search 162 for my $EmailAddress (@EmailAddressOnField) { 163 my $CleanEmailAddress = $ParserObject->GetEmailAddress( 164 Email => $EmailAddress, 165 ); 166 $EmailsToSearch{$CleanEmailAddress} = '1'; 167 } 168 } 169 170 # look for private keys for every email address 171 # extract every resulting cert and put it into an hash of hashes avoiding repeated 172 my %PrivateKeys; 173 for my $EmailAddress ( sort keys %EmailsToSearch ) { 174 my @PrivateKeysResult = $SMIMEObject->PrivateSearch( 175 Search => $EmailAddress, 176 ); 177 for my $Cert (@PrivateKeysResult) { 178 $PrivateKeys{ $Cert->{Filename} } = $Cert; 179 } 180 } 181 182 # search private cert to decrypt email 183 if ( !%PrivateKeys ) { 184 push( 185 @Return, 186 { 187 Key => Translatable('Crypted'), 188 Value => Translatable('Impossible to decrypt: private key for email was not found!'), 189 } 190 ); 191 return @Return; 192 } 193 194 my %Decrypt; 195 PRIVATESEARCH: 196 for my $CertResult ( values %PrivateKeys ) { 197 198 # decrypt 199 %Decrypt = $SMIMEObject->Decrypt( 200 Message => $Message, 201 SearchingNeededKey => 1, 202 %{$CertResult}, 203 ); 204 last PRIVATESEARCH if ( $Decrypt{Successful} ); 205 } 206 207 # ok, decryption went fine 208 if ( $Decrypt{Successful} ) { 209 210 push( 211 @Return, 212 { 213 Key => Translatable('Crypted'), 214 Value => $Decrypt{Message} || Translatable('Successful decryption'), 215 %Decrypt, 216 } 217 ); 218 219 # store decrypted data 220 my $EmailContent = $Decrypt{Data}; 221 222 # now check if the data contains a signature too 223 %SignCheck = $SMIMEObject->Verify( 224 Message => $Decrypt{Data}, 225 ); 226 227 if ( $SignCheck{SignatureFound} ) { 228 229 # If the signature was verified well, use the stripped content to store the email. 230 # Now it contains only the email without other SMIME generated data. 231 $EmailContent = $SignCheck{Content} if $SignCheck{Successful}; 232 233 push( 234 @Return, 235 { 236 Key => Translatable('Signed'), 237 Value => $SignCheck{Message}, 238 %SignCheck, 239 } 240 ); 241 } 242 243 # parse the decrypted email body 244 my $ParserObject = Kernel::System::EmailParser->new( 245 Email => $EmailContent 246 ); 247 my $Body = $ParserObject->GetMessageBody(); 248 249 # from RFC 3850 250 # 3. Using Distinguished Names for Internet Mail 251 # 252 # End-entity certificates MAY contain ... 253 # 254 # ... 255 # 256 # Sending agents SHOULD make the address in the From or Sender header 257 # in a mail message match an Internet mail address in the signer's 258 # certificate. Receiving agents MUST check that the address in the 259 # From or Sender header of a mail message matches an Internet mail 260 # address, if present, in the signer's certificate, if mail addresses 261 # are present in the certificate. A receiving agent SHOULD provide 262 # some explicit alternate processing of the message if this comparison 263 # fails, which may be to display a message that shows the recipient the 264 # addresses in the certificate or other certificate details. 265 266 # as described in bug#5098 and RFC 3850 an alternate mail handling should be 267 # made if sender and signer addresses does not match 268 269 # get original sender from email 270 my @OrigEmail = map {"$_\n"} split( /\n/, $Message ); 271 my $ParserObjectOrig = Kernel::System::EmailParser->new( 272 Email => \@OrigEmail, 273 ); 274 275 my $OrigFrom = $ParserObjectOrig->GetParam( WHAT => 'From' ); 276 my $OrigSender = $ParserObjectOrig->GetEmailAddress( Email => $OrigFrom ); 277 278 # compare sender email to signer email 279 my $SignerSenderMatch = 0; 280 SIGNER: 281 for my $Signer ( @{ $SignCheck{Signers} } ) { 282 if ( $OrigSender =~ m{\A \Q$Signer\E \z}xmsi ) { 283 $SignerSenderMatch = 1; 284 last SIGNER; 285 } 286 } 287 288 # sender email does not match signing certificate! 289 if ( !$SignerSenderMatch ) { 290 $SignCheck{Successful} = 0; 291 $SignCheck{Message} =~ s/successful/failed!/; 292 $SignCheck{Message} .= " (signed by " 293 . join( ' | ', @{ $SignCheck{Signers} } ) 294 . ")" 295 . ", but sender address $OrigSender: does not match certificate address!"; 296 } 297 298 # Determine if we have decrypted article and attachments before. 299 my %Index = $ArticleBackendObject->ArticleAttachmentIndex( 300 ArticleID => $Self->{ArticleID}, 301 ); 302 303 if ( 304 !grep { $Index{$_}->{ContentType} =~ m{ application/ (?: x- )? pkcs7-mime }xms } sort keys %Index 305 ) 306 { 307 return @Return; 308 } 309 310 # updated article body 311 $ArticleBackendObject->ArticleUpdate( 312 TicketID => $Param{Article}->{TicketID}, 313 ArticleID => $Self->{ArticleID}, 314 Key => 'Body', 315 Value => $Body, 316 UserID => $ChangeUserID, 317 ); 318 319 # delete crypted attachments 320 $ArticleBackendObject->ArticleDeleteAttachment( 321 ArticleID => $Self->{ArticleID}, 322 UserID => $ChangeUserID, 323 ); 324 325 # write attachments to the storage 326 for my $Attachment ( $ParserObject->GetAttachments() ) { 327 $ArticleBackendObject->ArticleWriteAttachment( 328 %{$Attachment}, 329 ArticleID => $Self->{ArticleID}, 330 UserID => $ChangeUserID, 331 ); 332 } 333 334 return @Return; 335 } 336 else { 337 push( 338 @Return, 339 { 340 Key => Translatable('Crypted'), 341 Value => "$Decrypt{Message}", 342 %Decrypt, 343 } 344 ); 345 } 346 } 347 348 if ( 349 $ContentType 350 && $ContentType =~ /application\/(x-pkcs7|pkcs7)/i 351 && $ContentType =~ /signed/i 352 ) 353 { 354 355 # check sign and get clear content 356 %SignCheck = $SMIMEObject->Verify( 357 Message => $Message, 358 ); 359 360 # parse and update clear content 361 if ( %SignCheck && $SignCheck{Successful} && $SignCheck{Content} ) { 362 363 my @Email = (); 364 my @Lines = split( /\n/, $SignCheck{Content} ); 365 for (@Lines) { 366 push( @Email, $_ . "\n" ); 367 } 368 my $ParserObject = Kernel::System::EmailParser->new( 369 Email => \@Email, 370 ); 371 my $Body = $ParserObject->GetMessageBody(); 372 373 # from RFC 3850 374 # 3. Using Distinguished Names for Internet Mail 375 # 376 # End-entity certificates MAY contain ... 377 # 378 # ... 379 # 380 # Sending agents SHOULD make the address in the From or Sender header 381 # in a mail message match an Internet mail address in the signer's 382 # certificate. Receiving agents MUST check that the address in the 383 # From or Sender header of a mail message matches an Internet mail 384 # address, if present, in the signer's certificate, if mail addresses 385 # are present in the certificate. A receiving agent SHOULD provide 386 # some explicit alternate processing of the message if this comparison 387 # fails, which may be to display a message that shows the recipient the 388 # addresses in the certificate or other certificate details. 389 390 # as described in bug#5098 and RFC 3850 an alternate mail handling should be 391 # made if sender and signer addresses does not match 392 393 # get original sender from email 394 my @OrigEmail = map {"$_\n"} split( /\n/, $Message ); 395 my $ParserObjectOrig = Kernel::System::EmailParser->new( 396 Email => \@OrigEmail, 397 ); 398 399 my $OrigFrom = $ParserObjectOrig->GetParam( WHAT => 'From' ); 400 my $OrigSender = $ParserObjectOrig->GetEmailAddress( Email => $OrigFrom ); 401 402 # compare sender email to signer email 403 my $SignerSenderMatch = 0; 404 SIGNER: 405 for my $Signer ( @{ $SignCheck{Signers} } ) { 406 if ( $OrigSender =~ m{\A \Q$Signer\E \z}xmsi ) { 407 $SignerSenderMatch = 1; 408 last SIGNER; 409 } 410 } 411 412 # sender email does not match signing certificate! 413 if ( !$SignerSenderMatch ) { 414 $SignCheck{Successful} = 0; 415 $SignCheck{Message} =~ s/successful/failed!/; 416 $SignCheck{Message} .= " (signed by " 417 . join( ' | ', @{ $SignCheck{Signers} } ) 418 . ")" 419 . ", but sender address $OrigSender: does not match certificate address!"; 420 } 421 422 # Determine if we have decrypted article and attachments before. 423 my %Index = $ArticleBackendObject->ArticleAttachmentIndex( 424 ArticleID => $Self->{ArticleID}, 425 ); 426 427 if ( 428 grep { $Index{$_}->{ContentType} =~ m{ application/ (?: x- )? pkcs7 }xms } sort keys %Index 429 ) 430 { 431 432 # Update article body. 433 $ArticleBackendObject->ArticleUpdate( 434 TicketID => $Param{Article}->{TicketID}, 435 ArticleID => $Self->{ArticleID}, 436 Key => 'Body', 437 Value => $Body, 438 UserID => $ChangeUserID, 439 ); 440 441 # Delete crypted attachments. 442 $ArticleBackendObject->ArticleDeleteAttachment( 443 ArticleID => $Self->{ArticleID}, 444 UserID => $ChangeUserID, 445 ); 446 447 # Write decrypted attachments to the storage. 448 for my $Attachment ( $ParserObject->GetAttachments() ) { 449 $ArticleBackendObject->ArticleWriteAttachment( 450 %{$Attachment}, 451 ArticleID => $Self->{ArticleID}, 452 UserID => $ChangeUserID, 453 ); 454 } 455 } 456 457 } 458 459 # output signature verification errors 460 elsif ( 461 %SignCheck 462 && !$SignCheck{SignatureFound} 463 && !$SignCheck{Successful} 464 && !$SignCheck{Content} 465 ) 466 { 467 468 # return result 469 push( 470 @Return, 471 { 472 Key => Translatable('Signed'), 473 Value => $SignCheck{Message}, 474 %SignCheck, 475 } 476 ); 477 } 478 } 479 } 480 481 if ( $SignCheck{SignatureFound} ) { 482 483 # return result 484 push( 485 @Return, 486 { 487 Key => Translatable('Signed'), 488 Value => $SignCheck{Message}, 489 %SignCheck, 490 } 491 ); 492 } 493 return @Return; 494} 495 496sub Filter { 497 my ( $Self, %Param ) = @_; 498 499 # remove signature if one is found 500 if ( $Self->{Result}->{SignatureFound} ) { 501 502 # remove SMIME begin signed message 503 $Param{Article}->{Body} =~ s/^-----BEGIN\sPKCS7-----.+?Hash:\s.+?$//sm; 504 505 # remove SMIME inline sign 506 $Param{Article}->{Body} =~ s/^-----END\sPKCS7-----//sm; 507 } 508 return 1; 509} 5101; 511