Compare commits

..

10 commits

Author SHA1 Message Date
Harlan Lieberman-Berg
9831a87844 Minor language cleanup. 2017-03-28 18:15:09 -04:00
Harlan Lieberman-Berg
cf3c2dff79 Cleanup in preparation for publishing. 2016-08-22 15:46:30 -04:00
Harlan Lieberman-Berg
9c36813918 Merge branch 'master' of ssh://stash.akamai.com:7999/infosec/rt-extension-messageid 2015-12-21 16:21:59 -05:00
Harlan Lieberman-Berg
615cac871f Use sprintf for log4perl. 2015-12-21 16:20:50 -05:00
Harlan Lieberman-Berg
cacbc9182c Add extension. 2015-12-21 16:17:37 -05:00
Harlan Lieberman-Berg
4ff8e0133c Cleanup from dev. 2015-12-21 16:17:31 -05:00
Harlan Lieberman-Berg
52a1213a1c Queue names are not directly accessible. 2015-12-01 13:59:19 -05:00
Harlan Lieberman-Berg
877bca0ca4 Add temporary block. 2015-12-01 13:58:39 -05:00
Harlan Lieberman-Berg
3e682d05e0 Update description. 2015-12-01 13:57:48 -05:00
Harlan Lieberman-Berg
e1d580141b Be strict. 2015-11-24 13:33:33 -05:00
4 changed files with 124 additions and 23 deletions

14
.gitignore vendored
View file

@ -1 +1,15 @@
blib*
Makefile
Makefile.old
pm_to_blib*
*.tar.gz
.lwpcookies
cover_db
pod2htm*.tmp
/RT-Extension-References*
*.bak
*.swp
/MYMETA.*
/t/tmp
/xt/tmp
*~

11
Makefile.PL Normal file
View file

@ -0,0 +1,11 @@
use inc::Module::Install;
RTx 'RT-Extension-ThreadByReference';
license 'perl';
repository 'https://github.com/akamai/rt-extension-threadbyreference';
requires_rt '4.0.0';
rt_too_new '4.4.0';
sign;
WriteAll;

View file

@ -0,0 +1,80 @@
use strict;
use warnings;
package RT::Extension::ThreadByReference;
our $VERSION = '0.01';
=head1 NAME
RT-Extension-ThreadByReference - Use the MIME Reference header to try and thread messages to tickets
=head1 DESCRIPTION
When an RT ticketing queue is CCed on a message thread, it can be very
difficult to get the subject lines correct in all parts of the
message. This can cause a single thread to spawn off tens of
different tickets that need manual merging.
This extension uses the MIME Reference header to search for threads
to associate a message with.
=head1 RT VERSION
Works with RT 4.0 and greater.
=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::ThreadByReference');
For RT 4.0, add this line:
Set(@Plugins, qw(RT::Extension::ThreadByReference));
or add C<RT::Extension::ThreadByReference> to your existing C<@Plugins> line.
=item Clear your mason cache
rm -rf /opt/rt4/var/mason_data/obj
=item Restart your webserver
=back
=head1 AUTHOR
Harlan Lieberman-Berg C<< <hlieberm@akamai.com> >>
=head1 BUGS
All bugs should be reported via email to
L<bug-RT-Extension-ThreadByReference@rt.cpan.org|mailto:bug-RT-Extension-ThreadByReference@rt.cpan.org>
or via the web at
L<rt.cpan.org|http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-ThreadByReference>.
=head1 LICENSE
Copyright (c) 2015-2016 by Akamai Technologies, Inc.
This software is free software; you can redistribute and/or modify it
under the same terms as Perl itself.
=cut
1;

View file

@ -1,18 +1,12 @@
package RT::Interface::Email::TryThreading;
package RT::Interface::Email::ThreadByReference;
use strict;
use warnings;
use RT::Interface::Email ();
=head1 NAME
RT::Interface::Email::TryThreading - Use In-Reply-To and other headers to try and find a ticket
=cut
sub GetCurrentUser {
$RT::Logger->debug("Entering TryThreading");
$RT::Logger->debug("Entering ThreadByReference");
my %args = (
Message => undef,
@ -25,13 +19,13 @@ sub GetCurrentUser {
@_
);
if ($args{'Ticket'}) {
$RT::Logger->debug("Ticket %s already assigned. You don't need my help!",
$args{'Ticket'});
if ($args{'Ticket'}->id) {
$RT::Logger->debug(sprintf("Ticket %s already assigned. You don't need my help!",
$args{'Ticket'}->id));
return ($args{'CurrentUser'}, $args{'AuthLevel'});
}
$RT::Logger->debug("Operating on queue %s", $args{'Queue'});
$RT::Logger->debug(sprintf("Operating on queue %s", $args{'Queue'}));
my @messageids = FetchPossibleHeaders($args{'Message'});
@ -41,9 +35,9 @@ sub GetCurrentUser {
}
my %tickets = ();
foreach $messageid (@messageids) {
if (MessageIdToTicket($messageid)) {
foreach $ticket ($_) {
foreach my $messageid (@messageids) {
if (my $ids = MessageIdToTicket($messageid)) {
foreach my $ticket ($ids) {
$tickets{$ticket} = undef;
}
}
@ -57,11 +51,11 @@ sub GetCurrentUser {
}
elsif (scalar(@tickets) > 1) {
$RT::Logger->warning("Email maps to more than one ticket.");
$RT::Logger->warning("Tickets: %s", @tickets);
$RT::Logger->warning(sprintf("Tickets: %s", @tickets));
}
# We have the ticket. Set it.
$RT::Logger->debug("Threading email in ticket %s", $tickets[0]);
$RT::Logger->debug(sprintf("Threading email in ticket %s", $tickets[0]));
$args{'Ticket'}->Load($tickets[0]);
return ($args{'CurrentUser'}, $args{'AuthLevel'});
@ -78,21 +72,22 @@ sub FetchPossibleHeaders {
# There may be multiple references
# In practice, In-Reply-To seems to no longer be worth parsing, as
# it seems to usually just be a repeat of the References.
if ($head->get('References')) {
if (my $refs = $head->get('References')) {
chomp();
foreach my $ref (split(/\s+/, $_)) {
foreach my $ref (split(/\s+/, $refs)) {
$ref =~ /,?<([^>]+)>/;
if ($1) {
push(@msgids, $1);
$RT::Logger->debug("Found reference: %s", $1);
$RT::Logger->debug(sprintf("Found reference: %s", $1));
}
else {
$RT::Logger->debug("Reference with borked syntax: %s", $ref);
$RT::Logger->debug(sprintf("Reference with borked syntax: %s", $ref));
next;
}
}
}
return @msgids;
}
sub MessageIdToTicket {
@ -136,10 +131,11 @@ sub MessageIdToTicket {
);
my %tickets;
while (my $attach => $attachments->Next) {
while (my $attach = $attachments->Next) {
$tickets{$attach->TransactionObj()->Ticket} = undef;
}
return keys(%tickets);
}
1;