3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
5 # (Except where explictly superceded by other copyright notices)
7 # This work is made available to you under the terms of Version 2 of
8 # the GNU General Public License. A copy of that license should have
9 # been provided with this software, but in any event can be snarfed
12 # This work is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # Unless otherwise specified, all modifications, corrections or
18 # extensions to this work which alter its source code become the
19 # property of Best Practical Solutions, LLC when submitted for
20 # inclusion in the work.
24 # Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
26 package RT::Action::SendEmail;
27 require RT::Action::Generic;
31 @ISA = qw(RT::Action::Generic);
33 use MIME::Words qw(encode_mimeword);
39 RT::Action::SendEmail - An Action which users can use to send mail
40 or can subclassed for more specialized mail sending behavior.
41 RT::Action::AutoReply is a good example subclass.
45 require RT::Action::SendEmail;
46 @ISA = qw(RT::Action::SendEmail);
51 Basically, you create another module RT::Action::YourAction which ISA
52 RT::Action::SendEmail.
54 If you want to set the recipients of the mail to something other than
55 the addresses mentioned in the To, Cc, Bcc and headers in
56 the template, you should subclass RT::Action::SendEmail and override
57 either the SetRecipients method or the SetTo, SetCc, etc methods (see
58 the comments for the SetRecipients sub).
63 ok (require RT::Action::SendEmail);
70 Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org>
78 # {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable)
81 # We use _Init from RT::Action
85 #Do what we need to do and send it out.
89 my $MIMEObj = $self->TemplateObj->MIMEObj;
90 my $msgid = $MIMEObj->head->get('Message-Id');
92 $RT::Logger->info($msgid." #".$self->TicketObj->id."/".$self->TransactionObj->id." - Scrip ". $self->ScripObj->id ." ".$self->ScripObj->Description);
95 # Weed out any RT addresses. We really don't want to talk to ourselves!
96 @{$self->{'To'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'To'}});
97 @{$self->{'Cc'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'Cc'}});
98 @{$self->{'Bcc'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'Bcc'}});
99 # If there are no recipients, don't try to send the message.
100 # If the transaction has content and has the header RT-Squelch-Replies-To
102 if ( defined $self->TransactionObj->Attachments->First() ) {
104 my $squelch = $self->TransactionObj->Attachments->First->GetHeader( 'RT-Squelch-Replies-To');
107 my @blacklist = split ( /,/, $squelch );
109 # Cycle through the people we're sending to and pull out anyone on the
112 foreach my $person_to_yank (@blacklist) {
113 $person_to_yank =~ s/\s//g;
115 grep ( !/^$person_to_yank$/, @{ $self->{'To'} } );
117 grep ( !/^$person_to_yank$/, @{ $self->{'Cc'} } );
118 @{ $self->{'Bcc'} } =
119 grep ( !/^$person_to_yank$/, @{ $self->{'Bcc'} } );
124 # Go add all the Tos, Ccs and Bccs that we need to to the message to
125 # make it happy, but only if we actually have values in those arrays.
127 $self->SetHeader( 'To', join ( ',', @{ $self->{'To'} } ) )
128 if ( $self->{'To'} && @{ $self->{'To'} } );
129 $self->SetHeader( 'Cc', join ( ',', @{ $self->{'Cc'} } ) )
130 if ( $self->{'Cc'} && @{ $self->{'Cc'} } );
131 $self->SetHeader( 'Bcc', join ( ',', @{ $self->{'Bcc'} } ) )
132 if ( $self->{'Cc'} && @{ $self->{'Bcc'} } );
135 $self->SetHeader('MIME-Version', '1.0');
137 # try to convert message body from utf-8 to $RT::EmailOutputEncoding
138 $self->SetHeader( 'Content-Type', 'text/plain; charset="utf-8"' );
140 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' );
141 $self->SetHeader( 'Content-Type', 'text/plain; charset="' . $RT::EmailOutputEncoding . '"' );
144 # Build up a MIME::Entity that looks like the original message.
146 my $do_attach = $self->TemplateObj->MIMEObj->head->get('RT-Attach-Message');
149 $self->TemplateObj->MIMEObj->head->delete('RT-Attach-Message');
151 my $attachments = RT::Attachments->new($RT::SystemUser);
152 $attachments->Limit( FIELD => 'TransactionId',
153 VALUE => $self->TransactionObj->Id );
154 $attachments->OrderBy('id');
156 my $transaction_content_obj = $self->TransactionObj->ContentObj;
158 # attach any of this transaction's attachments
159 while ( my $attach = $attachments->Next ) {
161 # Don't attach anything blank
162 next unless ( $attach->ContentLength );
164 # We want to make sure that we don't include the attachment that's being sued as the "Content" of this message"
166 if ( $transaction_content_obj
167 && $transaction_content_obj->Id == $attach->Id
168 && $transaction_content_obj->ContentType =~ qr{text/plain}i
170 $MIMEObj->make_multipart('mixed');
171 $MIMEObj->attach( Type => $attach->ContentType,
172 Charset => $attach->OriginalEncoding,
173 Data => $attach->OriginalContent,
174 Filename => $self->MIMEEncodeString( $attach->Filename, $RT::EmailOutputEncoding ),
175 Encoding => '-SUGGEST');
181 my $retval = $self->SendMessage($MIMEObj);
194 # This actually populates the MIME::Entity fields in the Template Object
196 unless ( $self->TemplateObj ) {
197 $RT::Logger->warning("No template object handed to $self\n");
200 unless ( $self->TransactionObj ) {
201 $RT::Logger->warning("No transaction object handed to $self\n");
205 unless ( $self->TicketObj ) {
206 $RT::Logger->warning("No ticket object handed to $self\n");
210 my ( $result, $message ) = $self->TemplateObj->Parse(
211 Argument => $self->Argument,
212 TicketObj => $self->TicketObj,
213 TransactionObj => $self->TransactionObj
219 $self->SetSubjectToken();
220 $self->SetRecipients();
221 $self->SetReturnAddress();
222 $self->SetRTSpecialHeaders();
223 if ($RT::EmailOutputEncoding) {
225 # l10n related header
226 $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding );
239 =head2 SendMessage MIMEObj
241 sends the message using RT's preferred API.
242 TODO: Break this out to a seperate module
250 my $msgid = $MIMEObj->head->get('Message-Id');
253 #If we don't have any recipients to send to, don't send a message;
254 unless ( $MIMEObj->head->get('To')
255 || $MIMEObj->head->get('Cc')
256 || $MIMEObj->head->get('Bcc') ) {
257 $RT::Logger->info($msgid. " No recipients found. Not sending.\n");
261 # PseudoTo (fake to headers) shouldn't get matched for message recipients.
262 # If we don't have any 'To' header, drop in the pseudo-to header.
264 $self->SetHeader( 'To', join ( ',', @{ $self->{'PseudoTo'} } ) )
265 if ( $self->{'PseudoTo'} && ( @{ $self->{'PseudoTo'} } )
266 and ( !$MIMEObj->head->get('To') ) );
267 if ( $RT::MailCommand eq 'sendmailpipe' ) {
269 open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" );
270 print MAIL $MIMEObj->as_string;
274 $RT::Logger->crit($msgid. "Could not send mail. -".$@ );
278 my @mailer_args = ($RT::MailCommand);
279 local $ENV{MAILADDRESS};
281 if ( $RT::MailCommand eq 'sendmail' ) {
282 push @mailer_args, $RT::SendmailArguments;
284 elsif ( $RT::MailCommand eq 'smtp' ) {
285 $ENV{MAILADDRESS} = $RT::SMTPFrom || $MIMEObj->head->get('From');
286 push @mailer_args, (Server => $RT::SMTPServer);
287 push @mailer_args, (Debug => $RT::SMTPDebug);
290 push @mailer_args, $RT::MailParams;
293 unless ( $MIMEObj->send( @mailer_args ) ) {
294 $RT::Logger->crit($msgid. "Could not send mail." );
300 my $success = ($msgid. " sent To: ".$MIMEObj->head->get('To') . " Cc: ".$MIMEObj->head->get('Cc') . " Bcc: ".$MIMEObj->head->get('Bcc'));
301 $success =~ s/\n//gi;
302 $RT::Logger->info($success);
309 # {{{ Deal with message headers (Set* subs, designed for easy overriding)
311 # {{{ sub SetRTSpecialHeaders
313 =head2 SetRTSpecialHeaders
315 This routine adds all the random headers that RT wants in a mail message
316 that don't matter much to anybody else.
320 sub SetRTSpecialHeaders {
323 $self->SetReferences();
325 $self->SetMessageID();
327 $self->SetPrecedence();
329 $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname );
330 $self->SetHeader( 'RT-Ticket',
331 $RT::rtname . " #" . $self->TicketObj->id() );
332 $self->SetHeader( 'Managed-by',
333 "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
335 $self->SetHeader( 'RT-Originator',
336 $self->TransactionObj->CreatorObj->EmailAddress );
341 # {{{ sub SetReferences
345 # This routine will set the References: and In-Reply-To headers,
346 # autopopulating it with all the correspondence on this ticket so
347 # far. This should make RT responses threadable.
354 # TODO: this one is broken. What is this email really a reply to?
355 # If it's a reply to an incoming message, we'll need to use the
356 # actual message-id from the appropriate Attachment object. For
357 # incoming mails, we would like to preserve the In-Reply-To and/or
360 $self->SetHeader( 'In-Reply-To',
361 "<rt-" . $self->TicketObj->id() . "\@" . $RT::rtname . ">" );
363 # TODO We should always add References headers for all message-ids
364 # of previous messages related to this ticket.
369 # {{{ sub SetMessageID
373 Without this one, threading won't work very nice in email agents.
374 Anyway, I'm not really sure it's that healthy if we need to send
375 several separate/different emails about the same transaction.
382 # TODO this one might be sort of broken. If we have several scrips +++
383 # sending several emails to several different persons, we need to
384 # pull out different message-ids. I'd suggest message ids like
385 # "rt-ticket#-transaction#-scrip#-receipient#"
387 $self->SetHeader( 'Message-ID',
390 . $self->TicketObj->id() . "-"
391 . $self->TransactionObj->id() . "."
393 . $RT::Organization . ">" )
394 unless $self->TemplateObj->MIMEObj->head->get('Message-ID');
401 # {{{ sub SetReturnAddress
403 =head2 SetReturnAddress is_comment => BOOLEAN
405 Calculate and set From and Reply-To headers based on the is_comment flag.
409 sub SetReturnAddress {
412 my %args = ( is_comment => 0,
416 # $args{is_comment} should be set if the comment address is to be used.
419 if ( $args{'is_comment'} ) {
420 $replyto = $self->TicketObj->QueueObj->CommentAddress
421 || $RT::CommentAddress;
424 $replyto = $self->TicketObj->QueueObj->CorrespondAddress
425 || $RT::CorrespondAddress;
428 unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
429 if ($RT::UseFriendlyFromLine) {
430 my $friendly_name = $self->TransactionObj->CreatorObj->RealName;
431 if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
435 $friendly_name =~ s/"/\\"/g;
436 $self->SetHeader( 'From',
437 sprintf($RT::FriendlyFromLineFormat,
438 $self->MIMEEncodeString( $friendly_name, $RT::EmailOutputEncoding ), $replyto),
442 $self->SetHeader( 'From', $replyto );
446 unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
447 $self->SetHeader( 'Reply-To', "$replyto" );
456 =head2 SetHeader FIELD, VALUE
458 Set the FIELD of the current MIME object into VALUE.
469 $self->TemplateObj->MIMEObj->head->fold_length( $field, 10000 );
470 $self->TemplateObj->MIMEObj->head->replace( $field, $val );
471 return $self->TemplateObj->MIMEObj->head->get($field);
476 # {{{ sub SetRecipients
480 Dummy method to be overriden by subclasses which want to set the recipients.
495 Takes a string that is the addresses you want to send mail to
501 my $addresses = shift;
502 return $self->SetHeader( 'To', $addresses );
511 Takes a string that is the addresses you want to Cc
517 my $addresses = shift;
519 return $self->SetHeader( 'Cc', $addresses );
528 Takes a string that is the addresses you want to Bcc
534 my $addresses = shift;
536 return $self->SetHeader( 'Bcc', $addresses );
541 # {{{ sub SetPrecedence
546 unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ) {
547 $self->SetHeader( 'Precedence', "bulk" );
557 This routine sets the subject. it does not add the rt tag. that gets done elsewhere
558 If $self->{'Subject'} is already defined, it uses that. otherwise, it tries to get
559 the transaction's subject.
567 unless ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
568 my $message = $self->TransactionObj->Attachments;
569 my $ticket = $self->TicketObj->Id;
571 if ( $self->{'Subject'} ) {
572 $subject = $self->{'Subject'};
574 elsif ( ( $message->First() )
575 && ( $message->First->Headers ) ) {
576 my $header = $message->First->Headers();
577 $header =~ s/\n\s+/ /g;
578 if ( $header =~ /^Subject: (.*?)$/m ) {
582 $subject = $self->TicketObj->Subject();
587 $subject = $self->TicketObj->Subject();
590 $subject =~ s/(\r\n|\n|\s)/ /gi;
593 $self->SetHeader( 'Subject', $subject );
601 # {{{ sub SetSubjectToken
603 =head2 SetSubjectToken
605 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
609 sub SetSubjectToken {
611 my $tag = "[$RT::rtname #" . $self->TicketObj->id . "]";
612 my $sub = $self->TemplateObj->MIMEObj->head->get('Subject');
613 unless ( $sub =~ /\Q$tag\E/ ) {
614 $sub =~ s/(\r\n|\n|\s)/ /gi;
616 $self->TemplateObj->MIMEObj->head->replace( 'Subject', "$tag $sub" );
626 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
628 This routine converts the field into specified charset encoding.
632 sub SetHeaderAsEncoding {
634 my ( $field, $enc ) = ( shift, shift );
636 if ($field eq 'From' and $RT::SMTPFrom) {
637 $self->TemplateObj->MIMEObj->head->replace( $field, $RT::SMTPFrom );
641 my $value = $self->TemplateObj->MIMEObj->head->get($field);
643 # don't bother if it's us-ascii
645 # See RT::I18N, 'NOTES: Why Encode::_utf8_off before Encode::from_to'
647 $value = $self->MIMEEncodeString($value, $enc);
649 $self->TemplateObj->MIMEObj->head->replace( $field, $value );
655 # {{{ MIMENcodeString
657 =head2 MIMEEncodeString STRING ENCODING
659 Takes a string and a possible encoding and returns the string wrapped in MIME goo.
663 sub MIMEEncodeString {
669 return ($value) unless $value =~ /[^\x20-\x7e]/;
672 Encode::_utf8_off($value);
673 my $res = Encode::from_to( $value, "utf-8", $enc );
674 $value = encode_mimeword( $value, 'B', $enc );
679 eval "require RT::Action::SendEmail_Vendor";
680 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm});
681 eval "require RT::Action::SendEmail_Local";
682 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm});