]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
320f0092 | 5 | # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC |
84fb5b46 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 | ||
49 | package RT::Interface::Email; | |
50 | ||
51 | use strict; | |
52 | use warnings; | |
53 | ||
54 | use Email::Address; | |
55 | use MIME::Entity; | |
56 | use RT::EmailParser; | |
57 | use File::Temp; | |
84fb5b46 MKG |
58 | use Mail::Mailer (); |
59 | use Text::ParseWords qw/shellwords/; | |
60 | ||
61 | BEGIN { | |
62 | use base 'Exporter'; | |
63 | use vars qw ( @EXPORT_OK); | |
64 | ||
84fb5b46 MKG |
65 | # your exported package globals go here, |
66 | # as well as any optionally exported functions | |
67 | @EXPORT_OK = qw( | |
68 | &CreateUser | |
69 | &GetMessageContent | |
70 | &CheckForLoops | |
71 | &CheckForSuspiciousSender | |
72 | &CheckForAutoGenerated | |
73 | &CheckForBounce | |
74 | &MailError | |
75 | &ParseCcAddressesFromHead | |
76 | &ParseSenderAddressFromHead | |
77 | &ParseErrorsToAddressFromHead | |
78 | &ParseAddressFromHeader | |
79 | &Gateway); | |
80 | ||
81 | } | |
82 | ||
83 | =head1 NAME | |
84 | ||
85 | RT::Interface::Email - helper functions for parsing email sent to RT | |
86 | ||
87 | =head1 SYNOPSIS | |
88 | ||
89 | use lib "!!RT_LIB_PATH!!"; | |
90 | use lib "!!RT_ETC_PATH!!"; | |
91 | ||
92 | use RT::Interface::Email qw(Gateway CreateUser); | |
93 | ||
94 | =head1 DESCRIPTION | |
95 | ||
96 | ||
97 | ||
98 | ||
99 | =head1 METHODS | |
100 | ||
101 | =head2 CheckForLoops HEAD | |
102 | ||
103 | Takes a HEAD object of L<MIME::Head> class and returns true if the | |
104 | message's been sent by this RT instance. Uses "X-RT-Loop-Prevention" | |
105 | field of the head for test. | |
106 | ||
107 | =cut | |
108 | ||
109 | sub CheckForLoops { | |
110 | my $head = shift; | |
111 | ||
112 | # If this instance of RT sent it our, we don't want to take it in | |
c33a4027 | 113 | my $RTLoop = Encode::decode( "UTF-8", $head->get("X-RT-Loop-Prevention") || "" ); |
84fb5b46 MKG |
114 | chomp ($RTLoop); # remove that newline |
115 | if ( $RTLoop eq RT->Config->Get('rtname') ) { | |
116 | return 1; | |
117 | } | |
118 | ||
119 | # TODO: We might not trap the case where RT instance A sends a mail | |
120 | # to RT instance B which sends a mail to ... | |
121 | return undef; | |
122 | } | |
123 | ||
124 | =head2 CheckForSuspiciousSender HEAD | |
125 | ||
126 | Takes a HEAD object of L<MIME::Head> class and returns true if sender | |
127 | is suspicious. Suspicious means mailer daemon. | |
128 | ||
129 | See also L</ParseSenderAddressFromHead>. | |
130 | ||
131 | =cut | |
132 | ||
133 | sub CheckForSuspiciousSender { | |
134 | my $head = shift; | |
135 | ||
136 | #if it's from a postmaster or mailer daemon, it's likely a bounce. | |
137 | ||
138 | #TODO: better algorithms needed here - there is no standards for | |
139 | #bounces, so it's very difficult to separate them from anything | |
140 | #else. At the other hand, the Return-To address is only ment to be | |
141 | #used as an error channel, we might want to put up a separate | |
142 | #Return-To address which is treated differently. | |
143 | ||
144 | #TODO: search through the whole email and find the right Ticket ID. | |
145 | ||
146 | my ( $From, $junk ) = ParseSenderAddressFromHead($head); | |
147 | ||
403d7b0b MKG |
148 | # If unparseable (non-ASCII), $From can come back undef |
149 | return undef if not defined $From; | |
150 | ||
84fb5b46 MKG |
151 | if ( ( $From =~ /^mailer-daemon\@/i ) |
152 | or ( $From =~ /^postmaster\@/i ) | |
153 | or ( $From eq "" )) | |
154 | { | |
155 | return (1); | |
156 | ||
157 | } | |
158 | ||
159 | return undef; | |
160 | } | |
161 | ||
162 | =head2 CheckForAutoGenerated HEAD | |
163 | ||
c33a4027 MKG |
164 | Takes a HEAD object of L<MIME::Head> class and returns true if message is |
165 | autogenerated. Checks C<Precedence>, C<Auto-Submitted>, and | |
166 | C<X-FC-Machinegenerated> fields of the head in tests. | |
84fb5b46 MKG |
167 | |
168 | =cut | |
169 | ||
170 | sub CheckForAutoGenerated { | |
171 | my $head = shift; | |
172 | ||
c33a4027 | 173 | if (grep { /^(bulk|junk)/i } $head->get_all("Precedence")) { |
84fb5b46 MKG |
174 | return (1); |
175 | } | |
176 | ||
177 | # Per RFC3834, any Auto-Submitted header which is not "no" means | |
178 | # it is auto-generated. | |
179 | my $AutoSubmitted = $head->get("Auto-Submitted") || ""; | |
180 | if ( length $AutoSubmitted and $AutoSubmitted ne "no" ) { | |
181 | return (1); | |
182 | } | |
183 | ||
184 | # First Class mailer uses this as a clue. | |
185 | my $FCJunk = $head->get("X-FC-Machinegenerated") || ""; | |
186 | if ( $FCJunk =~ /^true/i ) { | |
187 | return (1); | |
188 | } | |
189 | ||
190 | return (0); | |
191 | } | |
192 | ||
193 | ||
194 | sub CheckForBounce { | |
195 | my $head = shift; | |
196 | ||
197 | my $ReturnPath = $head->get("Return-path") || ""; | |
198 | return ( $ReturnPath =~ /<>/ ); | |
199 | } | |
200 | ||
201 | ||
202 | =head2 MailError PARAM HASH | |
203 | ||
204 | Sends an error message. Takes a param hash: | |
205 | ||
206 | =over 4 | |
207 | ||
208 | =item From - sender's address, by default is 'CorrespondAddress'; | |
209 | ||
210 | =item To - recipient, by default is 'OwnerEmail'; | |
211 | ||
212 | =item Bcc - optional Bcc recipients; | |
213 | ||
214 | =item Subject - subject of the message, default is 'There has been an error'; | |
215 | ||
216 | =item Explanation - main content of the error, default value is 'Unexplained error'; | |
217 | ||
218 | =item MIMEObj - optional MIME entity that's attached to the error mail, as well we | |
219 | add 'In-Reply-To' field to the error that points to this message. | |
220 | ||
221 | =item Attach - optional text that attached to the error as 'message/rfc822' part. | |
222 | ||
5b0d0914 MKG |
223 | =item LogLevel - log level under which we should write the subject and |
224 | explanation message into the log, by default we log it as critical. | |
84fb5b46 MKG |
225 | |
226 | =back | |
227 | ||
228 | =cut | |
229 | ||
230 | sub MailError { | |
231 | my %args = ( | |
232 | To => RT->Config->Get('OwnerEmail'), | |
233 | Bcc => undef, | |
234 | From => RT->Config->Get('CorrespondAddress'), | |
235 | Subject => 'There has been an error', | |
236 | Explanation => 'Unexplained error', | |
237 | MIMEObj => undef, | |
238 | Attach => undef, | |
239 | LogLevel => 'crit', | |
240 | @_ | |
241 | ); | |
242 | ||
243 | $RT::Logger->log( | |
244 | level => $args{'LogLevel'}, | |
5b0d0914 | 245 | message => "$args{Subject}: $args{'Explanation'}", |
84fb5b46 MKG |
246 | ) if $args{'LogLevel'}; |
247 | ||
248 | # the colons are necessary to make ->build include non-standard headers | |
249 | my %entity_args = ( | |
250 | Type => "multipart/mixed", | |
c33a4027 MKG |
251 | From => Encode::encode( "UTF-8", $args{'From'} ), |
252 | Bcc => Encode::encode( "UTF-8", $args{'Bcc'} ), | |
253 | To => Encode::encode( "UTF-8", $args{'To'} ), | |
254 | Subject => EncodeToMIME( String => $args{'Subject'} ), | |
255 | 'X-RT-Loop-Prevention:' => Encode::encode( "UTF-8", RT->Config->Get('rtname') ), | |
84fb5b46 MKG |
256 | ); |
257 | ||
258 | # only set precedence if the sysadmin wants us to | |
259 | if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) { | |
c33a4027 MKG |
260 | $entity_args{'Precedence:'} = |
261 | Encode::encode( "UTF-8", RT->Config->Get('DefaultErrorMailPrecedence') ); | |
84fb5b46 MKG |
262 | } |
263 | ||
264 | my $entity = MIME::Entity->build(%entity_args); | |
265 | SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} ); | |
266 | ||
c33a4027 MKG |
267 | $entity->attach( |
268 | Type => "text/plain", | |
269 | Charset => "UTF-8", | |
270 | Data => Encode::encode( "UTF-8", $args{'Explanation'} . "\n" ), | |
271 | ); | |
84fb5b46 MKG |
272 | |
273 | if ( $args{'MIMEObj'} ) { | |
274 | $args{'MIMEObj'}->sync_headers; | |
275 | $entity->add_part( $args{'MIMEObj'} ); | |
276 | } | |
277 | ||
278 | if ( $args{'Attach'} ) { | |
c33a4027 | 279 | $entity->attach( Data => Encode::encode( "UTF-8", $args{'Attach'} ), Type => 'message/rfc822' ); |
84fb5b46 MKG |
280 | |
281 | } | |
282 | ||
283 | SendEmail( Entity => $entity, Bounce => 1 ); | |
284 | } | |
285 | ||
286 | ||
287 | =head2 SendEmail Entity => undef, [ Bounce => 0, Ticket => undef, Transaction => undef ] | |
288 | ||
289 | Sends an email (passed as a L<MIME::Entity> object C<ENTITY>) using | |
290 | RT's outgoing mail configuration. If C<BOUNCE> is passed, and is a | |
291 | true value, the message will be marked as an autogenerated error, if | |
292 | possible. Sets Date field of the head to now if it's not set. | |
293 | ||
294 | If the C<X-RT-Squelch> header is set to any true value, the mail will | |
295 | not be sent. One use is to let extensions easily cancel outgoing mail. | |
296 | ||
297 | Ticket and Transaction arguments are optional. If Transaction is | |
298 | specified and Ticket is not then ticket of the transaction is | |
299 | used, but only if the transaction belongs to a ticket. | |
300 | ||
301 | Returns 1 on success, 0 on error or -1 if message has no recipients | |
302 | and hasn't been sent. | |
303 | ||
304 | =head3 Signing and Encrypting | |
305 | ||
306 | This function as well signs and/or encrypts the message according to | |
307 | headers of a transaction's attachment or properties of a ticket's queue. | |
308 | To get full access to the configuration Ticket and/or Transaction | |
309 | arguments must be provided, but you can force behaviour using Sign | |
310 | and/or Encrypt arguments. | |
311 | ||
312 | The following precedence of arguments are used to figure out if | |
313 | the message should be encrypted and/or signed: | |
314 | ||
315 | * if Sign or Encrypt argument is defined then its value is used | |
316 | ||
317 | * else if Transaction's first attachment has X-RT-Sign or X-RT-Encrypt | |
318 | header field then it's value is used | |
319 | ||
320 | * else properties of a queue of the Ticket are used. | |
321 | ||
322 | =cut | |
323 | ||
dab09ea8 MKG |
324 | sub WillSignEncrypt { |
325 | my %args = @_; | |
326 | my $attachment = delete $args{Attachment}; | |
327 | my $ticket = delete $args{Ticket}; | |
328 | ||
af59614d | 329 | if ( not RT->Config->Get('Crypt')->{'Enable'} ) { |
dab09ea8 MKG |
330 | $args{Sign} = $args{Encrypt} = 0; |
331 | return wantarray ? %args : 0; | |
332 | } | |
333 | ||
334 | for my $argument ( qw(Sign Encrypt) ) { | |
335 | next if defined $args{ $argument }; | |
336 | ||
337 | if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) { | |
338 | $args{$argument} = $attachment->GetHeader("X-RT-$argument"); | |
339 | } elsif ( $ticket and $argument eq "Encrypt" ) { | |
340 | $args{Encrypt} = $ticket->QueueObj->Encrypt(); | |
341 | } elsif ( $ticket and $argument eq "Sign" ) { | |
342 | # Note that $queue->Sign is UI-only, and that all | |
343 | # UI-generated messages explicitly set the X-RT-Crypt header | |
344 | # to 0 or 1; thus this path is only taken for messages | |
345 | # generated _not_ via the web UI. | |
346 | $args{Sign} = $ticket->QueueObj->SignAuto(); | |
347 | } | |
348 | } | |
349 | ||
350 | return wantarray ? %args : ($args{Sign} || $args{Encrypt}); | |
351 | } | |
352 | ||
84fb5b46 MKG |
353 | sub SendEmail { |
354 | my (%args) = ( | |
355 | Entity => undef, | |
356 | Bounce => 0, | |
357 | Ticket => undef, | |
358 | Transaction => undef, | |
359 | @_, | |
360 | ); | |
361 | ||
362 | my $TicketObj = $args{'Ticket'}; | |
363 | my $TransactionObj = $args{'Transaction'}; | |
364 | ||
84fb5b46 MKG |
365 | unless ( $args{'Entity'} ) { |
366 | $RT::Logger->crit( "Could not send mail without 'Entity' object" ); | |
367 | return 0; | |
368 | } | |
369 | ||
c33a4027 | 370 | my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' ); |
84fb5b46 MKG |
371 | chomp $msgid; |
372 | ||
373 | # If we don't have any recipients to send to, don't send a message; | |
374 | unless ( $args{'Entity'}->head->get('To') | |
375 | || $args{'Entity'}->head->get('Cc') | |
376 | || $args{'Entity'}->head->get('Bcc') ) | |
377 | { | |
378 | $RT::Logger->info( $msgid . " No recipients found. Not sending." ); | |
379 | return -1; | |
380 | } | |
381 | ||
382 | if ($args{'Entity'}->head->get('X-RT-Squelch')) { | |
383 | $RT::Logger->info( $msgid . " Squelch header found. Not sending." ); | |
384 | return -1; | |
385 | } | |
386 | ||
af59614d MKG |
387 | if (my $precedence = RT->Config->Get('DefaultMailPrecedence') |
388 | and !$args{'Entity'}->head->get("Precedence") | |
389 | ) { | |
c33a4027 | 390 | $args{'Entity'}->head->replace( 'Precedence', Encode::encode("UTF-8",$precedence) ); |
af59614d MKG |
391 | } |
392 | ||
84fb5b46 MKG |
393 | if ( $TransactionObj && !$TicketObj |
394 | && $TransactionObj->ObjectType eq 'RT::Ticket' ) | |
395 | { | |
396 | $TicketObj = $TransactionObj->Object; | |
397 | } | |
398 | ||
af59614d MKG |
399 | my $head = $args{'Entity'}->head; |
400 | unless ( $head->get('Date') ) { | |
401 | require RT::Date; | |
402 | my $date = RT::Date->new( RT->SystemUser ); | |
403 | $date->SetToNow; | |
c33a4027 | 404 | $head->replace( 'Date', Encode::encode("UTF-8",$date->RFC2822( Timezone => 'server' ) ) ); |
af59614d MKG |
405 | } |
406 | unless ( $head->get('MIME-Version') ) { | |
407 | # We should never have to set the MIME-Version header | |
c33a4027 | 408 | $head->replace( 'MIME-Version', '1.0' ); |
af59614d MKG |
409 | } |
410 | unless ( $head->get('Content-Transfer-Encoding') ) { | |
411 | # fsck.com #5959: Since RT sends 8bit mail, we should say so. | |
c33a4027 | 412 | $head->replace( 'Content-Transfer-Encoding', '8bit' ); |
af59614d MKG |
413 | } |
414 | ||
415 | if ( RT->Config->Get('Crypt')->{'Enable'} ) { | |
dab09ea8 MKG |
416 | %args = WillSignEncrypt( |
417 | %args, | |
418 | Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef, | |
419 | Ticket => $TicketObj, | |
420 | ); | |
421 | my $res = SignEncrypt( %args ); | |
84fb5b46 MKG |
422 | return $res unless $res > 0; |
423 | } | |
424 | ||
84fb5b46 MKG |
425 | my $mail_command = RT->Config->Get('MailCommand'); |
426 | ||
84fb5b46 MKG |
427 | # if it is a sub routine, we just return it; |
428 | return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' ); | |
429 | ||
430 | if ( $mail_command eq 'sendmailpipe' ) { | |
431 | my $path = RT->Config->Get('SendmailPath'); | |
432 | my @args = shellwords(RT->Config->Get('SendmailArguments')); | |
af59614d | 433 | push @args, "-t" unless grep {$_ eq "-t"} @args; |
84fb5b46 MKG |
434 | |
435 | # SetOutgoingMailFrom and bounces conflict, since they both want -f | |
436 | if ( $args{'Bounce'} ) { | |
437 | push @args, shellwords(RT->Config->Get('SendmailBounceArguments')); | |
01e3b242 MKG |
438 | } elsif ( my $MailFrom = RT->Config->Get('SetOutgoingMailFrom') ) { |
439 | my $OutgoingMailAddress = $MailFrom =~ /\@/ ? $MailFrom : undef; | |
440 | my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {}; | |
84fb5b46 MKG |
441 | |
442 | if ($TicketObj) { | |
c33a4027 MKG |
443 | my $Queue = $TicketObj->QueueObj; |
444 | my $QueueAddressOverride = $Overrides->{$Queue->id} | |
445 | || $Overrides->{$Queue->Name}; | |
84fb5b46 MKG |
446 | |
447 | if ($QueueAddressOverride) { | |
448 | $OutgoingMailAddress = $QueueAddressOverride; | |
449 | } else { | |
c33a4027 MKG |
450 | $OutgoingMailAddress ||= $Queue->CorrespondAddress |
451 | || RT->Config->Get('CorrespondAddress'); | |
84fb5b46 MKG |
452 | } |
453 | } | |
01e3b242 MKG |
454 | elsif ($Overrides->{'Default'}) { |
455 | $OutgoingMailAddress = $Overrides->{'Default'}; | |
456 | } | |
84fb5b46 MKG |
457 | |
458 | push @args, "-f", $OutgoingMailAddress | |
459 | if $OutgoingMailAddress; | |
460 | } | |
461 | ||
462 | # VERP | |
463 | if ( $TransactionObj and | |
464 | my $prefix = RT->Config->Get('VERPPrefix') and | |
465 | my $domain = RT->Config->Get('VERPDomain') ) | |
466 | { | |
467 | my $from = $TransactionObj->CreatorObj->EmailAddress; | |
468 | $from =~ s/@/=/g; | |
469 | $from =~ s/\s//g; | |
470 | push @args, "-f", "$prefix$from\@$domain"; | |
471 | } | |
472 | ||
473 | eval { | |
474 | # don't ignore CHLD signal to get proper exit code | |
475 | local $SIG{'CHLD'} = 'DEFAULT'; | |
476 | ||
477 | # if something wrong with $mail->print we will get PIPE signal, handle it | |
478 | local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" }; | |
479 | ||
480 | require IPC::Open2; | |
481 | my ($mail, $stdout); | |
482 | my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args ) | |
483 | or die "couldn't execute program: $!"; | |
484 | ||
485 | $args{'Entity'}->print($mail); | |
486 | close $mail or die "close pipe failed: $!"; | |
487 | ||
488 | waitpid($pid, 0); | |
489 | if ($?) { | |
490 | # sendmail exit statuses mostly errors with data not software | |
491 | # TODO: status parsing: core dump, exit on signal or EX_* | |
492 | my $msg = "$msgid: `$path @args` exited with code ". ($?>>8); | |
493 | $msg = ", interrupted by signal ". ($?&127) if $?&127; | |
494 | $RT::Logger->error( $msg ); | |
495 | die $msg; | |
496 | } | |
497 | }; | |
498 | if ( $@ ) { | |
499 | $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ ); | |
500 | if ( $TicketObj ) { | |
501 | _RecordSendEmailFailure( $TicketObj ); | |
502 | } | |
503 | return 0; | |
504 | } | |
505 | } | |
84fb5b46 MKG |
506 | else { |
507 | local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'}); | |
508 | ||
509 | my @mailer_args = ($mail_command); | |
510 | if ( $mail_command eq 'sendmail' ) { | |
511 | $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath'); | |
af59614d MKG |
512 | push @mailer_args, grep {$_ ne "-t"} |
513 | split(/\s+/, RT->Config->Get('SendmailArguments')); | |
514 | } elsif ( $mail_command eq 'testfile' ) { | |
515 | unless ($Mail::Mailer::testfile::config{outfile}) { | |
516 | $Mail::Mailer::testfile::config{outfile} = File::Temp->new; | |
517 | $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}"); | |
518 | } | |
519 | } else { | |
84fb5b46 MKG |
520 | push @mailer_args, RT->Config->Get('MailParams'); |
521 | } | |
522 | ||
523 | unless ( $args{'Entity'}->send( @mailer_args ) ) { | |
524 | $RT::Logger->crit( "$msgid: Could not send mail." ); | |
525 | if ( $TicketObj ) { | |
526 | _RecordSendEmailFailure( $TicketObj ); | |
527 | } | |
528 | return 0; | |
529 | } | |
530 | } | |
531 | return 1; | |
532 | } | |
533 | ||
534 | =head2 PrepareEmailUsingTemplate Template => '', Arguments => {} | |
535 | ||
536 | Loads a template. Parses it using arguments if it's not empty. | |
537 | Returns a tuple (L<RT::Template> object, error message). | |
538 | ||
539 | Note that even if a template object is returned MIMEObj method | |
540 | may return undef for empty templates. | |
541 | ||
542 | =cut | |
543 | ||
544 | sub PrepareEmailUsingTemplate { | |
545 | my %args = ( | |
546 | Template => '', | |
547 | Arguments => {}, | |
548 | @_ | |
549 | ); | |
550 | ||
551 | my $template = RT::Template->new( RT->SystemUser ); | |
552 | $template->LoadGlobalTemplate( $args{'Template'} ); | |
553 | unless ( $template->id ) { | |
554 | return (undef, "Couldn't load template '". $args{'Template'} ."'"); | |
555 | } | |
556 | return $template if $template->IsEmpty; | |
557 | ||
558 | my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } ); | |
559 | return (undef, $msg) unless $status; | |
560 | ||
561 | return $template; | |
562 | } | |
563 | ||
564 | =head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => '' | |
565 | ||
566 | Sends email using a template, takes name of template, arguments for it and recipients. | |
567 | ||
568 | =cut | |
569 | ||
570 | sub SendEmailUsingTemplate { | |
571 | my %args = ( | |
572 | Template => '', | |
573 | Arguments => {}, | |
574 | To => undef, | |
575 | Cc => undef, | |
576 | Bcc => undef, | |
577 | From => RT->Config->Get('CorrespondAddress'), | |
578 | InReplyTo => undef, | |
579 | ExtraHeaders => {}, | |
580 | @_ | |
581 | ); | |
582 | ||
583 | my ($template, $msg) = PrepareEmailUsingTemplate( %args ); | |
584 | return (0, $msg) unless $template; | |
585 | ||
586 | my $mail = $template->MIMEObj; | |
587 | unless ( $mail ) { | |
588 | $RT::Logger->info("Message is not sent as template #". $template->id ." is empty"); | |
589 | return -1; | |
590 | } | |
591 | ||
c33a4027 | 592 | $mail->head->replace( $_ => Encode::encode( "UTF-8", $args{ $_ } ) ) |
84fb5b46 MKG |
593 | foreach grep defined $args{$_}, qw(To Cc Bcc From); |
594 | ||
c33a4027 | 595 | $mail->head->replace( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) ) |
84fb5b46 MKG |
596 | foreach keys %{ $args{ExtraHeaders} }; |
597 | ||
598 | SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} ); | |
599 | ||
600 | return SendEmail( Entity => $mail ); | |
601 | } | |
602 | ||
af59614d | 603 | =head2 GetForwardFrom Ticket => undef, Transaction => undef |
84fb5b46 | 604 | |
af59614d | 605 | Resolve the From field to use in forward mail |
84fb5b46 MKG |
606 | |
607 | =cut | |
608 | ||
af59614d MKG |
609 | sub GetForwardFrom { |
610 | my %args = ( Ticket => undef, Transaction => undef, @_ ); | |
611 | my $txn = $args{Transaction}; | |
612 | my $ticket = $args{Ticket} || $txn->Object; | |
84fb5b46 | 613 | |
af59614d MKG |
614 | if ( RT->Config->Get('ForwardFromUser') ) { |
615 | return ( $txn || $ticket )->CurrentUser->EmailAddress; | |
84fb5b46 | 616 | } |
af59614d MKG |
617 | else { |
618 | return $ticket->QueueObj->CorrespondAddress | |
619 | || RT->Config->Get('CorrespondAddress'); | |
84fb5b46 | 620 | } |
84fb5b46 MKG |
621 | } |
622 | ||
af59614d | 623 | =head2 GetForwardAttachments Ticket => undef, Transaction => undef |
84fb5b46 | 624 | |
af59614d | 625 | Resolve the Attachments to forward |
84fb5b46 MKG |
626 | |
627 | =cut | |
628 | ||
af59614d | 629 | sub GetForwardAttachments { |
84fb5b46 MKG |
630 | my %args = ( Ticket => undef, Transaction => undef, @_ ); |
631 | my $txn = $args{Transaction}; | |
632 | my $ticket = $args{Ticket} || $txn->Object; | |
633 | ||
af59614d MKG |
634 | my $attachments = RT::Attachments->new( $ticket->CurrentUser ); |
635 | if ($txn) { | |
636 | $attachments->Limit( FIELD => 'TransactionId', VALUE => $txn->id ); | |
84fb5b46 MKG |
637 | } |
638 | else { | |
af59614d MKG |
639 | my $txns = $ticket->Transactions; |
640 | $txns->Limit( | |
641 | FIELD => 'Type', | |
642 | VALUE => $_, | |
643 | ) for qw(Create Correspond); | |
644 | ||
645 | while ( my $txn = $txns->Next ) { | |
646 | $attachments->Limit( FIELD => 'TransactionId', VALUE => $txn->id ); | |
647 | } | |
84fb5b46 | 648 | } |
af59614d | 649 | return $attachments; |
84fb5b46 MKG |
650 | } |
651 | ||
af59614d | 652 | |
84fb5b46 MKG |
653 | =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0 |
654 | ||
af59614d MKG |
655 | Signs and encrypts message using L<RT::Crypt>, but as well handle errors |
656 | with users' keys. | |
84fb5b46 MKG |
657 | |
658 | If a recipient has no key or has other problems with it, then the | |
659 | unction sends a error to him using 'Error: public key' template. | |
660 | Also, notifies RT's owner using template 'Error to RT owner: public key' | |
661 | to inform that there are problems with users' keys. Then we filter | |
662 | all bad recipients and retry. | |
663 | ||
664 | Returns 1 on success, 0 on error and -1 if all recipients are bad and | |
665 | had been filtered out. | |
666 | ||
667 | =cut | |
668 | ||
669 | sub SignEncrypt { | |
670 | my %args = ( | |
671 | Entity => undef, | |
672 | Sign => 0, | |
673 | Encrypt => 0, | |
674 | @_ | |
675 | ); | |
676 | return 1 unless $args{'Sign'} || $args{'Encrypt'}; | |
677 | ||
c33a4027 | 678 | my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' ); |
84fb5b46 MKG |
679 | chomp $msgid; |
680 | ||
681 | $RT::Logger->debug("$msgid Signing message") if $args{'Sign'}; | |
682 | $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'}; | |
683 | ||
af59614d | 684 | my %res = RT::Crypt->SignEncrypt( %args ); |
84fb5b46 MKG |
685 | return 1 unless $res{'exit_code'}; |
686 | ||
af59614d MKG |
687 | my @status = RT::Crypt->ParseStatus( |
688 | Protocol => $res{'Protocol'}, Status => $res{'status'}, | |
689 | ); | |
84fb5b46 MKG |
690 | |
691 | my @bad_recipients; | |
692 | foreach my $line ( @status ) { | |
693 | # if the passphrase fails, either you have a bad passphrase | |
694 | # or gpg-agent has died. That should get caught in Create and | |
695 | # Update, but at least throw an error here | |
696 | if (($line->{'Operation'}||'') eq 'PassphraseCheck' | |
697 | && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) { | |
698 | $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" ); | |
699 | return 0; | |
700 | } | |
701 | next unless ($line->{'Operation'}||'') eq 'RecipientsCheck'; | |
702 | next if $line->{'Status'} eq 'DONE'; | |
703 | $RT::Logger->error( $line->{'Message'} ); | |
704 | push @bad_recipients, $line; | |
705 | } | |
706 | return 0 unless @bad_recipients; | |
707 | ||
708 | $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0] | |
709 | foreach @bad_recipients; | |
710 | ||
711 | foreach my $recipient ( @bad_recipients ) { | |
712 | my $status = SendEmailUsingTemplate( | |
713 | To => $recipient->{'AddressObj'}->address, | |
714 | Template => 'Error: public key', | |
715 | Arguments => { | |
716 | %$recipient, | |
717 | TicketObj => $args{'Ticket'}, | |
718 | TransactionObj => $args{'Transaction'}, | |
719 | }, | |
720 | ); | |
721 | unless ( $status ) { | |
722 | $RT::Logger->error("Couldn't send 'Error: public key'"); | |
723 | } | |
724 | } | |
725 | ||
726 | my $status = SendEmailUsingTemplate( | |
727 | To => RT->Config->Get('OwnerEmail'), | |
728 | Template => 'Error to RT owner: public key', | |
729 | Arguments => { | |
730 | BadRecipients => \@bad_recipients, | |
731 | TicketObj => $args{'Ticket'}, | |
732 | TransactionObj => $args{'Transaction'}, | |
733 | }, | |
734 | ); | |
735 | unless ( $status ) { | |
736 | $RT::Logger->error("Couldn't send 'Error to RT owner: public key'"); | |
737 | } | |
738 | ||
739 | DeleteRecipientsFromHead( | |
740 | $args{'Entity'}->head, | |
741 | map $_->{'AddressObj'}->address, @bad_recipients | |
742 | ); | |
743 | ||
744 | unless ( $args{'Entity'}->head->get('To') | |
745 | || $args{'Entity'}->head->get('Cc') | |
746 | || $args{'Entity'}->head->get('Bcc') ) | |
747 | { | |
748 | $RT::Logger->debug("$msgid No recipients that have public key, not sending"); | |
749 | return -1; | |
750 | } | |
751 | ||
752 | # redo without broken recipients | |
af59614d | 753 | %res = RT::Crypt->SignEncrypt( %args ); |
84fb5b46 MKG |
754 | return 0 if $res{'exit_code'}; |
755 | ||
756 | return 1; | |
757 | } | |
758 | ||
759 | use MIME::Words (); | |
760 | ||
761 | =head2 EncodeToMIME | |
762 | ||
763 | Takes a hash with a String and a Charset. Returns the string encoded | |
764 | according to RFC2047, using B (base64 based) encoding. | |
765 | ||
766 | String must be a perl string, octets are returned. | |
767 | ||
768 | If Charset is not provided then $EmailOutputEncoding config option | |
769 | is used, or "latin-1" if that is not set. | |
770 | ||
771 | =cut | |
772 | ||
773 | sub EncodeToMIME { | |
774 | my %args = ( | |
775 | String => undef, | |
776 | Charset => undef, | |
777 | @_ | |
778 | ); | |
779 | my $value = $args{'String'}; | |
780 | return $value unless $value; # 0 is perfect ascii | |
781 | my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding'); | |
782 | my $encoding = 'B'; | |
783 | ||
784 | # using RFC2047 notation, sec 2. | |
785 | # encoded-word = "=?" charset "?" encoding "?" encoded-text "?=" | |
786 | ||
787 | # An 'encoded-word' may not be more than 75 characters long | |
788 | # | |
789 | # MIME encoding increases 4/3*(number of bytes), and always in multiples | |
790 | # of 4. Thus we have to find the best available value of bytes available | |
791 | # for each chunk. | |
792 | # | |
793 | # First we get the integer max which max*4/3 would fit on space. | |
794 | # Then we find the greater multiple of 3 lower or equal than $max. | |
795 | my $max = int( | |
796 | ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) ) | |
797 | * 3 | |
798 | ) / 4 | |
799 | ); | |
800 | $max = int( $max / 3 ) * 3; | |
801 | ||
802 | chomp $value; | |
803 | ||
804 | if ( $max <= 0 ) { | |
805 | ||
806 | # gives an error... | |
807 | $RT::Logger->crit("Can't encode! Charset or encoding too big."); | |
808 | return ($value); | |
809 | } | |
810 | ||
811 | return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s; | |
812 | ||
813 | $value =~ s/\s+$//; | |
814 | ||
84fb5b46 MKG |
815 | my ( $tmp, @chunks ) = ( '', () ); |
816 | while ( length $value ) { | |
817 | my $char = substr( $value, 0, 1, '' ); | |
818 | my $octets = Encode::encode( $charset, $char ); | |
819 | if ( length($tmp) + length($octets) > $max ) { | |
820 | push @chunks, $tmp; | |
821 | $tmp = ''; | |
822 | } | |
823 | $tmp .= $octets; | |
824 | } | |
825 | push @chunks, $tmp if length $tmp; | |
826 | ||
827 | # encode an join chuncks | |
828 | $value = join "\n ", | |
829 | map MIME::Words::encode_mimeword( $_, $encoding, $charset ), | |
830 | @chunks; | |
831 | return ($value); | |
832 | } | |
833 | ||
834 | sub CreateUser { | |
835 | my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_; | |
836 | ||
837 | my $NewUser = RT::User->new( RT->SystemUser ); | |
838 | ||
839 | my ( $Val, $Message ) = $NewUser->Create( | |
840 | Name => ( $Username || $Address ), | |
841 | EmailAddress => $Address, | |
842 | RealName => $Name, | |
843 | Password => undef, | |
844 | Privileged => 0, | |
845 | Comments => 'Autocreated on ticket submission', | |
846 | ); | |
847 | ||
848 | unless ($Val) { | |
849 | ||
850 | # Deal with the race condition of two account creations at once | |
851 | if ($Username) { | |
852 | $NewUser->LoadByName($Username); | |
853 | } | |
854 | ||
855 | unless ( $NewUser->Id ) { | |
856 | $NewUser->LoadByEmail($Address); | |
857 | } | |
858 | ||
859 | unless ( $NewUser->Id ) { | |
860 | MailError( | |
861 | To => $ErrorsTo, | |
862 | Subject => "User could not be created", | |
863 | Explanation => | |
864 | "User creation failed in mailgateway: $Message", | |
865 | MIMEObj => $entity, | |
866 | LogLevel => 'crit', | |
867 | ); | |
868 | } | |
869 | } | |
870 | ||
871 | #Load the new user object | |
872 | my $CurrentUser = RT::CurrentUser->new; | |
873 | $CurrentUser->LoadByEmail( $Address ); | |
874 | ||
875 | unless ( $CurrentUser->id ) { | |
876 | $RT::Logger->warning( | |
877 | "Couldn't load user '$Address'." . "giving up" ); | |
878 | MailError( | |
879 | To => $ErrorsTo, | |
880 | Subject => "User could not be loaded", | |
881 | Explanation => | |
882 | "User '$Address' could not be loaded in the mail gateway", | |
883 | MIMEObj => $entity, | |
884 | LogLevel => 'crit' | |
885 | ); | |
886 | } | |
887 | ||
888 | return $CurrentUser; | |
889 | } | |
890 | ||
891 | ||
892 | ||
893 | =head2 ParseCcAddressesFromHead HASH | |
894 | ||
895 | Takes a hash containing QueueObj, Head and CurrentUser objects. | |
896 | Returns a list of all email addresses in the To and Cc | |
403d7b0b | 897 | headers b<except> the current Queue's email addresses, the CurrentUser's |
84fb5b46 MKG |
898 | email address and anything that the configuration sub RT::IsRTAddress matches. |
899 | ||
900 | =cut | |
901 | ||
902 | sub ParseCcAddressesFromHead { | |
903 | my %args = ( | |
904 | Head => undef, | |
905 | QueueObj => undef, | |
906 | CurrentUser => undef, | |
907 | @_ | |
908 | ); | |
909 | ||
910 | my $current_address = lc $args{'CurrentUser'}->EmailAddress; | |
911 | my $user = $args{'CurrentUser'}->UserObj; | |
912 | ||
913 | return | |
914 | grep $_ ne $current_address && !RT::EmailParser->IsRTAddress( $_ ), | |
915 | map lc $user->CanonicalizeEmailAddress( $_->address ), | |
c33a4027 MKG |
916 | map RT::EmailParser->CleanupAddresses( Email::Address->parse( |
917 | Encode::decode( "UTF-8", $args{'Head'}->get( $_ ) ) ) ), | |
84fb5b46 MKG |
918 | qw(To Cc); |
919 | } | |
920 | ||
921 | ||
922 | ||
923 | =head2 ParseSenderAddressFromHead HEAD | |
924 | ||
403d7b0b MKG |
925 | Takes a MIME::Header object. Returns (user@host, friendly name, errors) |
926 | where the first two values are the From (evaluated in order of | |
927 | Reply-To:, From:, Sender). | |
928 | ||
929 | A list of error messages may be returned even when a Sender value is | |
930 | found, since it could be a parse error for another (checked earlier) | |
931 | sender field. In this case, the errors aren't fatal, but may be useful | |
932 | to investigate the parse failure. | |
84fb5b46 MKG |
933 | |
934 | =cut | |
935 | ||
936 | sub ParseSenderAddressFromHead { | |
937 | my $head = shift; | |
403d7b0b MKG |
938 | my @sender_headers = ('Reply-To', 'From', 'Sender'); |
939 | my @errors; # Accumulate any errors | |
84fb5b46 MKG |
940 | |
941 | #Figure out who's sending this message. | |
403d7b0b | 942 | foreach my $header ( @sender_headers ) { |
c33a4027 | 943 | my $addr_line = Encode::decode( "UTF-8", $head->get($header) ) || next; |
84fb5b46 MKG |
944 | my ($addr, $name) = ParseAddressFromHeader( $addr_line ); |
945 | # only return if the address is not empty | |
403d7b0b MKG |
946 | return ($addr, $name, @errors) if $addr; |
947 | ||
948 | chomp $addr_line; | |
949 | push @errors, "$header: $addr_line"; | |
84fb5b46 MKG |
950 | } |
951 | ||
403d7b0b | 952 | return (undef, undef, @errors); |
84fb5b46 MKG |
953 | } |
954 | ||
955 | =head2 ParseErrorsToAddressFromHead HEAD | |
956 | ||
957 | Takes a MIME::Header object. Return a single value : user@host | |
958 | of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:, | |
959 | From:, Sender) | |
960 | ||
961 | =cut | |
962 | ||
963 | sub ParseErrorsToAddressFromHead { | |
964 | my $head = shift; | |
965 | ||
966 | #Figure out who's sending this message. | |
967 | ||
968 | foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) { | |
969 | ||
970 | # If there's a header of that name | |
c33a4027 | 971 | my $headerobj = Encode::decode( "UTF-8", $head->get($header) ); |
84fb5b46 MKG |
972 | if ($headerobj) { |
973 | my ( $addr, $name ) = ParseAddressFromHeader($headerobj); | |
974 | ||
975 | # If it's got actual useful content... | |
976 | return ($addr) if ($addr); | |
977 | } | |
978 | } | |
979 | } | |
980 | ||
981 | ||
982 | ||
983 | =head2 ParseAddressFromHeader ADDRESS | |
984 | ||
985 | Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name | |
986 | ||
987 | =cut | |
988 | ||
989 | sub ParseAddressFromHeader { | |
990 | my $Addr = shift; | |
991 | ||
992 | # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate | |
993 | $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g; | |
994 | my @Addresses = RT::EmailParser->ParseEmailAddress($Addr); | |
995 | ||
996 | my ($AddrObj) = grep ref $_, @Addresses; | |
997 | unless ( $AddrObj ) { | |
998 | return ( undef, undef ); | |
999 | } | |
1000 | ||
1001 | return ( $AddrObj->address, $AddrObj->phrase ); | |
1002 | } | |
1003 | ||
1004 | =head2 DeleteRecipientsFromHead HEAD RECIPIENTS | |
1005 | ||
1006 | Gets a head object and list of addresses. | |
1007 | Deletes addresses from To, Cc or Bcc fields. | |
1008 | ||
1009 | =cut | |
1010 | ||
1011 | sub DeleteRecipientsFromHead { | |
1012 | my $head = shift; | |
1013 | my %skip = map { lc $_ => 1 } @_; | |
1014 | ||
1015 | foreach my $field ( qw(To Cc Bcc) ) { | |
c33a4027 | 1016 | $head->replace( $field => Encode::encode( "UTF-8", |
84fb5b46 | 1017 | join ', ', map $_->format, grep !$skip{ lc $_->address }, |
c33a4027 | 1018 | Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) ) |
84fb5b46 MKG |
1019 | ); |
1020 | } | |
1021 | } | |
1022 | ||
1023 | sub GenMessageId { | |
1024 | my %args = ( | |
1025 | Ticket => undef, | |
1026 | Scrip => undef, | |
1027 | ScripAction => undef, | |
1028 | @_ | |
1029 | ); | |
1030 | my $org = RT->Config->Get('Organization'); | |
1031 | my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0; | |
1032 | my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0; | |
1033 | my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0; | |
1034 | ||
1035 | return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.' | |
1036 | . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ; | |
1037 | } | |
1038 | ||
1039 | sub SetInReplyTo { | |
1040 | my %args = ( | |
1041 | Message => undef, | |
1042 | InReplyTo => undef, | |
1043 | Ticket => undef, | |
1044 | @_ | |
1045 | ); | |
1046 | return unless $args{'Message'} && $args{'InReplyTo'}; | |
1047 | ||
1048 | my $get_header = sub { | |
1049 | my @res; | |
1050 | if ( $args{'InReplyTo'}->isa('MIME::Entity') ) { | |
c33a4027 | 1051 | @res = map {Encode::decode("UTF-8", $_)} $args{'InReplyTo'}->head->get( shift ); |
84fb5b46 MKG |
1052 | } else { |
1053 | @res = $args{'InReplyTo'}->GetHeader( shift ) || ''; | |
1054 | } | |
1055 | return grep length, map { split /\s+/m, $_ } grep defined, @res; | |
1056 | }; | |
1057 | ||
1058 | my @id = $get_header->('Message-ID'); | |
1059 | #XXX: custom header should begin with X- otherwise is violation of the standard | |
1060 | my @rtid = $get_header->('RT-Message-ID'); | |
1061 | my @references = $get_header->('References'); | |
1062 | unless ( @references ) { | |
1063 | @references = $get_header->('In-Reply-To'); | |
1064 | } | |
1065 | push @references, @id, @rtid; | |
1066 | if ( $args{'Ticket'} ) { | |
af59614d | 1067 | my $pseudo_ref = PseudoReference( $args{'Ticket'} ); |
84fb5b46 MKG |
1068 | push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references; |
1069 | } | |
af59614d | 1070 | splice @references, 4, -6 |
84fb5b46 MKG |
1071 | if @references > 10; |
1072 | ||
1073 | my $mail = $args{'Message'}; | |
c33a4027 MKG |
1074 | $mail->head->replace( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; |
1075 | $mail->head->replace( 'References' => Encode::encode( "UTF-8", join ' ', @references) ); | |
dab09ea8 MKG |
1076 | } |
1077 | ||
af59614d MKG |
1078 | sub PseudoReference { |
1079 | my $ticket = shift; | |
1080 | return '<RT-Ticket-'. $ticket->id .'@'. RT->Config->Get('Organization') .'>'; | |
1081 | } | |
1082 | ||
c33a4027 MKG |
1083 | =head2 ExtractTicketId |
1084 | ||
1085 | Passed a MIME::Entity. Returns a ticket id or undef to signal 'new ticket'. | |
1086 | ||
1087 | This is a great entry point if you need to customize how ticket ids are | |
1088 | handled for your site. RT-Extension-RepliesToResolved demonstrates one | |
1089 | possible use for this extension. | |
1090 | ||
1091 | If the Subject of this ticket is modified, it will be reloaded by the | |
1092 | mail gateway code before Ticket creation. | |
1093 | ||
1094 | =cut | |
1095 | ||
dab09ea8 MKG |
1096 | sub ExtractTicketId { |
1097 | my $entity = shift; | |
1098 | ||
c33a4027 | 1099 | my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') || '' ); |
dab09ea8 MKG |
1100 | chomp $subject; |
1101 | return ParseTicketId( $subject ); | |
84fb5b46 MKG |
1102 | } |
1103 | ||
c33a4027 MKG |
1104 | =head2 ParseTicketId |
1105 | ||
1106 | Takes a string and searches for [subjecttag #id] | |
1107 | ||
1108 | Returns the id if a match is found. Otherwise returns undef. | |
1109 | ||
1110 | =cut | |
1111 | ||
84fb5b46 MKG |
1112 | sub ParseTicketId { |
1113 | my $Subject = shift; | |
1114 | ||
1115 | my $rtname = RT->Config->Get('rtname'); | |
1116 | my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i; | |
1117 | ||
af59614d MKG |
1118 | # We use @captures and pull out the last capture value to guard against |
1119 | # someone using (...) instead of (?:...) in $EmailSubjectTagRegex. | |
84fb5b46 | 1120 | my $id; |
af59614d MKG |
1121 | if ( my @captures = $Subject =~ /\[$test_name\s+\#(\d+)\s*\]/i ) { |
1122 | $id = $captures[-1]; | |
84fb5b46 MKG |
1123 | } else { |
1124 | foreach my $tag ( RT->System->SubjectTag ) { | |
af59614d MKG |
1125 | next unless my @captures = $Subject =~ /\[\Q$tag\E\s+\#(\d+)\s*\]/i; |
1126 | $id = $captures[-1]; | |
84fb5b46 MKG |
1127 | last; |
1128 | } | |
1129 | } | |
1130 | return undef unless $id; | |
1131 | ||
1132 | $RT::Logger->debug("Found a ticket ID. It's $id"); | |
1133 | return $id; | |
1134 | } | |
1135 | ||
1136 | sub AddSubjectTag { | |
1137 | my $subject = shift; | |
1138 | my $ticket = shift; | |
1139 | unless ( ref $ticket ) { | |
1140 | my $tmp = RT::Ticket->new( RT->SystemUser ); | |
1141 | $tmp->Load( $ticket ); | |
1142 | $ticket = $tmp; | |
1143 | } | |
1144 | my $id = $ticket->id; | |
1145 | my $queue_tag = $ticket->QueueObj->SubjectTag; | |
1146 | ||
1147 | my $tag_re = RT->Config->Get('EmailSubjectTagRegex'); | |
1148 | unless ( $tag_re ) { | |
1149 | my $tag = $queue_tag || RT->Config->Get('rtname'); | |
1150 | $tag_re = qr/\Q$tag\E/; | |
1151 | } elsif ( $queue_tag ) { | |
1152 | $tag_re = qr/$tag_re|\Q$queue_tag\E/; | |
1153 | } | |
1154 | return $subject if $subject =~ /\[$tag_re\s+#$id\]/; | |
1155 | ||
1156 | $subject =~ s/(\r\n|\n|\s)/ /g; | |
1157 | chomp $subject; | |
1158 | return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject"; | |
1159 | } | |
1160 | ||
1161 | ||
1162 | =head2 Gateway ARGSREF | |
1163 | ||
1164 | ||
1165 | Takes parameters: | |
1166 | ||
1167 | action | |
1168 | queue | |
1169 | message | |
1170 | ||
1171 | ||
1172 | This performs all the "guts" of the mail rt-mailgate program, and is | |
1173 | designed to be called from the web interface with a message, user | |
1174 | object, and so on. | |
1175 | ||
1176 | Can also take an optional 'ticket' parameter; this ticket id overrides | |
1177 | any ticket id found in the subject. | |
1178 | ||
1179 | Returns: | |
1180 | ||
1181 | An array of: | |
1182 | ||
1183 | (status code, message, optional ticket object) | |
1184 | ||
1185 | status code is a numeric value. | |
1186 | ||
1187 | for temporary failures, the status code should be -75 | |
1188 | ||
1189 | for permanent failures which are handled by RT, the status code | |
1190 | should be 0 | |
1191 | ||
1192 | for succces, the status code should be 1 | |
1193 | ||
1194 | ||
1195 | ||
1196 | =cut | |
1197 | ||
1198 | sub _LoadPlugins { | |
1199 | my @mail_plugins = @_; | |
1200 | ||
1201 | my @res; | |
1202 | foreach my $plugin (@mail_plugins) { | |
1203 | if ( ref($plugin) eq "CODE" ) { | |
1204 | push @res, $plugin; | |
1205 | } elsif ( !ref $plugin ) { | |
1206 | my $Class = $plugin; | |
1207 | $Class = "RT::Interface::Email::" . $Class | |
1208 | unless $Class =~ /^RT::/; | |
1209 | $Class->require or | |
1210 | do { $RT::Logger->error("Couldn't load $Class: $@"); next }; | |
1211 | ||
1212 | no strict 'refs'; | |
1213 | unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) { | |
1214 | $RT::Logger->crit( "No GetCurrentUser code found in $Class module"); | |
1215 | next; | |
1216 | } | |
1217 | push @res, $Class; | |
1218 | } else { | |
1219 | $RT::Logger->crit( "$plugin - is not class name or code reference"); | |
1220 | } | |
1221 | } | |
1222 | return @res; | |
1223 | } | |
1224 | ||
1225 | sub Gateway { | |
1226 | my $argsref = shift; | |
1227 | my %args = ( | |
1228 | action => 'correspond', | |
1229 | queue => '1', | |
1230 | ticket => undef, | |
1231 | message => undef, | |
1232 | %$argsref | |
1233 | ); | |
1234 | ||
1235 | my $SystemTicket; | |
1236 | my $Right; | |
1237 | ||
1238 | # Validate the action | |
1239 | my ( $status, @actions ) = IsCorrectAction( $args{'action'} ); | |
1240 | unless ($status) { | |
1241 | return ( | |
1242 | -75, | |
1243 | "Invalid 'action' parameter " | |
1244 | . $actions[0] | |
1245 | . " for queue " | |
1246 | . $args{'queue'}, | |
1247 | undef | |
1248 | ); | |
1249 | } | |
1250 | ||
1251 | my $parser = RT::EmailParser->new(); | |
1252 | $parser->SmartParseMIMEEntityFromScalar( | |
1253 | Message => $args{'message'}, | |
1254 | Decode => 0, | |
1255 | Exact => 1, | |
1256 | ); | |
1257 | ||
1258 | my $Message = $parser->Entity(); | |
1259 | unless ($Message) { | |
1260 | MailError( | |
1261 | Subject => "RT Bounce: Unparseable message", | |
1262 | Explanation => "RT couldn't process the message below", | |
1263 | Attach => $args{'message'} | |
1264 | ); | |
1265 | ||
1266 | return ( 0, | |
1267 | "Failed to parse this message. Something is likely badly wrong with the message" | |
1268 | ); | |
1269 | } | |
1270 | ||
1271 | my @mail_plugins = grep $_, RT->Config->Get('MailPlugins'); | |
1272 | push @mail_plugins, "Auth::MailFrom" unless @mail_plugins; | |
1273 | @mail_plugins = _LoadPlugins( @mail_plugins ); | |
1274 | ||
af59614d MKG |
1275 | #Set up a queue object |
1276 | my $SystemQueueObj = RT::Queue->new( RT->SystemUser ); | |
1277 | $SystemQueueObj->Load( $args{'queue'} ); | |
1278 | ||
84fb5b46 MKG |
1279 | my %skip_plugin; |
1280 | foreach my $class( grep !ref, @mail_plugins ) { | |
1281 | # check if we should apply filter before decoding | |
1282 | my $check_cb = do { | |
1283 | no strict 'refs'; | |
1284 | *{ $class . "::ApplyBeforeDecode" }{CODE}; | |
1285 | }; | |
1286 | next unless defined $check_cb; | |
1287 | next unless $check_cb->( | |
1288 | Message => $Message, | |
1289 | RawMessageRef => \$args{'message'}, | |
af59614d MKG |
1290 | Queue => $SystemQueueObj, |
1291 | Actions => \@actions, | |
84fb5b46 MKG |
1292 | ); |
1293 | ||
1294 | $skip_plugin{ $class }++; | |
1295 | ||
1296 | my $Code = do { | |
1297 | no strict 'refs'; | |
1298 | *{ $class . "::GetCurrentUser" }{CODE}; | |
1299 | }; | |
1300 | my ($status, $msg) = $Code->( | |
1301 | Message => $Message, | |
1302 | RawMessageRef => \$args{'message'}, | |
af59614d MKG |
1303 | Queue => $SystemQueueObj, |
1304 | Actions => \@actions, | |
84fb5b46 MKG |
1305 | ); |
1306 | next if $status > 0; | |
1307 | ||
1308 | if ( $status == -2 ) { | |
1309 | return (1, $msg, undef); | |
1310 | } elsif ( $status == -1 ) { | |
1311 | return (0, $msg, undef); | |
1312 | } | |
1313 | } | |
1314 | @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins; | |
1315 | $parser->_DecodeBodies; | |
403d7b0b | 1316 | $parser->RescueOutlook; |
84fb5b46 MKG |
1317 | $parser->_PostProcessNewEntity; |
1318 | ||
1319 | my $head = $Message->head; | |
1320 | my $ErrorsTo = ParseErrorsToAddressFromHead( $head ); | |
af59614d | 1321 | my $Sender = (ParseSenderAddressFromHead( $head ))[0]; |
c33a4027 | 1322 | my $From = Encode::decode( "UTF-8", $head->get("From") ); |
af59614d | 1323 | chomp $From if defined $From; |
84fb5b46 | 1324 | |
c33a4027 | 1325 | my $MessageId = Encode::decode( "UTF-8", $head->get('Message-ID') ) |
84fb5b46 MKG |
1326 | || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>'; |
1327 | ||
1328 | #Pull apart the subject line | |
c33a4027 | 1329 | my $Subject = Encode::decode( "UTF-8", $head->get('Subject') || ''); |
84fb5b46 MKG |
1330 | chomp $Subject; |
1331 | ||
1332 | # Lets check for mail loops of various sorts. | |
1333 | my ($should_store_machine_generated_message, $IsALoop, $result); | |
1334 | ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) = | |
1335 | _HandleMachineGeneratedMail( | |
1336 | Message => $Message, | |
1337 | ErrorsTo => $ErrorsTo, | |
1338 | Subject => $Subject, | |
1339 | MessageId => $MessageId | |
1340 | ); | |
1341 | ||
1342 | # Do not pass loop messages to MailPlugins, to make sure the loop | |
1343 | # is broken, unless $RT::StoreLoops is set. | |
1344 | if ($IsALoop && !$should_store_machine_generated_message) { | |
1345 | return ( 0, $result, undef ); | |
1346 | } | |
1347 | # }}} | |
1348 | ||
dab09ea8 | 1349 | $args{'ticket'} ||= ExtractTicketId( $Message ); |
84fb5b46 | 1350 | |
403d7b0b | 1351 | # ExtractTicketId may have been overridden, and edited the Subject |
c33a4027 | 1352 | my $NewSubject = Encode::decode( "UTF-8", $Message->head->get('Subject') ); |
403d7b0b MKG |
1353 | chomp $NewSubject; |
1354 | ||
84fb5b46 MKG |
1355 | $SystemTicket = RT::Ticket->new( RT->SystemUser ); |
1356 | $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ; | |
1357 | if ( $SystemTicket->id ) { | |
1358 | $Right = 'ReplyToTicket'; | |
1359 | } else { | |
1360 | $Right = 'CreateTicket'; | |
1361 | } | |
1362 | ||
84fb5b46 MKG |
1363 | # We can safely have no queue of we have a known-good ticket |
1364 | unless ( $SystemTicket->id || $SystemQueueObj->id ) { | |
1365 | return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef ); | |
1366 | } | |
1367 | ||
1368 | my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel( | |
1369 | MailPlugins => \@mail_plugins, | |
1370 | Actions => \@actions, | |
1371 | Message => $Message, | |
1372 | RawMessageRef => \$args{message}, | |
1373 | SystemTicket => $SystemTicket, | |
1374 | SystemQueue => $SystemQueueObj, | |
1375 | ); | |
1376 | ||
1377 | # If authentication fails and no new user was created, get out. | |
1378 | if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) { | |
1379 | ||
1380 | # If the plugins refused to create one, they lose. | |
1381 | unless ( $AuthStat == -1 ) { | |
1382 | _NoAuthorizedUserFound( | |
1383 | Right => $Right, | |
1384 | Message => $Message, | |
1385 | Requestor => $ErrorsTo, | |
1386 | Queue => $args{'queue'} | |
1387 | ); | |
1388 | ||
1389 | } | |
1390 | return ( 0, "Could not load a valid user", undef ); | |
1391 | } | |
1392 | ||
1393 | # If we got a user, but they don't have the right to say things | |
1394 | if ( $AuthStat == 0 ) { | |
1395 | MailError( | |
1396 | To => $ErrorsTo, | |
1397 | Subject => "Permission Denied", | |
1398 | Explanation => | |
1399 | "You do not have permission to communicate with RT", | |
1400 | MIMEObj => $Message | |
1401 | ); | |
1402 | return ( | |
1403 | 0, | |
af59614d MKG |
1404 | ($CurrentUser->EmailAddress || $CurrentUser->Name) |
1405 | . " ($Sender) tried to submit a message to " | |
84fb5b46 MKG |
1406 | . $args{'Queue'} |
1407 | . " without permission.", | |
1408 | undef | |
1409 | ); | |
1410 | } | |
1411 | ||
1412 | ||
1413 | unless ($should_store_machine_generated_message) { | |
1414 | return ( 0, $result, undef ); | |
1415 | } | |
1416 | ||
1417 | # if plugin's updated SystemTicket then update arguments | |
1418 | $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id; | |
1419 | ||
1420 | my $Ticket = RT::Ticket->new($CurrentUser); | |
1421 | ||
1422 | if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions ) | |
1423 | { | |
1424 | ||
1425 | my @Cc; | |
1426 | my @Requestors = ( $CurrentUser->id ); | |
1427 | ||
1428 | if (RT->Config->Get('ParseNewMessageForTicketCcs')) { | |
1429 | @Cc = ParseCcAddressesFromHead( | |
1430 | Head => $head, | |
1431 | CurrentUser => $CurrentUser, | |
1432 | QueueObj => $SystemQueueObj | |
1433 | ); | |
1434 | } | |
1435 | ||
403d7b0b MKG |
1436 | $head->replace('X-RT-Interface' => 'Email'); |
1437 | ||
84fb5b46 MKG |
1438 | my ( $id, $Transaction, $ErrStr ) = $Ticket->Create( |
1439 | Queue => $SystemQueueObj->Id, | |
403d7b0b | 1440 | Subject => $NewSubject, |
84fb5b46 MKG |
1441 | Requestor => \@Requestors, |
1442 | Cc => \@Cc, | |
1443 | MIMEObj => $Message | |
1444 | ); | |
1445 | if ( $id == 0 ) { | |
1446 | MailError( | |
1447 | To => $ErrorsTo, | |
1448 | Subject => "Ticket creation failed: $Subject", | |
1449 | Explanation => $ErrStr, | |
1450 | MIMEObj => $Message | |
1451 | ); | |
af59614d | 1452 | return ( 0, "Ticket creation From: $From failed: $ErrStr", $Ticket ); |
84fb5b46 MKG |
1453 | } |
1454 | ||
1455 | # strip comments&corresponds from the actions we don't need | |
1456 | # to record them if we've created the ticket just now | |
1457 | @actions = grep !/^(comment|correspond)$/, @actions; | |
1458 | $args{'ticket'} = $id; | |
1459 | ||
1460 | } elsif ( $args{'ticket'} ) { | |
1461 | ||
1462 | $Ticket->Load( $args{'ticket'} ); | |
1463 | unless ( $Ticket->Id ) { | |
1464 | my $error = "Could not find a ticket with id " . $args{'ticket'}; | |
1465 | MailError( | |
1466 | To => $ErrorsTo, | |
1467 | Subject => "Message not recorded: $Subject", | |
1468 | Explanation => $error, | |
1469 | MIMEObj => $Message | |
1470 | ); | |
1471 | ||
1472 | return ( 0, $error ); | |
1473 | } | |
1474 | $args{'ticket'} = $Ticket->id; | |
1475 | } else { | |
1476 | return ( 1, "Success", $Ticket ); | |
1477 | } | |
1478 | ||
1479 | # }}} | |
1480 | ||
1481 | my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands'); | |
1482 | foreach my $action (@actions) { | |
1483 | ||
1484 | # If the action is comment, add a comment. | |
1485 | if ( $action =~ /^(?:comment|correspond)$/i ) { | |
1486 | my $method = ucfirst lc $action; | |
1487 | my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message ); | |
1488 | unless ($status) { | |
1489 | ||
1490 | #Warn the sender that we couldn't actually submit the comment. | |
1491 | MailError( | |
1492 | To => $ErrorsTo, | |
5b0d0914 | 1493 | Subject => "Message not recorded ($method): $Subject", |
84fb5b46 MKG |
1494 | Explanation => $msg, |
1495 | MIMEObj => $Message | |
1496 | ); | |
af59614d | 1497 | return ( 0, "Message From: $From not recorded: $msg", $Ticket ); |
84fb5b46 MKG |
1498 | } |
1499 | } elsif ($unsafe_actions) { | |
1500 | my ( $status, $msg ) = _RunUnsafeAction( | |
1501 | Action => $action, | |
1502 | ErrorsTo => $ErrorsTo, | |
1503 | Message => $Message, | |
1504 | Ticket => $Ticket, | |
1505 | CurrentUser => $CurrentUser, | |
1506 | ); | |
1507 | return ($status, $msg, $Ticket) unless $status == 1; | |
1508 | } | |
1509 | } | |
1510 | return ( 1, "Success", $Ticket ); | |
1511 | } | |
1512 | ||
1513 | =head2 GetAuthenticationLevel | |
1514 | ||
1515 | # Authentication Level | |
1516 | # -1 - Get out. this user has been explicitly declined | |
1517 | # 0 - User may not do anything (Not used at the moment) | |
1518 | # 1 - Normal user | |
1519 | # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate | |
1520 | ||
1521 | =cut | |
1522 | ||
1523 | sub GetAuthenticationLevel { | |
1524 | my %args = ( | |
1525 | MailPlugins => [], | |
1526 | Actions => [], | |
1527 | Message => undef, | |
1528 | RawMessageRef => undef, | |
1529 | SystemTicket => undef, | |
1530 | SystemQueue => undef, | |
1531 | @_, | |
1532 | ); | |
1533 | ||
1534 | my ( $CurrentUser, $AuthStat, $error ); | |
1535 | ||
1536 | # Initalize AuthStat so comparisons work correctly | |
1537 | $AuthStat = -9999999; | |
1538 | ||
1539 | # if plugin returns AuthStat -2 we skip action | |
1540 | # NOTE: this is experimental API and it would be changed | |
1541 | my %skip_action = (); | |
1542 | ||
1543 | # Since this needs loading, no matter what | |
1544 | foreach (@{ $args{MailPlugins} }) { | |
1545 | my ($Code, $NewAuthStat); | |
1546 | if ( ref($_) eq "CODE" ) { | |
1547 | $Code = $_; | |
1548 | } else { | |
1549 | no strict 'refs'; | |
1550 | $Code = *{ $_ . "::GetCurrentUser" }{CODE}; | |
1551 | } | |
1552 | ||
1553 | foreach my $action (@{ $args{Actions} }) { | |
1554 | ( $CurrentUser, $NewAuthStat ) = $Code->( | |
1555 | Message => $args{Message}, | |
1556 | RawMessageRef => $args{RawMessageRef}, | |
1557 | CurrentUser => $CurrentUser, | |
1558 | AuthLevel => $AuthStat, | |
1559 | Action => $action, | |
1560 | Ticket => $args{SystemTicket}, | |
1561 | Queue => $args{SystemQueue}, | |
1562 | ); | |
1563 | ||
1564 | # You get the highest level of authentication you were assigned, unless you get the magic -1 | |
1565 | # If a module returns a "-1" then we discard the ticket, so. | |
1566 | $AuthStat = $NewAuthStat | |
1567 | if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 ); | |
1568 | ||
1569 | last if $AuthStat == -1; | |
1570 | $skip_action{$action}++ if $AuthStat == -2; | |
1571 | } | |
1572 | ||
1573 | # strip actions we should skip | |
1574 | @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}} | |
1575 | if $AuthStat == -2; | |
1576 | last unless @{$args{Actions}}; | |
1577 | ||
1578 | last if $AuthStat == -1; | |
1579 | } | |
1580 | ||
1581 | return $AuthStat if !wantarray; | |
1582 | ||
1583 | return ($AuthStat, $CurrentUser, $error); | |
1584 | } | |
1585 | ||
1586 | sub _RunUnsafeAction { | |
1587 | my %args = ( | |
1588 | Action => undef, | |
1589 | ErrorsTo => undef, | |
1590 | Message => undef, | |
1591 | Ticket => undef, | |
1592 | CurrentUser => undef, | |
1593 | @_ | |
1594 | ); | |
1595 | ||
c33a4027 | 1596 | my $From = Encode::decode( "UTF-8", $args{Message}->head->get("From") ); |
af59614d | 1597 | |
84fb5b46 MKG |
1598 | if ( $args{'Action'} =~ /^take$/i ) { |
1599 | my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id ); | |
1600 | unless ($status) { | |
1601 | MailError( | |
1602 | To => $args{'ErrorsTo'}, | |
1603 | Subject => "Ticket not taken", | |
1604 | Explanation => $msg, | |
1605 | MIMEObj => $args{'Message'} | |
1606 | ); | |
af59614d | 1607 | return ( 0, "Ticket not taken, by email From: $From" ); |
84fb5b46 MKG |
1608 | } |
1609 | } elsif ( $args{'Action'} =~ /^resolve$/i ) { | |
dab09ea8 MKG |
1610 | my $new_status = $args{'Ticket'}->FirstInactiveStatus; |
1611 | if ($new_status) { | |
1612 | my ( $status, $msg ) = $args{'Ticket'}->SetStatus($new_status); | |
1613 | unless ($status) { | |
84fb5b46 | 1614 | |
dab09ea8 MKG |
1615 | #Warn the sender that we couldn't actually submit the comment. |
1616 | MailError( | |
1617 | To => $args{'ErrorsTo'}, | |
1618 | Subject => "Ticket not resolved", | |
1619 | Explanation => $msg, | |
1620 | MIMEObj => $args{'Message'} | |
1621 | ); | |
af59614d | 1622 | return ( 0, "Ticket not resolved, by email From: $From" ); |
dab09ea8 | 1623 | } |
84fb5b46 MKG |
1624 | } |
1625 | } else { | |
af59614d | 1626 | return ( 0, "Not supported unsafe action $args{'Action'}, by email From: $From", $args{'Ticket'} ); |
84fb5b46 MKG |
1627 | } |
1628 | return ( 1, "Success" ); | |
1629 | } | |
1630 | ||
1631 | =head2 _NoAuthorizedUserFound | |
1632 | ||
1633 | Emails the RT Owner and the requestor when the auth plugins return "No auth user found" | |
1634 | ||
1635 | =cut | |
1636 | ||
1637 | sub _NoAuthorizedUserFound { | |
1638 | my %args = ( | |
1639 | Right => undef, | |
1640 | Message => undef, | |
1641 | Requestor => undef, | |
1642 | Queue => undef, | |
1643 | @_ | |
1644 | ); | |
1645 | ||
1646 | # Notify the RT Admin of the failure. | |
1647 | MailError( | |
1648 | To => RT->Config->Get('OwnerEmail'), | |
1649 | Subject => "Could not load a valid user", | |
1650 | Explanation => <<EOT, | |
1651 | RT could not load a valid user, and RT's configuration does not allow | |
1652 | for the creation of a new user for this email (@{[$args{Requestor}]}). | |
1653 | ||
1654 | You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the | |
1655 | queue @{[$args{'Queue'}]}. | |
1656 | ||
1657 | EOT | |
1658 | MIMEObj => $args{'Message'}, | |
1659 | LogLevel => 'error' | |
1660 | ); | |
1661 | ||
1662 | # Also notify the requestor that his request has been dropped. | |
1663 | if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) { | |
1664 | MailError( | |
1665 | To => $args{'Requestor'}, | |
1666 | Subject => "Could not load a valid user", | |
1667 | Explanation => <<EOT, | |
1668 | RT could not load a valid user, and RT's configuration does not allow | |
1669 | for the creation of a new user for your email. | |
1670 | ||
1671 | EOT | |
1672 | MIMEObj => $args{'Message'}, | |
1673 | LogLevel => 'error' | |
1674 | ); | |
1675 | } | |
1676 | } | |
1677 | ||
1678 | =head2 _HandleMachineGeneratedMail | |
1679 | ||
1680 | Takes named params: | |
1681 | Message | |
1682 | ErrorsTo | |
1683 | Subject | |
1684 | ||
1685 | Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc. | |
1686 | Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message", | |
1687 | "This message appears to be a loop (boolean)" ); | |
1688 | ||
1689 | =cut | |
1690 | ||
1691 | sub _HandleMachineGeneratedMail { | |
1692 | my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ ); | |
1693 | my $head = $args{'Message'}->head; | |
1694 | my $ErrorsTo = $args{'ErrorsTo'}; | |
1695 | ||
1696 | my $IsBounce = CheckForBounce($head); | |
1697 | ||
1698 | my $IsAutoGenerated = CheckForAutoGenerated($head); | |
1699 | ||
1700 | my $IsSuspiciousSender = CheckForSuspiciousSender($head); | |
1701 | ||
1702 | my $IsALoop = CheckForLoops($head); | |
1703 | ||
1704 | my $SquelchReplies = 0; | |
1705 | ||
1706 | my $owner_mail = RT->Config->Get('OwnerEmail'); | |
1707 | ||
1708 | #If the message is autogenerated, we need to know, so we can not | |
1709 | # send mail to the sender | |
1710 | if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) { | |
1711 | $SquelchReplies = 1; | |
1712 | $ErrorsTo = $owner_mail; | |
1713 | } | |
1714 | ||
1715 | # Warn someone if it's a loop, before we drop it on the ground | |
1716 | if ($IsALoop) { | |
1717 | $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself."); | |
1718 | ||
1719 | #Should we mail it to RTOwner? | |
1720 | if ( RT->Config->Get('LoopsToRTOwner') ) { | |
1721 | MailError( | |
1722 | To => $owner_mail, | |
1723 | Subject => "RT Bounce: ".$args{'Subject'}, | |
1724 | Explanation => "RT thinks this message may be a bounce", | |
1725 | MIMEObj => $args{Message} | |
1726 | ); | |
1727 | } | |
1728 | ||
1729 | #Do we actually want to store it? | |
1730 | return ( 0, $ErrorsTo, "Message Bounced", $IsALoop ) | |
1731 | unless RT->Config->Get('StoreLoops'); | |
1732 | } | |
1733 | ||
1734 | # Squelch replies if necessary | |
1735 | # Don't let the user stuff the RT-Squelch-Replies-To header. | |
1736 | if ( $head->get('RT-Squelch-Replies-To') ) { | |
1737 | $head->replace( | |
1738 | 'RT-Relocated-Squelch-Replies-To', | |
1739 | $head->get('RT-Squelch-Replies-To') | |
1740 | ); | |
1741 | $head->delete('RT-Squelch-Replies-To'); | |
1742 | } | |
1743 | ||
1744 | if ($SquelchReplies) { | |
1745 | ||
1746 | # Squelch replies to the sender, and also leave a clue to | |
1747 | # allow us to squelch ALL outbound messages. This way we | |
1748 | # can punt the logic of "what to do when we get a bounce" | |
1749 | # to the scrip. We might want to notify nobody. Or just | |
1750 | # the RT Owner. Or maybe all Privileged watchers. | |
1751 | my ( $Sender, $junk ) = ParseSenderAddressFromHead($head); | |
c33a4027 | 1752 | $head->replace( 'RT-Squelch-Replies-To', Encode::encode("UTF-8", $Sender ) ); |
84fb5b46 MKG |
1753 | $head->replace( 'RT-DetectedAutoGenerated', 'true' ); |
1754 | } | |
1755 | return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop ); | |
1756 | } | |
1757 | ||
1758 | =head2 IsCorrectAction | |
1759 | ||
1760 | Returns a list of valid actions we've found for this message | |
1761 | ||
1762 | =cut | |
1763 | ||
1764 | sub IsCorrectAction { | |
1765 | my $action = shift; | |
1766 | my @actions = grep $_, split /-/, $action; | |
1767 | return ( 0, '(no value)' ) unless @actions; | |
1768 | foreach ( @actions ) { | |
1769 | return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/; | |
1770 | } | |
1771 | return ( 1, @actions ); | |
1772 | } | |
1773 | ||
1774 | sub _RecordSendEmailFailure { | |
1775 | my $ticket = shift; | |
1776 | if ($ticket) { | |
c33a4027 MKG |
1777 | $ticket->_NewTransaction( |
1778 | Type => "SystemError", | |
1779 | Data => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.", #loc | |
1780 | ActivateScrips => 0, | |
84fb5b46 MKG |
1781 | ); |
1782 | return 1; | |
1783 | } | |
1784 | else { | |
1785 | $RT::Logger->error( "Can't record send email failure as ticket is missing" ); | |
1786 | return; | |
1787 | } | |
1788 | } | |
1789 | ||
af59614d MKG |
1790 | =head2 ConvertHTMLToText HTML |
1791 | ||
320f0092 MKG |
1792 | Takes HTML and converts it to plain text. Appropriate for generating a |
1793 | plain text part from an HTML part of an email. Returns undef if | |
1794 | conversion fails. | |
af59614d MKG |
1795 | |
1796 | =cut | |
1797 | ||
1798 | sub ConvertHTMLToText { | |
1799 | my $html = shift; | |
1800 | ||
1801 | require HTML::FormatText::WithLinks::AndTables; | |
320f0092 MKG |
1802 | my $text; |
1803 | eval { | |
1804 | $text = HTML::FormatText::WithLinks::AndTables->convert( | |
1805 | $html => { | |
1806 | leftmargin => 0, | |
1807 | rightmargin => 78, | |
1808 | no_rowspacing => 1, | |
1809 | before_link => '', | |
1810 | after_link => ' (%l)', | |
1811 | footnote => '', | |
1812 | skip_linked_urls => 1, | |
1813 | with_emphasis => 0, | |
1814 | } | |
1815 | ); | |
1816 | $text //= ''; | |
1817 | }; | |
1818 | $RT::Logger->error("Failed to downgrade HTML to plain text: $@") if $@; | |
1819 | return $text; | |
af59614d MKG |
1820 | } |
1821 | ||
320f0092 | 1822 | |
84fb5b46 MKG |
1823 | RT::Base->_ImportOverlays(); |
1824 | ||
1825 | 1; |