[Bps-public-commit] RT-Extension-CommandByMail branch, master, updated. 0.13-3-g1158b2a
Alex Vandiver
alexmv at bestpractical.com
Thu Oct 3 14:18:44 EDT 2013
The branch, master has been updated
via 1158b2a6fe579981f503cc84bfc594fb8e89f419 (commit)
via c1565ef15739be268e837591cac1ec2d7bcaadbe (commit)
from 216c0f0ffcdbaf085f239a3f53dab3fecc97c154 (commit)
Summary of changes:
Changes | 4 +
INSTALL | 66 --
META.yml | 2 +-
inc/Module/Install/RTx.pm | 11 +-
lib/RT/Extension/CommandByMail.pm | 60 +-
patch/command_by_email-0.1-RT-3.4.2.patch | 71 --
patch/command_by_email-0.1-RT-3.4.3.patch | 53 --
patch/command_by_email-0.1-RT-3.4.4.patch | 53 --
patch/command_by_email-0.1-RT-3.4.5.patch | 968 ----------------------
patch/command_by_email-0.1-RT-3.6.0.patch | 1272 -----------------------------
patch/errors_in_reply_to-RT-3.6.1.patch | 12 -
11 files changed, 63 insertions(+), 2509 deletions(-)
delete mode 100644 INSTALL
delete mode 100644 patch/command_by_email-0.1-RT-3.4.2.patch
delete mode 100644 patch/command_by_email-0.1-RT-3.4.3.patch
delete mode 100644 patch/command_by_email-0.1-RT-3.4.4.patch
delete mode 100644 patch/command_by_email-0.1-RT-3.4.5.patch
delete mode 100644 patch/command_by_email-0.1-RT-3.6.0.patch
delete mode 100644 patch/errors_in_reply_to-RT-3.6.1.patch
- Log -----------------------------------------------------------------
commit c1565ef15739be268e837591cac1ec2d7bcaadbe
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Oct 3 14:15:45 2013 -0400
Remove 3.6 install notes and patches; fold INSTALL into POD
diff --git a/INSTALL b/INSTALL
deleted file mode 100644
index 0815ad9..0000000
--- a/INSTALL
+++ /dev/null
@@ -1,66 +0,0 @@
-INSTALLATION
-
-To install this module, run the following commands:
-
- perl Makefile.PL
- make
- make install
-
-PATCH
-
-If you are using RT 3.6.0 or earlier, you MUST apply a patch in order to use
-this extension.
-
-Patch(es) are in patch directory. Apply patch with following commands:
-
- cd /opt/rt3
- patch -p0 <path/to/patch/command_by_mail-<patch version>-RT-<rt version>.patch
-
-
-Use the patch with the greatest <patch version> -- old patches are
-shipped with the distribution so you can revert old patch(es) and apply
-the new one on upgrades.
-
-If you are using RT 3.6.1 or later, you no longer need to apply a patch.
-
-CONFIGURE
-
-Add 'Filter::TakeAction' to the list of mail plugins in RT_SiteConfig.pm.
-(You'll need to add Auth::MailFrom to the list as well if you want to run the
-test suite. Auth::MailFrom is distributed with RT as
-RT::Interface::Email::Auth::MailFrom.)
-
-Restart web server.
-
-Note that Filter::TakeAction should be pushed into list *after* Auth::MailFrom
-or any similar plugin that loads a current user object.
-
-You can do this by adding the following line to your RT::SiteConfig:
-
-Set(@MailPlugins, qw(Auth::MailFrom Filter::TakeAction));
-
-If you are running a version of RT before 3.8, you will need to write.
-
- at MailPlugins = qw(Auth::MailFrom Filter::TakeAction);
-
-You will also need to add RT::Extension::CommandByMail to your
-Plugins list.
-
-Set(@Plugins,(qw(RT::Extension::CommandByMail)))
-
-There is an optional configuration option CommandByMailGroup
-Set($CommandByMailGroup, group_id);
-You can find the id by browsing to Configuration -> Groups
-
-You can get it to look for commands in headers as well by setting
-CommandByMailHeader like:
-
- Set($CommandByMailHeader, "X-RT-Command");
-
-If you only want it to look in headers and not the body, you can set
-CommandByMailOnlyHeaders to a true value, like:
-
- Set($CommandByMailOnlyHeaders, 1);
-
-Enjoy.
-
diff --git a/lib/RT/Extension/CommandByMail.pm b/lib/RT/Extension/CommandByMail.pm
index 731b73a..c3a854f 100644
--- a/lib/RT/Extension/CommandByMail.pm
+++ b/lib/RT/Extension/CommandByMail.pm
@@ -18,33 +18,71 @@ RT::Extension::CommandByMail - Change metadata of ticket via email
AddCc: dev1 at example.com
AddCc: dev2 at example.com
- Here goes comment/reply
+ The comment/reply text goes here
=head1 DESCRIPTION
-This extension allows you to manage tickets via email interface.
-You put commands into beginning of a mail and extension applies
+This extension allows you to manage tickets via email interface. You
+may put commands into beginning of a mail, and extension will apply
them. See the list of commands in the
L<RT::Interface::Email::Filter::TakeAction> docs.
-CAVEAT: commands are line oriented, so you can't expand to multiple
+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.
=head1 SECURITY
-This extension has no extended auth system, so all security issues
-that applies to the RT in general also applies to the extension.
+This extension has no extended auth system; so all security issues that
+apply to the RT in general also apply to the extension.
-=head1 INSTALLATION AND CONFIGURATION
+=head1 INSTALLATION
-Read L<INSTALL>. Note that you B<must patch> RT
-to use this extension, so read the file.
+=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>
+
+Add this line:
+
+ Set(@Plugins, ( @Plugins, "RT::Extension::CommandByMail" ));
+
+As well as:
+
+ Set(@MailPlugins, qw(Auth::MailFrom Filter::TakeAction));
+
+If you already have a C<@MailPlugins> configuration line, add
+C<Filter::TakeAction> B<after> any authentication plugins (such as
+C<Auth::MailFrom> or C<Auth::Crypt>).
+
+=item Restart your webserver
+
+=back
+
+=head1 CONFIGURATION
=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 headers.
+
=head1 CAVEATS
This extension is incompatible with C<UnsafeEmailCommands> RT option.
@@ -58,7 +96,7 @@ Shawn Moore C<< <sartak at bestpractical.com> >>
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2006-2008, Best Practical Solutions, LLC. All rights reserved.
+Copyright (c) 2006-2013, Best Practical Solutions, LLC. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
diff --git a/patch/command_by_email-0.1-RT-3.4.2.patch b/patch/command_by_email-0.1-RT-3.4.2.patch
deleted file mode 100644
index 39373d3..0000000
--- a/patch/command_by_email-0.1-RT-3.4.2.patch
+++ /dev/null
@@ -1,71 +0,0 @@
---- lib/RT/Interface/Email.pm 2006-05-17 06:05:17.000000000 +0400
-+++ lib/RT/Interface/Email.pm 2006-05-17 06:29:42.000000000 +0400
-@@ -544,10 +544,9 @@
-
- $args{'ticket'} ||= ParseTicketId($Subject);
-
-- my $SystemTicket;
-+ my $SystemTicket = RT::Ticket->new($RT::SystemUser);
- my $Right = 'CreateTicket';
- if ( $args{'ticket'} ) {
-- $SystemTicket = RT::Ticket->new($RT::SystemUser);
- $SystemTicket->Load( $args{'ticket'} );
- # if there's an existing ticket, this must be a reply
- $Right = 'ReplyToTicket';
-@@ -570,6 +569,10 @@
-
- push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins;
-
-+ # 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 (@RT::MailPlugins) {
-@@ -604,11 +607,12 @@
-
-
- # If a module returns a "-1" then we discard the ticket, so.
-- $AuthStat = -1 if $NewAuthStat == -1;
-+ $AuthStat = $NewAuthStat if $NewAuthStat == -1 or $NewAuthStat == -2;
-
- # You get the highest level of authentication you were assigned.
- $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
- last if $AuthStat == -1;
-+ $skip_action{ $args{'action'} }++ if $AuthStat == -2;
- }
-
- # {{{ If authentication fails and no new user was created, get out.
-@@ -730,7 +734,7 @@
- my $Ticket = RT::Ticket->new($CurrentUser);
-
- # {{{ If we don't have a ticket Id, we're creating a new ticket
-- if ( !$SystemTicket || !$SystemTicket->Id) {
-+ if ( (!$SystemTicket || !$SystemTicket->Id) && !$skip_action{ $args{'action'} } ) {
-
- # {{{ Create a new ticket
-
-@@ -769,10 +773,10 @@
- # }}}
-
- # If the action is comment, add a comment.
-- elsif ( $args{'action'} =~ /^(comment|correspond)$/i ) {
-- $Ticket->Load( $args{'ticket'} );
-+ elsif ( $args{'action'} =~ /^(comment|correspond)$/i && !$skip_action{ $args{'action'} } ) {
-+ $Ticket->Load( $SystemTicket->Id );
- unless ( $Ticket->Id ) {
-- my $message = "Could not find a ticket with id " . $args{'ticket'};
-+ my $message = "Could not find a ticket with id " . $SystemTicket->Id || $args{'ticket'};
- MailError(
- To => $ErrorsTo,
- Subject => "Message not recorded",
-@@ -803,7 +807,7 @@
- }
- }
-
-- else {
-+ elsif ( !$skip_action{ $args{'action'} } ) {
-
- #Return mail to the sender with an error
- MailError(
diff --git a/patch/command_by_email-0.1-RT-3.4.3.patch b/patch/command_by_email-0.1-RT-3.4.3.patch
deleted file mode 100644
index 736009e..0000000
--- a/patch/command_by_email-0.1-RT-3.4.3.patch
+++ /dev/null
@@ -1,53 +0,0 @@
---- lib/RT/Interface/Email.pm 2005-08-03 04:18:54.000000000 +0400
-+++ lib/RT/Interface/Email.pm 2006-05-17 07:39:13.000000000 +0400
-@@ -540,10 +540,9 @@
-
- $args{'ticket'} ||= ParseTicketId($Subject);
-
-- my $SystemTicket;
-+ my $SystemTicket = RT::Ticket->new($RT::SystemUser);
- my $Right = 'CreateTicket';
- if ( $args{'ticket'} ) {
-- $SystemTicket = RT::Ticket->new($RT::SystemUser);
- $SystemTicket->Load( $args{'ticket'} );
- # if there's an existing ticket, this must be a reply
- $Right = 'ReplyToTicket';
-@@ -566,6 +565,10 @@
-
- push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins;
-
-+ # 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 (@RT::MailPlugins) {
-@@ -602,12 +605,13 @@
-
-
- # If a module returns a "-1" then we discard the ticket, so.
-- $AuthStat = -1 if $NewAuthStat == -1;
-+ $AuthStat = $NewAuthStat if $NewAuthStat == -1 or $NewAuthStat == -2;
-
- # You get the highest level of authentication you were assigned.
- $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
-
- last if $AuthStat == -1;
-+ $skip_action{ $args{'action'} }++ if $AuthStat == -2;
- }
-
- last if $AuthStat == -1;
-@@ -729,6 +733,12 @@
-
- # }}}
-
-+ # strip skipped actions
-+ @actions = grep !$skip_action{$_}, @actions;
-+
-+ # if plugin changed system ticket then we should update ticket
-+ $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
-+
- my $Ticket = RT::Ticket->new($CurrentUser);
-
- # {{{ If we don't have a ticket Id, we're creating a new ticket
diff --git a/patch/command_by_email-0.1-RT-3.4.4.patch b/patch/command_by_email-0.1-RT-3.4.4.patch
deleted file mode 100644
index 736009e..0000000
--- a/patch/command_by_email-0.1-RT-3.4.4.patch
+++ /dev/null
@@ -1,53 +0,0 @@
---- lib/RT/Interface/Email.pm 2005-08-03 04:18:54.000000000 +0400
-+++ lib/RT/Interface/Email.pm 2006-05-17 07:39:13.000000000 +0400
-@@ -540,10 +540,9 @@
-
- $args{'ticket'} ||= ParseTicketId($Subject);
-
-- my $SystemTicket;
-+ my $SystemTicket = RT::Ticket->new($RT::SystemUser);
- my $Right = 'CreateTicket';
- if ( $args{'ticket'} ) {
-- $SystemTicket = RT::Ticket->new($RT::SystemUser);
- $SystemTicket->Load( $args{'ticket'} );
- # if there's an existing ticket, this must be a reply
- $Right = 'ReplyToTicket';
-@@ -566,6 +565,10 @@
-
- push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins;
-
-+ # 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 (@RT::MailPlugins) {
-@@ -602,12 +605,13 @@
-
-
- # If a module returns a "-1" then we discard the ticket, so.
-- $AuthStat = -1 if $NewAuthStat == -1;
-+ $AuthStat = $NewAuthStat if $NewAuthStat == -1 or $NewAuthStat == -2;
-
- # You get the highest level of authentication you were assigned.
- $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
-
- last if $AuthStat == -1;
-+ $skip_action{ $args{'action'} }++ if $AuthStat == -2;
- }
-
- last if $AuthStat == -1;
-@@ -729,6 +733,12 @@
-
- # }}}
-
-+ # strip skipped actions
-+ @actions = grep !$skip_action{$_}, @actions;
-+
-+ # if plugin changed system ticket then we should update ticket
-+ $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
-+
- my $Ticket = RT::Ticket->new($CurrentUser);
-
- # {{{ If we don't have a ticket Id, we're creating a new ticket
diff --git a/patch/command_by_email-0.1-RT-3.4.5.patch b/patch/command_by_email-0.1-RT-3.4.5.patch
deleted file mode 100644
index efffbf3..0000000
--- a/patch/command_by_email-0.1-RT-3.4.5.patch
+++ /dev/null
@@ -1,968 +0,0 @@
---- lib/RT/Interface/Email.pm (revision 1627)
-+++ lib/RT/Interface/Email.pm (local)
-@@ -50,13 +50,14 @@
- use MIME::Entity;
- use RT::EmailParser;
- use File::Temp;
-+use UNIVERSAL::require;
-
- BEGIN {
- use Exporter ();
-- use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-+ use vars qw ( @ISA @EXPORT_OK);
-
- # set the version for version checking
-- $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
-+ our $VERSION = 2.0;
-
- @ISA = qw(Exporter);
-
-@@ -111,8 +111,8 @@
-
- #If this instance of RT sent it our, we don't want to take it in
- my $RTLoop = $head->get("X-RT-Loop-Prevention") || "";
-- chomp ($RTLoop); #remove that newline
-- if ($RTLoop eq "$RT::rtname") {
-+ chomp($RTLoop); #remove that newline
-+ if ( $RTLoop eq "$RT::rtname" ) {
- return (1);
- }
-
-@@ -138,10 +138,11 @@
-
- #TODO: search through the whole email and find the right Ticket ID.
-
-- my ($From, $junk) = ParseSenderAddressFromHead($head);
-+ my ( $From, $junk ) = ParseSenderAddressFromHead($head);
-
-- if (($From =~ /^mailer-daemon\@/i) or
-- ($From =~ /^postmaster\@/i)){
-+ if ( ( $From =~ /^mailer-daemon\@/i )
-+ or ( $From =~ /^postmaster\@/i ) )
-+ {
- return (1);
-
- }
-@@ -156,14 +157,14 @@
- sub CheckForAutoGenerated {
- my $head = shift;
-
-- my $Precedence = $head->get("Precedence") || "" ;
-- if ($Precedence =~ /^(bulk|junk)/i) {
-+ my $Precedence = $head->get("Precedence") || "";
-+ if ( $Precedence =~ /^(bulk|junk)/i ) {
- return (1);
- }
-
- # First Class mailer uses this as a clue.
- my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
-- if ($FCJunk =~ /^true/i) {
-+ if ( $FCJunk =~ /^true/i ) {
- return (1);
- }
-
-@@ -176,8 +177,8 @@
- sub CheckForBounce {
- my $head = shift;
-
-- my $ReturnPath = $head->get("Return-path") || "" ;
-- return ($ReturnPath =~ /<>/);
-+ my $ReturnPath = $head->get("Return-path") || "";
-+ return ( $ReturnPath =~ /<>/ );
- }
-
- # }}}
-@@ -197,9 +198,10 @@
-
- # Example: the following rule would tell RT not to Cc
- # "tickets at noc.example.com"
-- if ( defined($RT::RTAddressRegexp) &&
-- $address =~ /$RT::RTAddressRegexp/i ) {
-- return(1);
-+ if ( defined($RT::RTAddressRegexp)
-+ && $address =~ /$RT::RTAddressRegexp/i )
-+ {
-+ return (1);
- } else {
- return (undef);
- }
-@@ -217,14 +219,15 @@
- =cut
-
- sub CullRTAddresses {
-- return (grep { IsRTAddress($_) } @_);
-+ return ( grep { IsRTAddress($_) } @_ );
- }
-
- # }}}
-
- # {{{ sub MailError
- sub MailError {
-- my %args = (To => $RT::OwnerEmail,
-+ my %args = (
-+ To => $RT::OwnerEmail,
- Bcc => undef,
- From => $RT::CorrespondAddress,
- Subject => 'There has been an error',
-@@ -232,13 +235,15 @@
- MIMEObj => undef,
- Attach => undef,
- LogLevel => 'crit',
-- @_);
--
-+ @_
-+ );
-
-- $RT::Logger->log(level => $args{'LogLevel'},
-+ $RT::Logger->log(
-+ level => $args{'LogLevel'},
- message => $args{'Explanation'}
- );
-- my $entity = MIME::Entity->build( Type =>"multipart/mixed",
-+ my $entity = MIME::Entity->build(
-+ Type => "multipart/mixed",
- From => $args{'From'},
- Bcc => $args{'Bcc'},
- To => $args{'To'},
-@@ -247,7 +252,7 @@
- 'X-RT-Loop-Prevention' => $RT::rtname,
- );
-
-- $entity->attach( Data => $args{'Explanation'}."\n");
-+ $entity->attach( Data => $args{'Explanation'} . "\n" );
-
- my $mimeobj = $args{'MIMEObj'};
- if ($mimeobj) {
-@@ -255,18 +260,20 @@
- $entity->add_part($mimeobj);
- }
-
-- if ($args{'Attach'}) {
-- $entity->attach(Data => $args{'Attach'}, Type => 'message/rfc822');
-+ if ( $args{'Attach'} ) {
-+ $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' );
-
- }
-
-- if ($RT::MailCommand eq 'sendmailpipe') {
-- open (MAIL, "|$RT::SendmailPath $RT::SendmailBounceArguments $RT::SendmailArguments") || return(0);
-+ if ( $RT::MailCommand eq 'sendmailpipe' ) {
-+ open( MAIL,
-+ "|$RT::SendmailPath $RT::SendmailBounceArguments $RT::SendmailArguments"
-+ )
-+ || return (0);
- print MAIL $entity->as_string;
- close(MAIL);
-- }
-- else {
-- $entity->send($RT::MailCommand, $RT::MailParams);
-+ } else {
-+ $entity->send( $RT::MailCommand, $RT::MailParams );
- }
- }
-
-@@ -275,11 +282,11 @@
- # {{{ Create User
-
- sub CreateUser {
-- my ($Username, $Address, $Name, $ErrorsTo, $entity) = @_;
-+ my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
- my $NewUser = RT::User->new($RT::SystemUser);
-
-- my ($Val, $Message) =
-- $NewUser->Create(Name => ($Username || $Address),
-+ my ( $Val, $Message ) = $NewUser->Create(
-+ Name => ( $Username || $Address ),
- EmailAddress => $Address,
- RealName => $Name,
- Password => undef,
-@@ -295,14 +302,16 @@
- $NewUser->LoadByName($Username);
- }
-
-- unless ($NewUser->Id) {
-+ unless ( $NewUser->Id ) {
- $NewUser->LoadByEmail($Address);
- }
-
-- unless ($NewUser->Id) {
-- MailError( To => $ErrorsTo,
-+ unless ( $NewUser->Id ) {
-+ MailError(
-+ To => $ErrorsTo,
- Subject => "User could not be created",
-- Explanation => "User creation failed in mailgateway: $Message",
-+ Explanation =>
-+ "User creation failed in mailgateway: $Message",
- MIMEObj => $entity,
- LogLevel => 'crit'
- );
-@@ -313,11 +322,14 @@
- my $CurrentUser = RT::CurrentUser->new();
- $CurrentUser->LoadByEmail($Address);
-
-- unless ($CurrentUser->id) {
-- $RT::Logger->warning("Couldn't load user '$Address'.". "giving up");
-- MailError( To => $ErrorsTo,
-+ 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",
-+ Explanation =>
-+ "User '$Address' could not be loaded in the mail gateway",
- MIMEObj => $entity,
- LogLevel => 'crit'
- );
-@@ -339,25 +352,28 @@
- =cut
-
- sub ParseCcAddressesFromHead {
-- my %args = ( Head => undef,
-+ my %args = (
-+ Head => undef,
- QueueObj => undef,
- CurrentUser => undef,
-- @_ );
-+ @_
-+ );
-
- my (@Addresses);
-
-- my @ToObjs = Mail::Address->parse($args{'Head'}->get('To'));
-- my @CcObjs = Mail::Address->parse($args{'Head'}->get('Cc'));
-+ my @ToObjs = Mail::Address->parse( $args{'Head'}->get('To') );
-+ my @CcObjs = Mail::Address->parse( $args{'Head'}->get('Cc') );
-
-- foreach my $AddrObj (@ToObjs, @CcObjs) {
-+ foreach my $AddrObj ( @ToObjs, @CcObjs ) {
- my $Address = $AddrObj->address;
-- $Address = $args{'CurrentUser'}->UserObj->CanonicalizeEmailAddress($Address);
-- next if ($args{'CurrentUser'}->EmailAddress =~ /^\Q$Address\E$/i);
-- next if ($args{'QueueObj'}->CorrespondAddress =~ /^\Q$Address\E$/i);
-- next if ($args{'QueueObj'}->CommentAddress =~ /^\Q$Address\E$/i);
-- next if (RT::EmailParser->IsRTAddress($Address));
-+ $Address = $args{'CurrentUser'}
-+ ->UserObj->CanonicalizeEmailAddress($Address);
-+ next if ( $args{'CurrentUser'}->EmailAddress =~ /^\Q$Address\E$/i );
-+ next if ( $args{'QueueObj'}->CorrespondAddress =~ /^\Q$Address\E$/i );
-+ next if ( $args{'QueueObj'}->CommentAddress =~ /^\Q$Address\E$/i );
-+ next if ( RT::EmailParser->IsRTAddress($Address) );
-
-- push (@Addresses, $Address);
-+ push( @Addresses, $Address );
- }
- return (@Addresses);
- }
-@@ -376,12 +391,14 @@
-
- sub ParseSenderAddressFromHead {
- my $head = shift;
-+
- #Figure out who's sending this message.
-- my $From = $head->get('Reply-To') ||
-- $head->get('From') ||
-- $head->get('Sender');
-- return (ParseAddressFromHeader($From));
-+ my $From = $head->get('Reply-To')
-+ || $head->get('From')
-+ || $head->get('Sender');
-+ return ( ParseAddressFromHeader($From) );
- }
-+
- # }}}
-
- # {{{ ParseErrorsToAdddressFromHead
-@@ -396,13 +413,18 @@
-
- sub ParseErrorsToAddressFromHead {
- my $head = shift;
-+
- #Figure out who's sending this message.
-
-- foreach my $header ('Return-path', 'Errors-To' , 'Reply-To', 'From', 'Sender' ) {
-+ foreach my $header ( 'Return-path', 'Errors-To', 'Reply-To', 'From',
-+ 'Sender' )
-+ {
-+
- # If there's a header of that name
- my $headerobj = $head->get($header);
- if ($headerobj) {
-- my ($addr, $name ) = ParseAddressFromHeader($headerobj);
-+ my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
-+
- # If it's got actual useful content...
- return ($addr) if ($addr);
- }
-@@ -418,27 +441,25 @@
-
- =cut
-
--
--sub ParseAddressFromHeader{
-+sub ParseAddressFromHeader {
- my $Addr = shift;
-
-- # Perl 5.8.0 breaks when doing regex matches on utf8
-- Encode::_utf8_off($Addr) if $] == 5.008;
- my @Addresses = Mail::Address->parse($Addr);
-
- my $AddrObj = $Addresses[0];
-
-- unless (ref($AddrObj)) {
-- return(undef,undef);
-+ unless ( ref($AddrObj) ) {
-+ return ( undef, undef );
- }
-
-- my $Name = ($AddrObj->phrase || $AddrObj->comment || $AddrObj->address);
-+ my $Name = ( $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
-
- #Lets take the from and load a user object.
- my $Address = $AddrObj->address;
-
-- return ($Address, $Name);
-+ return ( $Address, $Name );
- }
-+
- # }}}
-
- # {{{ sub ParseTicketId
-@@ -454,8 +474,7 @@
- my $id = $1;
- $RT::Logger->debug("Found a ticket ID. It's $id");
- return ($id);
-- }
-- else {
-+ } else {
- return (undef);
- }
- }
-@@ -501,28 +519,35 @@
-
- sub Gateway {
- my $argsref = shift;
-+ my %args = (
-+ action => 'correspond',
-+ queue => '1',
-+ ticket => undef,
-+ message => undef,
-+ %$argsref
-+ );
-
-- my %args = %$argsref;
--
-- # Set some reasonable defaults
-- $args{'action'} ||= 'correspond';
-- $args{'queue'} ||= '1';
-+ my $SystemTicket;
-+ my $Right;
-
- # Validate the action
-- my ($status, @actions) = IsCorrectAction( $args{'action'} );
-- unless ( $status ) {
--
-- # Can't safely loc this. What object do we loc around?
-- $RT::Logger->crit("Mail gateway called with an invalid action paramenter '".$actions[0]."' for queue '".$args{'queue'}."'");
--
-- return ( -75, "Invalid 'action' parameter", undef );
-+ 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'} );
-+ my $Message = $parser->Entity();
-
-- $parser->SmartParseMIMEEntityFromScalar( Message => $args{'message'});
--
-- if (!$parser->Entity()) {
-+ unless ($Message) {
- MailError(
- To => $RT::OwnerEmail,
- Subject => "RT Bounce: Unparseable message",
-@@ -530,17 +555,13 @@
- Attach => $args{'message'}
- );
-
-- return(0,"Failed to parse this message. Something is likely badly wrong with the message");
-+ return ( 0,
-+ "Failed to parse this message. Something is likely badly wrong with the message"
-+ );
- }
-
-- my $Message = $parser->Entity();
- my $head = $Message->head;
-
-- my ( $CurrentUser, $AuthStat, $error );
--
-- # Initalize AuthStat so comparisons work correctly
-- $AuthStat = -9999999;
--
- my $ErrorsTo = ParseErrorsToAddressFromHead($head);
-
- my $MessageId = $head->get('Message-ID')
-@@ -552,13 +573,12 @@
-
- $args{'ticket'} ||= ParseTicketId($Subject);
-
-- my $SystemTicket;
-- my $Right = 'CreateTicket';
-- if ( $args{'ticket'} ) {
- $SystemTicket = RT::Ticket->new($RT::SystemUser);
-- $SystemTicket->Load( $args{'ticket'} );
-- # if there's an existing ticket, this must be a reply
-+ $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
-+ if ( $SystemTicket->id ) {
- $Right = 'ReplyToTicket';
-+ } else {
-+ $Right = 'CreateTicket';
- }
-
- #Set up a queue object
-@@ -566,42 +586,45 @@
- $SystemQueueObj->Load( $args{'queue'} );
-
- # We can safely have no queue of we have a known-good ticket
-- unless ( $args{'ticket'} || $SystemQueueObj->id ) {
-+ unless ( $SystemTicket->id || $SystemQueueObj->id ) {
- return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
- }
-
-- # Authentication Level
-+ # Authentication Level ($AuthStat)
- # -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
-+ my ( $CurrentUser, $AuthStat, $error );
-+
-+ # Initalize AuthStat so comparisons work correctly
-+ $AuthStat = -9999999;
-
- push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins;
-
-- # Since this needs loading, no matter what
-+ # 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 (@RT::MailPlugins) {
-- my $Code;
-- my $NewAuthStat;
-+ my ($Code, $Class, $NewAuthStat);
- if ( ref($_) eq "CODE" ) {
- $Code = $_;
-- }
-- else {
-- $_ = "RT::Interface::Email::".$_ unless $_ =~ /^RT::Interface::Email::/;
-- eval "require $_;";
-- if ($@) {
-- $RT::Logger->crit("Couldn't load module '$_': $@");
-- next;
-+ } else {
-+ $Class = "RT::Interface::Email::" . $_
-+ unless $_ =~ /^RT::Interface::Email::/;
-+ $Class->require or
-+ do { $RT::Logger->error("Couldn't load $Class: $@"); next };
- }
- no strict 'refs';
-- if ( !defined( $Code = *{ $_ . "::GetCurrentUser" }{CODE} ) ) {
-- $RT::Logger->crit("No GetCurrentUser code found in $_ module");
-+ if ( !defined( $Code = *{ $Class . "::GetCurrentUser" }{CODE} ) ) {
-+ $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
- next;
- }
-- }
-
-- foreach my $action ( @actions ) {
-
-+ foreach my $action (@actions) {
- ( $CurrentUser, $NewAuthStat ) = $Code->(
- Message => $Message,
- RawMessageRef => \$args{'message'},
-@@ -612,14 +635,13 @@
- Queue => $SystemQueueObj
- );
-
--
-- # If a module returns a "-1" then we discard the ticket, so.
-- $AuthStat = -1 if $NewAuthStat == -1;
--
-- # You get the highest level of authentication you were assigned.
-- $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
-+# 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;
- }
-
- last if $AuthStat == -1;
-@@ -624,132 +646,64 @@
-
- last if $AuthStat == -1;
- }
--
- # {{{ If authentication fails and no new user was created, get out.
-- if ( !$CurrentUser or !$CurrentUser->Id or $AuthStat == -1 ) {
-+ if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
-
- # If the plugins refused to create one, they lose.
- unless ( $AuthStat == -1 ) {
--
-- # Notify the RT Admin of the failure.
-- # XXX Should this be configurable?
-- MailError(
-- To => $RT::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 ($ErrorsTo).
--
--You might need to grant 'Everyone' the right '$Right' for the
--queue @{[$args{'queue'}]}.
--
--EOT
-- MIMEObj => $Message,
-- LogLevel => 'error'
-+ _NoAuthorizedUserFound(
-+ Right => $Right,
-+ Message => $Message,
-+ Requestor => $ErrorsTo,
-+ Queue => $args{'queue'}
- );
-
-- # Also notify the requestor that his request has been dropped.
-- MailError(
-- To => $ErrorsTo,
-- 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 => $Message,
-- LogLevel => 'error'
-- );
- }
- return ( 0, "Could not load a valid user", undef );
- }
-
-- # }}}
--
-- # {{{ Lets check for mail loops of various sorts.
-- my $IsBounce = CheckForBounce($head);
--
-- my $IsAutoGenerated = CheckForAutoGenerated($head);
--
-- my $IsSuspiciousSender = CheckForSuspiciousSender($head);
--
-- my $IsALoop = CheckForLoops($head);
--
-- my $SquelchReplies = 0;
--
-- #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 = $RT::OwnerEmail;
-- }
--
-- # }}}
--
-- # {{{ Drop it if it's disallowed
-+ # 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",
-+ Explanation =>
-+ "You do not have permission to communicate with RT",
- MIMEObj => $Message
- );
-- }
--
-- # }}}
-- # {{{ Warn someone if it's a loop
--
-- # Warn someone if it's a loop, before we drop it on the ground
-- if ($IsALoop) {
-- $RT::Logger->crit("RT Recieved mail ($MessageId) from itself.");
--
-- #Should we mail it to RTOwner?
-- if ($RT::LoopsToRTOwner) {
-- MailError(
-- To => $RT::OwnerEmail,
-- Subject => "RT Bounce: $Subject",
-- Explanation => "RT thinks this message may be a bounce",
-- MIMEObj => $Message
-+ return (
-+ 0,
-+ "$ErrorsTo tried to submit a message to "
-+ . $args{'Queue'}
-+ . " without permission.",
-+ undef
- );
- }
-
-- #Do we actually want to store it?
-- return ( 0, "Message Bounced", undef ) unless ($RT::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->add(
-- 'RT-Relocated-Squelch-Replies-To',
-- $head->get('RT-Squelch-Replies-To')
-+ # {{{ Lets check for mail loops of various sorts.
-+ my ($continue, $result);
-+ ( $continue, $ErrorsTo, $result ) = _HandleMachineGeneratedMail(
-+ Message => $Message,
-+ ErrorsTo => $ErrorsTo,
-+ Subject => $Subject,
-+ MessageId => $MessageId
- );
-- $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->add( 'RT-Squelch-Replies-To', $Sender );
-- $head->add( 'RT-DetectedAutoGenerated', 'true' );
-+ unless ($continue) {
-+ return ( 0, $result, undef );
- }
-
-- # }}}
-+ # strip actions we should skip
-+ @actions = grep !$skip_action{$_}, @actions;
-
-- my $Ticket = RT::Ticket->new($CurrentUser);
-+ # if plugin's updated SystemTicket then update arguments
-+ $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
-
-- # {{{ If we don't have a ticket Id, we're creating a new ticket
-- if ( (!$SystemTicket || !$SystemTicket->Id) &&
-- grep /^(comment|correspond)$/, @actions ) {
-+ my $Ticket = RT::Ticket->new($CurrentUser);
-
-- # {{{ Create a new ticket
-+ if (( !$SystemTicket || !$SystemTicket->Id )
-+ && grep /^(comment|correspond)$/, @actions )
-+ {
-
- my @Cc;
- my @Requestors = ( $CurrentUser->id );
-@@ -776,38 +730,39 @@
- Explanation => $ErrStr,
- MIMEObj => $Message
- );
-- $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr ");
-- return ( 0, "Ticket creation failed", $Ticket );
-+ return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
- }
-- # strip comments&corresponds from the actions we don't need record twice
-+
-+# 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;
-
-- # }}}
-- }
-+ } else {
-
- $Ticket->Load( $args{'ticket'} );
- unless ( $Ticket->Id ) {
-- my $message = "Could not find a ticket with id " . $args{'ticket'};
-+ my $error = "Could not find a ticket with id " . $args{'ticket'};
- MailError(
- To => $ErrorsTo,
- Subject => "Message not recorded",
-- Explanation => $message,
-+ Explanation => $error,
- MIMEObj => $Message
- );
-
-- return ( 0, $message );
-+ return ( 0, $error );
-+ }
- }
-
- # }}}
-- foreach my $action( @actions ) {
-+ foreach my $action (@actions) {
-+
- # If the action is comment, add a comment.
-- if ( $action =~ /^(comment|correspond)$/i ) {
-+ if ( $action =~ /^(?:comment|correspond)$/i ) {
- my ( $status, $msg );
- if ( $action =~ /^correspond$/i ) {
-- ( $status, $msg ) = $Ticket->Correspond( MIMEObj => $Message );
-- }
-- else {
-+ ( $status, $msg )
-+ = $Ticket->Correspond( MIMEObj => $Message );
-+ } else {
- ( $status, $msg ) = $Ticket->Comment( MIMEObj => $Message );
- }
- unless ($status) {
-@@ -821,77 +776,196 @@
- );
- return ( 0, "Message not recorded", $Ticket );
- }
-+ } elsif ($RT::UnsafeEmailCommands) {
-+ return _RunUnsafeAction(
-+ Action => $action,
-+ ErrorsTo => $ErrorsTo,
-+ Message => $Message,
-+ Ticket => $Ticket,
-+ CurrentUser => $CurrentUser
-+ );
-+ }
- }
-- elsif ($RT::UnsafeEmailCommands && $action =~ /^take$/i ) {
-- my ( $status, $msg ) = $Ticket->SetOwner( $CurrentUser->id );
-- unless ($status) {
-+ return ( 1, "Success", $Ticket );
-+}
-
-- #Warn the sender that we couldn't actually submit the comment.
-+sub _RunUnsafeAction {
-+ my %args = (
-+ Action => undef,
-+ ErrorsTo => undef,
-+ Message => undef,
-+ Ticket => undef,
-+ CurrentUser => undef,
-+ @_
-+ );
-+
-+ if ( $args{'Action'} =~ /^take$/i ) {
-+ my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
-+ unless ($status) {
- MailError(
-- To => $ErrorsTo,
-+ To => $args{'ErrorsTo'},
- Subject => "Ticket not taken",
- Explanation => $msg,
-- MIMEObj => $Message
-+ MIMEObj => $args{'Message'}
- );
-- return ( 0, "Ticket not taken", $Ticket );
-- }
-+ return ( 0, "Ticket not taken", $args{'Ticket'} );
- }
-- elsif ( $RT::UnsafeEmailCommands && $action =~ /^resolve$/i ) {
-- my ( $status, $msg ) = $Ticket->SetStatus( 'resolved' );
-+ } elsif ( $args{'Action'} =~ /^resolve$/i ) {
-+ my ( $status, $msg ) = $args{'Ticket'}->SetStatus('resolved');
- unless ($status) {
-+
- #Warn the sender that we couldn't actually submit the comment.
- MailError(
-- To => $ErrorsTo,
-+ To => $args{'ErrorsTo'},
- Subject => "Ticket not resolved",
- Explanation => $msg,
-- MIMEObj => $Message
-+ MIMEObj => $args{'Message'}
- );
-- return ( 0, "Ticket not resolved", $Ticket );
-+ return ( 0, "Ticket not resolved", $args{'Ticket'} );
- }
- }
-+ return ( 0, 'Unknown action' );
-+}
-
-- else {
-+=head2 _NoAuthorizedUserFound
-
-- #Return mail to the sender with an error
-+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 => $ErrorsTo,
-- Subject => "RT Configuration error",
-- Explanation => "'"
-- . $args{'action'}
-- . "' not a recognized action."
-- . " Your RT administrator has misconfigured "
-- . "the mail aliases which invoke RT",
-- MIMEObj => $Message
-+ To => $RT::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'
- );
-- $RT::Logger->crit( $args{'action'} . " type unknown for $MessageId" );
-- return (
-- -75,
-- "Configuration error: "
-- . $args{'action'}
-- . " not a recognized action",
-- $Ticket
-+
-+ # Also notify the requestor that his request has been dropped.
-+ 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");
-+
-+=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;
-+
-+ #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 = $RT::OwnerEmail;
- }
-+
-+ # Warn someone if it's a loop, before we drop it on the ground
-+ if ($IsALoop) {
-+ $RT::Logger->crit("RT Recieved mail (".$args{MessageId}.") from itself.");
-+
-+ #Should we mail it to RTOwner?
-+ if ($RT::LoopsToRTOwner) {
-+ MailError(
-+ To => $RT::OwnerEmail,
-+ Subject => "RT Bounce: ".$args{'Subject'},
-+ Explanation => "RT thinks this message may be a bounce",
-+ MIMEObj => $args{Message}
-+ );
- }
-
-- return ( 1, "Success", $Ticket );
-+ #Do we actually want to store it?
-+ return ( 0, $ErrorsTo, "Message Bounced" ) unless ($RT::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->add(
-+ '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->add( 'RT-Squelch-Replies-To', $Sender );
-+ $head->add( 'RT-DetectedAutoGenerated', 'true' );
-+ }
-+ return ( 1, $ErrorsTo, "Handled machine detection" );
- }
-
--sub IsCorrectAction
--{
-+=head2 IsCorrectAction
-+
-+Returns a list of valid actions we've found for this message
-+
-+=cut
-+
-+sub IsCorrectAction {
- my $action = shift;
- my @actions = split /-/, $action;
-- foreach ( @actions ) {
-- return (0, $_) unless /^(?:comment|correspond|take|resolve)$/;
-+ foreach (@actions) {
-+ return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
- }
-- return (1, @actions);
-+ return ( 1, @actions );
- }
-
--
- eval "require RT::Interface::Email_Vendor";
--die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm});
-+die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm} );
- eval "require RT::Interface::Email_Local";
--die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Local.pm});
-+die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Interface/Email_Local.pm} );
-
- 1;
diff --git a/patch/command_by_email-0.1-RT-3.6.0.patch b/patch/command_by_email-0.1-RT-3.6.0.patch
deleted file mode 100644
index f0d3294..0000000
--- a/patch/command_by_email-0.1-RT-3.6.0.patch
+++ /dev/null
@@ -1,1272 +0,0 @@
-=== lib/RT/Interface/Email.pm
-==================================================================
---- lib/RT/Interface/Email.pm (revision 3269)
-+++ lib/RT/Interface/Email.pm (revision 3541)
-@@ -1,38 +1,38 @@
- # BEGIN BPS TAGGED BLOCK {{{
--#
-+#
- # COPYRIGHT:
- #
--# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
-+# This software is Copyright (c) 1996-2006 Best Practical Solutions, LLC
- # <jesse 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., 675 Mass Ave, Cambridge, MA 02139, USA.
--#
--#
-+#
-+#
- # 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
-@@ -41,7 +41,7 @@
- # 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;
-
-@@ -50,31 +50,32 @@
- use MIME::Entity;
- use RT::EmailParser;
- use File::Temp;
-+use UNIVERSAL::require;
-
- BEGIN {
- use Exporter ();
-- use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
--
-+ use vars qw ( @ISA @EXPORT_OK);
-+
- # set the version for version checking
-- $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
--
-- @ISA = qw(Exporter);
--
-+ our $VERSION = 2.0;
-+
-+ @ISA = qw(Exporter);
-+
- # 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);
-+ @EXPORT_OK = qw(
-+ &CreateUser
-+ &GetMessageContent
-+ &CheckForLoops
-+ &CheckForSuspiciousSender
-+ &CheckForAutoGenerated
-+ &CheckForBounce
-+ &MailError
-+ &ParseCcAddressesFromHead
-+ &ParseSenderAddressFromHead
-+ &ParseErrorsToAddressFromHead
-+ &ParseAddressFromHeader
-+ &Gateway);
-
- }
-
-@@ -103,19 +104,18 @@
-
- =cut
-
-+# {{{ sub CheckForLoops
-
--# {{{ sub CheckForLoops
-+sub CheckForLoops {
-+ my $head = shift;
-
--sub CheckForLoops {
-- my $head = shift;
--
- #If this instance of RT sent it our, we don't want to take it in
- my $RTLoop = $head->get("X-RT-Loop-Prevention") || "";
-- chomp ($RTLoop); #remove that newline
-- if ($RTLoop eq "$RT::rtname") {
-- return (1);
-+ chomp($RTLoop); #remove that newline
-+ if ( $RTLoop eq "$RT::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);
-@@ -129,23 +129,24 @@
- 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 (($From =~ /^mailer-daemon\@/i) or
-- ($From =~ /^postmaster\@/i)){
-- return (1);
--
-+ my ( $From, $junk ) = ParseSenderAddressFromHead($head);
-+
-+ if ( ( $From =~ /^mailer-daemon\@/i )
-+ or ( $From =~ /^postmaster\@/i ) )
-+ {
-+ return (1);
-+
- }
--
-+
- return (undef);
-
- }
-@@ -155,15 +156,15 @@
- # {{{ sub CheckForAutoGenerated
- sub CheckForAutoGenerated {
- my $head = shift;
--
-- my $Precedence = $head->get("Precedence") || "" ;
-- if ($Precedence =~ /^(bulk|junk)/i) {
-- return (1);
-+
-+ my $Precedence = $head->get("Precedence") || "";
-+ if ( $Precedence =~ /^(bulk|junk)/i ) {
-+ return (1);
- }
--
-+
- # First Class mailer uses this as a clue.
- my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
-- if ($FCJunk =~ /^true/i) {
-+ if ( $FCJunk =~ /^true/i ) {
- return (1);
- }
-
-@@ -175,9 +176,9 @@
- # {{{ sub CheckForBounce
- sub CheckForBounce {
- my $head = shift;
--
-- my $ReturnPath = $head->get("Return-path") || "" ;
-- return ($ReturnPath =~ /<>/);
-+
-+ my $ReturnPath = $head->get("Return-path") || "";
-+ return ( $ReturnPath =~ /<>/ );
- }
-
- # }}}
-@@ -195,11 +196,12 @@
- sub IsRTAddress {
- my $address = shift || '';
-
-- # Example: the following rule would tell RT not to Cc
-+ # Example: the following rule would tell RT not to Cc
- # "tickets at noc.example.com"
-- if ( defined($RT::RTAddressRegexp) &&
-- $address =~ /$RT::RTAddressRegexp/i ) {
-- return(1);
-+ if ( defined($RT::RTAddressRegexp)
-+ && $address =~ /$RT::RTAddressRegexp/i )
-+ {
-+ return (1);
- } else {
- return (undef);
- }
-@@ -217,57 +219,62 @@
- =cut
-
- sub CullRTAddresses {
-- return (grep { IsRTAddress($_) } @_);
-+ return ( grep { IsRTAddress($_) } @_ );
- }
-
- # }}}
-
--# {{{ sub MailError
-+# {{{ sub MailError
- sub MailError {
-- my %args = (To => $RT::OwnerEmail,
-- Bcc => undef,
-- From => $RT::CorrespondAddress,
-- Subject => 'There has been an error',
-- Explanation => 'Unexplained error',
-- MIMEObj => undef,
-- Attach => undef,
-- LogLevel => 'crit',
-- @_);
-+ my %args = (
-+ To => $RT::OwnerEmail,
-+ Bcc => undef,
-+ From => $RT::CorrespondAddress,
-+ Subject => 'There has been an error',
-+ Explanation => 'Unexplained error',
-+ MIMEObj => undef,
-+ Attach => undef,
-+ LogLevel => 'crit',
-+ @_
-+ );
-
-+ $RT::Logger->log(
-+ level => $args{'LogLevel'},
-+ message => $args{'Explanation'}
-+ );
-+ my $entity = MIME::Entity->build(
-+ Type => "multipart/mixed",
-+ From => $args{'From'},
-+ Bcc => $args{'Bcc'},
-+ To => $args{'To'},
-+ Subject => $args{'Subject'},
-+ Precedence => 'bulk',
-+ 'X-RT-Loop-Prevention' => $RT::rtname,
-+ );
-
-- $RT::Logger->log(level => $args{'LogLevel'},
-- message => $args{'Explanation'}
-- );
-- my $entity = MIME::Entity->build( Type =>"multipart/mixed",
-- From => $args{'From'},
-- Bcc => $args{'Bcc'},
-- To => $args{'To'},
-- Subject => $args{'Subject'},
-- Precedence => 'bulk',
-- 'X-RT-Loop-Prevention' => $RT::rtname,
-- );
-+ $entity->attach( Data => $args{'Explanation'} . "\n" );
-
-- $entity->attach( Data => $args{'Explanation'}."\n");
--
- my $mimeobj = $args{'MIMEObj'};
- if ($mimeobj) {
- $mimeobj->sync_headers();
- $entity->add_part($mimeobj);
- }
--
-- if ($args{'Attach'}) {
-- $entity->attach(Data => $args{'Attach'}, Type => 'message/rfc822');
-
-+ if ( $args{'Attach'} ) {
-+ $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' );
-+
- }
-
-- if ($RT::MailCommand eq 'sendmailpipe') {
-- open (MAIL, "|$RT::SendmailPath $RT::SendmailBounceArguments $RT::SendmailArguments") || return(0);
-+ if ( $RT::MailCommand eq 'sendmailpipe' ) {
-+ open( MAIL,
-+ "|$RT::SendmailPath $RT::SendmailBounceArguments $RT::SendmailArguments"
-+ )
-+ || return (0);
- print MAIL $entity->as_string;
- close(MAIL);
-+ } else {
-+ $entity->send( $RT::MailCommand, $RT::MailParams );
- }
-- else {
-- $entity->send($RT::MailCommand, $RT::MailParams);
-- }
- }
-
- # }}}
-@@ -275,37 +282,39 @@
- # {{{ Create User
-
- sub CreateUser {
-- my ($Username, $Address, $Name, $ErrorsTo, $entity) = @_;
-+ 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'
-- );
--
-+ 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) {
-+
-+ 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'
-- );
-+
-+ unless ( $NewUser->Id ) {
-+ MailError(
-+ To => $ErrorsTo,
-+ Subject => "User could not be created",
-+ Explanation =>
-+ "User creation failed in mailgateway: $Message",
-+ MIMEObj => $entity,
-+ LogLevel => 'crit'
-+ );
- }
- }
-
-@@ -313,21 +322,25 @@
- 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'
-- );
-+ 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;
- }
-+
- # }}}
-
--# {{{ ParseCcAddressesFromHead
-+# {{{ ParseCcAddressesFromHead
-
- =head2 ParseCcAddressesFromHead HASHREF
-
-@@ -337,32 +350,34 @@
- email address and anything that the configuration sub RT::IsRTAddress matches.
-
- =cut
--
-+
- sub ParseCcAddressesFromHead {
-- my %args = ( Head => undef,
-- QueueObj => undef,
-- CurrentUser => undef,
-- @_ );
--
-+ my %args = (
-+ Head => undef,
-+ QueueObj => undef,
-+ CurrentUser => undef,
-+ @_
-+ );
-+
- my (@Addresses);
--
-- my @ToObjs = Mail::Address->parse($args{'Head'}->get('To'));
-- my @CcObjs = Mail::Address->parse($args{'Head'}->get('Cc'));
--
-- foreach my $AddrObj (@ToObjs, @CcObjs) {
-- my $Address = $AddrObj->address;
-- $Address = $args{'CurrentUser'}->UserObj->CanonicalizeEmailAddress($Address);
-- next if ($args{'CurrentUser'}->EmailAddress =~ /^\Q$Address\E$/i);
-- next if ($args{'QueueObj'}->CorrespondAddress =~ /^\Q$Address\E$/i);
-- next if ($args{'QueueObj'}->CommentAddress =~ /^\Q$Address\E$/i);
-- next if (RT::EmailParser->IsRTAddress($Address));
--
-- push (@Addresses, $Address);
-+
-+ my @ToObjs = Mail::Address->parse( $args{'Head'}->get('To') );
-+ my @CcObjs = Mail::Address->parse( $args{'Head'}->get('Cc') );
-+
-+ foreach my $AddrObj ( @ToObjs, @CcObjs ) {
-+ my $Address = $AddrObj->address;
-+ $Address = $args{'CurrentUser'}
-+ ->UserObj->CanonicalizeEmailAddress($Address);
-+ next if ( $args{'CurrentUser'}->EmailAddress =~ /^\Q$Address\E$/i );
-+ next if ( $args{'QueueObj'}->CorrespondAddress =~ /^\Q$Address\E$/i );
-+ next if ( $args{'QueueObj'}->CommentAddress =~ /^\Q$Address\E$/i );
-+ next if ( RT::EmailParser->IsRTAddress($Address) );
-+
-+ push( @Addresses, $Address );
- }
- return (@Addresses);
- }
-
--
- # }}}
-
- # {{{ ParseSenderAdddressFromHead
-@@ -376,12 +391,14 @@
-
- sub ParseSenderAddressFromHead {
- my $head = shift;
-+
- #Figure out who's sending this message.
-- my $From = $head->get('Reply-To') ||
-- $head->get('From') ||
-- $head->get('Sender');
-- return (ParseAddressFromHeader($From));
-+ my $From = $head->get('Reply-To')
-+ || $head->get('From')
-+ || $head->get('Sender');
-+ return ( ParseAddressFromHeader($From) );
- }
-+
- # }}}
-
- # {{{ ParseErrorsToAdddressFromHead
-@@ -396,18 +413,22 @@
-
- sub ParseErrorsToAddressFromHead {
- my $head = shift;
-+
- #Figure out who's sending this message.
-
-- foreach my $header ('Return-path', 'Errors-To' , 'Reply-To', 'From', 'Sender' ) {
-- # If there's a header of that name
-- my $headerobj = $head->get($header);
-- if ($headerobj) {
-- my ($addr, $name ) = ParseAddressFromHeader($headerobj);
-- # If it's got actual useful content...
-- return ($addr) if ($addr);
-- }
-+ foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
-+
-+ # If there's a header of that name
-+ my $headerobj = $head->get($header);
-+ if ($headerobj) {
-+ my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
-+
-+ # If it's got actual useful content...
-+ return ($addr) if ($addr);
-+ }
- }
- }
-+
- # }}}
-
- # {{{ ParseAddressFromHeader
-@@ -418,32 +439,29 @@
-
- =cut
-
-+sub ParseAddressFromHeader {
-+ my $Addr = shift;
-
--sub ParseAddressFromHeader{
-- my $Addr = shift;
--
-- # Perl 5.8.0 breaks when doing regex matches on utf8
-- Encode::_utf8_off($Addr) if $] == 5.008;
- my @Addresses = Mail::Address->parse($Addr);
--
-+
- my $AddrObj = $Addresses[0];
-
-- unless (ref($AddrObj)) {
-- return(undef,undef);
-+ unless ( ref($AddrObj) ) {
-+ return ( undef, undef );
- }
--
-- my $Name = ($AddrObj->phrase || $AddrObj->comment || $AddrObj->address);
--
-+
-+ my $Name = ( $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
-+
- #Lets take the from and load a user object.
- my $Address = $AddrObj->address;
-
-- return ($Address, $Name);
-+ return ( $Address, $Name );
- }
-+
- # }}}
-
--# {{{ sub ParseTicketId
-+# {{{ sub ParseTicketId
-
--
- sub ParseTicketId {
- my $Subject = shift;
- my $id;
-@@ -454,15 +472,13 @@
- my $id = $1;
- $RT::Logger->debug("Found a ticket ID. It's $id");
- return ($id);
-- }
-- else {
-+ } else {
- return (undef);
- }
- }
-
- # }}}
-
--
- =head2 Gateway ARGSREF
-
-
-@@ -501,50 +517,53 @@
-
- sub Gateway {
- my $argsref = shift;
-+ my %args = (
-+ action => 'correspond',
-+ queue => '1',
-+ ticket => undef,
-+ message => undef,
-+ %$argsref
-+ );
-
-- my %args = %$argsref;
-+ my $SystemTicket;
-+ my $Right;
-
-- # Set some reasonable defaults
-- $args{'action'} ||= 'correspond';
-- $args{'queue'} ||= '1';
--
- # Validate the action
-- my ($status, @actions) = IsCorrectAction( $args{'action'} );
-- unless ( $status ) {
--
-- # Can't safely loc this. What object do we loc around?
-- $RT::Logger->crit("Mail gateway called with an invalid action paramenter '".$actions[0]."' for queue '".$args{'queue'}."'");
--
-- return ( -75, "Invalid 'action' parameter", undef );
-+ 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'} );
-+ my $Message = $parser->Entity();
-
-- $parser->SmartParseMIMEEntityFromScalar( Message => $args{'message'});
--
-- if (!$parser->Entity()) {
-+ unless ($Message) {
- MailError(
- To => $RT::OwnerEmail,
- Subject => "RT Bounce: Unparseable message",
- Explanation => "RT couldn't process the message below",
-- Attach => $args{'message'}
-+ Attach => $args{'message'}
- );
-
-- return(0,"Failed to parse this message. Something is likely badly wrong with the message");
-+ return ( 0,
-+ "Failed to parse this message. Something is likely badly wrong with the message"
-+ );
- }
-
-- my $Message = $parser->Entity();
-- my $head = $Message->head;
-+ my $head = $Message->head;
-
-- my ( $CurrentUser, $AuthStat, $error );
--
-- # Initalize AuthStat so comparisons work correctly
-- $AuthStat = -9999999;
--
- my $ErrorsTo = ParseErrorsToAddressFromHead($head);
-
- my $MessageId = $head->get('Message-ID')
-- || "<no-message-id-" . time . rand(2000) . "\@.$RT::Organization>";
-+ || "<no-message-id-" . time . rand(2000) . "\@.$RT::Organization>";
-
- #Pull apart the subject line
- my $Subject = $head->get('Subject') || '';
-@@ -552,13 +571,12 @@
-
- $args{'ticket'} ||= ParseTicketId($Subject);
-
-- my $SystemTicket;
-- my $Right = 'CreateTicket';
-- if ( $args{'ticket'} ) {
-- $SystemTicket = RT::Ticket->new($RT::SystemUser);
-- $SystemTicket->Load( $args{'ticket'} );
-- # if there's an existing ticket, this must be a reply
-- $Right = 'ReplyToTicket';
-+ $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
-@@ -566,191 +584,125 @@
- $SystemQueueObj->Load( $args{'queue'} );
-
- # We can safely have no queue of we have a known-good ticket
-- unless ( $args{'ticket'} || $SystemQueueObj->id ) {
-+ unless ( $SystemTicket->id || $SystemQueueObj->id ) {
- return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
- }
-
-- # Authentication Level
-+ # Authentication Level ($AuthStat)
- # -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
-+ my ( $CurrentUser, $AuthStat, $error );
-
-+ # Initalize AuthStat so comparisons work correctly
-+ $AuthStat = -9999999;
-+
- push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins;
-
-+ # 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 (@RT::MailPlugins) {
-- my $Code;
-- my $NewAuthStat;
-+ my ($Code, $NewAuthStat);
- if ( ref($_) eq "CODE" ) {
- $Code = $_;
-- }
-- else {
-- $_ = "RT::Interface::Email::".$_ unless $_ =~ /^RT::Interface::Email::/;
-- eval "require $_;";
-- if ($@) {
-- $RT::Logger->crit("Couldn't load module '$_': $@");
-- next;
-- }
-+ } else {
-+ my $Class = $_;
-+ $Class = "RT::Interface::Email::" . $Class
-+ unless $Class =~ /^RT::Interface::Email::/;
-+ $Class->require or
-+ do { $RT::Logger->error("Couldn't load $Class: $@"); next };
-+
- no strict 'refs';
-- if ( !defined( $Code = *{ $_ . "::GetCurrentUser" }{CODE} ) ) {
-- $RT::Logger->crit("No GetCurrentUser code found in $_ module");
-+ unless ( defined( $Code = *{ $Class . "::GetCurrentUser" }{CODE} ) ) {
-+ $RT::Logger->crit( "No 'GetCurrentUser' function found in '$Class' module");
- next;
- }
- }
-
-- foreach my $action ( @actions ) {
--
-+ foreach my $action (@actions) {
- ( $CurrentUser, $NewAuthStat ) = $Code->(
-- Message => $Message,
-+ Message => $Message,
- RawMessageRef => \$args{'message'},
-- CurrentUser => $CurrentUser,
-- AuthLevel => $AuthStat,
-- Action => $action,
-- Ticket => $SystemTicket,
-- Queue => $SystemQueueObj
-+ CurrentUser => $CurrentUser,
-+ AuthLevel => $AuthStat,
-+ Action => $action,
-+ Ticket => $SystemTicket,
-+ Queue => $SystemQueueObj
- );
-
-+# 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 );
-
-- # If a module returns a "-1" then we discard the ticket, so.
-- $AuthStat = -1 if $NewAuthStat == -1;
--
-- # You get the highest level of authentication you were assigned.
-- $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
--
- last if $AuthStat == -1;
-- }
-+ $skip_action{$action}++ if $AuthStat == -2;
-+ }
-
- last if $AuthStat == -1;
- }
--
- # {{{ If authentication fails and no new user was created, get out.
-- if ( !$CurrentUser or !$CurrentUser->Id or $AuthStat == -1 ) {
-+ if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
-
- # If the plugins refused to create one, they lose.
- unless ( $AuthStat == -1 ) {
--
-- # Notify the RT Admin of the failure.
-- # XXX Should this be configurable?
-- MailError(
-- To => $RT::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 ($ErrorsTo).
--
--You might need to grant 'Everyone' the right '$Right' for the
--queue @{[$args{'queue'}]}.
--
--EOT
-- MIMEObj => $Message,
-- LogLevel => 'error'
-+ _NoAuthorizedUserFound(
-+ Right => $Right,
-+ Message => $Message,
-+ Requestor => $ErrorsTo,
-+ Queue => $args{'queue'}
- );
-
-- # Also notify the requestor that his request has been dropped.
-- MailError(
-- To => $ErrorsTo,
-- 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 => $Message,
-- LogLevel => 'error'
-- );
- }
- return ( 0, "Could not load a valid user", undef );
- }
-
-- # }}}
--
-- # {{{ Lets check for mail loops of various sorts.
-- my $IsBounce = CheckForBounce($head);
--
-- my $IsAutoGenerated = CheckForAutoGenerated($head);
--
-- my $IsSuspiciousSender = CheckForSuspiciousSender($head);
--
-- my $IsALoop = CheckForLoops($head);
--
-- my $SquelchReplies = 0;
--
-- #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 = $RT::OwnerEmail;
-- }
--
-- # }}}
--
-- # {{{ Drop it if it's disallowed
-+ # 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
-+ Explanation =>
-+ "You do not have permission to communicate with RT",
-+ MIMEObj => $Message
- );
-- }
--
-- # }}}
-- # {{{ Warn someone if it's a loop
--
-- # Warn someone if it's a loop, before we drop it on the ground
-- if ($IsALoop) {
-- $RT::Logger->crit("RT Recieved mail ($MessageId) from itself.");
--
-- #Should we mail it to RTOwner?
-- if ($RT::LoopsToRTOwner) {
-- MailError(
-- To => $RT::OwnerEmail,
-- Subject => "RT Bounce: $Subject",
-- Explanation => "RT thinks this message may be a bounce",
-- MIMEObj => $Message
-- );
-- }
--
-- #Do we actually want to store it?
-- return ( 0, "Message Bounced", undef ) unless ($RT::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->add(
-- 'RT-Relocated-Squelch-Replies-To',
-- $head->get('RT-Squelch-Replies-To')
-+ return (
-+ 0,
-+ "$ErrorsTo tried to submit a message to "
-+ . $args{'Queue'}
-+ . " without permission.",
-+ undef
- );
-- $head->delete('RT-Squelch-Replies-To');
- }
-
-- if ($SquelchReplies) {
-+ # {{{ Lets check for mail loops of various sorts.
-+ my ($continue, $result);
-+ ( $continue, $ErrorsTo, $result ) = _HandleMachineGeneratedMail(
-+ Message => $Message,
-+ ErrorsTo => $ErrorsTo,
-+ Subject => $Subject,
-+ MessageId => $MessageId
-+ );
-
-- # 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->add( 'RT-Squelch-Replies-To', $Sender );
-- $head->add( 'RT-DetectedAutoGenerated', 'true' );
-+ unless ($continue) {
-+ return ( 0, $result, undef );
- }
-+
-+ # strip actions we should skip
-+ @actions = grep !$skip_action{$_}, @actions;
-
-- # }}}
-+ # if plugin's updated SystemTicket then update arguments
-+ $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
-
- my $Ticket = RT::Ticket->new($CurrentUser);
-
-- # {{{ If we don't have a ticket Id, we're creating a new ticket
-- if ( (!$SystemTicket || !$SystemTicket->Id) &&
-- grep /^(comment|correspond)$/, @actions ) {
-+ if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
-+ {
-
-- # {{{ Create a new ticket
--
- my @Cc;
- my @Requestors = ( $CurrentUser->id );
-
-@@ -776,42 +728,39 @@
- Explanation => $ErrStr,
- MIMEObj => $Message
- );
-- $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr ");
-- return ( 0, "Ticket creation failed", $Ticket );
-+ return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
- }
-- # strip comments&corresponds from the actions we don't need record twice
-- @actions = grep !/^(comment|correspond)$/, @actions;
-- $args{'ticket'} = $id;
-
-- # }}}
-- }
-+ # 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;
-
-- $Ticket->Load( $args{'ticket'} );
-- unless ( $Ticket->Id ) {
-- my $message = "Could not find a ticket with id " . $args{'ticket'};
-- MailError(
-- To => $ErrorsTo,
-- Subject => "Message not recorded",
-- Explanation => $message,
-- MIMEObj => $Message
-- );
--
-- return ( 0, $message );
-+ } else {
-+
-+ $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",
-+ Explanation => $error,
-+ MIMEObj => $Message
-+ );
-+
-+ return ( 0, $error );
-+ }
- }
-
- # }}}
-- foreach my $action( @actions ) {
-+ foreach my $action (@actions) {
-+
- # If the action is comment, add a comment.
-- if ( $action =~ /^(comment|correspond)$/i ) {
-- my ( $status, $msg );
-- if ( $action =~ /^correspond$/i ) {
-- ( $status, $msg ) = $Ticket->Correspond( MIMEObj => $Message );
-- }
-- else {
-- ( $status, $msg ) = $Ticket->Comment( MIMEObj => $Message );
-- }
-+ 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,
-@@ -819,79 +768,201 @@
- Explanation => $msg,
- MIMEObj => $Message
- );
-- return ( 0, "Message not recorded", $Ticket );
-+ return ( 0, "Message not recorded: $msg", $Ticket );
- }
-+ } elsif ($RT::UnsafeEmailCommands) {
-+ my ( $status, $msg ) = _RunUnsafeAction(
-+ Action => $action,
-+ ErrorsTo => $ErrorsTo,
-+ Message => $Message,
-+ Ticket => $Ticket,
-+ CurrentUser => $CurrentUser,
-+ );
-+ return ($status, $msg, $Ticket) unless $status == 1;
- }
-- elsif ($RT::UnsafeEmailCommands && $action =~ /^take$/i ) {
-- my ( $status, $msg ) = $Ticket->SetOwner( $CurrentUser->id );
-- unless ($status) {
--
-- #Warn the sender that we couldn't actually submit the comment.
-- MailError(
-- To => $ErrorsTo,
-- Subject => "Ticket not taken",
-- Explanation => $msg,
-- MIMEObj => $Message
-- );
-- return ( 0, "Ticket not taken", $Ticket );
-- }
-+ }
-+ return ( 1, "Success", $Ticket );
-+}
-+
-+sub _RunUnsafeAction {
-+ my %args = (
-+ Action => undef,
-+ ErrorsTo => undef,
-+ Message => undef,
-+ Ticket => undef,
-+ CurrentUser => undef,
-+ @_
-+ );
-+
-+ 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" );
- }
-- elsif ( $RT::UnsafeEmailCommands && $action =~ /^resolve$/i ) {
-- my ( $status, $msg ) = $Ticket->SetStatus( 'resolved' );
-- unless ($status) {
-- #Warn the sender that we couldn't actually submit the comment.
-- MailError(
-- To => $ErrorsTo,
-- Subject => "Ticket not resolved",
-- Explanation => $msg,
-- MIMEObj => $Message
-- );
-- return ( 0, "Ticket not resolved", $Ticket );
-- }
-+ } elsif ( $args{'Action'} =~ /^resolve$/i ) {
-+ my ( $status, $msg ) = $args{'Ticket'}->SetStatus('resolved');
-+ 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" );
- }
--
-- else {
--
-- #Return mail to the sender with an error
-+ } else {
-+ return ( 0, "Not supported unsafe action $args{'Action'}", $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::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.
-+ 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");
-+
-+=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;
-+
-+ #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 = $RT::OwnerEmail;
-+ }
-+
-+ # Warn someone if it's a loop, before we drop it on the ground
-+ if ($IsALoop) {
-+ $RT::Logger->crit("RT Recieved mail (".$args{MessageId}.") from itself.");
-+
-+ #Should we mail it to RTOwner?
-+ if ($RT::LoopsToRTOwner) {
- MailError(
-- To => $ErrorsTo,
-- Subject => "RT Configuration error",
-- Explanation => "'"
-- . $args{'action'}
-- . "' not a recognized action."
-- . " Your RT administrator has misconfigured "
-- . "the mail aliases which invoke RT",
-- MIMEObj => $Message
-+ To => $RT::OwnerEmail,
-+ Subject => "RT Bounce: ".$args{'Subject'},
-+ Explanation => "RT thinks this message may be a bounce",
-+ MIMEObj => $args{Message}
- );
-- $RT::Logger->crit( $args{'action'} . " type unknown for $MessageId" );
-- return (
-- -75,
-- "Configuration error: "
-- . $args{'action'}
-- . " not a recognized action",
-- $Ticket
-- );
--
- }
-+
-+ #Do we actually want to store it?
-+ return ( 0, $ErrorsTo, "Message Bounced" ) unless ($RT::StoreLoops);
- }
-
-- return ( 1, "Success", $Ticket );
-+ # Squelch replies if necessary
-+ # Don't let the user stuff the RT-Squelch-Replies-To header.
-+ if ( $head->get('RT-Squelch-Replies-To') ) {
-+ $head->add(
-+ '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->add( 'RT-Squelch-Replies-To', $Sender );
-+ $head->add( 'RT-DetectedAutoGenerated', 'true' );
-+ }
-+ return ( 1, $ErrorsTo, "Handled machine detection" );
- }
-
--sub IsCorrectAction
--{
-- my $action = shift;
-- my @actions = split /-/, $action;
-- foreach ( @actions ) {
-- return (0, $_) unless /^(?:comment|correspond|take|resolve)$/;
-- }
-- return (1, @actions);
-+=head2 IsCorrectAction
-+
-+Returns a list of valid actions we've found for this message
-+
-+=cut
-+
-+sub IsCorrectAction {
-+ my $action = shift;
-+ my @actions = split /-/, $action;
-+ foreach (@actions) {
-+ return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
-+ }
-+ return ( 1, @actions );
- }
-
--
- eval "require RT::Interface::Email_Vendor";
--die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm});
-+die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm} );
- eval "require RT::Interface::Email_Local";
--die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Local.pm});
-+die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Interface/Email_Local.pm} );
-
- 1;
diff --git a/patch/errors_in_reply_to-RT-3.6.1.patch b/patch/errors_in_reply_to-RT-3.6.1.patch
deleted file mode 100644
index 81fb8ab..0000000
--- a/patch/errors_in_reply_to-RT-3.6.1.patch
+++ /dev/null
@@ -1,12 +0,0 @@
-240a241
-> my $message_id = $args{'MIMEObj'}->head->get('Message-Id');
-244a246,247
-> $RT::Logger->debug("Message-ID: $message_id");
-> # the colons are necessary to make ->build include non-standard headers
-251,252c254,256
-< Precedence => 'bulk',
-< 'X-RT-Loop-Prevention' => $RT::rtname,
----
-> 'Precedence:' => 'bulk',
-> 'X-RT-Loop-Prevention:' => $RT::rtname,
-> 'In-Reply-To:' => $message_id,
commit 1158b2a6fe579981f503cc84bfc594fb8e89f419
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Oct 3 14:18:20 2013 -0400
Releng 0.14
diff --git a/Changes b/Changes
index 8728393..a07436b 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
Revision history for RT-Extension-CommandByMail
+0.14 Thu Oct 3 14:16:17 EDT 2013
+* RT 4.2 compatibility
+* Drop support for RT 3.6
+
0.13 Tue Jul 23 16:37:05 PDT 2013
* Add support for only inspecting headers, not the body
diff --git a/META.yml b/META.yml
index 0184c4a..5df829c 100644
--- a/META.yml
+++ b/META.yml
@@ -27,4 +27,4 @@ requires:
perl: 5.8.3
resources:
license: http://dev.perl.org/licenses/
-version: 0.13
+version: 0.14
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index c9fe996..ac04c79 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.31';
+our $VERSION = '0.32';
use FindBin;
use File::Glob ();
@@ -136,6 +136,7 @@ install ::
$has_etc{acl}++;
}
if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+ if ( -d 'etc/upgrade/' ) { $has_etc{upgrade}++; }
$self->postamble("$postamble\n");
unless ( $subdirs{'lib'} ) {
@@ -164,6 +165,12 @@ install ::
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
+ if ($has_etc{upgrade}) {
+ print "To upgrade from a previous version of this extension, use 'make upgrade-database'\n";
+ my $upgradedb = qq|\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(upgrade \$(NAME) \$(VERSION)))"\n|;
+ $self->postamble("upgrade-database ::\n$upgradedb\n");
+ $self->postamble("upgradedb ::\n$upgradedb\n");
+ }
}
}
@@ -209,4 +216,4 @@ sub requires_rt {
__END__
-#line 329
+#line 336
diff --git a/lib/RT/Extension/CommandByMail.pm b/lib/RT/Extension/CommandByMail.pm
index c3a854f..b89b097 100644
--- a/lib/RT/Extension/CommandByMail.pm
+++ b/lib/RT/Extension/CommandByMail.pm
@@ -1,7 +1,7 @@
use 5.008003;
package RT::Extension::CommandByMail;
-our $VERSION = '0.13';
+our $VERSION = '0.14';
1;
__END__
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list