[freeside-commits] branch master updated. f70b7c914d5b5ef307bc33f9d0fa53095da91b8d
Mark Wells
mark at 420.am
Mon Oct 19 15:56:24 PDT 2015
The branch, master has been updated
via f70b7c914d5b5ef307bc33f9d0fa53095da91b8d (commit)
via f2731f7f3883905cd17633f486d2aeb9593173da (commit)
from f641486e28214ad1eca18c47d2252701b83614f1 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit f70b7c914d5b5ef307bc33f9d0fa53095da91b8d
Author: Mark Wells <mark at freeside.biz>
Date: Mon Oct 19 15:55:25 2015 -0700
RT cleanup
diff --git a/rt/lib/RT/Action/CreateTickets.pm.orig b/rt/lib/RT/Action/CreateTickets.pm.orig
deleted file mode 100644
index 46791de..0000000
--- a/rt/lib/RT/Action/CreateTickets.pm.orig
+++ /dev/null
@@ -1,1295 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Action::CreateTickets;
-use base 'RT::Action';
-
-use strict;
-use warnings;
-
-use MIME::Entity;
-
-=head1 NAME
-
-RT::Action::CreateTickets - Create one or more tickets according to an externally supplied template
-
-=head1 SYNOPSIS
-
- ===Create-Ticket: codereview
- Subject: Code review for {$Tickets{'TOP'}->Subject}
- Depended-On-By: TOP
- Content: Someone has created a ticket. you should review and approve it,
- so they can finish their work
- ENDOFCONTENT
-
-=head1 DESCRIPTION
-
-The CreateTickets ScripAction allows you to create automated workflows in RT,
-creating new tickets in response to actions and conditions from other
-tickets.
-
-=head2 Format
-
-CreateTickets uses the RT template configured in the scrip as a template
-for an ordered set of tickets to create. The basic format is as follows:
-
- ===Create-Ticket: identifier
- Param: Value
- Param2: Value
- Param3: Value
- Content: Blah
- blah
- blah
- ENDOFCONTENT
- ===Create-Ticket: id2
- Param: Value
- Content: Blah
- ENDOFCONTENT
-
-As shown, you can put one or more C<===Create-Ticket:> sections in
-a template. Each C<===Create-Ticket:> section is evaluated as its own
-L<Text::Template> object, which means that you can embed snippets
-of Perl inside the L<Text::Template> using C<{}> delimiters, but that
-such sections absolutely can not span a C<===Create-Ticket:> boundary.
-
-Note that each C<Value> must come right after the C<Param> on the same
-line. The C<Content:> param can extend over multiple lines, but the text
-of the first line must start right after C<Content:>. Don't try to start
-your C<Content:> section with a newline.
-
-After each ticket is created, it's stuffed into a hash called C<%Tickets>
-making it available during the creation of other tickets during the
-same ScripAction. The hash key for each ticket is C<create-[identifier]>,
-where C<[identifier]> is the value you put after C<===Create-Ticket:>. The hash
-is prepopulated with the ticket which triggered the ScripAction as
-C<$Tickets{'TOP'}>. You can also access that ticket using the shorthand
-C<TOP>.
-
-A simple example:
-
- ===Create-Ticket: codereview
- Subject: Code review for {$Tickets{'TOP'}->Subject}
- Depended-On-By: TOP
- Content: Someone has created a ticket. you should review and approve it,
- so they can finish their work
- ENDOFCONTENT
-
-A convoluted example:
-
- ===Create-Ticket: approval
- { # Find out who the administrators of the group called "HR"
- # of which the creator of this ticket is a member
- my $name = "HR";
-
- my $groups = RT::Groups->new(RT->SystemUser);
- $groups->LimitToUserDefinedGroups();
- $groups->Limit(FIELD => "Name", OPERATOR => "=", VALUE => "$name");
- $groups->WithMember($TransactionObj->CreatorObj->Id);
-
- my $groupid = $groups->First->Id;
-
- my $adminccs = RT::Users->new(RT->SystemUser);
- $adminccs->WhoHaveRight(
- Right => "AdminGroup",
- Object =>$groups->First,
- IncludeSystemRights => undef,
- IncludeSuperusers => 0,
- IncludeSubgroupMembers => 0,
- );
-
- our @admins;
- while (my $admin = $adminccs->Next) {
- push (@admins, $admin->EmailAddress);
- }
- }
- Queue: ___Approvals
- Type: approval
- AdminCc: {join ("\nAdminCc: ", at admins) }
- Depended-On-By: TOP
- Refers-To: TOP
- Subject: Approval for ticket: {$Tickets{"TOP"}->Id} - {$Tickets{"TOP"}->Subject}
- Due: {time + 86400}
- Content-Type: text/plain
- Content: Your approval is requested for the ticket {$Tickets{"TOP"}->Id}: {$Tickets{"TOP"}->Subject}
- Blah
- Blah
- ENDOFCONTENT
- ===Create-Ticket: two
- Subject: Manager approval
- Type: approval
- Depended-On-By: TOP
- Refers-To: {$Tickets{"create-approval"}->Id}
- Queue: ___Approvals
- Content-Type: text/plain
- Content: Your approval is requred for this ticket, too.
- ENDOFCONTENT
-
-As shown above, you can include a block with Perl code to set up some
-values for the new tickets. If you want to access a variable in the
-template section after the block, you must scope it with C<our> rather
-than C<my>. Just as with other RT templates, you can also include
-Perl code in the template sections using C<{}>.
-
-=head2 Acceptable Fields
-
-A complete list of acceptable fields:
-
- * Queue => Name or id# of a queue
- Subject => A text string
- ! Status => A valid status. Defaults to 'new'
- Due => Dates can be specified in seconds since the epoch
- to be handled literally or in a semi-free textual
- format which RT will attempt to parse.
- Starts =>
- Started =>
- Resolved =>
- Owner => Username or id of an RT user who can and should own
- this ticket; forces the owner if necessary
- + Requestor => Email address
- + Cc => Email address
- + AdminCc => Email address
- + RequestorGroup => Group name
- + CcGroup => Group name
- + AdminCcGroup => Group name
- TimeWorked =>
- TimeEstimated =>
- TimeLeft =>
- InitialPriority =>
- FinalPriority =>
- Type =>
- +! DependsOn =>
- +! DependedOnBy =>
- +! RefersTo =>
- +! ReferredToBy =>
- +! Members =>
- +! MemberOf =>
- Content => Content. Can extend to multiple lines. Everything
- within a template after a Content: header is treated
- as content until we hit a line containing only
- ENDOFCONTENT
- ContentType => the content-type of the Content field. Defaults to
- 'text/plain'
- UpdateType => 'correspond' or 'comment'; used in conjunction with
- 'content' if this is an update. Defaults to
- 'correspond'
-
- CustomField-<id#> => custom field value
- CF-name => custom field value
- CustomField-name => custom field value
-
-Fields marked with an C<*> are required.
-
-Fields marked with a C<+> may have multiple values, simply
-by repeating the fieldname on a new line with an additional value.
-
-Fields marked with a C<!> have processing postponed until after all
-tickets in the same actions are created. Except for C<Status>, those
-fields can also take a ticket name within the same action (i.e.
-the identifiers after C<===Create-Ticket:>), instead of raw ticket ID
-numbers.
-
-When parsed, field names are converted to lowercase and have hyphens stripped.
-C<Refers-To>, C<RefersTo>, C<refersto>, C<refers-to> and C<r-e-f-er-s-tO> will
-all be treated as the same thing.
-
-=head1 METHODS
-
-=cut
-
-my %LINKTYPEMAP = (
- MemberOf => {
- Type => 'MemberOf',
- Mode => 'Target',
- },
- Parents => {
- Type => 'MemberOf',
- Mode => 'Target',
- },
- Members => {
- Type => 'MemberOf',
- Mode => 'Base',
- },
- Children => {
- Type => 'MemberOf',
- Mode => 'Base',
- },
- HasMember => {
- Type => 'MemberOf',
- Mode => 'Base',
- },
- RefersTo => {
- Type => 'RefersTo',
- Mode => 'Target',
- },
- ReferredToBy => {
- Type => 'RefersTo',
- Mode => 'Base',
- },
- DependsOn => {
- Type => 'DependsOn',
- Mode => 'Target',
- },
- DependedOnBy => {
- Type => 'DependsOn',
- Mode => 'Base',
- },
-
-);
-
-
-#Do what we need to do and send it out.
-sub Commit {
- my $self = shift;
-
- # Create all the tickets we care about
- return (1) unless $self->TicketObj->Type eq 'ticket';
-
- $self->CreateByTemplate( $self->TicketObj );
- $self->UpdateByTemplate( $self->TicketObj );
- return (1);
-}
-
-
-
-sub Prepare {
- my $self = shift;
-
- unless ( $self->TemplateObj ) {
- $RT::Logger->warning("No template object handed to $self");
- }
-
- unless ( $self->TransactionObj ) {
- $RT::Logger->warning("No transaction object handed to $self");
-
- }
-
- unless ( $self->TicketObj ) {
- $RT::Logger->warning("No ticket object handed to $self");
-
- }
-
- my $active = 0;
- if ( $self->TemplateObj->Type eq 'Perl' ) {
- $active = 1;
- } else {
- RT->Logger->info(sprintf(
- "Template #%d is type %s. You most likely want to use a Perl template instead.",
- $self->TemplateObj->id, $self->TemplateObj->Type
- ));
- }
-
- $self->Parse(
- Content => $self->TemplateObj->Content,
- _ActiveContent => $active,
- );
- return 1;
-
-}
-
-
-
-sub CreateByTemplate {
- my $self = shift;
- my $top = shift;
-
- $RT::Logger->debug("In CreateByTemplate");
-
- my @results;
-
- # XXX: cargo cult programming that works. i'll be back.
-
- local %T::Tickets = %T::Tickets;
- local $T::TOP = $T::TOP;
- local $T::ID = $T::ID;
- $T::Tickets{'TOP'} = $T::TOP = $top if $top;
- local $T::TransactionObj = $self->TransactionObj;
-
- my $ticketargs;
- my ( @links, @postponed );
- foreach my $template_id ( @{ $self->{'create_tickets'} } ) {
- $RT::Logger->debug("Workflow: processing $template_id of $T::TOP")
- if $T::TOP;
-
- $T::ID = $template_id;
- @T::AllID = @{ $self->{'create_tickets'} };
-
- ( $T::Tickets{$template_id}, $ticketargs )
- = $self->ParseLines( $template_id, \@links, \@postponed );
-
- # Now we have a %args to work with.
- # Make sure we have at least the minimum set of
- # reasonable data and do our thang
-
- my ( $id, $transid, $msg )
- = $T::Tickets{$template_id}->Create(%$ticketargs);
-
- foreach my $res ( split( '\n', $msg ) ) {
- push @results,
- $T::Tickets{$template_id}
- ->loc( "Ticket [_1]", $T::Tickets{$template_id}->Id ) . ': '
- . $res;
- }
- if ( !$id ) {
- if ( $self->TicketObj ) {
- $msg = "Couldn't create related ticket $template_id for "
- . $self->TicketObj->Id . " "
- . $msg;
- } else {
- $msg = "Couldn't create ticket $template_id " . $msg;
- }
-
- $RT::Logger->error($msg);
- next;
- }
-
- $RT::Logger->debug("Assigned $template_id with $id");
- $T::Tickets{$template_id}->SetOriginObj( $self->TicketObj )
- if $self->TicketObj
- && $T::Tickets{$template_id}->can('SetOriginObj');
-
- }
-
- $self->PostProcess( \@links, \@postponed );
-
- return @results;
-}
-
-sub UpdateByTemplate {
- my $self = shift;
- my $top = shift;
-
- # XXX: cargo cult programming that works. i'll be back.
-
- my @results;
- local %T::Tickets = %T::Tickets;
- local $T::ID = $T::ID;
-
- my $ticketargs;
- my ( @links, @postponed );
- foreach my $template_id ( @{ $self->{'update_tickets'} } ) {
- $RT::Logger->debug("Update Workflow: processing $template_id");
-
- $T::ID = $template_id;
- @T::AllID = @{ $self->{'update_tickets'} };
-
- ( $T::Tickets{$template_id}, $ticketargs )
- = $self->ParseLines( $template_id, \@links, \@postponed );
-
- # Now we have a %args to work with.
- # Make sure we have at least the minimum set of
- # reasonable data and do our thang
-
- my @attribs = qw(
- Subject
- FinalPriority
- Priority
- TimeEstimated
- TimeWorked
- TimeLeft
- Status
- Queue
- Due
- Starts
- Started
- Resolved
- );
-
- my $id = $template_id;
- $id =~ s/update-(\d+).*/$1/;
- my ($loaded, $msg) = $T::Tickets{$template_id}->LoadById($id);
-
- unless ( $loaded ) {
- $RT::Logger->error("Couldn't update ticket $template_id: " . $msg);
- push @results, $self->loc( "Couldn't load ticket '[_1]'", $id );
- next;
- }
-
- my $current = $self->GetBaseTemplate( $T::Tickets{$template_id} );
-
- $template_id =~ m/^update-(.*)/;
- my $base_id = "base-$1";
- my $base = $self->{'templates'}->{$base_id};
- if ($base) {
- $base =~ s/\r//g;
- $base =~ s/\n+$//;
- $current =~ s/\n+$//;
-
- # If we have no base template, set what we can.
- if ( $base ne $current ) {
- push @results,
- "Could not update ticket "
- . $T::Tickets{$template_id}->Id
- . ": Ticket has changed";
- next;
- }
- }
- push @results, $T::Tickets{$template_id}->Update(
- AttributesRef => \@attribs,
- ARGSRef => $ticketargs
- );
-
- if ( $ticketargs->{'Owner'} ) {
- ($id, $msg) = $T::Tickets{$template_id}->SetOwner($ticketargs->{'Owner'}, "Force");
- push @results, $msg unless $msg eq $self->loc("That user already owns that ticket");
- }
-
- push @results,
- $self->UpdateWatchers( $T::Tickets{$template_id}, $ticketargs );
-
- push @results,
- $self->UpdateCustomFields( $T::Tickets{$template_id}, $ticketargs );
-
- next unless $ticketargs->{'MIMEObj'};
- if ( $ticketargs->{'UpdateType'} =~ /^(private|comment)$/i ) {
- my ( $Transaction, $Description, $Object )
- = $T::Tickets{$template_id}->Comment(
- BccMessageTo => $ticketargs->{'Bcc'},
- MIMEObj => $ticketargs->{'MIMEObj'},
- TimeTaken => $ticketargs->{'TimeWorked'}
- );
- push( @results,
- $T::Tickets{$template_id}
- ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id )
- . ': '
- . $Description );
- } elsif ( $ticketargs->{'UpdateType'} =~ /^(public|response|correspond)$/i ) {
- my ( $Transaction, $Description, $Object )
- = $T::Tickets{$template_id}->Correspond(
- BccMessageTo => $ticketargs->{'Bcc'},
- MIMEObj => $ticketargs->{'MIMEObj'},
- TimeTaken => $ticketargs->{'TimeWorked'}
- );
- push( @results,
- $T::Tickets{$template_id}
- ->loc( "Ticket [_1]", $T::Tickets{$template_id}->id )
- . ': '
- . $Description );
- } else {
- push(
- @results,
- $T::Tickets{$template_id}->loc(
- "Update type was neither correspondence nor comment.")
- . " "
- . $T::Tickets{$template_id}->loc("Update not recorded.")
- );
- }
- }
-
- $self->PostProcess( \@links, \@postponed );
-
- return @results;
-}
-
-=head2 Parse
-
-Takes (in order) template content, a default queue, a default requestor, and
-active (a boolean flag).
-
-Parses a template in the template content, defaulting queue and requestor if
-unspecified in the template to the values provided as arguments.
-
-If the active flag is true, then we'll use L<Text::Template> to parse the
-templates, allowing you to embed active Perl in your templates.
-
-=cut
-
-sub Parse {
- my $self = shift;
- my %args = (
- Content => undef,
- Queue => undef,
- Requestor => undef,
- _ActiveContent => undef,
- @_
- );
-
- if ( $args{'_ActiveContent'} ) {
- $self->{'UsePerlTextTemplate'} = 1;
- } else {
-
- $self->{'UsePerlTextTemplate'} = 0;
- }
-
- if ( substr( $args{'Content'}, 0, 3 ) eq '===' ) {
- $self->_ParseMultilineTemplate(%args);
- } elsif ( $args{'Content'} =~ /(?:\t|,)/i ) {
- $self->_ParseXSVTemplate(%args);
- } else {
- RT->Logger->error("Invalid Template Content (Couldn't find ===, and is not a csv/tsv template) - unable to parse: $args{Content}");
- }
-}
-
-=head2 _ParseMultilineTemplate
-
-Parses mulitline templates. Things like:
-
- ===Create-Ticket: ...
-
-Takes the same arguments as L</Parse>.
-
-=cut
-
-sub _ParseMultilineTemplate {
- my $self = shift;
- my %args = (@_);
-
- my $template_id;
- my ( $queue, $requestor );
- $RT::Logger->debug("Line: ===");
- foreach my $line ( split( /\n/, $args{'Content'} ) ) {
- $line =~ s/\r$//;
- $RT::Logger->debug( "Line: $line" );
- if ( $line =~ /^===/ ) {
- if ( $template_id && !$queue && $args{'Queue'} ) {
- $self->{'templates'}->{$template_id}
- .= "Queue: $args{'Queue'}\n";
- }
- if ( $template_id && !$requestor && $args{'Requestor'} ) {
- $self->{'templates'}->{$template_id}
- .= "Requestor: $args{'Requestor'}\n";
- }
- $queue = 0;
- $requestor = 0;
- }
- if ( $line =~ /^===Create-Ticket: (.*)$/ ) {
- $template_id = "create-$1";
- $RT::Logger->debug("**** Create ticket: $template_id");
- push @{ $self->{'create_tickets'} }, $template_id;
- } elsif ( $line =~ /^===Update-Ticket: (.*)$/ ) {
- $template_id = "update-$1";
- $RT::Logger->debug("**** Update ticket: $template_id");
- push @{ $self->{'update_tickets'} }, $template_id;
- } elsif ( $line =~ /^===Base-Ticket: (.*)$/ ) {
- $template_id = "base-$1";
- $RT::Logger->debug("**** Base ticket: $template_id");
- push @{ $self->{'base_tickets'} }, $template_id;
- } elsif ( $line =~ /^===#.*$/ ) { # a comment
- next;
- } else {
- if ( $line =~ /^Queue:(.*)/i ) {
- $queue = 1;
- my $value = $1;
- $value =~ s/^\s//;
- $value =~ s/\s$//;
- if ( !$value && $args{'Queue'} ) {
- $value = $args{'Queue'};
- $line = "Queue: $value";
- }
- }
- if ( $line =~ /^Requestors?:(.*)/i ) {
- $requestor = 1;
- my $value = $1;
- $value =~ s/^\s//;
- $value =~ s/\s$//;
- if ( !$value && $args{'Requestor'} ) {
- $value = $args{'Requestor'};
- $line = "Requestor: $value";
- }
- }
- $self->{'templates'}->{$template_id} .= $line . "\n";
- }
- }
- if ( $template_id && !$queue && $args{'Queue'} ) {
- $self->{'templates'}->{$template_id} .= "Queue: $args{'Queue'}\n";
- }
- }
-
-sub ParseLines {
- my $self = shift;
- my $template_id = shift;
- my $links = shift;
- my $postponed = shift;
-
- my $content = $self->{'templates'}->{$template_id};
-
- if ( $self->{'UsePerlTextTemplate'} ) {
-
- $RT::Logger->debug(
- "Workflow: evaluating\n$self->{templates}{$template_id}");
-
- my $template = Text::Template->new(
- TYPE => 'STRING',
- SOURCE => $content
- );
-
- my $err;
- $content = $template->fill_in(
- PACKAGE => 'T',
- BROKEN => sub {
- $err = {@_}->{error};
- }
- );
-
- $RT::Logger->debug("Workflow: yielding $content");
-
- if ($err) {
- $RT::Logger->error( "Ticket creation failed: " . $err );
- while ( my ( $k, $v ) = each %T::X ) {
- $RT::Logger->debug(
- "Eliminating $template_id from ${k}'s parents.");
- delete $v->{$template_id};
- }
- next;
- }
- }
-
- my $TicketObj ||= RT::Ticket->new( $self->CurrentUser );
-
- my %args;
- my %original_tags;
- my @lines = ( split( /\n/, $content ) );
- while ( defined( my $line = shift @lines ) ) {
- if ( $line =~ /^(.*?):(?:\s+)(.*?)(?:\s*)$/ ) {
- my $value = $2;
- my $original_tag = $1;
- my $tag = lc($original_tag);
- $tag =~ s/-//g;
- $tag =~ s/^(requestor|cc|admincc)s?$/$1/i;
-
- $original_tags{$tag} = $original_tag;
-
- if ( ref( $args{$tag} ) )
- { #If it's an array, we want to push the value
- push @{ $args{$tag} }, $value;
- } elsif ( defined( $args{$tag} ) )
- { #if we're about to get a second value, make it an array
- $args{$tag} = [ $args{$tag}, $value ];
- } else { #if there's nothing there, just set the value
- $args{$tag} = $value;
- }
-
- if ( $tag =~ /^content$/i ) { #just build up the content
- # convert it to an array
- $args{$tag} = defined($value) ? [ $value . "\n" ] : [];
- while ( defined( my $l = shift @lines ) ) {
- last if ( $l =~ /^ENDOFCONTENT\s*$/ );
- push @{ $args{'content'} }, $l . "\n";
- }
- } else {
- # if it's not content, strip leading and trailing spaces
- if ( $args{$tag} ) {
- $args{$tag} =~ s/^\s+//g;
- $args{$tag} =~ s/\s+$//g;
- }
- if (
- ($tag =~ /^(requestor|cc|admincc)(group)?$/i
- or grep {lc $_ eq $tag} keys %LINKTYPEMAP)
- and $args{$tag} =~ /,/
- ) {
- $args{$tag} = [ split /,\s*/, $args{$tag} ];
- }
- }
- }
- }
-
- foreach my $date (qw(due starts started resolved)) {
- my $dateobj = RT::Date->new( $self->CurrentUser );
- next unless $args{$date};
- if ( $args{$date} =~ /^\d+$/ ) {
- $dateobj->Set( Format => 'unix', Value => $args{$date} );
- } else {
- eval {
- $dateobj->Set( Format => 'iso', Value => $args{$date} );
- };
- if ($@ or $dateobj->Unix <= 0) {
- $dateobj->Set( Format => 'unknown', Value => $args{$date} );
- }
- }
- $args{$date} = $dateobj->ISO;
- }
-
- foreach my $role (qw(requestor cc admincc)) {
- next unless my $value = $args{ $role . 'group' };
-
- my $group = RT::Group->new( $self->CurrentUser );
- $group->LoadUserDefinedGroup( $value );
- unless ( $group->id ) {
- $RT::Logger->error("Couldn't load group '$value'");
- next;
- }
-
- $args{ $role } = $args{ $role } ? [$args{ $role }] : []
- unless ref $args{ $role };
- push @{ $args{ $role } }, $group->PrincipalObj->id;
- }
-
- $args{'requestor'} ||= $self->TicketObj->Requestors->MemberEmailAddresses
- if $self->TicketObj;
-
- $args{'type'} ||= 'ticket';
-
- my %ticketargs = (
- Queue => $args{'queue'},
- Subject => $args{'subject'},
- Status => $args{'status'} || 'new',
- Due => $args{'due'},
- Starts => $args{'starts'},
- Started => $args{'started'},
- Resolved => $args{'resolved'},
- Owner => $args{'owner'},
- Requestor => $args{'requestor'},
- Cc => $args{'cc'},
- AdminCc => $args{'admincc'},
- TimeWorked => $args{'timeworked'},
- TimeEstimated => $args{'timeestimated'},
- TimeLeft => $args{'timeleft'},
- InitialPriority => $args{'initialpriority'} || 0,
- FinalPriority => $args{'finalpriority'} || 0,
- SquelchMailTo => $args{'squelchmailto'},
- Type => $args{'type'},
- $self->Rules
- );
-
- if ( $args{content} ) {
- my $mimeobj = MIME::Entity->build(
- Type => $args{'contenttype'} || 'text/plain',
- Charset => 'UTF-8',
- Data => [ map {Encode::encode( "UTF-8", $_ )} @{$args{'content'}} ],
- );
- $ticketargs{MIMEObj} = $mimeobj;
- $ticketargs{UpdateType} = $args{'updatetype'} || 'correspond';
- }
-
- foreach my $tag ( keys(%args) ) {
- # if the tag was added later, skip it
- my $orig_tag = $original_tags{$tag} or next;
- if ( $orig_tag =~ /^customfield-?(\d+)$/i ) {
- $ticketargs{ "CustomField-" . $1 } = $args{$tag};
- } elsif ( $orig_tag =~ /^(?:customfield|cf)-?(.+)$/i ) {
- my $cf = RT::CustomField->new( $self->CurrentUser );
- $cf->LoadByName( Name => $1, Queue => $ticketargs{Queue} );
- $cf->LoadByName( Name => $1, Queue => 0 ) unless $cf->id;
- next unless $cf->id;
- $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
- } elsif ($orig_tag) {
- my $cf = RT::CustomField->new( $self->CurrentUser );
- $cf->LoadByName( Name => $orig_tag, Queue => $ticketargs{Queue} );
- $cf->LoadByName( Name => $orig_tag, Queue => 0 ) unless $cf->id;
- next unless $cf->id;
- $ticketargs{ "CustomField-" . $cf->id } = $args{$tag};
-
- }
- }
-
- $self->GetDeferred( \%args, $template_id, $links, $postponed );
-
- return $TicketObj, \%ticketargs;
-}
-
-
-=head2 _ParseXSVTemplate
-
-Parses a tab or comma delimited template. Should only ever be called by
-L</Parse>.
-
-=cut
-
-sub _ParseXSVTemplate {
- my $self = shift;
- my %args = (@_);
-
- use Regexp::Common qw(delimited);
- my($first, $content) = split(/\r?\n/, $args{'Content'}, 2);
-
- my $delimiter;
- if ( $first =~ /\t/ ) {
- $delimiter = "\t";
- } else {
- $delimiter = ',';
- }
- my @fields = split( /$delimiter/, $first );
-
- my $delimiter_re = qr[$delimiter];
- my $justquoted = qr[$RE{quoted}];
-
- # Used to generate automatic template ids
- my $autoid = 1;
-
- LINE:
- while ($content) {
- $content =~ s/^(\s*\r?\n)+//;
-
- # Keep track of Queue and Requestor, so we can provide defaults
- my $queue;
- my $requestor;
-
- # The template for this line
- my $template;
-
- # What column we're on
- my $i = 0;
-
- # If the last iteration was the end of the line
- my $EOL = 0;
-
- # The template id
- my $template_id;
-
- COLUMN:
- while (not $EOL and length $content and $content =~ s/^($justquoted|.*?)($delimiter_re|$)//smix) {
- $EOL = not $2;
-
- # Strip off quotes, if they exist
- my $value = $1;
- if ( $value =~ /^$RE{delimited}{-delim=>qq{\'\"}}$/ ) {
- substr( $value, 0, 1 ) = "";
- substr( $value, -1, 1 ) = "";
- }
-
- # What column is this?
- my $field = $fields[$i++];
- next COLUMN unless $field =~ /\S/;
- $field =~ s/^\s//;
- $field =~ s/\s$//;
-
- if ( $field =~ /^id$/i ) {
- # Special case if this is the ID column
- if ( $value =~ /^\d+$/ ) {
- $template_id = 'update-' . $value;
- push @{ $self->{'update_tickets'} }, $template_id;
- } elsif ( $value =~ /^#base-(\d+)$/ ) {
- $template_id = 'base-' . $1;
- push @{ $self->{'base_tickets'} }, $template_id;
- } elsif ( $value =~ /\S/ ) {
- $template_id = 'create-' . $value;
- push @{ $self->{'create_tickets'} }, $template_id;
- }
- } else {
- # Some translations
- if ( $field =~ /^Body$/i
- || $field =~ /^Data$/i
- || $field =~ /^Message$/i )
- {
- $field = 'Content';
- } elsif ( $field =~ /^Summary$/i ) {
- $field = 'Subject';
- } elsif ( $field =~ /^Queue$/i ) {
- # Note that we found a queue
- $queue = 1;
- $value ||= $args{'Queue'};
- } elsif ( $field =~ /^Requestors?$/i ) {
- $field = 'Requestor'; # Remove plural
- # Note that we found a requestor
- $requestor = 1;
- $value ||= $args{'Requestor'};
- }
-
- # Tack onto the end of the template
- $template .= $field . ": ";
- $template .= (defined $value ? $value : "");
- $template .= "\n";
- $template .= "ENDOFCONTENT\n"
- if $field =~ /^Content$/i;
- }
- }
-
- # Ignore blank lines
- next unless $template;
-
- # If we didn't find a queue of requestor, tack on the defaults
- if ( !$queue && $args{'Queue'} ) {
- $template .= "Queue: $args{'Queue'}\n";
- }
- if ( !$requestor && $args{'Requestor'} ) {
- $template .= "Requestor: $args{'Requestor'}\n";
- }
-
- # If we never found an ID, come up with one
- unless ($template_id) {
- $autoid++ while exists $self->{'templates'}->{"create-auto-$autoid"};
- $template_id = "create-auto-$autoid";
- # Also, it's a ticket to create
- push @{ $self->{'create_tickets'} }, $template_id;
- }
-
- # Save the template we generated
- $self->{'templates'}->{$template_id} = $template;
-
- }
-}
-
-sub GetDeferred {
- my $self = shift;
- my $args = shift;
- my $id = shift;
- my $links = shift;
- my $postponed = shift;
-
- # Unify the aliases for child/parent
- $args->{$_} = [$args->{$_}]
- for grep {$args->{$_} and not ref $args->{$_}} qw/members hasmember memberof/;
- push @{$args->{'children'}}, @{delete $args->{'members'}} if $args->{'members'};
- push @{$args->{'children'}}, @{delete $args->{'hasmember'}} if $args->{'hasmember'};
- push @{$args->{'parents'}}, @{delete $args->{'memberof'}} if $args->{'memberof'};
-
- # Deferred processing
- push @$links,
- (
- $id,
- { DependsOn => $args->{'dependson'},
- DependedOnBy => $args->{'dependedonby'},
- RefersTo => $args->{'refersto'},
- ReferredToBy => $args->{'referredtoby'},
- Children => $args->{'children'},
- Parents => $args->{'parents'},
- }
- );
-
- push @$postponed, (
-
- # Status is postponed so we don't violate dependencies
- $id, { Status => $args->{'status'}, }
- );
-}
-
-sub GetUpdateTemplate {
- my $self = shift;
- my $t = shift;
-
- my $string;
- $string .= "Queue: " . $t->QueueObj->Name . "\n";
- $string .= "Subject: " . $t->Subject . "\n";
- $string .= "Status: " . $t->Status . "\n";
- $string .= "UpdateType: correspond\n";
- $string .= "Content: \n";
- $string .= "ENDOFCONTENT\n";
- $string .= "Due: " . $t->DueObj->AsString . "\n";
- $string .= "Starts: " . $t->StartsObj->AsString . "\n";
- $string .= "Started: " . $t->StartedObj->AsString . "\n";
- $string .= "Resolved: " . $t->ResolvedObj->AsString . "\n";
- $string .= "Owner: " . $t->OwnerObj->Name . "\n";
- $string .= "Requestor: " . $t->RequestorAddresses . "\n";
- $string .= "Cc: " . $t->CcAddresses . "\n";
- $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
- $string .= "TimeWorked: " . $t->TimeWorked . "\n";
- $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
- $string .= "TimeLeft: " . $t->TimeLeft . "\n";
- $string .= "InitialPriority: " . $t->Priority . "\n";
- $string .= "FinalPriority: " . $t->FinalPriority . "\n";
-
- foreach my $type ( sort keys %LINKTYPEMAP ) {
-
- # don't display duplicates
- if ( $type eq "HasMember"
- || $type eq "Members"
- || $type eq "MemberOf" )
- {
- next;
- }
- $string .= "$type: ";
-
- my $mode = $LINKTYPEMAP{$type}->{Mode};
- my $method = $LINKTYPEMAP{$type}->{Type};
-
- my $links = '';
- while ( my $link = $t->$method->Next ) {
- $links .= ", " if $links;
-
- my $object = $mode . "Obj";
- my $member = $link->$object;
- $links .= $member->Id if $member;
- }
- $string .= $links;
- $string .= "\n";
- }
-
- return $string;
-}
-
-sub GetBaseTemplate {
- my $self = shift;
- my $t = shift;
-
- my $string;
- $string .= "Queue: " . $t->Queue . "\n";
- $string .= "Subject: " . $t->Subject . "\n";
- $string .= "Status: " . $t->Status . "\n";
- $string .= "Due: " . $t->DueObj->Unix . "\n";
- $string .= "Starts: " . $t->StartsObj->Unix . "\n";
- $string .= "Started: " . $t->StartedObj->Unix . "\n";
- $string .= "Resolved: " . $t->ResolvedObj->Unix . "\n";
- $string .= "Owner: " . $t->Owner . "\n";
- $string .= "Requestor: " . $t->RequestorAddresses . "\n";
- $string .= "Cc: " . $t->CcAddresses . "\n";
- $string .= "AdminCc: " . $t->AdminCcAddresses . "\n";
- $string .= "TimeWorked: " . $t->TimeWorked . "\n";
- $string .= "TimeEstimated: " . $t->TimeEstimated . "\n";
- $string .= "TimeLeft: " . $t->TimeLeft . "\n";
- $string .= "InitialPriority: " . $t->Priority . "\n";
- $string .= "FinalPriority: " . $t->FinalPriority . "\n";
-
- return $string;
-}
-
-sub GetCreateTemplate {
- my $self = shift;
-
- my $string;
-
- $string .= "Queue: General\n";
- $string .= "Subject: \n";
- $string .= "Status: new\n";
- $string .= "Content: \n";
- $string .= "ENDOFCONTENT\n";
- $string .= "Due: \n";
- $string .= "Starts: \n";
- $string .= "Started: \n";
- $string .= "Resolved: \n";
- $string .= "Owner: \n";
- $string .= "Requestor: \n";
- $string .= "Cc: \n";
- $string .= "AdminCc:\n";
- $string .= "TimeWorked: \n";
- $string .= "TimeEstimated: \n";
- $string .= "TimeLeft: \n";
- $string .= "InitialPriority: \n";
- $string .= "FinalPriority: \n";
-
- foreach my $type ( keys %LINKTYPEMAP ) {
-
- # don't display duplicates
- if ( $type eq "HasMember"
- || $type eq 'Members'
- || $type eq 'MemberOf' )
- {
- next;
- }
- $string .= "$type: \n";
- }
- return $string;
-}
-
-sub UpdateWatchers {
- my $self = shift;
- my $ticket = shift;
- my $args = shift;
-
- my @results;
-
- foreach my $type (qw(Requestor Cc AdminCc)) {
- my $method = $type . 'Addresses';
- my $oldaddr = $ticket->$method;
-
- # Skip unless we have a defined field
- next unless defined $args->{$type};
- my $newaddr = $args->{$type};
-
- my @old = split( /,\s*/, $oldaddr );
- my @new;
- for (ref $newaddr ? @{$newaddr} : split( /,\s*/, $newaddr )) {
- # Sometimes these are email addresses, sometimes they're
- # users. Try to guess which is which, as we want to deal
- # with email addresses if at all possible.
- if (/^\S+@\S+$/) {
- push @new, $_;
- } else {
- # It doesn't look like an email address. Try to load it.
- my $user = RT::User->new($self->CurrentUser);
- $user->Load($_);
- if ($user->Id) {
- push @new, $user->EmailAddress;
- } else {
- push @new, $_;
- }
- }
- }
-
- my %oldhash = map { $_ => 1 } @old;
- my %newhash = map { $_ => 1 } @new;
-
- my @add = grep( !defined $oldhash{$_}, @new );
- my @delete = grep( !defined $newhash{$_}, @old );
-
- foreach (@add) {
- my ( $val, $msg ) = $ticket->AddWatcher(
- Type => $type,
- Email => $_
- );
-
- push @results,
- $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
- }
-
- foreach (@delete) {
- my ( $val, $msg ) = $ticket->DeleteWatcher(
- Type => $type,
- Email => $_
- );
- push @results,
- $ticket->loc( "Ticket [_1]", $ticket->Id ) . ': ' . $msg;
- }
- }
- return @results;
-}
-
-sub UpdateCustomFields {
- my $self = shift;
- my $ticket = shift;
- my $args = shift;
-
- my @results;
- foreach my $arg (keys %{$args}) {
- next unless $arg =~ /^CustomField-(\d+)$/;
- my $cf = $1;
-
- my $CustomFieldObj = RT::CustomField->new($self->CurrentUser);
- $CustomFieldObj->SetContextObject( $ticket );
- $CustomFieldObj->LoadById($cf);
-
- my @values;
- if ($CustomFieldObj->Type =~ /text/i) { # Both Text and Wikitext
- @values = ($args->{$arg});
- } else {
- @values = split /\n/, $args->{$arg};
- }
-
- if ( ($CustomFieldObj->Type eq 'Freeform'
- && ! $CustomFieldObj->SingleValue) ||
- $CustomFieldObj->Type =~ /text/i) {
- foreach my $val (@values) {
- $val =~ s/\r//g;
- }
- }
-
- foreach my $value (@values) {
- next unless length($value);
- my ( $val, $msg ) = $ticket->AddCustomFieldValue(
- Field => $cf,
- Value => $value
- );
- push ( @results, $msg );
- }
- }
- return @results;
-}
-
-sub PostProcess {
- my $self = shift;
- my $links = shift;
- my $postponed = shift;
-
- # postprocessing: add links
-
- while ( my $template_id = shift(@$links) ) {
- my $ticket = $T::Tickets{$template_id};
- $RT::Logger->debug( "Handling links for " . $ticket->Id );
- my %args = %{ shift(@$links) };
-
- foreach my $type ( keys %LINKTYPEMAP ) {
- next unless ( defined $args{$type} );
- foreach my $link (
- ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
- {
- next unless $link;
-
- if ( $link =~ /^TOP$/i ) {
- $RT::Logger->debug( "Building $type link for $link: "
- . $T::Tickets{TOP}->Id );
- $link = $T::Tickets{TOP}->Id;
-
- } elsif ( $link !~ m/^\d+$/ ) {
- my $key = "create-$link";
- if ( !exists $T::Tickets{$key} ) {
- $RT::Logger->debug(
- "Skipping $type link for $key (non-existent)");
- next;
- }
- $RT::Logger->debug( "Building $type link for $link: "
- . $T::Tickets{$key}->Id );
- $link = $T::Tickets{$key}->Id;
- } else {
- $RT::Logger->debug("Building $type link for $link");
- }
-
- my ( $wval, $wmsg ) = $ticket->AddLink(
- Type => $LINKTYPEMAP{$type}->{'Type'},
- $LINKTYPEMAP{$type}->{'Mode'} => $link,
- Silent => 1
- );
-
- $RT::Logger->warning("AddLink thru $link failed: $wmsg")
- unless $wval;
-
- # push @non_fatal_errors, $wmsg unless ($wval);
- }
-
- }
- }
-
- # postponed actions -- Status only, currently
- while ( my $template_id = shift(@$postponed) ) {
- my $ticket = $T::Tickets{$template_id};
- $RT::Logger->debug( "Handling postponed actions for " . $ticket->id );
- my %args = %{ shift(@$postponed) };
- $ticket->SetStatus( $args{Status} ) if defined $args{Status};
- }
-
-}
-
-sub Options {
- my $self = shift;
- my $queues = RT::Queues->new($self->CurrentUser);
- $queues->UnLimit;
- my @names;
- while (my $queue = $queues->Next) {
- push @names, $queue->Id, $queue->Name;
- }
- return (
- {
- 'name' => 'Queue',
- 'label' => 'In queue',
- 'type' => 'select',
- 'options' => \@names
- }
- )
-}
-
-RT::Base->_ImportOverlays();
-
-1;
-
diff --git a/rt/lib/RT/Action/SendEmail.pm.orig b/rt/lib/RT/Action/SendEmail.pm.orig
deleted file mode 100755
index af3a6bf..0000000
--- a/rt/lib/RT/Action/SendEmail.pm.orig
+++ /dev/null
@@ -1,1133 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-# Portions Copyright 2000 Tobias Brox <tobix at cpan.org>
-
-package RT::Action::SendEmail;
-
-use strict;
-use warnings;
-
-use base qw(RT::Action);
-
-use RT::EmailParser;
-use RT::Interface::Email;
-use Email::Address;
-our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc);
-
-
-=head1 NAME
-
-RT::Action::SendEmail - An Action which users can use to send mail
-or can subclassed for more specialized mail sending behavior.
-RT::Action::AutoReply is a good example subclass.
-
-=head1 SYNOPSIS
-
- use base 'RT::Action::SendEmail';
-
-=head1 DESCRIPTION
-
-Basically, you create another module RT::Action::YourAction which ISA
-RT::Action::SendEmail.
-
-=head1 METHODS
-
-=head2 CleanSlate
-
-Cleans class-wide options, like L</AttachTickets>.
-
-=cut
-
-sub CleanSlate {
- my $self = shift;
- $self->AttachTickets(undef);
-}
-
-=head2 Commit
-
-Sends the prepared message and writes outgoing record into DB if the feature is
-activated in the config.
-
-=cut
-
-sub Commit {
- my $self = shift;
-
- return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
- unless RT->Config->Get('RecordOutgoingEmail');
-
- $self->DeferDigestRecipients();
- my $message = $self->TemplateObj->MIMEObj;
-
- my $orig_message;
- $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
- Attachment => $self->TransactionObj->Attachments->First,
- Ticket => $self->TicketObj,
- );
-
- my ($ret) = $self->SendMessage($message);
- return abs( $ret ) if $ret <= 0;
-
- if ($orig_message) {
- $message->attach(
- Type => 'application/x-rt-original-message',
- Disposition => 'inline',
- Data => $orig_message->as_string,
- );
- }
- $self->RecordOutgoingMailTransaction($message);
- $self->RecordDeferredRecipients();
- return 1;
-}
-
-=head2 Prepare
-
-Builds an outgoing email we're going to send using scrip's template.
-
-=cut
-
-sub Prepare {
- my $self = shift;
-
- my ( $result, $message ) = $self->TemplateObj->Parse(
- Argument => $self->Argument,
- TicketObj => $self->TicketObj,
- TransactionObj => $self->TransactionObj
- );
- if ( !$result ) {
- return (undef);
- }
-
- my $MIMEObj = $self->TemplateObj->MIMEObj;
-
- # Header
- $self->SetRTSpecialHeaders();
-
- my %seen;
- foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
- @{ $self->{$type} }
- = grep defined && length && !$seen{ lc $_ }++,
- @{ $self->{$type} };
- }
-
- $self->RemoveInappropriateRecipients();
-
- # Go add all the Tos, Ccs and Bccs that we need to to the message to
- # make it happy, but only if we actually have values in those arrays.
-
-# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
-
- for my $header (@EMAIL_RECIPIENT_HEADERS) {
-
- $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
- if (!$MIMEObj->head->get($header)
- && $self->{$header}
- && @{ $self->{$header} } );
- }
- # PseudoTo (fake to headers) shouldn't get matched for message recipients.
- # If we don't have any 'To' header (but do have other recipients), drop in
- # the pseudo-to header.
- $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) )
- if $self->{'PseudoTo'}
- && @{ $self->{'PseudoTo'} }
- && !$MIMEObj->head->get('To')
- && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
-
- # We should never have to set the MIME-Version header
- $self->SetHeader( 'MIME-Version', '1.0' );
-
- # fsck.com #5959: Since RT sends 8bit mail, we should say so.
- $self->SetHeader( 'Content-Transfer-Encoding', '8bit' );
-
- # For security reasons, we only send out textual mails.
- foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
- my $type = $part->mime_type || 'text/plain';
- $type = 'text/plain' unless RT::I18N::IsTextualContentType($type);
- $part->head->mime_attr( "Content-Type" => $type );
- # utf-8 here is for _FindOrGuessCharset in I18N.pm
- # it's not the final charset/encoding sent
- $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
- }
-
- RT::I18N::SetMIMEEntityToEncoding( $MIMEObj,
- RT->Config->Get('EmailOutputEncoding'),
- 'mime_words_ok', );
-
- # Build up a MIME::Entity that looks like the original message.
- $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
- && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) );
-
- $self->AddTickets;
-
- my $attachment = $self->TransactionObj->Attachments->First;
- if ($attachment
- && !(
- $attachment->GetHeader('X-RT-Encrypt')
- || $self->TicketObj->QueueObj->Encrypt
- )
- )
- {
- $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
- if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
- 'Success';
- }
-
- return $result;
-}
-
-=head2 To
-
-Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
-
-=cut
-
-sub To {
- my $self = shift;
- return ( $self->AddressesFromHeader('To') );
-}
-
-=head2 Cc
-
-Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
-
-=cut
-
-sub Cc {
- my $self = shift;
- return ( $self->AddressesFromHeader('Cc') );
-}
-
-=head2 Bcc
-
-Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
-
-=cut
-
-sub Bcc {
- my $self = shift;
- return ( $self->AddressesFromHeader('Bcc') );
-
-}
-
-sub AddressesFromHeader {
- my $self = shift;
- my $field = shift;
- my $header = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field));
- my @addresses = Email::Address->parse($header);
-
- return (@addresses);
-}
-
-=head2 SendMessage MIMEObj
-
-sends the message using RT's preferred API.
-TODO: Break this out to a separate module
-
-=cut
-
-sub SendMessage {
-
- # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's
- # ability to pass @_ to a 'post' routine.
- my ( $self, $MIMEObj ) = @_;
-
- my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
- chomp $msgid;
-
- $self->ScripActionObj->{_Message_ID}++;
-
- $RT::Logger->info( $msgid . " #"
- . $self->TicketObj->id . "/"
- . $self->TransactionObj->id
- . " - Scrip "
- . ($self->ScripObj->id || '#rule'). " "
- . ( $self->ScripObj->Description || '' ) );
-
- my $status = RT::Interface::Email::SendEmail(
- Entity => $MIMEObj,
- Ticket => $self->TicketObj,
- Transaction => $self->TransactionObj,
- );
-
-
- return $status unless ($status > 0 || exists $self->{'Deferred'});
-
- my $success = $msgid . " sent ";
- foreach (@EMAIL_RECIPIENT_HEADERS) {
- my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) );
- $success .= " $_: " . $recipients if $recipients;
- }
-
- if( exists $self->{'Deferred'} ) {
- for (qw(daily weekly susp)) {
- $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } )
- if exists $self->{'Deferred'}{ $_ };
- }
- }
-
- $success =~ s/\n//g;
-
- $RT::Logger->info($success);
-
- return (1);
-}
-
-=head2 AddAttachments
-
-Takes any attachments to this transaction and attaches them to the message
-we're building.
-
-=cut
-
-sub AddAttachments {
- my $self = shift;
-
- my $MIMEObj = $self->TemplateObj->MIMEObj;
-
- $MIMEObj->head->delete('RT-Attach-Message');
-
- my $attachments = RT::Attachments->new( RT->SystemUser );
- $attachments->Limit(
- FIELD => 'TransactionId',
- VALUE => $self->TransactionObj->Id
- );
-
- # Don't attach anything blank
- $attachments->LimitNotEmpty;
- $attachments->OrderBy( FIELD => 'id' );
-
- # We want to make sure that we don't include the attachment that's
- # being used as the "Content" of this message" unless that attachment's
- # content type is not like text/...
- my $transaction_content_obj = $self->TransactionObj->ContentObj;
-
- if ( $transaction_content_obj
- && $transaction_content_obj->ContentType =~ m{text/}i )
- {
- # If this was part of a multipart/alternative, skip all of the kids
- my $parent = $transaction_content_obj->ParentObj;
- if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
- $attachments->Limit(
- ENTRYAGGREGATOR => 'AND',
- FIELD => 'parent',
- OPERATOR => '!=',
- VALUE => $parent->Id,
- );
- } else {
- $attachments->Limit(
- ENTRYAGGREGATOR => 'AND',
- FIELD => 'id',
- OPERATOR => '!=',
- VALUE => $transaction_content_obj->Id,
- );
- }
- }
-
- # attach any of this transaction's attachments
- my $seen_attachment = 0;
- while ( my $attach = $attachments->Next ) {
- if ( !$seen_attachment ) {
- $MIMEObj->make_multipart( 'mixed', Force => 1 );
- $seen_attachment = 1;
- }
- $self->AddAttachment($attach);
- }
-}
-
-=head2 AddAttachment $attachment
-
-Takes one attachment object of L<RT::Attachment> class and attaches it to the message
-we're building.
-
-=cut
-
-sub AddAttachment {
- my $self = shift;
- my $attach = shift;
- my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
-
- # $attach->TransactionObj may not always be $self->TransactionObj
- return unless $attach->Id
- and $attach->TransactionObj->CurrentUserCanSee;
-
- # ->attach expects just the disposition type; extract it if we have the header
- # or default to "attachment"
- my $disp = ($attach->GetHeader('Content-Disposition') || '')
- =~ /^\s*(inline|attachment)/i ? $1 : "attachment";
-
- $MIMEObj->attach(
- Type => $attach->ContentType,
- Charset => $attach->OriginalEncoding,
- Data => $attach->OriginalContent,
- Disposition => $disp,
- Filename => $self->MIMEEncodeString( $attach->Filename ),
- 'RT-Attachment:' => $self->TicketObj->Id . "/"
- . $self->TransactionObj->Id . "/"
- . $attach->id,
- Encoding => '-SUGGEST',
- );
-}
-
-=head2 AttachTickets [@IDs]
-
-Returns or set list of ticket's IDs that should be attached to an outgoing message.
-
-B<Note> this method works as a class method and setup things global, so you have to
-clean list by passing undef as argument.
-
-=cut
-
-{
- my $list = [];
-
- sub AttachTickets {
- my $self = shift;
- $list = [ grep defined, @_ ] if @_;
- return @$list;
- }
-}
-
-=head2 AddTickets
-
-Attaches tickets to the current message, list of tickets' ids get from
-L</AttachTickets> method.
-
-=cut
-
-sub AddTickets {
- my $self = shift;
- $self->AddTicket($_) foreach $self->AttachTickets;
- return;
-}
-
-=head2 AddTicket $ID
-
-Attaches a ticket with ID to the message.
-
-Each ticket is attached as multipart entity and all its messages and attachments
-are attached as sub entities in order of creation, but only if transaction type
-is Create or Correspond.
-
-=cut
-
-sub AddTicket {
- my $self = shift;
- my $tid = shift;
-
- my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj );
- my $txn_alias = $attachs->TransactionAlias;
- $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
- $attachs->Limit(
- ALIAS => $txn_alias,
- FIELD => 'Type',
- VALUE => 'Correspond'
- );
- $attachs->LimitByTicket($tid);
- $attachs->LimitNotEmpty;
- $attachs->OrderBy( FIELD => 'Created' );
-
- my $ticket_mime = MIME::Entity->build(
- Type => 'multipart/mixed',
- Top => 0,
- Description => "ticket #$tid",
- );
- while ( my $attachment = $attachs->Next ) {
- $self->AddAttachment( $attachment, $ticket_mime );
- }
- if ( $ticket_mime->parts ) {
- my $email_mime = $self->TemplateObj->MIMEObj;
- $email_mime->make_multipart;
- $email_mime->add_part($ticket_mime);
- }
- return;
-}
-
-=head2 RecordOutgoingMailTransaction MIMEObj
-
-Record a transaction in RT with this outgoing message for future record-keeping purposes
-
-=cut
-
-sub RecordOutgoingMailTransaction {
- my $self = shift;
- my $MIMEObj = shift;
-
- my @parts = $MIMEObj->parts;
- my @attachments;
- my @keep;
- foreach my $part (@parts) {
- my $attach = $part->head->get('RT-Attachment');
- if ($attach) {
- $RT::Logger->debug(
- "We found an attachment. we want to not record it.");
- push @attachments, $attach;
- } else {
- $RT::Logger->debug("We found a part. we want to record it.");
- push @keep, $part;
- }
- }
- $MIMEObj->parts( \@keep );
- foreach my $attachment (@attachments) {
- $MIMEObj->head->add( 'RT-Attachment', $attachment );
- }
-
- RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
-
- my $transaction
- = RT::Transaction->new( $self->TransactionObj->CurrentUser );
-
-# XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
-
- my $type;
- if ( $self->TransactionObj->Type eq 'Comment' ) {
- $type = 'CommentEmailRecord';
- } else {
- $type = 'EmailRecord';
- }
-
- my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
- chomp $msgid;
-
- my ( $id, $msg ) = $transaction->Create(
- Ticket => $self->TicketObj->Id,
- Type => $type,
- Data => $msgid,
- MIMEObj => $MIMEObj,
- ActivateScrips => 0
- );
-
- if ($id) {
- $self->{'OutgoingMailTransaction'} = $id;
- } else {
- $RT::Logger->warning(
- "Could not record outgoing message transaction: $msg");
- }
- return $id;
-}
-
-=head2 SetRTSpecialHeaders
-
-This routine adds all the random headers that RT wants in a mail message
-that don't matter much to anybody else.
-
-=cut
-
-sub SetRTSpecialHeaders {
- my $self = shift;
-
- $self->SetSubject();
- $self->SetSubjectToken();
- $self->SetHeaderAsEncoding( 'Subject',
- RT->Config->Get('EmailOutputEncoding') )
- if ( RT->Config->Get('EmailOutputEncoding') );
- $self->SetReturnAddress();
- $self->SetReferencesHeaders();
-
- unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
-
- # Get Message-ID for this txn
- my $msgid = "";
- if ( my $msg = $self->TransactionObj->Message->First ) {
- $msgid = $msg->GetHeader("RT-Message-ID")
- || $msg->GetHeader("Message-ID");
- }
-
- # If there is one, and we can parse it, then base our Message-ID on it
- if ( $msgid
- and $msgid
- =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
- "<$1." . $self->TicketObj->id
- . "-" . $self->ScripObj->id
- . "-" . $self->ScripActionObj->{_Message_ID}
- . "@" . RT->Config->Get('Organization') . ">"/eg
- and $2 == $self->TicketObj->id
- )
- {
- $self->SetHeader( "Message-ID" => $msgid );
- } else {
- $self->SetHeader(
- 'Message-ID' => RT::Interface::Email::GenMessageId(
- Ticket => $self->TicketObj,
- Scrip => $self->ScripObj,
- ScripAction => $self->ScripActionObj
- ),
- );
- }
- }
-
- if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
- and !$self->TemplateObj->MIMEObj->head->get("Precedence")
- ) {
- $self->SetHeader( 'Precedence', $precedence );
- }
-
- $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
- $self->SetHeader( 'RT-Ticket',
- RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
- $self->SetHeader( 'Managed-by',
- "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
-
-# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
-# refactored into user's method.
- if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
- and ! defined $self->TemplateObj->MIMEObj->head->get("RT-Originator")
- and RT->Config->Get('UseOriginatorHeader')
- ) {
- $self->SetHeader( 'RT-Originator', $email );
- }
-
-}
-
-
-sub DeferDigestRecipients {
- my $self = shift;
- $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
-
- # The digest attribute will be an array of notifications that need to
- # be sent for this transaction. The array will have the following
- # format for its objects.
- # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
- # -> sent -> {true|false}
- # The "sent" flag will be used by the cron job to indicate that it has
- # run on this transaction.
- # In a perfect world we might move this hash construction to the
- # extension module itself.
- my $digest_hash = {};
-
- foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
- # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
- next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
- $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
-
- # Store the 'daily digest' folk in an array.
- my ( @send_now, @daily_digest, @weekly_digest, @suspended );
-
- # Have to get the list of addresses directly from the MIME header
- # at this point.
- $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) );
- foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
- next unless $rcpt;
- my $user_obj = RT::User->new(RT->SystemUser);
- $user_obj->LoadByEmail($rcpt);
- if ( ! $user_obj->id ) {
- # If there's an email address in here without an associated
- # RT user, pass it on through.
- $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail.");
- push( @send_now, $rcpt );
- next;
- }
-
- my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
- $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
-
- if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
- elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
- elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
- else { push( @send_now, $rcpt ) }
- }
-
- # Reset the relevant mail field.
- $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
- if (@send_now) {
- $self->SetHeader( $mailfield, join( ', ', @send_now ) );
- } else { # No recipients! Remove the header.
- $self->TemplateObj->MIMEObj->head->delete($mailfield);
- }
-
- # Push the deferred addresses into the appropriate field in
- # our attribute hash, with the appropriate mail header.
- $RT::Logger->debug(
- "Setting deferred recipients for attribute creation");
- $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest);
- $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest);
- $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended);
- }
-
- if ( scalar keys %$digest_hash ) {
-
- # Save the hash so that we can add it as an attribute to the
- # outgoing email transaction.
- $self->{'Deferred'} = $digest_hash;
- } else {
- $RT::Logger->debug( "No recipients found for deferred delivery on "
- . "transaction #"
- . $self->TransactionObj->id );
- }
-}
-
-
-
-sub RecordDeferredRecipients {
- my $self = shift;
- return unless exists $self->{'Deferred'};
-
- my $txn_id = $self->{'OutgoingMailTransaction'};
- return unless $txn_id;
-
- my $txn_obj = RT::Transaction->new( $self->CurrentUser );
- $txn_obj->Load( $txn_id );
- my( $ret, $msg ) = $txn_obj->AddAttribute(
- Name => 'DeferredRecipients',
- Content => $self->{'Deferred'}
- );
- $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
- unless $ret;
-
- return ($ret,$msg);
-}
-
-=head2 SquelchMailTo
-
-Returns list of the addresses to squelch on this transaction.
-
-=cut
-
-sub SquelchMailTo {
- my $self = shift;
- return map $_->Content, $self->TransactionObj->SquelchMailTo;
-}
-
-=head2 RemoveInappropriateRecipients
-
-Remove addresses that are RT addresses or that are on this transaction's blacklist
-
-=cut
-
-sub RemoveInappropriateRecipients {
- my $self = shift;
-
- my @blacklist = ();
-
- # If there are no recipients, don't try to send the message.
- # If the transaction has content and has the header RT-Squelch-Replies-To
-
- my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') );
- if ( my $attachment = $self->TransactionObj->Attachments->First ) {
-
- if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
-
- # What do we want to do with this? It's probably (?) a bounce
- # caused by one of the watcher addresses being broken.
- # Default ("true") is to redistribute, for historical reasons.
-
- if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
-
- # Don't send to any watchers.
- @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
- $RT::Logger->info( $msgid
- . " The incoming message was autogenerated. "
- . "Not redistributing this message based on site configuration."
- );
- } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
- 'privileged' )
- {
-
- # Only send to "privileged" watchers.
- foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
- foreach my $addr ( @{ $self->{$type} } ) {
- my $user = RT::User->new(RT->SystemUser);
- $user->LoadByEmail($addr);
- push @blacklist, $addr unless $user->id && $user->Privileged;
- }
- }
- $RT::Logger->info( $msgid
- . " The incoming message was autogenerated. "
- . "Not redistributing this message to unprivileged users based on site configuration."
- );
- }
- }
-
- if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
- push @blacklist, split( /,/, $squelch );
- }
- }
-
- # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted
- push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo;
-
- # Cycle through the people we're sending to and pull out anyone on the
- # system blacklist
-
- # Trim leading and trailing spaces.
- @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) }
- Email::Address->parse( join ', ', grep defined, @blacklist );
-
- foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
- my @addrs;
- foreach my $addr ( @{ $self->{$type} } ) {
-
- # Weed out any RT addresses. We really don't want to talk to ourselves!
- # If we get a reply back, that means it's not an RT address
- if ( !RT::EmailParser->CullRTAddresses($addr) ) {
- $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
- next;
- }
- if ( grep $addr eq $_, @blacklist ) {
- $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
- next;
- }
- push @addrs, $addr;
- }
- foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) {
- # never send email to itself
- if ( !RT::EmailParser->CullRTAddresses($addr) ) {
- $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
- next;
- }
- push @addrs, $addr;
- }
- @{ $self->{$type} } = @addrs;
- }
-}
-
-=head2 SetReturnAddress is_comment => BOOLEAN
-
-Calculate and set From and Reply-To headers based on the is_comment flag.
-
-=cut
-
-sub SetReturnAddress {
-
- my $self = shift;
- my %args = (
- is_comment => 0,
- friendly_name => undef,
- @_
- );
-
- # From and Reply-To
- # $args{is_comment} should be set if the comment address is to be used.
- my $replyto;
-
- if ( $args{'is_comment'} ) {
- $replyto = $self->TicketObj->QueueObj->CommentAddress
- || RT->Config->Get('CommentAddress');
- } else {
- $replyto = $self->TicketObj->QueueObj->CorrespondAddress
- || RT->Config->Get('CorrespondAddress');
- }
-
- unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
- $self->SetFrom( %args, From => $replyto );
- }
-
- unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
- $self->SetHeader( 'Reply-To', "$replyto" );
- }
-
-}
-
-=head2 SetFrom ( From => emailaddress )
-
-Set the From: address for outgoing email
-
-=cut
-
-sub SetFrom {
- my $self = shift;
- my %args = @_;
-
- my $from = $args{From};
-
- if ( RT->Config->Get('UseFriendlyFromLine') ) {
- my $friendly_name = $self->GetFriendlyName(%args);
- $from =
- sprintf(
- RT->Config->Get('FriendlyFromLineFormat'),
- $self->MIMEEncodeString(
- $friendly_name, RT->Config->Get('EmailOutputEncoding')
- ),
- $args{From}
- );
- }
-
- $self->SetHeader( 'From', $from );
-
- #also set Sender:, otherwise MTAs add a nonsensical value like rt at machine,
- #and then Outlook prepends "rt at machine on behalf of" to the From: header
- $self->SetHeader( 'Sender', $from );
-}
-
-=head2 GetFriendlyName
-
-Calculate the proper Friendly Name based on the creator of the transaction
-
-=cut
-
-sub GetFriendlyName {
- my $self = shift;
- my %args = (
- is_comment => 0,
- friendly_name => '',
- @_
- );
- my $friendly_name = $args{friendly_name};
-
- unless ( $friendly_name ) {
- $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
- if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
- $friendly_name = $1;
- }
- }
-
- $friendly_name =~ s/"/\\"/g;
- return $friendly_name;
-
-}
-
-=head2 SetHeader FIELD, VALUE
-
-Set the FIELD of the current MIME object into VALUE, which should be in
-characters, not bytes. Returns the new header, in bytes.
-
-=cut
-
-sub SetHeader {
- my $self = shift;
- my $field = shift;
- my $val = shift;
-
- chomp $val;
- chomp $field;
- my $head = $self->TemplateObj->MIMEObj->head;
- $head->fold_length( $field, 10000 );
- $head->replace( $field, Encode::encode( "UTF-8", $val ) );
- return $head->get($field);
-}
-
-=head2 SetSubject
-
-This routine sets the subject. it does not add the rt tag. That gets done elsewhere
-If subject is already defined via template, it uses that. otherwise, it tries to get
-the transaction's subject.
-
-=cut
-
-sub SetSubject {
- my $self = shift;
- my $subject;
-
- if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
- return ();
- }
-
- # don't use Transaction->Attachments because it caches
- # and anything which later calls ->Attachments will be hurt
- # by our RowsPerPage() call. caching is hard.
- my $message = RT::Attachments->new( $self->CurrentUser );
- $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
- $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
- $message->RowsPerPage(1);
-
- if ( $self->{'Subject'} ) {
- $subject = $self->{'Subject'};
- } elsif ( my $first = $message->First ) {
- my $tmp = $first->GetHeader('Subject');
- $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
- } else {
- $subject = $self->TicketObj->Subject;
- }
- $subject = '' unless defined $subject;
- chomp $subject;
-
- $subject =~ s/(\r\n|\n|\s)/ /g;
-
- $self->SetHeader( 'Subject', $subject );
-
-}
-
-=head2 SetSubjectToken
-
-This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
-
-=cut
-
-sub SetSubjectToken {
- my $self = shift;
-
- my $head = $self->TemplateObj->MIMEObj->head;
- $self->SetHeader(
- Subject =>
- RT::Interface::Email::AddSubjectTag(
- Encode::decode( "UTF-8", $head->get('Subject') ),
- $self->TicketObj,
- ),
- );
-}
-
-=head2 SetReferencesHeaders
-
-Set References and In-Reply-To headers for this message.
-
-=cut
-
-sub SetReferencesHeaders {
- my $self = shift;
-
- my $top = $self->TransactionObj->Message->First;
- unless ( $top ) {
- $self->SetHeader( References => $self->PseudoReference );
- return (undef);
- }
-
- my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
- my @references = split( /\s+/m, $top->GetHeader('References') || '' );
- my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' );
-
- # There are two main cases -- this transaction was created with
- # the RT Web UI, and hence we want to *not* append its Message-ID
- # to the References and In-Reply-To. OR it came from an outside
- # source, and we should treat it as per the RFC
- my $org = RT->Config->Get('Organization');
- if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
-
- # Make all references which are internal be to version which we
- # have sent out
-
- for ( @references, @in_reply_to ) {
- s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
- "<$1." . $self->TicketObj->id .
- "-" . $self->ScripObj->id .
- "-" . $self->ScripActionObj->{_Message_ID} .
- "@" . $org . ">"/eg
- }
-
- # In reply to whatever the internal message was in reply to
- $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
-
- # Default the references to whatever we're in reply to
- @references = @in_reply_to unless @references;
-
- # References are unchanged from internal
- } else {
-
- # In reply to that message
- $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
-
- # Default the references to whatever we're in reply to
- @references = @in_reply_to unless @references;
-
- # Push that message onto the end of the references
- push @references, @msgid;
- }
-
- # Push pseudo-ref to the front
- my $pseudo_ref = $self->PseudoReference;
- @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
-
- # If there are more than 10 references headers, remove all but the
- # first four and the last six (Gotta keep this from growing
- # forever)
- splice( @references, 4, -6 ) if ( $#references >= 10 );
-
- # Add on the references
- $self->SetHeader( 'References', join( " ", @references ) );
- $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
-
-}
-
-=head2 PseudoReference
-
-Returns a fake Message-ID: header for the ticket to allow a base level of threading
-
-=cut
-
-sub PseudoReference {
-
- my $self = shift;
- my $pseudo_ref
- = '<RT-Ticket-'
- . $self->TicketObj->id . '@'
- . RT->Config->Get('Organization') . '>';
- return $pseudo_ref;
-}
-
-=head2 SetHeaderAsEncoding($field_name, $charset_encoding)
-
-This routine converts the field into specified charset encoding, then
-applies the MIME-Header transfer encoding.
-
-=cut
-
-sub SetHeaderAsEncoding {
- my $self = shift;
- my ( $field, $enc ) = ( shift, shift );
-
- my $head = $self->TemplateObj->MIMEObj->head;
-
- if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
- $head->replace( $field, Encode::encode( "UTF-8", RT->Config->Get('SMTPFrom') ) );
- return;
- }
-
- my $value = Encode::decode("UTF-8", $head->get( $field ));
- $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes
- $head->replace( $field, $value );
-
-}
-
-=head2 MIMEEncodeString
-
-Takes a perl string and optional encoding pass it over
-L<RT::Interface::Email/EncodeToMIME>.
-
-Basicly encode a string using B encoding according to RFC2047, returning
-bytes.
-
-=cut
-
-sub MIMEEncodeString {
- my $self = shift;
- return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
-}
-
-RT::Base->_ImportOverlays();
-
-1;
-
diff --git a/rt/lib/RT/Interface/Email.pm.orig b/rt/lib/RT/Interface/Email.pm.orig
deleted file mode 100755
index f860461..0000000
--- a/rt/lib/RT/Interface/Email.pm.orig
+++ /dev/null
@@ -1,1949 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Email;
-
-use strict;
-use warnings;
-
-use Email::Address;
-use MIME::Entity;
-use RT::EmailParser;
-use File::Temp;
-use UNIVERSAL::require;
-use Mail::Mailer ();
-use Text::ParseWords qw/shellwords/;
-
-BEGIN {
- use base 'Exporter';
- use vars qw ( @EXPORT_OK);
-
- # set the version for version checking
- our $VERSION = 2.0;
-
- # your exported package globals go here,
- # as well as any optionally exported functions
- @EXPORT_OK = qw(
- &CreateUser
- &GetMessageContent
- &CheckForLoops
- &CheckForSuspiciousSender
- &CheckForAutoGenerated
- &CheckForBounce
- &MailError
- &ParseCcAddressesFromHead
- &ParseSenderAddressFromHead
- &ParseErrorsToAddressFromHead
- &ParseAddressFromHeader
- &Gateway);
-
-}
-
-=head1 NAME
-
- RT::Interface::Email - helper functions for parsing email sent to RT
-
-=head1 SYNOPSIS
-
- use lib "!!RT_LIB_PATH!!";
- use lib "!!RT_ETC_PATH!!";
-
- use RT::Interface::Email qw(Gateway CreateUser);
-
-=head1 DESCRIPTION
-
-
-
-
-=head1 METHODS
-
-=head2 CheckForLoops HEAD
-
-Takes a HEAD object of L<MIME::Head> class and returns true if the
-message's been sent by this RT instance. Uses "X-RT-Loop-Prevention"
-field of the head for test.
-
-=cut
-
-sub CheckForLoops {
- my $head = shift;
-
- # If this instance of RT sent it our, we don't want to take it in
- my $RTLoop = Encode::decode( "UTF-8", $head->get("X-RT-Loop-Prevention") || "" );
- chomp ($RTLoop); # remove that newline
- if ( $RTLoop eq RT->Config->Get('rtname') ) {
- return 1;
- }
-
- # TODO: We might not trap the case where RT instance A sends a mail
- # to RT instance B which sends a mail to ...
- return undef;
-}
-
-=head2 CheckForSuspiciousSender HEAD
-
-Takes a HEAD object of L<MIME::Head> class and returns true if sender
-is suspicious. Suspicious means mailer daemon.
-
-See also L</ParseSenderAddressFromHead>.
-
-=cut
-
-sub CheckForSuspiciousSender {
- my $head = shift;
-
- #if it's from a postmaster or mailer daemon, it's likely a bounce.
-
- #TODO: better algorithms needed here - there is no standards for
- #bounces, so it's very difficult to separate them from anything
- #else. At the other hand, the Return-To address is only ment to be
- #used as an error channel, we might want to put up a separate
- #Return-To address which is treated differently.
-
- #TODO: search through the whole email and find the right Ticket ID.
-
- my ( $From, $junk ) = ParseSenderAddressFromHead($head);
-
- # If unparseable (non-ASCII), $From can come back undef
- return undef if not defined $From;
-
- if ( ( $From =~ /^mailer-daemon\@/i )
- or ( $From =~ /^postmaster\@/i )
- or ( $From eq "" ))
- {
- return (1);
-
- }
-
- return undef;
-}
-
-=head2 CheckForAutoGenerated HEAD
-
-Takes a HEAD object of L<MIME::Head> class and returns true if message
-is autogenerated. Checks 'Precedence' and 'X-FC-Machinegenerated'
-fields of the head in tests.
-
-=cut
-
-sub CheckForAutoGenerated {
- my $head = shift;
-
- my $Precedence = $head->get("Precedence") || "";
- if ( $Precedence =~ /^(bulk|junk)/i ) {
- return (1);
- }
-
- # Per RFC3834, any Auto-Submitted header which is not "no" means
- # it is auto-generated.
- my $AutoSubmitted = $head->get("Auto-Submitted") || "";
- if ( length $AutoSubmitted and $AutoSubmitted ne "no" ) {
- return (1);
- }
-
- # First Class mailer uses this as a clue.
- my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
- if ( $FCJunk =~ /^true/i ) {
- return (1);
- }
-
- return (0);
-}
-
-
-sub CheckForBounce {
- my $head = shift;
-
- my $ReturnPath = $head->get("Return-path") || "";
- return ( $ReturnPath =~ /<>/ );
-}
-
-
-=head2 MailError PARAM HASH
-
-Sends an error message. Takes a param hash:
-
-=over 4
-
-=item From - sender's address, by default is 'CorrespondAddress';
-
-=item To - recipient, by default is 'OwnerEmail';
-
-=item Bcc - optional Bcc recipients;
-
-=item Subject - subject of the message, default is 'There has been an error';
-
-=item Explanation - main content of the error, default value is 'Unexplained error';
-
-=item MIMEObj - optional MIME entity that's attached to the error mail, as well we
-add 'In-Reply-To' field to the error that points to this message.
-
-=item Attach - optional text that attached to the error as 'message/rfc822' part.
-
-=item LogLevel - log level under which we should write the subject and
-explanation message into the log, by default we log it as critical.
-
-=back
-
-=cut
-
-sub MailError {
- my %args = (
- To => RT->Config->Get('OwnerEmail'),
- Bcc => undef,
- From => RT->Config->Get('CorrespondAddress'),
- Subject => 'There has been an error',
- Explanation => 'Unexplained error',
- MIMEObj => undef,
- Attach => undef,
- LogLevel => 'crit',
- @_
- );
-
- $RT::Logger->log(
- level => $args{'LogLevel'},
- message => "$args{Subject}: $args{'Explanation'}",
- ) if $args{'LogLevel'};
-
- # the colons are necessary to make ->build include non-standard headers
- my %entity_args = (
- Type => "multipart/mixed",
- From => Encode::encode( "UTF-8", $args{'From'} ),
- Bcc => Encode::encode( "UTF-8", $args{'Bcc'} ),
- To => Encode::encode( "UTF-8", $args{'To'} ),
- Subject => EncodeToMIME( String => $args{'Subject'} ),
- 'X-RT-Loop-Prevention:' => Encode::encode( "UTF-8", RT->Config->Get('rtname') ),
- );
-
- # only set precedence if the sysadmin wants us to
- if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) {
- $entity_args{'Precedence:'} =
- Encode::encode( "UTF-8", RT->Config->Get('DefaultErrorMailPrecedence') );
- }
-
- my $entity = MIME::Entity->build(%entity_args);
- SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} );
-
- $entity->attach(
- Type => "text/plain",
- Charset => "UTF-8",
- Data => Encode::encode( "UTF-8", $args{'Explanation'} . "\n" ),
- );
-
- if ( $args{'MIMEObj'} ) {
- $args{'MIMEObj'}->sync_headers;
- $entity->add_part( $args{'MIMEObj'} );
- }
-
- if ( $args{'Attach'} ) {
- $entity->attach( Data => Encode::encode( "UTF-8", $args{'Attach'} ), Type => 'message/rfc822' );
-
- }
-
- SendEmail( Entity => $entity, Bounce => 1 );
-}
-
-
-=head2 SendEmail Entity => undef, [ Bounce => 0, Ticket => undef, Transaction => undef ]
-
-Sends an email (passed as a L<MIME::Entity> object C<ENTITY>) using
-RT's outgoing mail configuration. If C<BOUNCE> is passed, and is a
-true value, the message will be marked as an autogenerated error, if
-possible. Sets Date field of the head to now if it's not set.
-
-If the C<X-RT-Squelch> header is set to any true value, the mail will
-not be sent. One use is to let extensions easily cancel outgoing mail.
-
-Ticket and Transaction arguments are optional. If Transaction is
-specified and Ticket is not then ticket of the transaction is
-used, but only if the transaction belongs to a ticket.
-
-Returns 1 on success, 0 on error or -1 if message has no recipients
-and hasn't been sent.
-
-=head3 Signing and Encrypting
-
-This function as well signs and/or encrypts the message according to
-headers of a transaction's attachment or properties of a ticket's queue.
-To get full access to the configuration Ticket and/or Transaction
-arguments must be provided, but you can force behaviour using Sign
-and/or Encrypt arguments.
-
-The following precedence of arguments are used to figure out if
-the message should be encrypted and/or signed:
-
-* if Sign or Encrypt argument is defined then its value is used
-
-* else if Transaction's first attachment has X-RT-Sign or X-RT-Encrypt
-header field then it's value is used
-
-* else properties of a queue of the Ticket are used.
-
-=cut
-
-sub WillSignEncrypt {
- my %args = @_;
- my $attachment = delete $args{Attachment};
- my $ticket = delete $args{Ticket};
-
- if ( not RT->Config->Get('GnuPG')->{'Enable'} ) {
- $args{Sign} = $args{Encrypt} = 0;
- return wantarray ? %args : 0;
- }
-
- for my $argument ( qw(Sign Encrypt) ) {
- next if defined $args{ $argument };
-
- if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) {
- $args{$argument} = $attachment->GetHeader("X-RT-$argument");
- } elsif ( $ticket and $argument eq "Encrypt" ) {
- $args{Encrypt} = $ticket->QueueObj->Encrypt();
- } elsif ( $ticket and $argument eq "Sign" ) {
- # Note that $queue->Sign is UI-only, and that all
- # UI-generated messages explicitly set the X-RT-Crypt header
- # to 0 or 1; thus this path is only taken for messages
- # generated _not_ via the web UI.
- $args{Sign} = $ticket->QueueObj->SignAuto();
- }
- }
-
- return wantarray ? %args : ($args{Sign} || $args{Encrypt});
-}
-
-sub SendEmail {
- my (%args) = (
- Entity => undef,
- Bounce => 0,
- Ticket => undef,
- Transaction => undef,
- @_,
- );
-
- my $TicketObj = $args{'Ticket'};
- my $TransactionObj = $args{'Transaction'};
-
- foreach my $arg( qw(Entity Bounce) ) {
- next unless defined $args{ lc $arg };
-
- $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead");
- $args{ $arg } = delete $args{ lc $arg };
- }
-
- unless ( $args{'Entity'} ) {
- $RT::Logger->crit( "Could not send mail without 'Entity' object" );
- return 0;
- }
-
- my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' );
- chomp $msgid;
-
- # If we don't have any recipients to send to, don't send a message;
- unless ( $args{'Entity'}->head->get('To')
- || $args{'Entity'}->head->get('Cc')
- || $args{'Entity'}->head->get('Bcc') )
- {
- $RT::Logger->info( $msgid . " No recipients found. Not sending." );
- return -1;
- }
-
- if ($args{'Entity'}->head->get('X-RT-Squelch')) {
- $RT::Logger->info( $msgid . " Squelch header found. Not sending." );
- return -1;
- }
-
- if ( $TransactionObj && !$TicketObj
- && $TransactionObj->ObjectType eq 'RT::Ticket' )
- {
- $TicketObj = $TransactionObj->Object;
- }
-
- if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
- %args = WillSignEncrypt(
- %args,
- Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef,
- Ticket => $TicketObj,
- );
- my $res = SignEncrypt( %args );
- return $res unless $res > 0;
- }
-
- unless ( $args{'Entity'}->head->get('Date') ) {
- require RT::Date;
- my $date = RT::Date->new( RT->SystemUser );
- $date->SetToNow;
- $args{'Entity'}->head->set( 'Date', Encode::encode( "UTF-8", $date->RFC2822( Timezone => 'server' ) ) );
- }
-
- my $mail_command = RT->Config->Get('MailCommand');
-
- if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) {
- $Mail::Mailer::testfile::config{outfile} = File::Temp->new;
- $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}");
- }
-
- # if it is a sub routine, we just return it;
- return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' );
-
- if ( $mail_command eq 'sendmailpipe' ) {
- my $path = RT->Config->Get('SendmailPath');
- my @args = shellwords(RT->Config->Get('SendmailArguments'));
-
- # SetOutgoingMailFrom and bounces conflict, since they both want -f
- if ( $args{'Bounce'} ) {
- push @args, shellwords(RT->Config->Get('SendmailBounceArguments'));
- } elsif ( my $MailFrom = RT->Config->Get('SetOutgoingMailFrom') ) {
- my $OutgoingMailAddress = $MailFrom =~ /\@/ ? $MailFrom : undef;
- my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {};
-
- if ($TicketObj) {
- my $QueueName = $TicketObj->QueueObj->Name;
- my $QueueAddressOverride = $Overrides->{$QueueName};
-
- if ($QueueAddressOverride) {
- $OutgoingMailAddress = $QueueAddressOverride;
- } else {
- $OutgoingMailAddress ||= $TicketObj->QueueObj->CorrespondAddress
- || RT->Config->Get('CorrespondAddress');
- }
- }
- elsif ($Overrides->{'Default'}) {
- $OutgoingMailAddress = $Overrides->{'Default'};
- }
-
- push @args, "-f", $OutgoingMailAddress
- if $OutgoingMailAddress;
- }
-
- # VERP
- if ( $TransactionObj and
- my $prefix = RT->Config->Get('VERPPrefix') and
- my $domain = RT->Config->Get('VERPDomain') )
- {
- my $from = $TransactionObj->CreatorObj->EmailAddress;
- $from =~ s/@/=/g;
- $from =~ s/\s//g;
- push @args, "-f", "$prefix$from\@$domain";
- }
-
- eval {
- # don't ignore CHLD signal to get proper exit code
- local $SIG{'CHLD'} = 'DEFAULT';
-
- # if something wrong with $mail->print we will get PIPE signal, handle it
- local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" };
-
- require IPC::Open2;
- my ($mail, $stdout);
- my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args )
- or die "couldn't execute program: $!";
-
- $args{'Entity'}->print($mail);
- close $mail or die "close pipe failed: $!";
-
- waitpid($pid, 0);
- if ($?) {
- # sendmail exit statuses mostly errors with data not software
- # TODO: status parsing: core dump, exit on signal or EX_*
- my $msg = "$msgid: `$path @args` exited with code ". ($?>>8);
- $msg = ", interrupted by signal ". ($?&127) if $?&127;
- $RT::Logger->error( $msg );
- die $msg;
- }
- };
- if ( $@ ) {
- $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ );
- if ( $TicketObj ) {
- _RecordSendEmailFailure( $TicketObj );
- }
- return 0;
- }
- }
- elsif ( $mail_command eq 'smtp' ) {
- require Net::SMTP;
- my $smtp = do { local $@; eval { Net::SMTP->new(
- Host => RT->Config->Get('SMTPServer'),
- Debug => RT->Config->Get('SMTPDebug'),
- ) } };
- unless ( $smtp ) {
- $RT::Logger->crit( "Could not connect to SMTP server.");
- if ($TicketObj) {
- _RecordSendEmailFailure( $TicketObj );
- }
- return 0;
- }
-
- # duplicate head as we want drop Bcc field
- my $head = $args{'Entity'}->head->dup;
- my @recipients = map $_->address, map
- Email::Address->parse(Encode::decode("UTF-8", $head->get($_))),
- qw(To Cc Bcc);
- $head->delete('Bcc');
-
- my $sender = RT->Config->Get('SMTPFrom')
- || Encode::decode( "UTF-8", $args{'Entity'}->head->get('From') );
- chomp $sender;
-
- my $status = $smtp->mail( $sender )
- && $smtp->recipient( @recipients );
-
- if ( $status ) {
- $smtp->data;
- my $fh = $smtp->tied_fh;
- $head->print( $fh );
- print $fh "\n";
- $args{'Entity'}->print_body( $fh );
- $smtp->dataend;
- }
- $smtp->quit;
-
- unless ( $status ) {
- $RT::Logger->crit( "$msgid: Could not send mail via SMTP." );
- if ( $TicketObj ) {
- _RecordSendEmailFailure( $TicketObj );
- }
- return 0;
- }
- }
- else {
- local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'});
-
- my @mailer_args = ($mail_command);
- if ( $mail_command eq 'sendmail' ) {
- $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath');
- push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments'));
- }
- else {
- push @mailer_args, RT->Config->Get('MailParams');
- }
-
- unless ( $args{'Entity'}->send( @mailer_args ) ) {
- $RT::Logger->crit( "$msgid: Could not send mail." );
- if ( $TicketObj ) {
- _RecordSendEmailFailure( $TicketObj );
- }
- return 0;
- }
- }
- return 1;
-}
-
-=head2 PrepareEmailUsingTemplate Template => '', Arguments => {}
-
-Loads a template. Parses it using arguments if it's not empty.
-Returns a tuple (L<RT::Template> object, error message).
-
-Note that even if a template object is returned MIMEObj method
-may return undef for empty templates.
-
-=cut
-
-sub PrepareEmailUsingTemplate {
- my %args = (
- Template => '',
- Arguments => {},
- @_
- );
-
- my $template = RT::Template->new( RT->SystemUser );
- $template->LoadGlobalTemplate( $args{'Template'} );
- unless ( $template->id ) {
- return (undef, "Couldn't load template '". $args{'Template'} ."'");
- }
- return $template if $template->IsEmpty;
-
- my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } );
- return (undef, $msg) unless $status;
-
- return $template;
-}
-
-=head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => ''
-
-Sends email using a template, takes name of template, arguments for it and recipients.
-
-=cut
-
-sub SendEmailUsingTemplate {
- my %args = (
- Template => '',
- Arguments => {},
- To => undef,
- Cc => undef,
- Bcc => undef,
- From => RT->Config->Get('CorrespondAddress'),
- InReplyTo => undef,
- ExtraHeaders => {},
- @_
- );
-
- my ($template, $msg) = PrepareEmailUsingTemplate( %args );
- return (0, $msg) unless $template;
-
- my $mail = $template->MIMEObj;
- unless ( $mail ) {
- $RT::Logger->info("Message is not sent as template #". $template->id ." is empty");
- return -1;
- }
-
- $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ $_ } ) )
- foreach grep defined $args{$_}, qw(To Cc Bcc From);
-
- $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) )
- foreach keys %{ $args{ExtraHeaders} };
-
- SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
-
- return SendEmail( Entity => $mail );
-}
-
-=head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => ''
-
-Forwards transaction with all attachments as 'message/rfc822'.
-
-=cut
-
-sub ForwardTransaction {
- my $txn = shift;
- my %args = ( To => '', Cc => '', Bcc => '', @_ );
-
- my $entity = $txn->ContentAsMIME;
-
- my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn );
- if ($ret) {
- my $ticket = $txn->TicketObj;
- my ( $ret, $msg ) = $ticket->_NewTransaction(
- Type => 'Forward Transaction',
- Field => $txn->id,
- Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
- );
- unless ($ret) {
- $RT::Logger->error("Failed to create transaction: $msg");
- }
- }
- return ( $ret, $msg );
-}
-
-=head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
-
-Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'.
-
-=cut
-
-sub ForwardTicket {
- my $ticket = shift;
- my %args = ( To => '', Cc => '', Bcc => '', @_ );
-
- my $txns = $ticket->Transactions;
- $txns->Limit(
- FIELD => 'Type',
- VALUE => $_,
- ) for qw(Create Correspond);
-
- my $entity = MIME::Entity->build(
- Type => 'multipart/mixed',
- Description => 'forwarded ticket',
- );
- $entity->add_part( $_ ) foreach
- map $_->ContentAsMIME,
- @{ $txns->ItemsArrayRef };
-
- my ( $ret, $msg ) = SendForward(
- %args,
- Entity => $entity,
- Ticket => $ticket,
- Template => 'Forward Ticket',
- );
-
- if ($ret) {
- my ( $ret, $msg ) = $ticket->_NewTransaction(
- Type => 'Forward Ticket',
- Field => $ticket->id,
- Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
- );
- unless ($ret) {
- $RT::Logger->error("Failed to create transaction: $msg");
- }
- }
-
- return ( $ret, $msg );
-
-}
-
-=head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
-
-Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template.
-
-=cut
-
-sub SendForward {
- my (%args) = (
- Entity => undef,
- Ticket => undef,
- Transaction => undef,
- Template => 'Forward',
- To => '', Cc => '', Bcc => '',
- @_
- );
-
- my $txn = $args{'Transaction'};
- my $ticket = $args{'Ticket'};
- $ticket ||= $txn->Object if $txn;
-
- my $entity = $args{'Entity'};
- unless ( $entity ) {
- require Carp;
- $RT::Logger->error(Carp::longmess("No entity provided"));
- return (0, $ticket->loc("Couldn't send email"));
- }
-
- my ($template, $msg) = PrepareEmailUsingTemplate(
- Template => $args{'Template'},
- Arguments => {
- Ticket => $ticket,
- Transaction => $txn,
- },
- );
-
- my $mail;
- if ( $template ) {
- $mail = $template->MIMEObj;
- } else {
- $RT::Logger->warning($msg);
- }
- unless ( $mail ) {
- $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
-
- my $description;
- unless ( $args{'Transaction'} ) {
- $description = 'This is forward of ticket #'. $ticket->id;
- } else {
- $description = 'This is forward of transaction #'
- . $txn->id ." of a ticket #". $txn->ObjectId;
- }
- $mail = MIME::Entity->build(
- Type => 'text/plain',
- Charset => "UTF-8",
- Data => Encode::encode( "UTF-8", $description ),
- );
- }
-
- $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
- foreach grep defined $args{$_}, qw(To Cc Bcc);
-
- $mail->make_multipart unless $mail->is_multipart;
- $mail->add_part( $entity );
-
- my $from;
- unless (defined $mail->head->get('Subject')) {
- my $subject = '';
- $subject = $txn->Subject if $txn;
- $subject ||= $ticket->Subject if $ticket;
-
- unless ( RT->Config->Get('ForwardFromUser') ) {
- # XXX: what if want to forward txn of other object than ticket?
- $subject = AddSubjectTag( $subject, $ticket );
- }
-
- $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
- }
-
- $mail->head->set(
- From => EncodeToMIME(
- String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
- )
- );
-
- my $status = RT->Config->Get('ForwardFromUser')
- # never sign if we forward from User
- ? SendEmail( %args, Entity => $mail, Sign => 0 )
- : SendEmail( %args, Entity => $mail );
- return (0, $ticket->loc("Couldn't send email")) unless $status;
- return (1, $ticket->loc("Sent email successfully"));
-}
-
-=head2 GetForwardFrom Ticket => undef, Transaction => undef
-
-Resolve the From field to use in forward mail
-
-=cut
-
-sub GetForwardFrom {
- my %args = ( Ticket => undef, Transaction => undef, @_ );
- my $txn = $args{Transaction};
- my $ticket = $args{Ticket} || $txn->Object;
-
- if ( RT->Config->Get('ForwardFromUser') ) {
- return ( $txn || $ticket )->CurrentUser->EmailAddress;
- }
- else {
- return $ticket->QueueObj->CorrespondAddress
- || RT->Config->Get('CorrespondAddress');
- }
-}
-
-=head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
-
-Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
-handle errors with users' keys.
-
-If a recipient has no key or has other problems with it, then the
-unction sends a error to him using 'Error: public key' template.
-Also, notifies RT's owner using template 'Error to RT owner: public key'
-to inform that there are problems with users' keys. Then we filter
-all bad recipients and retry.
-
-Returns 1 on success, 0 on error and -1 if all recipients are bad and
-had been filtered out.
-
-=cut
-
-sub SignEncrypt {
- my %args = (
- Entity => undef,
- Sign => 0,
- Encrypt => 0,
- @_
- );
- return 1 unless $args{'Sign'} || $args{'Encrypt'};
-
- my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' );
- chomp $msgid;
-
- $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
- $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
-
- require RT::Crypt::GnuPG;
- my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
- return 1 unless $res{'exit_code'};
-
- my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
-
- my @bad_recipients;
- foreach my $line ( @status ) {
- # if the passphrase fails, either you have a bad passphrase
- # or gpg-agent has died. That should get caught in Create and
- # Update, but at least throw an error here
- if (($line->{'Operation'}||'') eq 'PassphraseCheck'
- && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
- $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
- return 0;
- }
- next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
- next if $line->{'Status'} eq 'DONE';
- $RT::Logger->error( $line->{'Message'} );
- push @bad_recipients, $line;
- }
- return 0 unless @bad_recipients;
-
- $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
- foreach @bad_recipients;
-
- foreach my $recipient ( @bad_recipients ) {
- my $status = SendEmailUsingTemplate(
- To => $recipient->{'AddressObj'}->address,
- Template => 'Error: public key',
- Arguments => {
- %$recipient,
- TicketObj => $args{'Ticket'},
- TransactionObj => $args{'Transaction'},
- },
- );
- unless ( $status ) {
- $RT::Logger->error("Couldn't send 'Error: public key'");
- }
- }
-
- my $status = SendEmailUsingTemplate(
- To => RT->Config->Get('OwnerEmail'),
- Template => 'Error to RT owner: public key',
- Arguments => {
- BadRecipients => \@bad_recipients,
- TicketObj => $args{'Ticket'},
- TransactionObj => $args{'Transaction'},
- },
- );
- unless ( $status ) {
- $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
- }
-
- DeleteRecipientsFromHead(
- $args{'Entity'}->head,
- map $_->{'AddressObj'}->address, @bad_recipients
- );
-
- unless ( $args{'Entity'}->head->get('To')
- || $args{'Entity'}->head->get('Cc')
- || $args{'Entity'}->head->get('Bcc') )
- {
- $RT::Logger->debug("$msgid No recipients that have public key, not sending");
- return -1;
- }
-
- # redo without broken recipients
- %res = RT::Crypt::GnuPG::SignEncrypt( %args );
- return 0 if $res{'exit_code'};
-
- return 1;
-}
-
-use MIME::Words ();
-
-=head2 EncodeToMIME
-
-Takes a hash with a String and a Charset. Returns the string encoded
-according to RFC2047, using B (base64 based) encoding.
-
-String must be a perl string, octets are returned.
-
-If Charset is not provided then $EmailOutputEncoding config option
-is used, or "latin-1" if that is not set.
-
-=cut
-
-sub EncodeToMIME {
- my %args = (
- String => undef,
- Charset => undef,
- @_
- );
- my $value = $args{'String'};
- return $value unless $value; # 0 is perfect ascii
- my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
- my $encoding = 'B';
-
- # using RFC2047 notation, sec 2.
- # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
-
- # An 'encoded-word' may not be more than 75 characters long
- #
- # MIME encoding increases 4/3*(number of bytes), and always in multiples
- # of 4. Thus we have to find the best available value of bytes available
- # for each chunk.
- #
- # First we get the integer max which max*4/3 would fit on space.
- # Then we find the greater multiple of 3 lower or equal than $max.
- my $max = int(
- ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
- * 3
- ) / 4
- );
- $max = int( $max / 3 ) * 3;
-
- chomp $value;
-
- if ( $max <= 0 ) {
-
- # gives an error...
- $RT::Logger->crit("Can't encode! Charset or encoding too big.");
- return ($value);
- }
-
- return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
-
- $value =~ s/\s+$//;
-
- my ( $tmp, @chunks ) = ( '', () );
- while ( length $value ) {
- my $char = substr( $value, 0, 1, '' );
- my $octets = Encode::encode( $charset, $char );
- if ( length($tmp) + length($octets) > $max ) {
- push @chunks, $tmp;
- $tmp = '';
- }
- $tmp .= $octets;
- }
- push @chunks, $tmp if length $tmp;
-
- # encode an join chuncks
- $value = join "\n ",
- map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
- @chunks;
- return ($value);
-}
-
-sub CreateUser {
- my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
-
- my $NewUser = RT::User->new( RT->SystemUser );
-
- my ( $Val, $Message ) = $NewUser->Create(
- Name => ( $Username || $Address ),
- EmailAddress => $Address,
- RealName => $Name,
- Password => undef,
- Privileged => 0,
- Comments => 'Autocreated on ticket submission',
- );
-
- unless ($Val) {
-
- # Deal with the race condition of two account creations at once
- if ($Username) {
- $NewUser->LoadByName($Username);
- }
-
- unless ( $NewUser->Id ) {
- $NewUser->LoadByEmail($Address);
- }
-
- unless ( $NewUser->Id ) {
- MailError(
- To => $ErrorsTo,
- Subject => "User could not be created",
- Explanation =>
- "User creation failed in mailgateway: $Message",
- MIMEObj => $entity,
- LogLevel => 'crit',
- );
- }
- }
-
- #Load the new user object
- my $CurrentUser = RT::CurrentUser->new;
- $CurrentUser->LoadByEmail( $Address );
-
- unless ( $CurrentUser->id ) {
- $RT::Logger->warning(
- "Couldn't load user '$Address'." . "giving up" );
- MailError(
- To => $ErrorsTo,
- Subject => "User could not be loaded",
- Explanation =>
- "User '$Address' could not be loaded in the mail gateway",
- MIMEObj => $entity,
- LogLevel => 'crit'
- );
- }
-
- return $CurrentUser;
-}
-
-
-
-=head2 ParseCcAddressesFromHead HASH
-
-Takes a hash containing QueueObj, Head and CurrentUser objects.
-Returns a list of all email addresses in the To and Cc
-headers b<except> the current Queue's email addresses, the CurrentUser's
-email address and anything that the configuration sub RT::IsRTAddress matches.
-
-=cut
-
-sub ParseCcAddressesFromHead {
- my %args = (
- Head => undef,
- QueueObj => undef,
- CurrentUser => undef,
- @_
- );
-
- my $current_address = lc $args{'CurrentUser'}->EmailAddress;
- my $user = $args{'CurrentUser'}->UserObj;
-
- return
- grep { $_ ne $current_address
- && !RT::EmailParser->IsRTAddress( $_ )
- && !IgnoreCcAddress( $_ )
- }
- map lc $user->CanonicalizeEmailAddress( $_->address ),
- map RT::EmailParser->CleanupAddresses( Email::Address->parse(
- Encode::decode( "UTF-8", $args{'Head'}->get( $_ ) ) ) ),
- qw(To Cc);
-}
-
-=head2 IgnoreCcAddress ADDRESS
-
-Returns true if ADDRESS matches the $IgnoreCcRegexp config variable.
-
-=cut
-
-sub IgnoreCcAddress {
- my $address = shift;
- if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) {
- return 1 if $address =~ /$address_re/i;
- }
- return undef;
-}
-
-=head2 ParseSenderAddressFromHead HEAD
-
-Takes a MIME::Header object. Returns (user at host, friendly name, errors)
-where the first two values are the From (evaluated in order of
-Reply-To:, From:, Sender).
-
-A list of error messages may be returned even when a Sender value is
-found, since it could be a parse error for another (checked earlier)
-sender field. In this case, the errors aren't fatal, but may be useful
-to investigate the parse failure.
-
-=cut
-
-sub ParseSenderAddressFromHead {
- my $head = shift;
- my @sender_headers = ('Reply-To', 'From', 'Sender');
- my @errors; # Accumulate any errors
-
- #Figure out who's sending this message.
- foreach my $header ( @sender_headers ) {
- my $addr_line = Encode::decode( "UTF-8", $head->get($header) ) || next;
- my ($addr, $name) = ParseAddressFromHeader( $addr_line );
- # only return if the address is not empty
- return ($addr, $name, @errors) if $addr;
-
- chomp $addr_line;
- push @errors, "$header: $addr_line";
- }
-
- return (undef, undef, @errors);
-}
-
-=head2 ParseErrorsToAddressFromHead HEAD
-
-Takes a MIME::Header object. Return a single value : user at host
-of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
-From:, Sender)
-
-=cut
-
-sub ParseErrorsToAddressFromHead {
- my $head = shift;
-
- #Figure out who's sending this message.
-
- foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
-
- # If there's a header of that name
- my $headerobj = Encode::decode( "UTF-8", $head->get($header) );
- if ($headerobj) {
- my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
-
- # If it's got actual useful content...
- return ($addr) if ($addr);
- }
- }
-}
-
-
-
-=head2 ParseAddressFromHeader ADDRESS
-
-Takes an address from C<$head->get('Line')> and returns a tuple: user at host, friendly name
-
-=cut
-
-sub ParseAddressFromHeader {
- my $Addr = shift;
-
- # Some broken mailers send: ""Vincent, Jesse"" <jesse at fsck.com>. Hate
- $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
- my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
-
- my ($AddrObj) = grep ref $_, @Addresses;
- unless ( $AddrObj ) {
- return ( undef, undef );
- }
-
- return ( $AddrObj->address, $AddrObj->phrase );
-}
-
-=head2 DeleteRecipientsFromHead HEAD RECIPIENTS
-
-Gets a head object and list of addresses.
-Deletes addresses from To, Cc or Bcc fields.
-
-=cut
-
-sub DeleteRecipientsFromHead {
- my $head = shift;
- my %skip = map { lc $_ => 1 } @_;
-
- foreach my $field ( qw(To Cc Bcc) ) {
- $head->set( $field => Encode::encode( "UTF-8",
- join ', ', map $_->format, grep !$skip{ lc $_->address },
- Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) )
- );
- }
-}
-
-sub GenMessageId {
- my %args = (
- Ticket => undef,
- Scrip => undef,
- ScripAction => undef,
- @_
- );
- my $org = RT->Config->Get('Organization');
- my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0;
- my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0;
- my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0;
-
- return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.'
- . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ;
-}
-
-sub SetInReplyTo {
- my %args = (
- Message => undef,
- InReplyTo => undef,
- Ticket => undef,
- @_
- );
- return unless $args{'Message'} && $args{'InReplyTo'};
-
- my $get_header = sub {
- my @res;
- if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
- @res = map {Encode::decode("UTF-8", $_)} $args{'InReplyTo'}->head->get( shift );
- } else {
- @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
- }
- return grep length, map { split /\s+/m, $_ } grep defined, @res;
- };
-
- my @id = $get_header->('Message-ID');
- #XXX: custom header should begin with X- otherwise is violation of the standard
- my @rtid = $get_header->('RT-Message-ID');
- my @references = $get_header->('References');
- unless ( @references ) {
- @references = $get_header->('In-Reply-To');
- }
- push @references, @id, @rtid;
- if ( $args{'Ticket'} ) {
- my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>';
- push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references;
- }
- @references = splice @references, 4, -6
- if @references > 10;
-
- my $mail = $args{'Message'};
- $mail->head->set( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
- $mail->head->set( 'References' => Encode::encode( "UTF-8", join ' ', @references) );
-}
-
-sub ExtractTicketId {
- my $entity = shift;
-
- my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') || '' );
- chomp $subject;
- return ParseTicketId( $subject );
-}
-
-sub ParseTicketId {
- my $Subject = shift;
-
- my $rtname = RT->Config->Get('rtname');
- my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
-
- my $id;
- if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
- $id = $1;
- } else {
- foreach my $tag ( RT->System->SubjectTag ) {
- next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i;
- $id = $1;
- last;
- }
- }
- return undef unless $id;
-
- $RT::Logger->debug("Found a ticket ID. It's $id");
- return $id;
-}
-
-sub AddSubjectTag {
- my $subject = shift;
- my $ticket = shift;
- unless ( ref $ticket ) {
- my $tmp = RT::Ticket->new( RT->SystemUser );
- $tmp->Load( $ticket );
- $ticket = $tmp;
- }
- my $id = $ticket->id;
- my $queue_tag = $ticket->QueueObj->SubjectTag;
-
- my $tag_re = RT->Config->Get('EmailSubjectTagRegex');
- unless ( $tag_re ) {
- my $tag = $queue_tag || RT->Config->Get('rtname');
- $tag_re = qr/\Q$tag\E/;
- } elsif ( $queue_tag ) {
- $tag_re = qr/$tag_re|\Q$queue_tag\E/;
- }
- return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
-
- $subject =~ s/(\r\n|\n|\s)/ /g;
- chomp $subject;
- return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
-}
-
-
-=head2 Gateway ARGSREF
-
-
-Takes parameters:
-
- action
- queue
- message
-
-
-This performs all the "guts" of the mail rt-mailgate program, and is
-designed to be called from the web interface with a message, user
-object, and so on.
-
-Can also take an optional 'ticket' parameter; this ticket id overrides
-any ticket id found in the subject.
-
-Returns:
-
- An array of:
-
- (status code, message, optional ticket object)
-
- status code is a numeric value.
-
- for temporary failures, the status code should be -75
-
- for permanent failures which are handled by RT, the status code
- should be 0
-
- for succces, the status code should be 1
-
-
-
-=cut
-
-sub _LoadPlugins {
- my @mail_plugins = @_;
-
- my @res;
- foreach my $plugin (@mail_plugins) {
- if ( ref($plugin) eq "CODE" ) {
- push @res, $plugin;
- } elsif ( !ref $plugin ) {
- my $Class = $plugin;
- $Class = "RT::Interface::Email::" . $Class
- unless $Class =~ /^RT::/;
- $Class->require or
- do { $RT::Logger->error("Couldn't load $Class: $@"); next };
-
- no strict 'refs';
- unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) {
- $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
- next;
- }
- push @res, $Class;
- } else {
- $RT::Logger->crit( "$plugin - is not class name or code reference");
- }
- }
- return @res;
-}
-
-sub Gateway {
- my $argsref = shift;
- my %args = (
- action => 'correspond',
- queue => '1',
- ticket => undef,
- message => undef,
- %$argsref
- );
-
- my $SystemTicket;
- my $Right;
-
- # Validate the action
- my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
- unless ($status) {
- return (
- -75,
- "Invalid 'action' parameter "
- . $actions[0]
- . " for queue "
- . $args{'queue'},
- undef
- );
- }
-
- my $parser = RT::EmailParser->new();
- $parser->SmartParseMIMEEntityFromScalar(
- Message => $args{'message'},
- Decode => 0,
- Exact => 1,
- );
-
- my $Message = $parser->Entity();
- unless ($Message) {
- MailError(
- Subject => "RT Bounce: Unparseable message",
- Explanation => "RT couldn't process the message below",
- Attach => $args{'message'}
- );
-
- return ( 0,
- "Failed to parse this message. Something is likely badly wrong with the message"
- );
- }
-
- my @mail_plugins = grep $_, RT->Config->Get('MailPlugins');
- push @mail_plugins, "Auth::MailFrom" unless @mail_plugins;
- @mail_plugins = _LoadPlugins( @mail_plugins );
-
- my %skip_plugin;
- foreach my $class( grep !ref, @mail_plugins ) {
- # check if we should apply filter before decoding
- my $check_cb = do {
- no strict 'refs';
- *{ $class . "::ApplyBeforeDecode" }{CODE};
- };
- next unless defined $check_cb;
- next unless $check_cb->(
- Message => $Message,
- RawMessageRef => \$args{'message'},
- );
-
- $skip_plugin{ $class }++;
-
- my $Code = do {
- no strict 'refs';
- *{ $class . "::GetCurrentUser" }{CODE};
- };
- my ($status, $msg) = $Code->(
- Message => $Message,
- RawMessageRef => \$args{'message'},
- );
- next if $status > 0;
-
- if ( $status == -2 ) {
- return (1, $msg, undef);
- } elsif ( $status == -1 ) {
- return (0, $msg, undef);
- }
- }
- @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
- $parser->_DecodeBodies;
- $parser->RescueOutlook;
- $parser->_PostProcessNewEntity;
-
- my $head = $Message->head;
- my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
- my $Sender = (ParseSenderAddressFromHead( $head ))[0];
- my $From = Encode::decode( "UTF-8", $head->get("From") );
- chomp $From if defined $From;
-
- my $MessageId = Encode::decode( "UTF-8", $head->get('Message-ID') )
- || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
-
- #Pull apart the subject line
- my $Subject = Encode::decode( "UTF-8", $head->get('Subject') || '');
- chomp $Subject;
-
- # Lets check for mail loops of various sorts.
- my ($should_store_machine_generated_message, $IsALoop, $result);
- ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
- _HandleMachineGeneratedMail(
- Message => $Message,
- ErrorsTo => $ErrorsTo,
- Subject => $Subject,
- MessageId => $MessageId
- );
-
- # Do not pass loop messages to MailPlugins, to make sure the loop
- # is broken, unless $RT::StoreLoops is set.
- if ($IsALoop && !$should_store_machine_generated_message) {
- return ( 0, $result, undef );
- }
- # }}}
-
- $args{'ticket'} ||= ExtractTicketId( $Message );
-
- # ExtractTicketId may have been overridden, and edited the Subject
- my $NewSubject = Encode::decode( "UTF-8", $Message->head->get('Subject') );
- chomp $NewSubject;
-
- $SystemTicket = RT::Ticket->new( RT->SystemUser );
- $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
- if ( $SystemTicket->id ) {
- $Right = 'ReplyToTicket';
- } else {
- $Right = 'CreateTicket';
- }
-
- #Set up a queue object
- my $SystemQueueObj = RT::Queue->new( RT->SystemUser );
- $SystemQueueObj->Load( $args{'queue'} );
-
- # We can safely have no queue of we have a known-good ticket
- unless ( $SystemTicket->id || $SystemQueueObj->id ) {
- return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
- }
-
- my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel(
- MailPlugins => \@mail_plugins,
- Actions => \@actions,
- Message => $Message,
- RawMessageRef => \$args{message},
- SystemTicket => $SystemTicket,
- SystemQueue => $SystemQueueObj,
- );
-
- # If authentication fails and no new user was created, get out.
- if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
-
- # If the plugins refused to create one, they lose.
- unless ( $AuthStat == -1 ) {
- _NoAuthorizedUserFound(
- Right => $Right,
- Message => $Message,
- Requestor => $ErrorsTo,
- Queue => $args{'queue'}
- );
-
- }
- return ( 0, "Could not load a valid user", undef );
- }
-
- # If we got a user, but they don't have the right to say things
- if ( $AuthStat == 0 ) {
- MailError(
- To => $ErrorsTo,
- Subject => "Permission Denied",
- Explanation =>
- "You do not have permission to communicate with RT",
- MIMEObj => $Message
- );
- return (
- 0,
- ($CurrentUser->EmailAddress || $CurrentUser->Name)
- . " ($Sender) tried to submit a message to "
- . $args{'Queue'}
- . " without permission.",
- undef
- );
- }
-
-
- unless ($should_store_machine_generated_message) {
- return ( 0, $result, undef );
- }
-
- # if plugin's updated SystemTicket then update arguments
- $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
-
- my $Ticket = RT::Ticket->new($CurrentUser);
-
- if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
- {
-
- my @Cc;
- my @Requestors = ( $CurrentUser->id );
-
- if (RT->Config->Get('ParseNewMessageForTicketCcs')) {
- @Cc = ParseCcAddressesFromHead(
- Head => $head,
- CurrentUser => $CurrentUser,
- QueueObj => $SystemQueueObj
- );
- }
-
- $head->replace('X-RT-Interface' => 'Email');
-
- my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
- Queue => $SystemQueueObj->Id,
- Subject => $NewSubject,
- Requestor => \@Requestors,
- Cc => \@Cc,
- MIMEObj => $Message
- );
- if ( $id == 0 ) {
- MailError(
- To => $ErrorsTo,
- Subject => "Ticket creation failed: $Subject",
- Explanation => $ErrStr,
- MIMEObj => $Message
- );
- return ( 0, "Ticket creation From: $From failed: $ErrStr", $Ticket );
- }
-
- # strip comments&corresponds from the actions we don't need
- # to record them if we've created the ticket just now
- @actions = grep !/^(comment|correspond)$/, @actions;
- $args{'ticket'} = $id;
-
- } elsif ( $args{'ticket'} ) {
-
- $Ticket->Load( $args{'ticket'} );
- unless ( $Ticket->Id ) {
- my $error = "Could not find a ticket with id " . $args{'ticket'};
- MailError(
- To => $ErrorsTo,
- Subject => "Message not recorded: $Subject",
- Explanation => $error,
- MIMEObj => $Message
- );
-
- return ( 0, $error );
- }
- $args{'ticket'} = $Ticket->id;
- } else {
- return ( 1, "Success", $Ticket );
- }
-
- # }}}
-
- my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands');
- foreach my $action (@actions) {
-
- # If the action is comment, add a comment.
- if ( $action =~ /^(?:comment|correspond)$/i ) {
- my $method = ucfirst lc $action;
- my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
- unless ($status) {
-
- #Warn the sender that we couldn't actually submit the comment.
- MailError(
- To => $ErrorsTo,
- Subject => "Message not recorded ($method): $Subject",
- Explanation => $msg,
- MIMEObj => $Message
- );
- return ( 0, "Message From: $From not recorded: $msg", $Ticket );
- }
- } elsif ($unsafe_actions) {
- my ( $status, $msg ) = _RunUnsafeAction(
- Action => $action,
- ErrorsTo => $ErrorsTo,
- Message => $Message,
- Ticket => $Ticket,
- CurrentUser => $CurrentUser,
- );
- return ($status, $msg, $Ticket) unless $status == 1;
- }
- }
- return ( 1, "Success", $Ticket );
-}
-
-=head2 GetAuthenticationLevel
-
- # Authentication Level
- # -1 - Get out. this user has been explicitly declined
- # 0 - User may not do anything (Not used at the moment)
- # 1 - Normal user
- # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
-
-=cut
-
-sub GetAuthenticationLevel {
- my %args = (
- MailPlugins => [],
- Actions => [],
- Message => undef,
- RawMessageRef => undef,
- SystemTicket => undef,
- SystemQueue => undef,
- @_,
- );
-
- my ( $CurrentUser, $AuthStat, $error );
-
- # Initalize AuthStat so comparisons work correctly
- $AuthStat = -9999999;
-
- # if plugin returns AuthStat -2 we skip action
- # NOTE: this is experimental API and it would be changed
- my %skip_action = ();
-
- # Since this needs loading, no matter what
- foreach (@{ $args{MailPlugins} }) {
- my ($Code, $NewAuthStat);
- if ( ref($_) eq "CODE" ) {
- $Code = $_;
- } else {
- no strict 'refs';
- $Code = *{ $_ . "::GetCurrentUser" }{CODE};
- }
-
- foreach my $action (@{ $args{Actions} }) {
- ( $CurrentUser, $NewAuthStat ) = $Code->(
- Message => $args{Message},
- RawMessageRef => $args{RawMessageRef},
- CurrentUser => $CurrentUser,
- AuthLevel => $AuthStat,
- Action => $action,
- Ticket => $args{SystemTicket},
- Queue => $args{SystemQueue},
- );
-
-# You get the highest level of authentication you were assigned, unless you get the magic -1
-# If a module returns a "-1" then we discard the ticket, so.
- $AuthStat = $NewAuthStat
- if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
-
- last if $AuthStat == -1;
- $skip_action{$action}++ if $AuthStat == -2;
- }
-
- # strip actions we should skip
- @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}}
- if $AuthStat == -2;
- last unless @{$args{Actions}};
-
- last if $AuthStat == -1;
- }
-
- return $AuthStat if !wantarray;
-
- return ($AuthStat, $CurrentUser, $error);
-}
-
-sub _RunUnsafeAction {
- my %args = (
- Action => undef,
- ErrorsTo => undef,
- Message => undef,
- Ticket => undef,
- CurrentUser => undef,
- @_
- );
-
- my $From = Encode::decode( "UTF-8", $args{Message}->head->get("From") );
-
- if ( $args{'Action'} =~ /^take$/i ) {
- my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
- unless ($status) {
- MailError(
- To => $args{'ErrorsTo'},
- Subject => "Ticket not taken",
- Explanation => $msg,
- MIMEObj => $args{'Message'}
- );
- return ( 0, "Ticket not taken, by email From: $From" );
- }
- } elsif ( $args{'Action'} =~ /^resolve$/i ) {
- my $new_status = $args{'Ticket'}->FirstInactiveStatus;
- if ($new_status) {
- my ( $status, $msg ) = $args{'Ticket'}->SetStatus($new_status);
- unless ($status) {
-
- #Warn the sender that we couldn't actually submit the comment.
- MailError(
- To => $args{'ErrorsTo'},
- Subject => "Ticket not resolved",
- Explanation => $msg,
- MIMEObj => $args{'Message'}
- );
- return ( 0, "Ticket not resolved, by email From: $From" );
- }
- }
- } else {
- return ( 0, "Not supported unsafe action $args{'Action'}, by email From: $From", $args{'Ticket'} );
- }
- return ( 1, "Success" );
-}
-
-=head2 _NoAuthorizedUserFound
-
-Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
-
-=cut
-
-sub _NoAuthorizedUserFound {
- my %args = (
- Right => undef,
- Message => undef,
- Requestor => undef,
- Queue => undef,
- @_
- );
-
- # Notify the RT Admin of the failure.
- MailError(
- To => RT->Config->Get('OwnerEmail'),
- Subject => "Could not load a valid user",
- Explanation => <<EOT,
-RT could not load a valid user, and RT's configuration does not allow
-for the creation of a new user for this email (@{[$args{Requestor}]}).
-
-You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
-queue @{[$args{'Queue'}]}.
-
-EOT
- MIMEObj => $args{'Message'},
- LogLevel => 'error'
- );
-
- # Also notify the requestor that his request has been dropped.
- if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) {
- MailError(
- To => $args{'Requestor'},
- Subject => "Could not load a valid user",
- Explanation => <<EOT,
-RT could not load a valid user, and RT's configuration does not allow
-for the creation of a new user for your email.
-
-EOT
- MIMEObj => $args{'Message'},
- LogLevel => 'error'
- );
- }
-}
-
-=head2 _HandleMachineGeneratedMail
-
-Takes named params:
- Message
- ErrorsTo
- Subject
-
-Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
-Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
-"This message appears to be a loop (boolean)" );
-
-=cut
-
-sub _HandleMachineGeneratedMail {
- my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
- my $head = $args{'Message'}->head;
- my $ErrorsTo = $args{'ErrorsTo'};
-
- my $IsBounce = CheckForBounce($head);
-
- my $IsAutoGenerated = CheckForAutoGenerated($head);
-
- my $IsSuspiciousSender = CheckForSuspiciousSender($head);
-
- my $IsALoop = CheckForLoops($head);
-
- my $SquelchReplies = 0;
-
- my $owner_mail = RT->Config->Get('OwnerEmail');
-
- #If the message is autogenerated, we need to know, so we can not
- # send mail to the sender
- if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
- $SquelchReplies = 1;
- $ErrorsTo = $owner_mail;
- }
-
- # Warn someone if it's a loop, before we drop it on the ground
- if ($IsALoop) {
- $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself.");
-
- #Should we mail it to RTOwner?
- if ( RT->Config->Get('LoopsToRTOwner') ) {
- MailError(
- To => $owner_mail,
- Subject => "RT Bounce: ".$args{'Subject'},
- Explanation => "RT thinks this message may be a bounce",
- MIMEObj => $args{Message}
- );
- }
-
- #Do we actually want to store it?
- return ( 0, $ErrorsTo, "Message Bounced", $IsALoop )
- unless RT->Config->Get('StoreLoops');
- }
-
- # Squelch replies if necessary
- # Don't let the user stuff the RT-Squelch-Replies-To header.
- if ( $head->get('RT-Squelch-Replies-To') ) {
- $head->replace(
- 'RT-Relocated-Squelch-Replies-To',
- $head->get('RT-Squelch-Replies-To')
- );
- $head->delete('RT-Squelch-Replies-To');
- }
-
- if ($SquelchReplies) {
-
- # Squelch replies to the sender, and also leave a clue to
- # allow us to squelch ALL outbound messages. This way we
- # can punt the logic of "what to do when we get a bounce"
- # to the scrip. We might want to notify nobody. Or just
- # the RT Owner. Or maybe all Privileged watchers.
- my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
- $head->replace( 'RT-Squelch-Replies-To', Encode::encode("UTF-8", $Sender ) );
- $head->replace( 'RT-DetectedAutoGenerated', 'true' );
- }
- return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
-}
-
-=head2 IsCorrectAction
-
-Returns a list of valid actions we've found for this message
-
-=cut
-
-sub IsCorrectAction {
- my $action = shift;
- my @actions = grep $_, split /-/, $action;
- return ( 0, '(no value)' ) unless @actions;
- foreach ( @actions ) {
- return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
- }
- return ( 1, @actions );
-}
-
-sub _RecordSendEmailFailure {
- my $ticket = shift;
- if ($ticket) {
- $ticket->_RecordNote(
- NoteType => 'SystemError',
- Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.",
- );
- return 1;
- }
- else {
- $RT::Logger->error( "Can't record send email failure as ticket is missing" );
- return;
- }
-}
-
-RT::Base->_ImportOverlays();
-
-1;
commit f2731f7f3883905cd17633f486d2aeb9593173da
Author: Mark Wells <mark at freeside.biz>
Date: Mon Oct 19 15:54:37 2015 -0700
rename WebExternalAutoInfo to WebRemoteUserAutocreateInfo, #37318
diff --git a/FS/FS/TicketSystem/RT_Internal.pm b/FS/FS/TicketSystem/RT_Internal.pm
index b70ac53..1c4513e 100644
--- a/FS/FS/TicketSystem/RT_Internal.pm
+++ b/FS/FS/TicketSystem/RT_Internal.pm
@@ -572,7 +572,7 @@ sub _web_external_auth {
# now get user specific information, to better create our user.
my $new_user_info
- = RT::Interface::Web::WebExternalAutoInfo($user);
+ = RT::Interface::Web::WebRemoteUserAutocreateInfo($user);
# set the attributes that have been defined.
# FIXME: this is a horrible kludge. I'm sure there's something cleaner
diff --git a/rt/etc/RT_SiteConfig.pm b/rt/etc/RT_SiteConfig.pm
index daf1363..0e98238 100644
--- a/rt/etc/RT_SiteConfig.pm
+++ b/rt/etc/RT_SiteConfig.pm
@@ -25,9 +25,9 @@ Set($Organization, '%%%RT_DOMAIN%%%');
Set($Timezone, '%%%RT_TIMEZONE%%%');
-Set($WebExternalAuth, 1);
+Set($WebRemoteUserAuth, 1);
Set($WebFallbackToInternal, 1); #no
-Set($WebExternalAuto, 1);
+Set($WebRemoteUserAutocreate, 1);
$RT::URI::freeside::IntegrationType = 'Internal';
$RT::URI::freeside::URL = '%%%FREESIDE_URL%%%';
-----------------------------------------------------------------------
Summary of changes:
FS/FS/TicketSystem/RT_Internal.pm | 2 +-
rt/etc/RT_SiteConfig.pm | 4 +-
rt/lib/RT/Action/CreateTickets.pm.orig | 1295 ---------------------
rt/lib/RT/Action/SendEmail.pm.orig | 1133 -------------------
rt/lib/RT/Interface/Email.pm.orig | 1949 --------------------------------
5 files changed, 3 insertions(+), 4380 deletions(-)
delete mode 100644 rt/lib/RT/Action/CreateTickets.pm.orig
delete mode 100755 rt/lib/RT/Action/SendEmail.pm.orig
delete mode 100755 rt/lib/RT/Interface/Email.pm.orig
More information about the freeside-commits
mailing list