use 5.10.1;
package RT::Extension::CommandByMail;
use RT::EmailParser;
use Email::Address;
our @REGULAR_ATTRIBUTES = qw(Queue Owner Subject Status Priority FinalPriority);
our @TIME_ATTRIBUTES = qw(TimeWorked TimeLeft TimeEstimated);
our @DATE_ATTRIBUTES = qw(Due Starts Started Resolved Told);
our @LINK_ATTRIBUTES = qw(MemberOf Parents Members Children
HasMember RefersTo ReferredToBy DependsOn DependedOnBy);
our @WATCHER_ATTRIBUTES = qw(Requestor Cc AdminCc);
our $VERSION = '2.03';
=head1 NAME
RT::Extension::CommandByMail - Change ticket metadata via email
=head1 RT VERSION
Works with RT 4.0, 4.2, 4.4
=head1 SYNOPSIS
(Send email with content that looks like the following.)
Status: stalled
Subject: change subject
AddAdminCc: boss@example.com
AddCc: dev1@example.com
AddCc: dev2@example.com
The comment/reply text goes here
=head1 INSTALLATION
=over
=item C<perl Makefile.PL>
=item C<make>
=item C<make install>
May need root permissions
=item Edit your F</opt/rt4/etc/RT_SiteConfig.pm>
If you are using RT 4.2 or greater, add this line:
Plugin('RT::Extension::CommandByMail');
For RT 4.0, add this line:
Set(@Plugins, qw(RT::Extension::CommandByMail));
or add C<RT::Extension::CommandByMail> to your existing C<@Plugins> line.
For RT 4.2 or older, also add C<Filter::TakeAction> to your
C<@MailPlugins> configuration, as follows:
Set(@MailPlugins, qw(Auth::MailFrom Filter::TakeAction));
For RT 4.4 or newer, the plugin code is in C<Action::CommandByMail>, so
add this:
Set(@MailPlugins, qw(Auth::MailFrom Action::CommandByMail));
Be sure to include C<Auth::MailFrom> in the list as well.
B<Note:> The plugin name has changed for RT 4.4, so after upgrading you
must also update your C<RT_SiteConfig.pm> file to change
C<Filter::TakeAction> to the new C<Action::CommandByMail>.
=item Patch RT
For RT 4.4.0, apply the included patch:
cd /opt/rt4 # Your location may be different
patch -p1 < /download/dir/RT-Extension-CommandByMail/etc/handle_action_pass_currentuser.patch
=item Restart your webserver
=back
=head1 CONFIGURATION
In addition to adding the configuration above to activate the extension in
RT, the following options are available.
=head2 C<$CommandByMailGroup>
You may set a C<$CommandByMailGroup> to a particular group ID in RT_SiteConfig.
If set, only members of this group may perform commands by mail.
=head2 C<$CommandByMailHeader>
You may set this configuration value to the name of a header to examine
as well. For example:
Set($CommandByMailHeader, "X-RT-Command");
=head2 C<$CommandByMailOnlyHeaders>
If set, the body will not be examined, only the header defined by the previous
configuration option.
=head1 CAVEATS
This extension is incompatible with C<UnsafeEmailCommands> RT option.
=head1 DESCRIPTION
This extension allows you to manage ticket metadata via email. You
may put commands into the beginning of an email, and the extension will apply
them. The list of commands is detailed below.
B<CAVEAT:> commands are line oriented, so you can't expand to multiple
lines for each command, i.e. values can't contains new lines. The module
also currently expects and parses text, not HTML.
=head2 FORMAT
This extension parses the body, and optionally a header, in incoming messages
for commands to update ticket metadata. The format of commands is:
Command: value
Command: value
...
You can find list of L</COMMANDS> below.
Some commands (like Status, Queue and other) can be used only once. Commands
that manage lists can be used multiple times, for example link, custom fields
and watchers commands. Also, the latter can be used with C<Add> and C<Del>
prefixes to add/delete values from the current list of the ticket you reply to
or comment on.
=head2 COMMANDS
=head3 Basic
=over 4
=item Queue: <name>
Set new queue for the ticket
=item Subject: <string>
Set new subject to the given string
=item Status: <status>
Set new status, one of new, open, stalled, resolved, rejected or deleted
=item Owner: <username>
Set new owner using the given username
=item Priority: <#>
Set new priority to the given value
=item FinalPriority: <#>
Set new final priority to the given value
=back
=head3 Dates
Set new date/timestamp, or 0 to unset:
Due: <new timestamp>
Starts: <new timestamp>
Started: <new timestamp>
=head3 Time
Set new times to the given value in minutes. Note that
on correspond/comment B<< C<TimeWorked> add time >> to the current
value.
TimeWorked: <minutes>
TimeEstimated: <minutes>
TimeLeft: <minutes>
=head3 Watchers
Manage watchers: requestors, ccs and admin ccs. This commands
can be used several times and/or with C<Add> and C<Del> prefixes,
for example C<Requestor> comand set requestor(s) and the current
requestors would be deleted, but C<AddRequestor> command adds
to the current list.
Requestor: <address> Set requestor(s) using the email address
AddRequestor: <address> Add new requestor using the email address
DelRequestor: <address> Remove email address as requestor
Cc: <address> Set Cc watcher(s) using the email address
AddCc: <address> Add new Cc watcher using the email address
DelCc: <address> Remove email address as Cc watcher
AdminCc: <address> Set AdminCc watcher(s) using the email address
AddAdminCc: <address> Add new AdminCc watcher using the email address
DelAdminCc: <address> Remove email address as AdminCc watcher
=head3 Links
Manage links. These commands are also could be used several times in one
message.
DependsOn: <ticket id>
DependedOnBy: <ticket id>
RefersTo: <ticket id>
ReferredToBy: <ticket id>
Members: <ticket id>
MemberOf: <ticket id>
=head3 Custom field values
Manage custom field values. Could be used multiple times. (The curly braces
are literal.)
CustomField.{<CFName>}: <custom field value>
AddCustomField.{<CFName>}: <custom field value>
DelCustomField.{<CFName>}: <custom field value>
Short forms:
CF.{<CFName>}: <custom field value>
AddCF.{<CFName>}: <custom field value>
DelCF.{<CFName>}: <custom field value>
=head3 Transaction Custom field values
Manage custom field values of transactions. Could be used multiple times. (The curly braces
are literal.)
TransactionCustomField.{<CFName>}: <custom field value>
Short forms:
TxnCustomField.{<CFName>}: <custom field value>
TransactionCF.{<CFName>}: <custom field value>
TxnCF.{<CFName>}: <custom field value>
=head1 SECURITY
This extension has no extended auth system; so all security issues that
apply to the RT in general also apply to the extension.
=head1 METHODS
=head2 ProcessCommands
This method provides the main email processing functionality. It supports
both RT 4.2 and earlier and 4.4 and later. To do this, the return hashes
contain some values used by 4.2 code and some used by 4.4. The return
values coexist and unused values are ignored by the different versions.
For 4.4, returning C<{ DeferToRT =E<gt> 1 }> invokes the normal RT mail processing
flow. This allows CommandByMail to pass on processing an email message for
cases like a user not being a member of C<CommandByMailGroup>.
=cut
sub ProcessCommands {
my %args = (
Message => undef,
RawMessageRef => undef,
CurrentUser => undef,
AuthLevel => undef,
Action => undef,
Ticket => undef,
Queue => undef,
@_
);
unless ( $args{'CurrentUser'} && $args{'CurrentUser'}->Id ) {
$RT::Logger->error(
"CommandByMail executed when "
."CurrentUser (actor) is not authorized. "
);
return { CurrentUser => $args{'CurrentUser'},
AuthLevel => $args{'AuthLevel'},
MailError => 1,
ErrorSubject => "Permission Denied",
Explanation => "CurrentUser is not set when trying to "
. "process email command via CommandByMail",
Failure => 1
};
}
$RT::Logger->debug("Running CommandByMail as ".$args{'CurrentUser'}->UserObj->Name);
# If the user isn't asking for a comment or a correspond,
# bail out. Only relevant for pre-4.2.
unless ( $args{'Action'} =~ /^(?:comment|correspond)$/i ) {
return { CurrentUser => $args{'CurrentUser'},
AuthLevel => $args{'AuthLevel'} };
}
# If only a particular group may perform commands by mail,
# bail out
my $new_config = RT->can('Config') && RT->Config->can('Get');
my $group_id = $new_config
? RT->Config->Get('CommandByMailGroup')
: $RT::CommandByMailGroup;
if (defined $group_id) {
my $group = RT::Group->new($args{'CurrentUser'});
$group->Load($group_id);
if (!$group->HasMemberRecursively($args{'CurrentUser'}->PrincipalObj)) {
$RT::Logger->debug("CurrentUser not in CommandByMailGroup");
# User has no access to process commands, so defer to RT to process
# like a normal email response.
return { DeferToRT => 1 };
}
}
my $headername = $new_config
? RT->Config->Get('CommandByMailHeader')
: $RT::CommandByMailHeader;
my $only_headers = $new_config
? RT->Config->Get('CommandByMailOnlyHeaders')
: $RT::CommandByMailOnlyHeaders;
# find the content
my @content = ();
my @parts = $only_headers ? () : $args{'Message'}->parts_DFS;
foreach my $part (@parts) {
my $body = $part->bodyhandle or next;
#if it looks like it has pseudoheaders, that's our content
if ( $body->as_string =~ /^(?:\S+)(?:{.*})?:/m ) {
@content = $body->as_lines;
last;
}
}
if (defined $headername) {
unshift @content, map {Encode::decode("UTF-8",$_)}
$args{'Message'}->head->get_all($headername);
}
my @items;
my $found_pseudoheaders = 0;
foreach my $line (@content) {
next if $line =~ /^\s*$/ && ! $found_pseudoheaders;
last if $line !~ /^(?:(\S+(?:{.*})?)\s*?:\s*?(.*)\s*?|)$/;
last if not defined $1 and $found_pseudoheaders;
next if not defined $1;
$found_pseudoheaders = 1;
push( @items, $1 => $2 );
$RT::Logger->debug("Found pseudoheader: $1 => $2");
}
my %cmds;
while ( my $key = _CanonicalizeCommand( shift @items ) ) {
my $val = shift @items;
# strip leading and trailing spaces
$val =~ s/^\s+|\s+$//g;
$RT::Logger->debug("Got command $key => $val");
if ( exists $cmds{$key} ) {
$cmds{$key} = [ $cmds{$key} ] unless ref $cmds{$key};
push @{ $cmds{$key} }, $val;
} else {
$cmds{$key} = $val;
}
}
my %results;
foreach my $cmd ( keys %cmds ) {
my ($val, $msg) = _CheckCommand( $cmd );
unless ( $val ) {
$results{ $cmd } = {
value => delete $cmds{ $cmd },
result => $val,
message => $msg,
};
}
}
my $ticket_as_user = RT::Ticket->new( $args{'CurrentUser'} );
my $queue = RT::Queue->new( $args{'CurrentUser'} );
if ( $cmds{'queue'} ) {
$queue->Load( $cmds{'queue'} );
}
if ( !$queue->id ) {
$queue->Load( $args{'Queue'}->id );
}
my $transaction;
# If we're updating.
if ( $args{'Ticket'}->id ) {
$ticket_as_user->Load( $args{'Ticket'}->id );
$RT::Logger->debug("Updating Ticket ".$ticket_as_user->Id." in Queue ".$queue->Name);
# we set status later as correspond can reopen ticket
foreach my $attribute (grep !/^(Status|TimeWorked)/, @REGULAR_ATTRIBUTES, @TIME_ATTRIBUTES) {
next unless defined $cmds{ lc $attribute };
next if $ticket_as_user->$attribute() eq $cmds{ lc $attribute };
# canonicalize owner -- accept an e-mail address
if ( $attribute eq 'Owner' && $cmds{ lc $attribute } =~ /\@/ ) {
my $user = RT::User->new($RT::SystemUser);
$user->LoadByEmail( $cmds{ lc $attribute } );
$cmds{ lc $attribute } = $user->Name if $user->id;
}
_SetAttribute(
$ticket_as_user, $attribute,
$cmds{ lc $attribute }, \%results
);
}
# we want the queue the ticket is currently in, not the queue
# that was passed to rt-mailgate, otherwise we can't find the
# proper set of Custom Fields. But, we have to do this after
# we potentially update the Queue from @REGULAR_ATTRIBUTES
$queue = $ticket_as_user->QueueObj();
foreach my $attribute (@DATE_ATTRIBUTES) {
next unless ( $cmds{ lc $attribute } );
my $date = RT::Date->new( $args{'CurrentUser'} );
$date->Set(
Format => 'unknown',
Value => $cmds{ lc $attribute },
);
_SetAttribute( $ticket_as_user, $attribute, $date->ISO,
\%results );
$results{ $attribute }->{value} = $cmds{ lc $attribute };
}
foreach my $type ( @WATCHER_ATTRIBUTES ) {
my %tmp = _ParseAdditiveCommand( \%cmds, 1, $type );
next unless keys %tmp;
$tmp{'Default'} = [ do {
my $method = $type;
$method .= 's' if $type eq 'Requestor';
$args{'Ticket'}->$method->MemberEmailAddresses;
} ];
my ($add, $del) = _CompileAdditiveForUpdate( %tmp );
foreach my $text ( @$del ) {
my $user = RT::User->new($RT::SystemUser);
$user->LoadByEmail($text) if $text =~ /\@/;
$user->Load($text) unless $user->id;
my ( $val, $msg ) = $ticket_as_user->DeleteWatcher(
Type => $type,
PrincipalId => $user->PrincipalId,
);
push @{ $results{ 'Del'. $type } }, {
value => $text,
result => $val,
message => $msg
};
}
foreach my $text ( @$add ) {
my $user = RT::User->new($RT::SystemUser);
$user->LoadByEmail($text) if $text =~ /\@/;
$user->Load($text) unless $user->id;
my ( $val, $msg ) = $ticket_as_user->AddWatcher(
Type => $type,
$user->id
? (PrincipalId => $user->PrincipalId)
: (Email => $text)
,
);
push @{ $results{ 'Add'. $type } }, {
value => $text,
result => $val,
message => $msg
};
}
}
{
my $time_taken = 0;
if (grep $_ eq 'TimeWorked', @TIME_ATTRIBUTES) {
if (ref $cmds{'timeworked'}) {
map { $time_taken += ($_ || 0) } @{ $cmds{'timeworked'} };
$RT::Logger->debug("Time taken: $time_taken");
}
else {
$time_taken = $cmds{'timeworked'} || 0;
}
}
my $method = ucfirst $args{'Action'};
(my $status, my $msg, $transaction) = $ticket_as_user->$method(
TimeTaken => $time_taken,
MIMEObj => $args{'Message'},
);
unless ( $status ) {
$RT::Logger->warning(
"Couldn't write $args{'Action'}."
." Fallback to standard mailgate. Error: $msg");
return { CurrentUser => $args{'CurrentUser'},
AuthLevel => $args{'AuthLevel'},
MailError => 1,
ErrorSubject => "Unable to execute $args{'Action'}",
Explanation => "Unable to execute $args{'Action'} on ticket "
. $args{'Ticket'}->Id . ": $msg",
Failure => 1
};
}
}
foreach my $type ( @LINK_ATTRIBUTES ) {
my %tmp = _ParseAdditiveCommand( \%cmds, 1, $type );
next unless keys %tmp;
my $typemap = keys %RT::Link::TYPEMAP ? \%RT::Link::TYPEMAP : $ticket_as_user->LINKTYPEMAP;
my $link_type = $typemap->{$type}->{'Type'};
my $link_mode = $typemap->{$type}->{'Mode'};
$tmp{'Default'} = [ do {
my %h = ( Base => 'Target', Target => 'Base' );
my $links = $args{'Ticket'}->_Links( $h{$link_mode}, $link_type );
my @res;
while ( my $link = $links->Next ) {
my $method = $link_mode .'URI';
my $uri = $link->$method();
next unless $uri->IsLocal;
push @res, $uri->Object->Id;
}
@res;
} ];
my ($add, $del) = _CompileAdditiveForUpdate( %tmp );
foreach ( @$del ) {
my ($val, $msg) = $ticket_as_user->DeleteLink(
Type => $link_type,
$link_mode => $_,
);
$results{ 'Del'. $type } = {
value => $_,
result => $val,
message => $msg,
};
}
foreach ( @$add ) {
my ($val, $msg) = $ticket_as_user->AddLink(
Type => $link_type,
$link_mode => $_,
);
$results{ 'Add'. $type } = {
value => $_,
result => $val,
message => $msg,
};
}
}
my $custom_fields = $queue->TicketCustomFields;
while ( my $cf = $custom_fields->Next ) {
my %tmp = _ParseAdditiveCommand( \%cmds, 0, "CustomField{". $cf->Name ."}" );
next unless keys %tmp;
$tmp{'Default'} = [ do {
my $values = $args{'Ticket'}->CustomFieldValues( $cf->id );
my @res;
while ( my $value = $values->Next ) {
push @res, $value->Content;
}
@res;
} ];
my ($add, $del) = _CompileAdditiveForUpdate( %tmp );
foreach ( @$del ) {
my ( $val, $msg ) = $ticket_as_user->DeleteCustomFieldValue(
Field => $cf->id,
Value => $_
);
$results{ "DelCustomField{". $cf->Name ."}" } = {
value => $_,
result => $val,
message => $msg,
};
}
foreach ( @$add ) {
my ( $val, $msg ) = $ticket_as_user->AddCustomFieldValue(
Field => $cf->id,
Value => $_
);
$results{ "DelCustomField{". $cf->Name ."}" } = {
value => $_,
result => $val,
message => $msg,
};
}
}
foreach my $attribute (grep $_ eq 'Status', @REGULAR_ATTRIBUTES) {
next unless defined $cmds{ lc $attribute };
next if $ticket_as_user->$attribute() eq $cmds{ lc $attribute };
_SetAttribute(
$ticket_as_user, $attribute,
lc $cmds{ lc $attribute }, \%results
);
}
} else {
my %create_args = ();
foreach my $attribute (@REGULAR_ATTRIBUTES, @TIME_ATTRIBUTES) {
next unless exists $cmds{ lc $attribute };
# canonicalize owner -- accept an e-mail address
if ( $attribute eq 'Owner' && $cmds{ lc $attribute } =~ /\@/ ) {
my $user = RT::User->new($RT::SystemUser);
$user->LoadByEmail( $cmds{ lc $attribute } );
$cmds{ lc $attribute } = $user->Name if $user->id;
}
if ( $attribute eq 'TimeWorked' && ref $cmds{ lc $attribute } ) {
my $time_taken = 0;
map { $time_taken += ($_ || 0) } @{ $cmds{'timeworked'} };
$cmds{'timeworked'} = $time_taken;
$RT::Logger->debug("Time taken on create: $time_taken");
}
if ( $attribute eq 'Status' && $cmds{ lc $attribute } ) {
$cmds{ lc $attribute } = lc $cmds{ lc $attribute };
}
$create_args{$attribute} = $cmds{ lc $attribute };
}
foreach my $attribute (@DATE_ATTRIBUTES) {
next unless exists $cmds{ lc $attribute };
my $date = RT::Date->new( $args{'CurrentUser'} );
$date->Set(
Format => 'unknown',
Value => $cmds{ lc $attribute }
);
$create_args{$attribute} = $date->ISO;
}
# Canonicalize links
foreach my $type ( @LINK_ATTRIBUTES ) {
$create_args{ $type } = [ _CompileAdditiveForCreate(
_ParseAdditiveCommand( \%cmds, 0, $type ),
) ];
}
# Canonicalize custom fields
my $custom_fields = $queue->TicketCustomFields;
while ( my $cf = $custom_fields->Next ) {
my %tmp = _ParseAdditiveCommand( \%cmds, 0, "CustomField{". $cf->Name ."}" );
next unless keys %tmp;
$create_args{ 'CustomField-' . $cf->id } = [ _CompileAdditiveForCreate(%tmp) ];
}
# Canonicalize watchers
# First of all fetch default values
foreach my $type ( @WATCHER_ATTRIBUTES ) {
my %tmp = _ParseAdditiveCommand( \%cmds, 1, $type );
$tmp{'Default'} = [ $args{'CurrentUser'}->EmailAddress ] if $type eq 'Requestor';
$tmp{'Default'} = [
ParseCcAddressesFromHead(
Head => $args{'Message'}->head,
CurrentUser => $args{'CurrentUser'},
QueueObj => $args{'Queue'},
)
] if $type eq 'Cc' && $RT::ParseNewMessageForTicketCcs;
$create_args{ $type } = [ _CompileAdditiveForCreate( %tmp ) ];
}
# get queue unless mail contain it
$create_args{'Queue'} = $args{'Queue'}->Id unless exists $create_args{'Queue'};
# subject
unless ( $create_args{'Subject'} ) {
$create_args{'Subject'} = $args{'Message'}->head->get('Subject');
$create_args{'Subject'} = Encode::decode("UTF-8", $create_args{'Subject'});
chomp $create_args{'Subject'};
}
# If we don't already have a ticket, we're going to create a new
# ticket
my ( $id, $txn_id, $msg ) = $ticket_as_user->Create(
%create_args,
MIMEObj => $args{'Message'}
);
unless ( $id ) {
$msg = "Couldn't create ticket from message with commands, ".
"fallback to standard mailgate.\n\nError: $msg";
$RT::Logger->error( $msg );
$results{'Create'} = {
result => $id,
message => $msg,
};
_ReportResults( Results => \%results, Message => $args{'Message'} );
return { CurrentUser => $args{'CurrentUser'},
AuthLevel => $args{'AuthLevel'} };
}
$transaction = RT::Transaction->new( $ticket_as_user->CurrentUser );
$transaction->Load( $txn_id );
}
if ( $transaction && $transaction->id ) {
my $custom_fields = $transaction->CustomFields;
while ( my $cf = $custom_fields->Next ) {
my $cmd = 'TransactionCustomField{'. $cf->Name .'}';
my @values = ($cmds{ lc $cmd });
@values = @{ $values[0] } if ref $values[0] eq 'ARRAY';
@values = grep defined && length, @values;
next unless @values;
foreach my $value ( @values ) {
my ($status, $msg) = $transaction->AddCustomFieldValue(
Field => $cf->Name, Value => $value,
);
push @{ $results{ $cmd } ||= [] }, {
value => $value, result => $status, message => $msg,
};
}
}
}
_ReportResults(
Ticket => $args{'Ticket'},
Results => \%results,
Message => $args{'Message'},
);
# make sure ticket is loaded
$args{'Ticket'}->Load( $transaction->ObjectId );
# The -2 magic value is the pre-4.4 method of stopping evaluation
# of additional GetCurrentUser methods and telling the Gateway to
# return success. See RT::Interface::Email::Gateway in pre-4.4 codebase.
return { CurrentUser => $args{'CurrentUser'},
AuthLevel => -2,
Transaction => $transaction };
}
sub _ParseAdditiveCommand {
my ($cmds, $plural_forms, $base) = @_;
my (%res);
my @types = $base;
push @types, $base.'s' if $plural_forms;
push @types, 'Add'. $base;
push @types, 'Add'. $base .'s' if $plural_forms;
push @types, 'Del'. $base;
push @types, 'Del'. $base .'s' if $plural_forms;
foreach my $type ( @types ) {
next unless defined $cmds->{lc $type};
my @values = ref $cmds->{lc $type} eq 'ARRAY'?
@{ $cmds->{lc $type} }: $cmds->{lc $type};
if ( $type =~ /^\Q$base\Es?/ ) {
push @{ $res{'Set'} }, @values;
} elsif ( $type =~ /^Add/ ) {
push @{ $res{'Add'} }, @values;
} else {
push @{ $res{'Del'} }, @values;
}
}
return %res;
}
sub _CompileAdditiveForCreate {
my %cmd = @_;
unless ( exists $cmd{'Default'} && defined $cmd{'Default'} ) {
$cmd{'Default'} = [];
} elsif ( ref $cmd{'Default'} ne 'ARRAY' ) {
$cmd{'Default'} = [ $cmd{'Default'} ];
}
my @list;
@list = @{ $cmd{'Default'} } unless $cmd{'Set'};
@list = @{ $cmd{'Set'} } if $cmd{'Set'};
push @list, @{ $cmd{'Add'} } if $cmd{'Add'};
if ( $cmd{'Del'} ) {
my %seen;
$seen{$_} = 1 foreach @{ $cmd{'Del'} };
@list = grep !$seen{$_}, @list;
}
return @list;
}
sub _CompileAdditiveForUpdate {
my %cmd = @_;
my @new = _CompileAdditiveForCreate( %cmd );
unless ( exists $cmd{'Default'} && defined $cmd{'Default'} ) {
$cmd{'Default'} = [];
} elsif ( ref $cmd{'Default'} ne 'ARRAY' ) {
$cmd{'Default'} = [ $cmd{'Default'} ];
}
my ($add, $del);
unless ( @{ $cmd{'Default'} } ) {
$add = \@new;
} elsif ( !@new ) {
$del = $cmd{'Default'};
} else {
my (%cur, %new);
$cur{$_} = 1 foreach @{ $cmd{'Default'} };
$new{$_} = 1 foreach @new;
$add = [ grep !$cur{$_}, @new ];
$del = [ grep !$new{$_}, @{ $cmd{'Default'} } ];
}
$_ ||= [] foreach ($add, $del);
return ($add, $del);
}
sub _SetAttribute {
my $ticket = shift;
my $attribute = shift;
my $value = shift;
my $results = shift;
my $setter = "Set$attribute";
my ( $val, $msg ) = $ticket->$setter($value);
$results->{$attribute} = {
value => $value,
result => $val,
message => $msg
};
}
sub _CanonicalizeCommand {
my $key = shift;
return $key unless defined $key;
$key = lc $key;
# CustomField commands
$key =~ s/^(add|del|)c(?:ustom)?-?f(?:ield)?\.?[({\[](.*)[)}\]]$/$1customfield{$2}/i;
$key =~ s/^(?:transaction|txn)c(?:ustom)?-?f(?:ield)?\.?[({\[](.*)[)}\]]$/transactioncustomfield{$1}/i;
return $key;
}
sub _CheckCommand {
my ($cmd, $val) = (lc shift, shift);
return 1 if $cmd =~ /^(add|del|)customfield\{.*\}$/i;
return 1 if $cmd =~ /^transactioncustomfield\{.*\}$/i;
if ( grep $cmd eq lc $_, @REGULAR_ATTRIBUTES, @TIME_ATTRIBUTES, @DATE_ATTRIBUTES ) {
return 1 unless ref $val;
return (0, "Command '$cmd' doesn't support multiple values");
}
return 1 if grep $cmd eq lc $_, @LINK_ATTRIBUTES, @WATCHER_ATTRIBUTES;
if ( $cmd =~ /^(?:add|del)(.*)$/i ) {
my $cmd = $1;
if ( grep $cmd eq lc $_, @REGULAR_ATTRIBUTES, @TIME_ATTRIBUTES, @DATE_ATTRIBUTES ) {
return (0, "Command '$cmd' doesn't support multiple values");
}
return 1 if grep $cmd eq lc $_, @LINK_ATTRIBUTES, @WATCHER_ATTRIBUTES;
}
return (0, "Command '$cmd' is unknown");
}
sub _ReportResults {
my %args = ( Ticket => undef, Message => undef, Results => {}, @_ );
my $msg = '';
unless ( $args{'Ticket'} && $args{'Ticket'}->id ) {
$msg .= $args{'Results'}{'Create'}{'message'} || '';
$msg .= "\n" if $msg;
delete $args{'Results'}{'Create'};
}
foreach my $key ( keys %{ $args{'Results'} } ) {
my @records = ref $args{'Results'}->{ $key } eq 'ARRAY'?
@{$args{'Results'}->{ $key }}: $args{'Results'}->{ $key };
foreach my $rec ( @records ) {
next if $rec->{'result'};
$msg .= "Failed command '". $key .": ". $rec->{'value'} ."'\n";
$msg .= "Error message: ". ($rec->{'message'}||"(no message)") ."\n\n";
}
}
return unless $msg && $msg !~ /^\s*$/;
$RT::Logger->warning( $msg );
my $ErrorsTo = RT::Interface::Email::ParseErrorsToAddressFromHead( $args{'Message'}->head );
RT::Interface::Email::MailError(
To => $ErrorsTo,
Subject => "Extended mailgate error",
Explanation => $msg,
MIMEObj => $args{'Message'},
Attach => $args{'Message'}->as_string,
);
return;
}
=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
# Originally part of RT, this function was refactored into core 'create'
# functionality in 4.4 via 5ccf5a14f. It's still useful in the logic flow
# here, so reproduce the old function.
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( $_ ),
map lc $user->CanonicalizeEmailAddress( $_->address ),
map RT::EmailParser->CleanupAddresses( Email::Address->parse(
Encode::decode( "UTF-8", $args{'Head'}->get( $_ ) ) ) ),
qw(To Cc);
}
1;
__END__
=head1 AUTHOR
Best Practical Solutions, LLC E<lt>modules@bestpractical.comE<gt>
=head1 BUGS
All bugs should be reported via email to
L<bug-RT-Extension-CommandByMail@rt.cpan.org|mailto:bug-RT-Extension-CommandByMail@rt.cpan.org>
or via the web at
L<rt.cpan.org|http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-CommandByMail>.
=head1 LICENSE AND COPYRIGHT
This software is Copyright (c) 2014 by Best Practical Solutions
This is free software, licensed under:
The GNU General Public License, Version 2, June 1991
=cut