summaryrefslogtreecommitdiff
path: root/rt/lib/RT/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'rt/lib/RT/Interface')
-rw-r--r--rt/lib/RT/Interface/CLI.pm48
-rwxr-xr-xrt/lib/RT/Interface/Email.pm134
-rwxr-xr-xrt/lib/RT/Interface/Email/Auth/GnuPG.pm12
-rw-r--r--rt/lib/RT/Interface/Email/Auth/MailFrom.pm13
-rw-r--r--rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm97
-rw-r--r--rt/lib/RT/Interface/REST.pm21
-rw-r--r--rt/lib/RT/Interface/Web.pm850
-rw-r--r--rt/lib/RT/Interface/Web/Handler.pm218
-rw-r--r--rt/lib/RT/Interface/Web/Menu.pm259
-rw-r--r--rt/lib/RT/Interface/Web/Menu/Item.pm88
-rwxr-xr-xrt/lib/RT/Interface/Web/QueryBuilder.pm2
-rwxr-xr-xrt/lib/RT/Interface/Web/QueryBuilder/Tree.pm12
-rw-r--r--rt/lib/RT/Interface/Web/Request.pm51
-rw-r--r--rt/lib/RT/Interface/Web/Session.pm2
-rwxr-xr-xrt/lib/RT/Interface/Web/Standalone.pm126
-rw-r--r--rt/lib/RT/Interface/Web/Standalone/PreFork.pm103
16 files changed, 1231 insertions, 805 deletions
diff --git a/rt/lib/RT/Interface/CLI.pm b/rt/lib/RT/Interface/CLI.pm
index fe109d02a..bcdc13cdf 100644
--- a/rt/lib/RT/Interface/CLI.pm
+++ b/rt/lib/RT/Interface/CLI.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -46,25 +46,12 @@
#
# END BPS TAGGED BLOCK }}}
+package RT::Interface::CLI;
use strict;
-
use RT;
-package RT::Interface::CLI;
-
-
-BEGIN {
- use base 'Exporter';
- use vars qw ($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
- # set the version for version checking
- $VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
-
- # your exported package globals go here,
- # as well as any optionally exported functions
- @EXPORT_OK = qw(&CleanEnv
- &GetCurrentUser &GetMessageContent &debug &loc);
-}
+use base 'Exporter';
+our @EXPORT_OK = qw(CleanEnv GetCurrentUser GetMessageContent debug loc);
=head1 NAME
@@ -124,7 +111,6 @@ sub CleanEnv {
my $CurrentUser; # shared betwen GetCurrentUser and loc
-# {{{ sub GetCurrentUser
=head2 GetCurrentUser
@@ -144,7 +130,7 @@ sub GetCurrentUser {
#If the current user is 0, then RT will assume that the User object
#is that of the currentuser.
- $CurrentUser = new RT::CurrentUser();
+ $CurrentUser = RT::CurrentUser->new();
$CurrentUser->LoadByGecos($Gecos);
unless ($CurrentUser->Id) {
@@ -153,10 +139,8 @@ sub GetCurrentUser {
return($CurrentUser);
}
-# }}}
-# {{{ sub loc
=head2 loc
@@ -168,12 +152,10 @@ sub loc {
die "No current user yet" unless $CurrentUser ||= RT::CurrentUser->new;
return $CurrentUser->loc(@_);
}
-# }}}
}
-# {{{ sub GetMessageContent
=head2 GetMessageContent
@@ -200,7 +182,7 @@ sub GetMessageContent {
#Load the sourcefile, if it's been handed to us
if ($source) {
- open( SOURCE, '<', $source ) or die $!;
+ open( SOURCE, '<', $source ) or die $!;
@lines = (<SOURCE>) or die $!;
close (SOURCE) or die $!;
}
@@ -235,9 +217,7 @@ sub GetMessageContent {
}
-# }}}
-# {{{ sub debug
sub debug {
my $val = shift;
@@ -253,8 +233,20 @@ sub debug {
}
}
-# }}}
-
+sub ShowHelp {
+ my $self = shift;
+ my %args = @_;
+ require Pod::Usage;
+ Pod::Usage::pod2usage(
+ -message => $args{'Message'},
+ -exitval => $args{'ExitValue'} || 0,
+ -verbose => 99,
+ -sections => $args{'Sections'} || ($args{'ExitValue'}
+ ? 'NAME|USAGE'
+ : 'NAME|USAGE|OPTIONS|DESCRIPTION'
+ ),
+ );
+}
RT::Base->_ImportOverlays();
diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm
index 9216887cd..b9145d63a 100755
--- a/rt/lib/RT/Interface/Email.pm
+++ b/rt/lib/RT/Interface/Email.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -387,7 +387,7 @@ sub SendEmail {
unless ( $args{'Entity'}->head->get('Date') ) {
require RT::Date;
- my $date = RT::Date->new( $RT::SystemUser );
+ my $date = RT::Date->new( RT->SystemUser );
$date->SetToNow;
$args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) );
}
@@ -406,8 +406,10 @@ sub SendEmail {
my $path = RT->Config->Get('SendmailPath');
my $args = RT->Config->Get('SendmailArguments');
- # SetOutgoingMailFrom
- if ( RT->Config->Get('SetOutgoingMailFrom') ) {
+ # SetOutgoingMailFrom and bounces conflict, since they both want -f
+ if ( $args{'Bounce'} ) {
+ $args .= ' '. RT->Config->Get('SendmailBounceArguments');
+ } elsif ( RT->Config->Get('SetOutgoingMailFrom') ) {
my $OutgoingMailAddress;
if ($TicketObj) {
@@ -427,9 +429,6 @@ sub SendEmail {
if $OutgoingMailAddress;
}
- # Set Bounce Arguments
- $args .= ' '. RT->Config->Get('SendmailBounceArguments') if $args{'Bounce'};
-
# VERP
if ( $TransactionObj and
my $prefix = RT->Config->Get('VERPPrefix') and
@@ -555,7 +554,7 @@ sub PrepareEmailUsingTemplate {
@_
);
- my $template = RT::Template->new( $RT::SystemUser );
+ my $template = RT::Template->new( RT->SystemUser );
$template->LoadGlobalTemplate( $args{'Template'} );
unless ( $template->id ) {
return (undef, "Couldn't load template '". $args{'Template'} ."'");
@@ -583,6 +582,7 @@ sub SendEmailUsingTemplate {
Bcc => undef,
From => RT->Config->Get('CorrespondAddress'),
InReplyTo => undef,
+ ExtraHeaders => {},
@_
);
@@ -598,6 +598,9 @@ sub SendEmailUsingTemplate {
$mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) )
foreach grep defined $args{$_}, qw(To Cc Bcc From);
+ $mail->head->set( $_ => $args{ExtraHeaders}{$_} )
+ foreach keys %{ $args{ExtraHeaders} };
+
SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
return SendEmail( Entity => $mail );
@@ -615,7 +618,19 @@ sub ForwardTransaction {
my $entity = $txn->ContentAsMIME;
- return SendForward( %args, Entity => $entity, Transaction => $txn );
+ my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn );
+ if ($ret) {
+ my $ticket = $txn->TicketObj;
+ my ( $ret, $msg ) = $ticket->_NewTransaction(
+ Type => 'Forward Transaction',
+ Field => $txn->id,
+ Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
+ );
+ unless ($ret) {
+ $RT::Logger->error("Failed to create transaction: $msg");
+ }
+ }
+ return ( $ret, $msg );
}
=head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
@@ -635,13 +650,33 @@ sub ForwardTicket {
) for qw(Create Correspond);
my $entity = MIME::Entity->build(
- Type => 'multipart/mixed',
+ Type => 'multipart/mixed',
+ Description => 'forwarded ticket',
);
$entity->add_part( $_ ) foreach
map $_->ContentAsMIME,
@{ $txns->ItemsArrayRef };
- return SendForward( %args, Entity => $entity, Ticket => $ticket, Template => 'Forward Ticket' );
+ my ( $ret, $msg ) = SendForward(
+ %args,
+ Entity => $entity,
+ Ticket => $ticket,
+ Template => 'Forward Ticket',
+ );
+
+ if ($ret) {
+ my ( $ret, $msg ) = $ticket->_NewTransaction(
+ Type => 'Forward Ticket',
+ Field => $ticket->id,
+ Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
+ );
+ unless ($ret) {
+ $RT::Logger->error("Failed to create transaction: $msg");
+ }
+ }
+
+ return ( $ret, $msg );
+
}
=head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
@@ -704,34 +739,52 @@ sub SendForward {
$mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
foreach grep defined $args{$_}, qw(To Cc Bcc);
- $mail->attach(
- Type => 'message/rfc822',
- Disposition => 'attachment',
- Description => 'forwarded message',
- Data => $entity->as_string,
- );
+ $mail->make_multipart unless $mail->is_multipart;
+ $mail->add_part( $entity );
my $from;
my $subject = '';
$subject = $txn->Subject if $txn;
$subject ||= $ticket->Subject if $ticket;
- if ( RT->Config->Get('ForwardFromUser') ) {
- $from = ($txn || $ticket)->CurrentUser->UserObj->EmailAddress;
- } else {
+
+ unless ( RT->Config->Get('ForwardFromUser') ) {
# XXX: what if want to forward txn of other object than ticket?
$subject = AddSubjectTag( $subject, $ticket );
- $from = $ticket->QueueObj->CorrespondAddress
- || RT->Config->Get('CorrespondAddress');
}
+
$mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
- $mail->head->set( From => EncodeToMIME( String => $from ) );
+ $mail->head->set(
+ From => EncodeToMIME(
+ String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
+ )
+ );
my $status = RT->Config->Get('ForwardFromUser')
# never sign if we forward from User
? SendEmail( %args, Entity => $mail, Sign => 0 )
: SendEmail( %args, Entity => $mail );
return (0, $ticket->loc("Couldn't send email")) unless $status;
- return (1, $ticket->loc("Send email successfully"));
+ return (1, $ticket->loc("Sent email successfully"));
+}
+
+=head2 GetForwardFrom Ticket => undef, Transaction => undef
+
+Resolve the From field to use in forward mail
+
+=cut
+
+sub GetForwardFrom {
+ my %args = ( Ticket => undef, Transaction => undef, @_ );
+ my $txn = $args{Transaction};
+ my $ticket = $args{Ticket} || $txn->Object;
+
+ if ( RT->Config->Get('ForwardFromUser') ) {
+ return ( $txn || $ticket )->CurrentUser->UserObj->EmailAddress;
+ }
+ else {
+ return $ticket->QueueObj->CorrespondAddress
+ || RT->Config->Get('CorrespondAddress');
+ }
}
=head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
@@ -891,7 +944,7 @@ sub EncodeToMIME {
return ($value);
}
- return ($value) unless $value =~ /[^\x20-\x7e]/;
+ return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
$value =~ s/\s+$//;
@@ -920,7 +973,7 @@ sub EncodeToMIME {
sub CreateUser {
my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
- my $NewUser = RT::User->new( $RT::SystemUser );
+ my $NewUser = RT::User->new( RT->SystemUser );
my ( $Val, $Message ) = $NewUser->Create(
Name => ( $Username || $Address ),
@@ -955,7 +1008,7 @@ sub CreateUser {
}
#Load the new user object
- my $CurrentUser = new RT::CurrentUser;
+ my $CurrentUser = RT::CurrentUser->new;
$CurrentUser->LoadByEmail( $Address );
unless ( $CurrentUser->id ) {
@@ -1087,12 +1140,7 @@ sub ParseAddressFromHeader {
return ( undef, undef );
}
- my $Name = ( $AddrObj->name || $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
-
- #Lets take the from and load a user object.
- my $Address = $AddrObj->address;
-
- return ( $Address, $Name );
+ return ( $AddrObj->address, $AddrObj->phrase );
}
=head2 DeleteRecipientsFromHead HEAD RECIPIENTS
@@ -1195,7 +1243,7 @@ sub AddSubjectTag {
my $subject = shift;
my $ticket = shift;
unless ( ref $ticket ) {
- my $tmp = RT::Ticket->new( $RT::SystemUser );
+ my $tmp = RT::Ticket->new( RT->SystemUser );
$tmp->Load( $ticket );
$ticket = $tmp;
}
@@ -1211,7 +1259,7 @@ sub AddSubjectTag {
}
return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
- $subject =~ s/(\r\n|\n|\s)/ /gi;
+ $subject =~ s/(\r\n|\n|\s)/ /g;
chomp $subject;
return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
}
@@ -1263,7 +1311,7 @@ sub _LoadPlugins {
} elsif ( !ref $plugin ) {
my $Class = $plugin;
$Class = "RT::Interface::Email::" . $Class
- unless $Class =~ /^RT::Interface::Email::/;
+ unless $Class =~ /^RT::/;
$Class->require or
do { $RT::Logger->error("Couldn't load $Class: $@"); next };
@@ -1375,7 +1423,7 @@ sub Gateway {
my $Subject = $head->get('Subject') || '';
chomp $Subject;
- # {{{ Lets check for mail loops of various sorts.
+ # Lets check for mail loops of various sorts.
my ($should_store_machine_generated_message, $IsALoop, $result);
( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
_HandleMachineGeneratedMail(
@@ -1394,7 +1442,7 @@ sub Gateway {
$args{'ticket'} ||= ParseTicketId( $Subject );
- $SystemTicket = RT::Ticket->new( $RT::SystemUser );
+ $SystemTicket = RT::Ticket->new( RT->SystemUser );
$SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
if ( $SystemTicket->id ) {
$Right = 'ReplyToTicket';
@@ -1403,7 +1451,7 @@ sub Gateway {
}
#Set up a queue object
- my $SystemQueueObj = RT::Queue->new( $RT::SystemUser );
+ my $SystemQueueObj = RT::Queue->new( RT->SystemUser );
$SystemQueueObj->Load( $args{'queue'} );
# We can safely have no queue of we have a known-good ticket
@@ -1420,7 +1468,7 @@ sub Gateway {
SystemQueue => $SystemQueueObj,
);
- # {{{ If authentication fails and no new user was created, get out.
+ # If authentication fails and no new user was created, get out.
if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
# If the plugins refused to create one, they lose.
@@ -1772,7 +1820,7 @@ sub _HandleMachineGeneratedMail {
# 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(
+ $head->replace(
'RT-Relocated-Squelch-Replies-To',
$head->get('RT-Squelch-Replies-To')
);
@@ -1787,8 +1835,8 @@ sub _HandleMachineGeneratedMail {
# 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' );
+ $head->replace( 'RT-Squelch-Replies-To', $Sender );
+ $head->replace( 'RT-DetectedAutoGenerated', 'true' );
}
return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
}
diff --git a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm
index 6d43b9610..e508908fb 100755
--- a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm
+++ b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -58,7 +58,7 @@ To use the gnupg-secured mail gateway, you need to do the following:
Set up a GnuPG key directory with a pubring containing only the keys
you care about and specify the following in your SiteConfig.pm
- Set(%GnuPGOptions, homedir => '/opt/rt3/var/data/GnuPG');
+ Set(%GnuPGOptions, homedir => '/opt/rt4/var/data/GnuPG');
Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);
=cut
@@ -88,7 +88,7 @@ sub GetCurrentUser {
Entity => $args{'Message'}, AddStatus => 1,
);
if ( $status && !@res ) {
- $args{'Message'}->head->add(
+ $args{'Message'}->head->replace(
'X-RT-Incoming-Encryption' => 'Not encrypted'
);
@@ -112,7 +112,7 @@ sub GetCurrentUser {
Data => ${ $args{'RawMessageRef'} },
);
- $args{'Message'}->head->add( 'X-RT-Privacy' => 'PGP' );
+ $args{'Message'}->head->replace( 'X-RT-Privacy' => 'PGP' );
foreach my $part ( $args{'Message'}->parts_DFS ) {
my $decrypted;
@@ -124,14 +124,14 @@ sub GetCurrentUser {
$decrypted = 1;
}
if ( $_->{Operation} eq 'Verify' && $_->{Status} eq 'DONE' ) {
- $part->head->add(
+ $part->head->replace(
'X-RT-Incoming-Signature' => $_->{UserString}
);
}
}
}
- $part->head->add(
+ $part->head->replace(
'X-RT-Incoming-Encryption' =>
$decrypted ? 'Success' : 'Not encrypted'
);
diff --git a/rt/lib/RT/Interface/Email/Auth/MailFrom.pm b/rt/lib/RT/Interface/Email/Auth/MailFrom.pm
index be2f517e1..e733bdaae 100644
--- a/rt/lib/RT/Interface/Email/Auth/MailFrom.pm
+++ b/rt/lib/RT/Interface/Email/Auth/MailFrom.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -47,10 +47,12 @@
# END BPS TAGGED BLOCK }}}
package RT::Interface::Email::Auth::MailFrom;
-use RT::Interface::Email qw(ParseSenderAddressFromHead CreateUser);
+
use strict;
use warnings;
+use RT::Interface::Email qw(ParseSenderAddressFromHead CreateUser);
+
# This is what the ordinary, non-enhanced gateway does at the moment.
sub GetCurrentUser {
@@ -70,7 +72,7 @@ sub GetCurrentUser {
return ( $args{'CurrentUser'}, -1 );
}
- my $CurrentUser = new RT::CurrentUser;
+ my $CurrentUser = RT::CurrentUser->new;
$CurrentUser->LoadByEmail( $Address );
$CurrentUser->LoadByName( $Address ) unless $CurrentUser->Id;
if ( $CurrentUser->Id ) {
@@ -79,14 +81,13 @@ sub GetCurrentUser {
}
# If the user can't be loaded, we may need to create one. Figure out the acl situation.
- my $unpriv = RT::Group->new( $RT::SystemUser );
- $unpriv->LoadSystemInternalGroup('Unprivileged');
+ my $unpriv = RT->UnprivilegedUsers();
unless ( $unpriv->Id ) {
$RT::Logger->crit("Couldn't find the 'Unprivileged' internal group");
return ( $args{'CurrentUser'}, -1 );
}
- my $everyone = RT::Group->new( $RT::SystemUser );
+ my $everyone = RT::Group->new( RT->SystemUser );
$everyone->LoadSystemInternalGroup('Everyone');
unless ( $everyone->Id ) {
$RT::Logger->crit("Couldn't find the 'Everyone' internal group");
diff --git a/rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm b/rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm
deleted file mode 100644
index 0470e6340..000000000
--- a/rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm
+++ /dev/null
@@ -1,97 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Email::Filter::SpamAssassin;
-use strict;
-use warnings;
-
-use Mail::SpamAssassin;
-my $spamtest = Mail::SpamAssassin->new();
-
-sub GetCurrentUser {
- my %args = (
- Message => undef,
- CurrentUser => undef,
- AuthLevel => undef,
- @_
- );
- my $status = $spamtest->check( $args{'Message'} );
- return ( $args{'CurrentUser'}, $args{'AuthLevel'} )
- unless $status->is_spam();
-
- eval { $status->rewrite_mail() };
- if ( $status->get_hits > $status->get_required_hits() * 1.5 ) {
-
- # Spammy indeed
- return ( $args{'CurrentUser'}, -1 );
- }
- return ( $args{'CurrentUser'}, $args{'AuthLevel'} );
-
-}
-
-=head1 NAME
-
-RT::Interface::Email::Filter::SpamAssassin - Spam filter for RT
-
-=head1 SYNOPSIS
-
- # in RT config
- Set(@MailPlugins, 'Filter::SpamAssassin', ...other filters...);
-
-=head1 DESCRIPTION
-
-This plugin checks to see if an incoming mail is spam (using
-C<spamassassin>) and if so, rewrites its headers. If the mail is very
-definitely spam - 1.5x more hits than required - then it is dropped on
-the floor; otherwise, it is passed on as normal.
-
-=cut
-
-RT::Base->_ImportOverlays();
-
-1;
diff --git a/rt/lib/RT/Interface/REST.pm b/rt/lib/RT/Interface/REST.pm
index 7f6c9ac54..aed8f39a2 100644
--- a/rt/lib/RT/Interface/REST.pm
+++ b/rt/lib/RT/Interface/REST.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -46,22 +46,13 @@
#
# END BPS TAGGED BLOCK }}}
-# lib/RT/Interface/REST.pm
-#
-
package RT::Interface::REST;
use strict;
use warnings;
use RT;
-BEGIN {
- use base 'Exporter';
- use vars qw($VERSION @EXPORT);
-
- $VERSION = do { my @r = (q$Revision: 1.1.1.10 $ =~ /\d+/g); sprintf "%d."."%02d"x$#r, @r };
-
- @EXPORT = qw(expand_list form_parse form_compose vpush vsplit);
-}
+use base 'Exporter';
+our @EXPORT = qw(expand_list form_parse form_compose vpush vsplit);
sub custom_field_spec {
my $self = shift;
@@ -200,7 +191,7 @@ sub form_parse {
# Returns text representing a set of forms.
sub form_compose {
my ($forms) = @_;
- my (@text, $form);
+ my (@text);
foreach my $form (@$forms) {
my ($c, $o, $k, $e) = @$form;
@@ -214,10 +205,10 @@ sub form_compose {
$text .= $e;
}
elsif ($o) {
- my (@lines, $key);
+ my (@lines);
foreach my $key (@$o) {
- my ($line, $sp, $v);
+ my ($line, $sp);
my @values = (ref $k->{$key} eq 'ARRAY') ?
@{ $k->{$key} } :
$k->{$key};
diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm
index e4167e4cc..65cf308b2 100644
--- a/rt/lib/RT/Interface/Web.pm
+++ b/rt/lib/RT/Interface/Web.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -65,11 +65,52 @@ package RT::Interface::Web;
use RT::SavedSearches;
use URI qw();
+use RT::Interface::Web::Menu;
use RT::Interface::Web::Session;
use Digest::MD5 ();
use Encode qw();
+use List::MoreUtils qw();
+use JSON qw();
-# {{{ EscapeUTF8
+=head2 SquishedCSS $style
+
+=cut
+
+my %SQUISHED_CSS;
+sub SquishedCSS {
+ my $style = shift or die "need name";
+ return $SQUISHED_CSS{$style} if $SQUISHED_CSS{$style};
+ require RT::Squish::CSS;
+ my $css = RT::Squish::CSS->new( Style => $style );
+ $SQUISHED_CSS{ $css->Style } = $css;
+ return $css;
+}
+
+=head2 SquishedJS
+
+=cut
+
+my $SQUISHED_JS;
+sub SquishedJS {
+ return $SQUISHED_JS if $SQUISHED_JS;
+
+ require RT::Squish::JS;
+ my $js = RT::Squish::JS->new();
+ $SQUISHED_JS = $js;
+ return $js;
+}
+
+=head2 ClearSquished
+
+Removes the cached CSS and JS entries, forcing them to be regenerated
+on next use.
+
+=cut
+
+sub ClearSquished {
+ undef $SQUISHED_JS;
+ %SQUISHED_CSS = ();
+}
=head2 EscapeUTF8 SCALARREF
@@ -90,9 +131,7 @@ sub EscapeUTF8 {
$$ref =~ s/'/&#39;/g;
}
-# }}}
-# {{{ EscapeURI
=head2 EscapeURI SCALARREF
@@ -108,9 +147,16 @@ sub EscapeURI {
$$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
}
-# }}}
+=head2 EncodeJSON SCALAR
+
+Encodes the SCALAR to JSON and returns a JSON string. SCALAR may be a simple
+value or a reference.
-# {{{ WebCanonicalizeInfo
+=cut
+
+sub EncodeJSON {
+ JSON::to_json(shift, { utf8 => 1, allow_nonref => 1 });
+}
=head2 WebCanonicalizeInfo();
@@ -124,9 +170,7 @@ sub WebCanonicalizeInfo {
return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_USER'};
}
-# }}}
-# {{{ WebExternalAutoInfo
=head2 WebExternalAutoInfo($user);
@@ -163,17 +207,21 @@ sub WebExternalAutoInfo {
return {%user_info};
}
-# }}}
sub HandleRequest {
my $ARGS = shift;
+ if (RT->Config->Get('DevelMode')) {
+ require Module::Refresh;
+ Module::Refresh->refresh;
+ }
+
$HTML::Mason::Commands::r->content_type("text/html; charset=utf-8");
$HTML::Mason::Commands::m->{'rt_base_time'} = [ Time::HiRes::gettimeofday() ];
# Roll back any dangling transactions from a previous failed connection
- $RT::Handle->ForceRollback() if $RT::Handle->TransactionDepth;
+ $RT::Handle->ForceRollback() if $RT::Handle and $RT::Handle->TransactionDepth;
MaybeEnableSQLStatementLog();
@@ -183,6 +231,8 @@ sub HandleRequest {
$HTML::Mason::Commands::m->autoflush( $HTML::Mason::Commands::m->request_comp->attr('AutoFlush') )
if ( $HTML::Mason::Commands::m->request_comp->attr_exists('AutoFlush') );
+ ValidateWebConfig();
+
DecodeARGS($ARGS);
PreprocessTimeUpdates($ARGS);
@@ -243,10 +293,16 @@ sub HandleRequest {
$HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' );
ShowRequestedPage($ARGS);
- LogRecordedSQLStatements();
+ LogRecordedSQLStatements(RequestData => {
+ Path => $HTML::Mason::Commands::m->request_comp->path,
+ });
# Process per-page final cleanup callbacks
$HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Final', CallbackPage => '/autohandler' );
+
+ $HTML::Mason::Commands::m->comp( '/Elements/Footer', %$ARGS )
+ unless $HTML::Mason::Commands::r->content_type
+ =~ qr<^(text|application)/(x-)?(css|javascript)>;
}
sub _ForceLogout {
@@ -449,6 +505,14 @@ sub MaybeRejectPrivateComponentRequest {
return;
}
+sub InitializeMenu {
+ $HTML::Mason::Commands::m->notes('menu', RT::Interface::Web::Menu->new());
+ $HTML::Mason::Commands::m->notes('page-menu', RT::Interface::Web::Menu->new());
+ $HTML::Mason::Commands::m->notes('page-widgets', RT::Interface::Web::Menu->new());
+
+}
+
+
=head2 ShowRequestedPage \%ARGS
This function, called exclusively by RT's autohandler, dispatches
@@ -462,6 +526,11 @@ sub ShowRequestedPage {
my $m = $HTML::Mason::Commands::m;
+ # precache all system level rights for the current user
+ $HTML::Mason::Commands::session{CurrentUser}->PrincipalObj->HasRights( Object => RT->System );
+
+ InitializeMenu();
+
SendSessionCookie();
# If the user isn't privileged, they can only see SelfService
@@ -509,6 +578,7 @@ sub AttemptExternalAuth {
$user =~ s/^\Q$NodeName\E\\//i;
}
+ my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''};
InstantiateNewSession() unless _UserLoggedIn;
$HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
$HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user);
@@ -516,7 +586,7 @@ sub AttemptExternalAuth {
if ( RT->Config->Get('WebExternalAuto') and not _UserLoggedIn() ) {
# Create users on-the-fly
- my $UserObj = RT::User->new($RT::SystemUser);
+ my $UserObj = RT::User->new(RT->SystemUser);
my ( $val, $msg ) = $UserObj->Create(
%{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} },
Name => $user,
@@ -556,6 +626,15 @@ sub AttemptExternalAuth {
if ( _UserLoggedIn() ) {
$m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' );
+ # It is possible that we did a redirect to the login page,
+ # if the external auth allows lack of auth through with no
+ # REMOTE_USER set, instead of forcing a "permission
+ # denied" message. Honor the $next.
+ Redirect($next) if $next;
+ # Unlike AttemptPasswordAuthentication below, we do not
+ # force a redirect to / if $next is not set -- otherwise,
+ # straight-up external auth would always redirect to /
+ # when you first hit it.
} else {
delete $HTML::Mason::Commands::session{'CurrentUser'};
$user = $orig_user;
@@ -696,7 +775,7 @@ sub Redirect {
# If the user is coming in via a non-canonical
# hostname, don't redirect them to the canonical host,
# it will just upset them (and invalidate their credentials)
- # don't do this if $RT::CanoniaclRedirectURLs is true
+ # don't do this if $RT::CanonicalizeRedirectURLs is true
if ( !RT->Config->Get('CanonicalizeRedirectURLs')
&& $uri->host eq $server_uri->host
&& $uri->port eq $server_uri->port )
@@ -708,7 +787,7 @@ sub Redirect {
}
# [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST
- $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} );
+ $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'});
$uri->port( $ENV{'SERVER_PORT'} );
}
@@ -733,7 +812,7 @@ This routine could really use _accurate_ heuristics. (XXX TODO)
=cut
sub StaticFileHeaders {
- my $date = RT::Date->new($RT::SystemUser);
+ my $date = RT::Date->new(RT->SystemUser);
# make cache public
$HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
@@ -834,13 +913,6 @@ sub SendStaticFile {
}
$type ||= "application/octet-stream";
}
-
- # CGI.pm version 3.51 and 3.52 bang charset=iso-8859-1 onto our JS
- # since we don't specify a charset
- if ( $type =~ m{application/javascript} &&
- $type !~ m{charset=([\w-]+)$} ) {
- $type .= "; charset=utf-8";
- }
$HTML::Mason::Commands::r->content_type($type);
open( my $fh, '<', $file ) or die "couldn't open file: $!";
binmode($fh);
@@ -852,6 +924,21 @@ sub SendStaticFile {
close $fh;
}
+
+
+sub MobileClient {
+ my $self = shift;
+
+
+if (($ENV{'HTTP_USER_AGENT'} || '') =~ /(?:hiptop|Blazer|Novarra|Vagabond|SonyEricsson|Symbian|NetFront|UP.Browser|UP.Link|Windows CE|MIDP|J2ME|DoCoMo|J-PHONE|PalmOS|PalmSource|iPhone|iPod|AvantGo|Nokia|Android|WebOS|S60)/io && !$HTML::Mason::Commands::session{'NotMobile'}) {
+ return 1;
+} else {
+ return undef;
+}
+
+}
+
+
sub StripContent {
my %args = @_;
my $content = $args{Content};
@@ -887,15 +974,14 @@ sub StripContent {
return '' if not $html and $content =~ /^(--)?\Q$sig\E$/;
# Check for html-formatted sig; we don't use EscapeUTF8 here
- # because we want to precisely match the escaping that FCKEditor
- # uses. see also 311223f5, which fixed this for 4.0
+ # because we want to precisely match the escapting that FCKEditor
+ # uses.
$sig =~ s/&/&amp;/g;
$sig =~ s/</&lt;/g;
$sig =~ s/>/&gt;/g;
-
- return ''
- if $html
- and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s;
+ $sig =~ s/"/&quot;/g;
+ $sig =~ s/'/&#39;/g;
+ return '' if $html and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s;
# Pass it through
return $return_content;
@@ -963,12 +1049,20 @@ sub MaybeEnableSQLStatementLog {
}
sub LogRecordedSQLStatements {
+ my %args = @_;
+
my $log_sql_statements = RT->Config->Get('StatementLog');
return unless ($log_sql_statements);
my @log = $RT::Handle->SQLStatementLog;
$RT::Handle->ClearSQLStatementLog;
+
+ $RT::Handle->AddRequestToHistory({
+ %{ $args{RequestData} },
+ Queries => \@log,
+ });
+
for my $stmt (@log) {
my ( $time, $sql, $bind, $duration ) = @{$stmt};
my @bind;
@@ -984,17 +1078,77 @@ sub LogRecordedSQLStatements {
message => "SQL("
. sprintf( "%.6f", $duration )
. "s): $sql;"
- . ( @bind ? " [ bound values: @{[map{qq|'$_'|} @bind]} ]" : "" )
+ . ( @bind ? " [ bound values: @{[map{ defined $_ ? qq|'$_'| : 'undef'} @bind]} ]" : "" )
);
}
}
+my $_has_validated_web_config = 0;
+sub ValidateWebConfig {
+ my $self = shift;
+
+ # do this once per server instance, not once per request
+ return if $_has_validated_web_config;
+ $_has_validated_web_config = 1;
+
+ if (!$ENV{'rt.explicit_port'} && $ENV{SERVER_PORT} != RT->Config->Get('WebPort')) {
+ $RT::Logger->warn("The actual SERVER_PORT ($ENV{SERVER_PORT}) does NOT match the configured WebPort ($RT::WebPort). Perhaps you should Set(\$WebPort, $ENV{SERVER_PORT}); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+ }
+
+ if ($ENV{HTTP_HOST}) {
+ # match "example.com" or "example.com:80"
+ my ($host) = $ENV{HTTP_HOST} =~ /^(.*?)(:\d+)?$/;
+
+ if ($host ne RT->Config->Get('WebDomain')) {
+ $RT::Logger->warn("The actual HTTP_HOST ($host) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+ }
+ }
+ else {
+ if ($ENV{SERVER_NAME} ne RT->Config->Get('WebDomain')) {
+ $RT::Logger->warn("The actual SERVER_NAME ($ENV{SERVER_NAME}) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$ENV{SERVER_NAME}'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+ }
+ }
+
+ if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath')) {
+ $RT::Logger->warn("The actual SCRIPT_NAME ($ENV{SCRIPT_NAME}) does NOT match the configured WebPath ($RT::WebPath). Perhaps you should Set(\$WebPath, '$ENV{SCRIPT_NAME}'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+ }
+}
+
+sub ComponentRoots {
+ my $self = shift;
+ my %args = ( Names => 0, @_ );
+ my @roots;
+ if (defined $HTML::Mason::Commands::m) {
+ @roots = $HTML::Mason::Commands::m->interp->comp_root_array;
+ } else {
+ @roots = (
+ [ local => $RT::MasonLocalComponentRoot ],
+ (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}),
+ [ standard => $RT::MasonComponentRoot ]
+ );
+ }
+ @roots = map { $_->[1] } @roots unless $args{Names};
+ return @roots;
+}
+
package HTML::Mason::Commands;
use vars qw/$r $m %session/;
-# {{{ loc
+sub Menu {
+ return $HTML::Mason::Commands::m->notes('menu');
+}
+
+sub PageMenu {
+ return $HTML::Mason::Commands::m->notes('page-menu');
+}
+
+sub PageWidgets {
+ return $HTML::Mason::Commands::m->notes('page-widgets');
+}
+
+
=head2 loc ARRAY
@@ -1025,9 +1179,7 @@ sub loc {
}
}
-# }}}
-# {{{ loc_fuzzy
=head2 loc_fuzzy STRING
@@ -1047,14 +1199,12 @@ sub loc_fuzzy {
{
return ( $session{'CurrentUser'}->loc_fuzzy($msg) );
} else {
- my $u = RT::CurrentUser->new( $RT::SystemUser->Id );
+ my $u = RT::CurrentUser->new( RT->SystemUser->Id );
return ( $u->loc_fuzzy($msg) );
}
}
-# }}}
-# {{{ sub Abort
# Error - calls Error and aborts
sub Abort {
my $why = shift;
@@ -1072,9 +1222,79 @@ sub Abort {
}
}
-# }}}
+sub MaybeRedirectForResults {
+ my %args = (
+ Path => $HTML::Mason::Commands::m->request_comp->path,
+ Arguments => {},
+ Anchor => undef,
+ Actions => undef,
+ Force => 0,
+ @_
+ );
+ my $has_actions = $args{'Actions'} && grep( defined, @{ $args{'Actions'} } );
+ return unless $has_actions || $args{'Force'};
+
+ my %arguments = %{ $args{'Arguments'} };
+
+ if ( $has_actions ) {
+ my $key = Digest::MD5::md5_hex( rand(1024) );
+ push @{ $session{"Actions"}{ $key } ||= [] }, @{ $args{'Actions'} };
+ $session{'i'}++;
+ $arguments{'results'} = $key;
+ }
+
+ $args{'Path'} =~ s!^/+!!;
+ my $url = RT->Config->Get('WebURL') . $args{Path};
+
+ if ( keys %arguments ) {
+ $url .= '?'. $m->comp( '/Elements/QueryString', %arguments );
+ }
+ if ( $args{'Anchor'} ) {
+ $url .= "#". $args{'Anchor'};
+ }
+ return RT::Interface::Web::Redirect($url);
+}
+
+=head2 MaybeRedirectToApproval Path => 'path', Whitelist => REGEX, ARGSRef => HASHREF
+
+If the ticket specified by C<< $ARGSRef->{id} >> is an approval ticket,
+redirect to the approvals display page, preserving any arguments.
+
+C<Path>s matching C<Whitelist> are let through.
+
+This is a no-op if the C<ForceApprovalsView> option isn't enabled.
-# {{{ sub CreateTicket
+=cut
+
+sub MaybeRedirectToApproval {
+ my %args = (
+ Path => $HTML::Mason::Commands::m->request_comp->path,
+ ARGSRef => {},
+ Whitelist => undef,
+ @_
+ );
+
+ return unless $ENV{REQUEST_METHOD} eq 'GET';
+
+ my $id = $args{ARGSRef}->{id};
+
+ if ( $id
+ and RT->Config->Get('ForceApprovalsView')
+ and not $args{Path} =~ /$args{Whitelist}/)
+ {
+ my $ticket = RT::Ticket->new( $session{'CurrentUser'} );
+ $ticket->Load($id);
+
+ if ($ticket and $ticket->id and lc($ticket->Type) eq 'approval') {
+ MaybeRedirectForResults(
+ Path => "/Approvals/Display.html",
+ Force => 1,
+ Anchor => $args{ARGSRef}->{Anchor},
+ Arguments => $args{ARGSRef},
+ );
+ }
+ }
+}
=head2 CreateTicket ARGS
@@ -1087,9 +1307,9 @@ sub CreateTicket {
my (@Actions);
- my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
+ my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
- my $Queue = new RT::Queue( $session{'CurrentUser'} );
+ my $Queue = RT::Queue->new( $session{'CurrentUser'} );
unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
Abort('Queue not found');
}
@@ -1100,12 +1320,12 @@ sub CreateTicket {
my $due;
if ( defined $ARGS{'Due'} and $ARGS{'Due'} =~ /\S/ ) {
- $due = new RT::Date( $session{'CurrentUser'} );
+ $due = RT::Date->new( $session{'CurrentUser'} );
$due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
}
my $starts;
if ( defined $ARGS{'Starts'} and $ARGS{'Starts'} =~ /\S/ ) {
- $starts = new RT::Date( $session{'CurrentUser'} );
+ $starts = RT::Date->new( $session{'CurrentUser'} );
$starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
}
@@ -1139,9 +1359,8 @@ sub CreateTicket {
}
foreach my $argument (qw(Encrypt Sign)) {
- $MIMEObj->head->add(
- "X-RT-$argument" => Encode::encode_utf8( $ARGS{$argument} )
- ) if defined $ARGS{$argument};
+ $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 )
+ if defined $ARGS{$argument};
}
my %create_args = (
@@ -1165,17 +1384,13 @@ sub CreateTicket {
MIMEObj => $MIMEObj
);
- my @temp_squelch;
+ my @txn_squelch;
foreach my $type (qw(Requestor Cc AdminCc)) {
- push @temp_squelch, map $_->address, Email::Address->parse( $create_args{$type} )
+ push @txn_squelch, map $_->address, Email::Address->parse( $create_args{$type} )
if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] };
-
- }
-
- if (@temp_squelch) {
- require RT::Action::SendEmail;
- RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
}
+ $create_args{TransSquelchMailTo} = \@txn_squelch
+ if @txn_squelch;
if ( $ARGS{'AttachTickets'} ) {
require RT::Action::SendEmail;
@@ -1259,9 +1474,7 @@ sub CreateTicket {
}
-# }}}
-# {{{ sub LoadTicket - loads a ticket
=head2 LoadTicket id
@@ -1291,9 +1504,7 @@ sub LoadTicket {
return $Ticket;
}
-# }}}
-# {{{ sub ProcessUpdateMessage
=head2 ProcessUpdateMessage
@@ -1341,7 +1552,7 @@ sub ProcessUpdateMessage {
return;
}
- if ( $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject ) {
+ if ( $args{ARGSRef}->{'UpdateSubject'} eq ($args{'TicketObj'}->Subject || '') ) {
$args{ARGSRef}->{'UpdateSubject'} = undef;
}
@@ -1351,7 +1562,7 @@ sub ProcessUpdateMessage {
Type => $args{ARGSRef}->{'UpdateContentType'},
);
- $Message->head->add( 'Message-ID' => Encode::encode_utf8(
+ $Message->head->replace( 'Message-ID' => Encode::encode_utf8(
RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
) );
my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
@@ -1381,9 +1592,6 @@ sub ProcessUpdateMessage {
: ( $args{ARGSRef}->{'AttachTickets'} ) );
}
- my $bcc = $args{ARGSRef}->{'UpdateBcc'};
- my $cc = $args{ARGSRef}->{'UpdateCc'};
-
my %txn_customfields;
foreach my $key ( keys %{ $args{ARGSRef} } ) {
@@ -1393,70 +1601,83 @@ sub ProcessUpdateMessage {
}
my %message_args = (
- CcMessageTo => $cc,
- BccMessageTo => $bcc,
- Sign => $args{ARGSRef}->{'Sign'},
- Encrypt => $args{ARGSRef}->{'Encrypt'},
+ Sign => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ),
+ Encrypt => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ),
MIMEObj => $Message,
TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'},
CustomFields => \%txn_customfields,
);
- my @temp_squelch;
+ _ProcessUpdateMessageRecipients(
+ MessageArgs => \%message_args,
+ %args,
+ );
+
+ my @results;
+ if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
+ my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args);
+ push( @results, $Description );
+ $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
+ } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
+ my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args);
+ push( @results, $Description );
+ $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
+ } else {
+ push( @results,
+ loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
+ }
+ return @results;
+}
+
+sub _ProcessUpdateMessageRecipients {
+ my %args = (
+ ARGSRef => undef,
+ TicketObj => undef,
+ MessageArgs => undef,
+ @_,
+ );
+
+ my $bcc = $args{ARGSRef}->{'UpdateBcc'};
+ my $cc = $args{ARGSRef}->{'UpdateCc'};
+
+ my $message_args = $args{MessageArgs};
+
+ $message_args->{CcMessageTo} = $cc;
+ $message_args->{BccMessageTo} = $bcc;
+
+ my @txn_squelch;
foreach my $type (qw(Cc AdminCc)) {
if (grep $_ eq $type || $_ eq ( $type . 's' ), @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
- push @temp_squelch, map $_->address, Email::Address->parse( $message_args{$type} );
- push @temp_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
- push @temp_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
+ push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{$type} );
+ push @txn_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
+ push @txn_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
}
}
if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
- push @temp_squelch, map $_->address, Email::Address->parse( $message_args{Requestor} );
- push @temp_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
- }
+ push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} );
+ push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
- if (@temp_squelch) {
- require RT::Action::SendEmail;
- RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
}
+ push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo};
+ $message_args->{SquelchMailTo} = \@txn_squelch
+ if @txn_squelch;
+
unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) {
foreach my $key ( keys %{ $args{ARGSRef} } ) {
next unless $key =~ /^Update(Cc|Bcc)-(.*)$/;
my $var = ucfirst($1) . 'MessageTo';
my $value = $2;
- if ( $message_args{$var} ) {
- $message_args{$var} .= ", $value";
+ if ( $message_args->{$var} ) {
+ $message_args->{$var} .= ", $value";
} else {
- $message_args{$var} = $value;
+ $message_args->{$var} = $value;
}
}
}
-
- my @results;
- # Do the update via the appropriate Ticket method
- if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
- my ( $Transaction, $Description, $Object ) =
- $args{TicketObj}->Comment(%message_args);
- push( @results, $Description );
- #$Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
- } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
- my ( $Transaction, $Description, $Object ) =
- $args{TicketObj}->Correspond(%message_args);
- push( @results, $Description );
- #$Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
- } else {
- push( @results,
- loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
- }
- return @results;
}
-# }}}
-
-# {{{ sub MakeMIMEEntity
-
=head2 MakeMIMEEntity PARAMHASH
Takes a paramhash Subject, Body and AttachmentFieldName.
@@ -1481,6 +1702,7 @@ sub MakeMIMEEntity {
);
my $Message = MIME::Entity->build(
Type => 'multipart/mixed',
+ "Message-Id" => RT::Interface::Email::GenMessageId,
map { $_ => Encode::encode_utf8( $args{ $_} ) }
grep defined $args{$_}, qw(Subject From Cc)
);
@@ -1500,8 +1722,8 @@ sub MakeMIMEEntity {
if ( $args{'AttachmentFieldName'} ) {
my $cgi_object = $m->cgi_object;
-
- if ( my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
+ my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} );
+ if ( defined $filehandle && length $filehandle ) {
my ( @content, $buffer );
while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
@@ -1510,10 +1732,7 @@ sub MakeMIMEEntity {
my $uploadinfo = $cgi_object->uploadInfo($filehandle);
- # Prefer the cached name first over CGI.pm stringification.
- my $filename = $RT::Mason::CGI::Filename;
- $filename = "$filehandle" unless defined $filename;
- $filename = Encode::encode_utf8( $filename );
+ my $filename = "$filehandle";
$filename =~ s{^.*[\\/]}{};
$Message->attach(
@@ -1524,6 +1743,9 @@ sub MakeMIMEEntity {
if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) {
$Message->head->set( 'Subject' => $filename );
}
+
+ # Attachment parts really shouldn't get a Message-ID
+ $Message->head->delete('Message-ID');
}
}
@@ -1535,9 +1757,7 @@ sub MakeMIMEEntity {
}
-# }}}
-# {{{ sub ParseDateToISO
=head2 ParseDateToISO
@@ -1557,9 +1777,7 @@ sub ParseDateToISO {
return ( $date_obj->ISO );
}
-# }}}
-# {{{ sub ProcessACLChanges
sub ProcessACLChanges {
my $ARGSref = shift;
@@ -1608,9 +1826,145 @@ sub ProcessACLChanges {
return (@results);
}
-# }}}
-# {{{ sub UpdateRecordObj
+=head2 ProcessACLs
+
+ProcessACLs expects values from a series of checkboxes that describe the full
+set of rights a principal should have on an object.
+
+It expects form inputs with names like SetRights-PrincipalId-ObjType-ObjId
+instead of with the prefixes Grant/RevokeRight. Each input should be an array
+listing the rights the principal should have, and ProcessACLs will modify the
+current rights to match. Additionally, the previously unused CheckACL input
+listing PrincipalId-ObjType-ObjId is now used to catch cases when all the
+rights are removed from a principal and as such no SetRights input is
+submitted.
+
+=cut
+
+sub ProcessACLs {
+ my $ARGSref = shift;
+ my (%state, @results);
+
+ my $CheckACL = $ARGSref->{'CheckACL'};
+ my @check = grep { defined } (ref $CheckACL eq 'ARRAY' ? @$CheckACL : $CheckACL);
+
+ # Check if we want to grant rights to a previously rights-less user
+ for my $type (qw(user group)) {
+ my $key = "AddPrincipalForRights-$type";
+
+ next unless $ARGSref->{$key};
+
+ my $principal;
+ if ( $type eq 'user' ) {
+ $principal = RT::User->new( $session{'CurrentUser'} );
+ $principal->LoadByCol( Name => $ARGSref->{$key} );
+ }
+ else {
+ $principal = RT::Group->new( $session{'CurrentUser'} );
+ $principal->LoadUserDefinedGroup( $ARGSref->{$key} );
+ }
+
+ unless ($principal->PrincipalId) {
+ push @results, loc("Couldn't load the specified principal");
+ next;
+ }
+
+ my $principal_id = $principal->PrincipalId;
+
+ # Turn our addprincipal rights spec into a real one
+ for my $arg (keys %$ARGSref) {
+ next unless $arg =~ /^SetRights-addprincipal-(.+?-\d+)$/;
+
+ my $tuple = "$principal_id-$1";
+ my $key = "SetRights-$tuple";
+
+ # If we have it already, that's odd, but merge them
+ if (grep { $_ eq $tuple } @check) {
+ $ARGSref->{$key} = [
+ (ref $ARGSref->{$key} eq 'ARRAY' ? @{$ARGSref->{$key}} : $ARGSref->{$key}),
+ (ref $ARGSref->{$arg} eq 'ARRAY' ? @{$ARGSref->{$arg}} : $ARGSref->{$arg}),
+ ];
+ } else {
+ $ARGSref->{$key} = $ARGSref->{$arg};
+ push @check, $tuple;
+ }
+ }
+ }
+
+ # Build our rights state for each Principal-Object tuple
+ foreach my $arg ( keys %$ARGSref ) {
+ next unless $arg =~ /^SetRights-(\d+-.+?-\d+)$/;
+
+ my $tuple = $1;
+ my $value = $ARGSref->{$arg};
+ my @rights = grep { $_ } (ref $value eq 'ARRAY' ? @$value : $value);
+ next unless @rights;
+
+ $state{$tuple} = { map { $_ => 1 } @rights };
+ }
+
+ foreach my $tuple (List::MoreUtils::uniq @check) {
+ next unless $tuple =~ /^(\d+)-(.+?)-(\d+)$/;
+
+ my ( $principal_id, $object_type, $object_id ) = ( $1, $2, $3 );
+
+ my $principal = RT::Principal->new( $session{'CurrentUser'} );
+ $principal->Load($principal_id);
+
+ my $obj;
+ if ( $object_type eq 'RT::System' ) {
+ $obj = $RT::System;
+ } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) {
+ $obj = $object_type->new( $session{'CurrentUser'} );
+ $obj->Load($object_id);
+ unless ( $obj->id ) {
+ $RT::Logger->error("couldn't load $object_type #$object_id");
+ next;
+ }
+ } else {
+ $RT::Logger->error("object type '$object_type' is incorrect");
+ push( @results, loc("System Error") . ': ' . loc( "Rights could not be granted for [_1]", $object_type ) );
+ next;
+ }
+
+ my $acls = RT::ACL->new($session{'CurrentUser'});
+ $acls->LimitToObject( $obj );
+ $acls->LimitToPrincipal( Id => $principal_id );
+
+ while ( my $ace = $acls->Next ) {
+ my $right = $ace->RightName;
+
+ # Has right and should have right
+ next if delete $state{$tuple}->{$right};
+
+ # Has right and shouldn't have right
+ my ($val, $msg) = $principal->RevokeRight( Object => $obj, Right => $right );
+ push @results, $msg;
+ }
+
+ # For everything left, they don't have the right but they should
+ for my $right (keys %{ $state{$tuple} || {} }) {
+ delete $state{$tuple}->{$right};
+ my ($val, $msg) = $principal->GrantRight( Object => $obj, Right => $right );
+ push @results, $msg;
+ }
+
+ # Check our state for leftovers
+ if ( keys %{ $state{$tuple} || {} } ) {
+ my $missed = join '|', %{$state{$tuple} || {}};
+ $RT::Logger->warn(
+ "Uh-oh, it looks like we somehow missed a right in "
+ ."ProcessACLs. Here's what was leftover: $missed"
+ );
+ }
+ }
+
+ return (@results);
+}
+
+
+
=head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
@@ -1639,9 +1993,7 @@ sub UpdateRecordObject {
return (@results);
}
-# }}}
-# {{{ Sub ProcessCustomFieldUpdates
sub ProcessCustomFieldUpdates {
my %args = (
@@ -1694,9 +2046,7 @@ sub ProcessCustomFieldUpdates {
return (@results);
}
-# }}}
-# {{{ sub ProcessTicketBasics
=head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
@@ -1715,7 +2065,9 @@ sub ProcessTicketBasics {
my $TicketObj = $args{'TicketObj'};
my $ARGSRef = $args{'ARGSRef'};
- # {{{ Set basic fields
+ my $OrigOwner = $TicketObj->Owner;
+
+ # Set basic fields
my @attribs = qw(
Subject
FinalPriority
@@ -1728,11 +2080,15 @@ sub ProcessTicketBasics {
Queue
);
- if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
- my $tempqueue = RT::Queue->new($RT::SystemUser);
- $tempqueue->Load( $ARGSRef->{'Queue'} );
- if ( $tempqueue->id ) {
- $ARGSRef->{'Queue'} = $tempqueue->id;
+ # Canonicalize Queue and Owner to their IDs if they aren't numeric
+ for my $field (qw(Queue Owner)) {
+ if ( $ARGSRef->{$field} and ( $ARGSRef->{$field} !~ /^(\d+)$/ ) ) {
+ my $class = $field eq 'Owner' ? "RT::User" : "RT::$field";
+ my $temp = $class->new(RT->SystemUser);
+ $temp->Load( $ARGSRef->{$field} );
+ if ( $temp->id ) {
+ $ARGSRef->{$field} = $temp->id;
+ }
}
}
@@ -1747,12 +2103,15 @@ sub ProcessTicketBasics {
);
# We special case owner changing, so we can use ForceOwnerChange
- if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
+ if ( $ARGSRef->{'Owner'}
+ && $ARGSRef->{'Owner'} !~ /\D/
+ && ( $OrigOwner != $ARGSRef->{'Owner'} ) ) {
my ($ChownType);
if ( $ARGSRef->{'ForceOwnerChange'} ) {
$ChownType = "Force";
- } else {
- $ChownType = "Give";
+ }
+ else {
+ $ChownType = "Set";
}
my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
@@ -1764,7 +2123,64 @@ sub ProcessTicketBasics {
return (@results);
}
-# }}}
+sub ProcessTicketReminders {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $Ticket = $args{'TicketObj'};
+ my $args = $args{'ARGSRef'};
+ my @results;
+
+ my $reminder_collection = $Ticket->Reminders->Collection;
+
+ if ( $args->{'update-reminders'} ) {
+ while ( my $reminder = $reminder_collection->Next ) {
+ if ( $reminder->Status ne 'resolved' && $args->{ 'Complete-Reminder-' . $reminder->id } ) {
+ $Ticket->Reminders->Resolve($reminder);
+ }
+ elsif ( $reminder->Status eq 'resolved' && !$args->{ 'Complete-Reminder-' . $reminder->id } ) {
+ $Ticket->Reminders->Open($reminder);
+ }
+
+ if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) {
+ $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ;
+ }
+
+ if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) {
+ $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ;
+ }
+
+ if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) {
+ my $DateObj = RT::Date->new( $session{'CurrentUser'} );
+ $DateObj->Set(
+ Format => 'unknown',
+ Value => $args->{ 'Reminder-Due-' . $reminder->id }
+ );
+ if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) {
+ $reminder->SetDue( $DateObj->ISO );
+ }
+ }
+ }
+ }
+
+ if ( $args->{'NewReminder-Subject'} ) {
+ my $due_obj = RT::Date->new( $session{'CurrentUser'} );
+ $due_obj->Set(
+ Format => 'unknown',
+ Value => $args->{'NewReminder-Due'}
+ );
+ my ( $add_id, $msg, $txnid ) = $Ticket->Reminders->Add(
+ Subject => $args->{'NewReminder-Subject'},
+ Owner => $args->{'NewReminder-Owner'},
+ Due => $due_obj->ISO
+ );
+ push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'});
+ }
+ return @results;
+}
sub ProcessTicketCustomFieldUpdates {
my %args = @_;
@@ -1838,7 +2254,7 @@ sub ProcessObjectCustomFieldUpdates {
sub _ProcessObjectCustomFieldUpdates {
my %args = @_;
my $cf = $args{'CustomField'};
- my $cf_type = $cf->Type;
+ my $cf_type = $cf->Type || '';
# Remove blank Values since the magic field will take care of this. Sometimes
# the browser gives you a blank value which causes CFs to be processed twice
@@ -1939,6 +2355,9 @@ sub _ProcessObjectCustomFieldUpdates {
# For Date Cfs, @values is empty when there is no changes (no datas in form input)
return @results if ( $cf->Type eq 'Date' && ! @values );
+ # For Date Cfs, @values is empty when there is no changes (no datas in form input)
+ return @results if ( $cf->Type =~ /^Date(?:Time)?$/ && ! @values );
+
$cf_values->RedoSearch;
while ( my $cf_value = $cf_values->Next ) {
next if $values_hash{ $cf_value->id };
@@ -1985,7 +2404,6 @@ sub _ProcessObjectCustomFieldUpdates {
return @results;
}
-# {{{ sub ProcessTicketWatchers
=head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
@@ -2067,9 +2485,7 @@ sub ProcessTicketWatchers {
return (@results);
}
-# }}}
-# {{{ sub ProcessTicketDates
=head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
@@ -2089,7 +2505,7 @@ sub ProcessTicketDates {
my (@results);
- # {{{ Set date fields
+ # Set date fields
my @date_fields = qw(
Told
Resolved
@@ -2125,9 +2541,7 @@ sub ProcessTicketDates {
return (@results);
}
-# }}}
-# {{{ sub ProcessTicketLinks
=head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
@@ -2157,7 +2571,6 @@ sub ProcessTicketLinks {
return (@results);
}
-# }}}
sub ProcessRecordLinks {
my %args = (
@@ -2291,6 +2704,99 @@ sub ProcessColumnMapValue {
return $value;
}
+=head2 GetPrincipalsMap OBJECT, CATEGORIES
+
+Returns an array suitable for passing to /Admin/Elements/EditRights with the
+principal collections mapped from the categories given.
+
+=cut
+
+sub GetPrincipalsMap {
+ my $object = shift;
+ my @map;
+ for (@_) {
+ if (/System/) {
+ my $system = RT::Groups->new($session{'CurrentUser'});
+ $system->LimitToSystemInternalGroups();
+ $system->OrderBy( FIELD => 'Type', ORDER => 'ASC' );
+ push @map, [
+ 'System' => $system, # loc_left_pair
+ 'Type' => 1,
+ ];
+ }
+ elsif (/Groups/) {
+ my $groups = RT::Groups->new($session{'CurrentUser'});
+ $groups->LimitToUserDefinedGroups();
+ $groups->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+
+ # Only show groups who have rights granted on this object
+ $groups->WithGroupRight(
+ Right => '',
+ Object => $object,
+ IncludeSystemRights => 0,
+ IncludeSubgroupMembers => 0,
+ );
+
+ push @map, [
+ 'User Groups' => $groups, # loc_left_pair
+ 'Name' => 0
+ ];
+ }
+ elsif (/Roles/) {
+ my $roles = RT::Groups->new($session{'CurrentUser'});
+
+ if ($object->isa('RT::System')) {
+ $roles->LimitToRolesForSystem();
+ }
+ elsif ($object->isa('RT::Queue')) {
+ $roles->LimitToRolesForQueue($object->Id);
+ }
+ else {
+ $RT::Logger->warn("Skipping unknown object type ($object) for Role principals");
+ next;
+ }
+ $roles->OrderBy( FIELD => 'Type', ORDER => 'ASC' );
+ push @map, [
+ 'Roles' => $roles, # loc_left_pair
+ 'Type' => 1
+ ];
+ }
+ elsif (/Users/) {
+ my $Users = RT->PrivilegedUsers->UserMembersObj();
+ $Users->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+
+ # Only show users who have rights granted on this object
+ my $group_members = $Users->WhoHaveGroupRight(
+ Right => '',
+ Object => $object,
+ IncludeSystemRights => 0,
+ IncludeSubgroupMembers => 0,
+ );
+
+ # Limit to UserEquiv groups
+ my $groups = $Users->NewAlias('Groups');
+ $Users->Join(
+ ALIAS1 => $groups,
+ FIELD1 => 'id',
+ ALIAS2 => $group_members,
+ FIELD2 => 'GroupId'
+ );
+ $Users->Limit( ALIAS => $groups, FIELD => 'Domain', VALUE => 'ACLEquivalence' );
+ $Users->Limit( ALIAS => $groups, FIELD => 'Type', VALUE => 'UserEquiv' );
+
+
+ my $display = sub {
+ $m->scomp('/Elements/ShowUser', User => $_[0], NoEscape => 1)
+ };
+ push @map, [
+ 'Users' => $Users, # loc_left_pair
+ $display => 0
+ ];
+ }
+ }
+ return @map;
+}
+
=head2 _load_container_object ( $type, $id );
Instantiate container object for saving searches.
@@ -2322,6 +2828,82 @@ sub _parse_saved_search {
return ( _load_container_object( $obj_type, $obj_id ), $search_id );
}
+=head2 ScrubHTML content
+
+Removes unsafe and undesired HTML from the passed content
+
+=cut
+
+my $SCRUBBER;
+sub ScrubHTML {
+ my $Content = shift;
+ $SCRUBBER = _NewScrubber() unless $SCRUBBER;
+
+ $Content = '' if !defined($Content);
+ return $SCRUBBER->scrub($Content);
+}
+
+=head2 _NewScrubber
+
+Returns a new L<HTML::Scrubber> object. Override this if you insist on
+letting more HTML through.
+
+=cut
+
+sub _NewScrubber {
+ require HTML::Scrubber;
+ my $scrubber = HTML::Scrubber->new();
+ $scrubber->default(
+ 0,
+ {
+ '*' => 0,
+ id => 1,
+ class => 1,
+ # Match http, ftp and relative urls
+ # XXX: we also scrub format strings with this module then allow simple config options
+ href => qr{^(?:http:|ftp:|https:|/|__Web(?:Path|BaseURL|URL)__)}i,
+ face => 1,
+ size => 1,
+ target => 1,
+ style => qr{
+ ^(?:\s*
+ (?:(?:background-)?color: \s*
+ (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) | # rgb(d,d,d)
+ \#[a-f0-9]{3,6} | # #fff or #ffffff
+ [\w\-]+ # green, light-blue, etc.
+ ) |
+ text-align: \s* \w+ |
+ font-size: \s* [\w.\-]+ |
+ font-family: \s* [\w\s"',.\-]+ |
+ font-weight: \s* [\w\-]+ |
+
+ # MS Office styles, which are probably fine. If we don't, then any
+ # associated styles in the same attribute get stripped.
+ mso-[\w\-]+?: \s* [\w\s"',.\-]+
+ )\s* ;? \s*)
+ +$ # one or more of these allowed properties from here 'till sunset
+ }ix,
+ }
+ );
+ $scrubber->deny(qw[*]);
+ $scrubber->allow(
+ qw[A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP STRIKE H1 H2 H3 H4 H5 H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE]
+ );
+ $scrubber->comment(0);
+
+ return $scrubber;
+}
+
+=head2 JSON
+
+Redispatches to L<RT::Interface::Web/EncodeJSON>
+
+=cut
+
+sub JSON {
+ RT::Interface::Web::EncodeJSON(@_);
+}
+
package RT::Interface::Web;
RT::Base->_ImportOverlays();
diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm
index 4bb648451..69eee60f6 100644
--- a/rt/lib/RT/Interface/Web/Handler.pm
+++ b/rt/lib/RT/Interface/Web/Handler.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -47,6 +47,8 @@
# END BPS TAGGED BLOCK }}}
package RT::Interface::Web::Handler;
+use warnings;
+use strict;
use CGI qw/-private_tempfiles/;
use MIME::Entity;
@@ -54,19 +56,16 @@ use Text::Wrapper;
use CGI::Cookie;
use Time::ParseDate;
use Time::HiRes;
-use HTML::Entities;
use HTML::Scrubber;
-use RT::Interface::Web::Handler;
+use RT::Interface::Web;
use RT::Interface::Web::Request;
use File::Path qw( rmtree );
use File::Glob qw( bsd_glob );
use File::Spec::Unix;
sub DefaultHandlerArgs { (
- comp_root => [
- [ local => $RT::MasonLocalComponentRoot ],
- (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}),
- [ standard => $RT::MasonComponentRoot ]
+ comp_root => [
+ RT::Interface::Web->ComponentRoots( Names => 1 ),
],
default_escape_flags => 'h',
data_dir => "$RT::MasonDataDir",
@@ -80,27 +79,6 @@ sub DefaultHandlerArgs { (
named_component_subs => $INC{'Devel/Cover.pm'} ? 1 : 0,
) };
-# {{{ sub new
-
-=head2 new
-
- Constructs a web handler of the appropriate class.
- Takes options to pass to the constructor.
-
-=cut
-
-sub new {
- my $class = shift;
- $class->InitSessionDir;
-
- if ( ($mod_perl::VERSION && $mod_perl::VERSION >= 1.9908) || $CGI::MOD_PERL) {
- goto &NewApacheHandler;
- }
- else {
- goto &NewCGIHandler;
- }
-}
-
sub InitSessionDir {
# Activate the following if running httpd as root (the normal case).
# Resets ownership of all files created by Mason at startup.
@@ -125,81 +103,14 @@ sub InitSessionDir {
}
-# }}}
-
-# {{{ sub NewApacheHandler
-
-=head2 NewApacheHandler
-
- Takes extra options to pass to HTML::Mason::ApacheHandler->new
- Returns a new Mason::ApacheHandler object
-
-=cut
-
-sub NewApacheHandler {
- require HTML::Mason::ApacheHandler;
- return NewHandler('HTML::Mason::ApacheHandler', args_method => "CGI", @_);
-}
-
-# }}}
-
-# {{{ sub NewCGIHandler
-
-=head2 NewCGIHandler
-
- Returns a new Mason::CGIHandler object
-
-=cut
-
-sub NewCGIHandler {
- require HTML::Mason::CGIHandler;
- return NewHandler(
- 'HTML::Mason::CGIHandler',
- out_method => sub {
- my $m = HTML::Mason::Request->instance;
- my $r = $m->cgi_request;
-
- # Send headers if they have not been sent by us or by user.
- $r->send_http_header unless $r->http_header_sent;
-
- # Set up a default
- $r->content_type('text/html; charset=utf-8')
- unless $r->content_type;
-
- if ( $r->content_type =~ /charset=([\w-]+)$/ ) {
- my $enc = $1;
- if ( lc $enc !~ /utf-?8$/ ) {
- for my $str (@_) {
- next unless $str;
-
- # only encode perl internal strings
- next unless utf8::is_utf8($str);
- $str = Encode::encode( $enc, $str );
- }
- }
- }
-
- # default to utf8 encoding
- for my $str (@_) {
- next unless $str;
- next unless utf8::is_utf8($str);
- $str = Encode::encode( 'utf8', $str );
- }
-
- # We could perhaps install a new, faster out_method here that
- # wouldn't have to keep checking whether headers have been
- # sent and what the $r->method is. That would require
- # additions to the Request interface, though.
- print STDOUT grep {defined} @_;
- },
- @_
- );
-}
+use UNIVERSAL::require;
sub NewHandler {
my $class = shift;
+ $class->require or die $!;
my $handler = $class->new(
DefaultHandlerArgs(),
+ RT->Config->Get('MasonParameters'),
@_
);
@@ -208,6 +119,23 @@ sub NewHandler {
return($handler);
}
+=head2 _mason_dir_index
+
+=cut
+
+sub _mason_dir_index {
+ my ($self, $interp, $path) = @_;
+ $path =~ s!/$!!;
+ if ( !$interp->comp_exists( $path )
+ && $interp->comp_exists( $path . "/index.html" ) )
+ {
+ return $path . "/index.html";
+ }
+
+ return $path;
+}
+
+
=head2 CleanupRequest
Clean ups globals, caches and other things that could be still
@@ -266,9 +194,97 @@ sub CleanupRequest {
delete $RT::System->{attributes};
# Explicitly remove any tmpfiles that GPG opened, and close their
- # filehandles.
- File::Temp::cleanup;
+ # filehandles. unless we are doing inline psgi testing, which kills all the tmp file created by tests.
+ File::Temp::cleanup()
+ unless $INC{'Test/WWW/Mechanize/PSGI.pm'};
+
+
+}
+
+
+# PSGI App
+
+use RT::Interface::Web::Handler;
+use CGI::Emulate::PSGI;
+use Plack::Request;
+use Plack::Response;
+use Plack::Util;
+use Encode qw(encode_utf8);
+
+sub PSGIApp {
+ my $self = shift;
+
+ # XXX: this is fucked
+ require HTML::Mason::CGIHandler;
+ require HTML::Mason::PSGIHandler::Streamy;
+ my $h = RT::Interface::Web::Handler::NewHandler('HTML::Mason::PSGIHandler::Streamy');
+
+ $self->InitSessionDir;
+
+ return sub {
+ my $env = shift;
+ RT::ConnectToDatabase() unless RT->InstallMode;
+
+ my $req = Plack::Request->new($env);
+
+ # CGI.pm normalizes .. out of paths so when you requested
+ # /NoAuth/../Ticket/Display.html we saw Ticket/Display.html
+ # PSGI doesn't normalize .. so we have to deal ourselves.
+ if ( $req->path_info =~ m{/\.} ) {
+ $RT::Logger->crit("Invalid request for ".$req->path_info." aborting");
+ my $res = Plack::Response->new(400);
+ return $self->_psgi_response_cb($res->finalize,sub { $self->CleanupRequest });
+ }
+ $env->{PATH_INFO} = $self->_mason_dir_index( $h->interp, $req->path_info);
+
+ my $ret;
+ {
+ # XXX: until we get rid of all $ENV stuff.
+ local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env));
+
+ $ret = $h->handle_psgi($env);
+ }
+
+ $RT::Logger->crit($@) if $@ && $RT::Logger;
+ warn $@ if $@ && !$RT::Logger;
+ if (ref($ret) eq 'CODE') {
+ my $orig_ret = $ret;
+ $ret = sub {
+ my $respond = shift;
+ local %ENV = (%ENV, CGI::Emulate::PSGI->emulate_environment($env));
+ $orig_ret->($respond);
+ };
+ }
+
+ return $self->_psgi_response_cb($ret,
+ sub {
+ $self->CleanupRequest()
+ });
+};
+
+sub _psgi_response_cb {
+ my $self = shift;
+ my ($ret, $cleanup) = @_;
+ Plack::Util::response_cb
+ ($ret,
+ sub {
+ my $res = shift;
+
+ if ( RT->Config->Get('Framebusting') ) {
+ # XXX TODO: Do we want to make the value of this header configurable?
+ Plack::Util::header_set($res->[1], 'X-Frame-Options' => 'DENY');
+ }
+
+ return sub {
+ if (!defined $_[0]) {
+ $cleanup->();
+ return '';
+ }
+ return utf8::is_utf8($_[0]) ? encode_utf8($_[0]) : $_[0];
+ return $_[0];
+ };
+ });
+ }
}
-# }}}
1;
diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm
index 3b6ce888e..6b351e94b 100644
--- a/rt/lib/RT/Interface/Web/Menu.pm
+++ b/rt/lib/RT/Interface/Web/Menu.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -48,22 +48,267 @@
package RT::Interface::Web::Menu;
+use strict;
+use warnings;
+
+
+use base qw/Class::Accessor::Fast/;
+use URI;
+use Scalar::Util qw(weaken);
+
+__PACKAGE__->mk_accessors(qw(
+ key title description raw_html escape_title sort_order target class
+));
+
+=head1 NAME
+
+RT::Interface::Web::Menu - Handle the API for menu navigation
+
+=head1 METHODS
+
+=head2 new PARAMHASH
+
+Creates a new L<RT::Interface::Web::Menu> object. Possible keys in the
+I<PARAMHASH> are L</parent>, L</title>, L</description>, L</path>,
+L</raw_html>, L<escape_title>, L</sort_order>, L</class>, L</target> and
+L</active>. See the subroutines with the respective name below for
+each option's use.
+
+=cut
sub new {
- my $class = shift;
- my $self = bless {}, $class;
- $self->{'root_node'} = RT::Interface::Web::Menu::Item->new();
+ my $package = shift;
+ my $args = ref($_[0]) eq 'HASH' ? shift @_ : {@_};
+
+ my $parent = delete $args->{'parent'};
+ $args->{sort_order} ||= 0;
+
+ # Class::Accessor only wants a hashref;
+ my $self = $package->SUPER::new( $args );
+
+ # make sure our reference is weak
+ $self->parent($parent) if defined $parent;
+
return $self;
}
-sub as_hash_of_hashes {
+=head2 title [STRING]
+
+Sets or returns the string that the menu item will be displayed as.
+
+=head2 escape_title [BOOLEAN]
+
+Sets or returns whether or not to HTML escape the title before output.
+
+=head2 parent [MENU]
+Gets or sets the parent L<RT::Interface::Web::Menu> of this item; this defaults
+to null. This ensures that the reference is weakened.
+
+=head2 raw_html [STRING]
+
+Sets the content of this menu item to a raw blob of HTML. When building the
+menu, rather than constructing a link, we will return this raw content. No
+escaping is done.
+
+=cut
+
+sub parent {
+ my $self = shift;
+ if (@_) {
+ $self->{parent} = shift;
+ weaken $self->{parent};
+ }
+
+ return $self->{parent};
+}
+
+
+=head2 sort_order [NUMBER]
+
+Gets or sets the sort order of the item, as it will be displayed under
+the parent. This defaults to adding onto the end.
+
+=head2 target [STRING]
+
+Get or set the frame or pseudo-target for this link. something like L<_blank>
+
+=head2 class [STRING]
+
+Gets or sets the CSS class the menu item should have in addition to the default
+classes. This is only used if L</raw_html> isn't specified.
+
+=head2 path
+
+Gets or sets the URL that the menu's link goes to. If the link
+provided is not absolute (does not start with a "/"), then is is
+treated as relative to it's parent's path, and made absolute.
+
+=cut
+
+sub path {
+ my $self = shift;
+ if (@_) {
+ $self->{path} = shift;
+ $self->{path} = URI->new_abs($self->{path}, $self->parent->path . "/")->as_string
+ if defined $self->{path} and $self->parent and $self->parent->path;
+ $self->{path} =~ s!///!/! if $self->{path};
+ }
+ return $self->{path};
+}
+
+=head2 active [BOOLEAN]
+
+Gets or sets if the menu item is marked as active. Setting this
+cascades to all of the parents of the menu item.
+
+This is currently B<unused>.
+
+=cut
+
+sub active {
+ my $self = shift;
+ if (@_) {
+ $self->{active} = shift;
+ $self->parent->active($self->{active}) if defined $self->parent;
+ }
+ return $self->{active};
}
-sub root {
+=head2 child KEY [, PARAMHASH]
+
+If only a I<KEY> is provided, returns the child with that I<KEY>.
+
+Otherwise, creates or overwrites the child with that key, passing the
+I<PARAMHASH> to L<RT::Interface::Web::Menu/new>. Additionally, the paramhash's
+L</title> defaults to the I<KEY>, and the L</sort_order> defaults to the
+pre-existing child's sort order (if a C<KEY> is being over-written) or
+the end of the list, if it is a new C<KEY>.
+
+If the paramhash contains a key called C<menu>, that will be used instead
+of creating a new RT::Interface::Web::Menu.
+
+
+=cut
+
+sub child {
+ my $self = shift;
+ my $key = shift;
+ my $proto = ref $self || $self;
+
+ if ( my %args = @_ ) {
+
+ # Clear children ordering cache
+ delete $self->{children_list};
+
+ my $child;
+ if ( $child = $args{menu} ) {
+ $child->parent($self);
+ } else {
+ $child = $proto->new(
+ { parent => $self,
+ key => $key,
+ title => $key,
+ escape_title=> 1,
+ %args
+ }
+ );
+ }
+ $self->{children}{$key} = $child;
+
+ $child->sort_order( $args{sort_order} || (scalar values %{ $self->{children} }) )
+ unless ($child->sort_order());
+
+ # URL is relative to parents, and cached, so set it up now
+ $child->path( $child->{path} );
+
+ # Figure out the URL
+ my $path = $child->path;
+
+ # Activate it
+ if ( defined $path and length $path ) {
+ my $base_path = $HTML::Mason::Commands::r->path_info;
+ my $query = $HTML::Mason::Commands::m->cgi_object->query_string;
+ $base_path .= "?$query" if defined $query and length $query;
+
+ $base_path =~ s/index\.html$//;
+ $base_path =~ s/\/+$//;
+ $path =~ s/index\.html$//;
+ $path =~ s/\/+$//;
+
+ if ( $path eq $base_path ) {
+ $self->{children}{$key}->active(1);
+ }
+ }
+ }
+
+ return $self->{children}{$key};
+}
+
+=head2 active_child
+
+Returns the first active child node, or C<undef> is there is none.
+
+=cut
+
+sub active_child {
+ my $self = shift;
+ foreach my $kid ($self->children) {
+ return $kid if $kid->active;
+ }
+ return undef;
+}
+
+
+=head2 delete KEY
+
+Removes the child with the provided I<KEY>.
+
+=cut
+
+sub delete {
+ my $self = shift;
+ my $key = shift;
+ delete $self->{children_list};
+ delete $self->{children}{$key};
+}
+
+
+=head2 has_children
+
+Returns true if there are any children on this menu
+
+=cut
+
+sub has_children {
+ my $self = shift;
+ if (@{ $self->children}) {
+ return 1
+ } else {
+ return 0;
+ }
+}
+
+
+=head2 children
+
+Returns the children of this menu item in sorted order; as an array in
+array context, or as an array reference in scalar context.
+
+=cut
+
+sub children {
my $self = shift;
- return $self->{'root_node'};
+ my @kids;
+ if ($self->{children_list}) {
+ @kids = @{$self->{children_list}};
+ } else {
+ @kids = values %{$self->{children} || {}};
+ @kids = sort {$a->{sort_order} <=> $b->{sort_order}} @kids;
+ $self->{children_list} = \@kids;
+ }
+ return wantarray ? @kids : \@kids;
}
1;
diff --git a/rt/lib/RT/Interface/Web/Menu/Item.pm b/rt/lib/RT/Interface/Web/Menu/Item.pm
deleted file mode 100644
index 29fb13bcc..000000000
--- a/rt/lib/RT/Interface/Web/Menu/Item.pm
+++ /dev/null
@@ -1,88 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Web::Menu::Item;
-use strict;
-use warnings;
-
-sub new {
- my $class = shift;
- my $self = bless {},$class;
- $self->{'_attributes'} = {};
- return($self);
-}
-
-sub label { my $self = shift; $self->_accessor( label => @_) } ;
-sub absolute_url { my $self = shift; $self->_accessor( absolute_url => @_) } ;
-sub rt_path { my $self = shift; $self->_accessor( rt_path => @_) } ;
-sub hilight { my $self = shift; $self->_accessor( hilight => @_);
- $self->parent->hilight(1);
- } ;
-sub sort_order { my $self = shift; $self->_accessor( sort_order => @_) } ;
-
-sub add_child {
-}
-
-sub delete {
-}
-
-sub children {
-
-}
-
-sub _accessor {
- my $self = shift;
- my $key = shift;
- if (@_){
- $self->{'attributes'}->{$key} = shift;
-
- }
- return $self->{'_attributes'}->{$key};
-}
-
-1;
diff --git a/rt/lib/RT/Interface/Web/QueryBuilder.pm b/rt/lib/RT/Interface/Web/QueryBuilder.pm
index 09b95398c..79a0b9718 100755
--- a/rt/lib/RT/Interface/Web/QueryBuilder.pm
+++ b/rt/lib/RT/Interface/Web/QueryBuilder.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
diff --git a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
index 493ab444d..e2ec1e58d 100755
--- a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
+++ b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -260,20 +260,24 @@ sub ParseSQL {
my $class;
if ( exists $lcfield{ lc $main_key } ) {
- $class = $field{ $main_key }->[0];
$key =~ s/^[^.]+/ $lcfield{ lc $main_key } /e;
+ ($main_key) = split /[.]/, $key; # make the case right
+ $class = $field{ $main_key }->[0];
}
unless( $class ) {
push @results, [ $args{'CurrentUser'}->loc("Unknown field: [_1]", $key), -1 ]
}
- $value =~ s/'/\\'/g;
if ( lc $op eq 'is' || lc $op eq 'is not' ) {
$value = 'NULL'; # just fix possible mistakes here
} elsif ( $value !~ /^[+-]?[0-9]+$/ ) {
+ $value =~ s/(['\\])/\\$1/g;
$value = "'$value'";
}
- $key = "'$key'" if $key =~ /^CF./;
+
+ if ($key =~ s/(['\\])/\\$1/g or $key =~ /\s/) {
+ $key = "'$key'";
+ }
my $clause = { Key => $key, Op => $op, Value => $value };
$node->addChild( __PACKAGE__->new( $clause ) );
diff --git a/rt/lib/RT/Interface/Web/Request.pm b/rt/lib/RT/Interface/Web/Request.pm
index 84dd28dd6..d0865117d 100644
--- a/rt/lib/RT/Interface/Web/Request.pm
+++ b/rt/lib/RT/Interface/Web/Request.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -52,51 +52,16 @@ use strict;
use warnings;
our $VERSION = '0.30';
-use base qw(HTML::Mason::Request);
+use HTML::Mason::PSGIHandler;
+use base qw(HTML::Mason::Request::PSGI);
+use Params::Validate qw(:all);
sub new {
my $class = shift;
-
- my $new_class = $HTML::Mason::ApacheHandler::VERSION ?
- 'HTML::Mason::Request::ApacheHandler' :
- $HTML::Mason::CGIHandler::VERSION ?
- 'HTML::Mason::Request::CGI' :
- 'HTML::Mason::Request';
-
- $class->alter_superclass( $new_class );
- $class->valid_params( %{ $new_class->valid_params } );
+ $class->valid_params( %{ $class->valid_params },cgi_request => { type => OBJECT, optional => 1 } );
return $class->SUPER::new(@_);
}
-# XXX TODO: This alter_superclass replaces teh funcitonality in Mason 1.39
-# with code which doesn't trigger a bug in Perl 5.10.
-# (Perl 5.10.0 does NOT take kindly to having its @INC entries changed)
-# http://rt.perl.org/rt3/Public/Bug/Display.html?id=54566
-#
-# This routine can be removed when either:
-# * RT depends on a version of mason which contains this fix
-# * Perl 5.10.0 is not supported for running RT
-sub alter_superclass {
- my $class = shift;
- my $new_super = shift;
- my $isa_ref;
- { no strict 'refs'; my @entries = @{$class."::ISA"}; $isa_ref = \@entries; }
-
- # handles multiple inheritance properly and preserve
- # inheritance order
- for ( my $x = 0; $x <= $#{$isa_ref} ; $x++ ) {
- if ( $isa_ref->[$x]->isa('HTML::Mason::Request') ) {
- my $old_super = $isa_ref->[$x];
- $isa_ref->[$x] = $new_super
- if ( $old_super ne $new_super );
- last;
- }
- }
-
- { no strict 'refs'; @{$class."::ISA"} = @$isa_ref; }
- $class->valid_params( %{ $class->valid_params } );
-}
-
=head2 callback
@@ -153,11 +118,7 @@ sub callback {
unless ( $callbacks ) {
$callbacks = [];
my $path = "/Callbacks/*$page/$name";
- my @roots = map $_->[1],
- $HTML::Mason::VERSION <= 1.28
- ? $self->interp->resolver->comp_root_array
- : $self->interp->comp_root_array;
-
+ my @roots = RT::Interface::Web->ComponentRoots;
my %seen;
@$callbacks = (
grep defined && length,
diff --git a/rt/lib/RT/Interface/Web/Session.pm b/rt/lib/RT/Interface/Web/Session.pm
index 8ce8afd2b..c5b88f127 100644
--- a/rt/lib/RT/Interface/Web/Session.pm
+++ b/rt/lib/RT/Interface/Web/Session.pm
@@ -2,7 +2,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
diff --git a/rt/lib/RT/Interface/Web/Standalone.pm b/rt/lib/RT/Interface/Web/Standalone.pm
deleted file mode 100755
index 3157e315e..000000000
--- a/rt/lib/RT/Interface/Web/Standalone.pm
+++ /dev/null
@@ -1,126 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-use strict;
-use warnings;
-package RT::Interface::Web::Standalone;
-
-use base 'HTTP::Server::Simple::Mason';
-use RT::Interface::Web::Handler;
-use RT::Interface::Web;
-use URI;
-
-sub handler_class { "RT::Interface::Web::Handler" }
-
-sub setup_escapes {
- my $self = shift;
- my $handler = shift;
-
- # Override HTTP::Server::Simple::Mason's version of this method to do
- # nothing. (RT::Interface::Web::Handler does this already for us in
- # NewHandler.)
-}
-
-sub default_mason_config {
- return RT->Config->Get('MasonParameters');
-}
-
-sub handle_request {
-
- my $self = shift;
- my $cgi = shift;
-
- Module::Refresh->refresh if RT->Config->Get('DevelMode');
- RT::ConnectToDatabase() unless RT->InstallMode;
-
- # Each environment has its own way of handling .. and so on in paths,
- # so RT consistently forbids such paths.
- if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
- return RT::Interface::Web::Handler->CleanupRequest();
- }
-
- $self->SUPER::handle_request($cgi);
- $RT::Logger->crit($@) if $@ && $RT::Logger;
- warn $@ if $@ && !$RT::Logger;
- RT::Interface::Web::Handler->CleanupRequest();
-}
-
-sub net_server {
- my $self = shift;
- $self->{rt_net_server} = shift if @_;
- return $self->{rt_net_server};
-}
-
-
-=head2 print_banner
-
-This routine prints a banner before the server request-handling loop
-starts.
-
-Methods below this point are probably not terribly useful to define
-yourself in subclasses.
-
-=cut
-
-sub print_banner {
- my $self = shift;
-
- my $url = URI->new( RT->Config->Get('WebBaseURL'));
- $url->host('127.0.0.1') if ($url->host() eq 'localhost');
- $url->port($self->port);
- print(
- "You can connect to your server at "
- . $url->canonical
- . "\n" );
-
-}
-
-
-1;
diff --git a/rt/lib/RT/Interface/Web/Standalone/PreFork.pm b/rt/lib/RT/Interface/Web/Standalone/PreFork.pm
deleted file mode 100644
index f569e4f00..000000000
--- a/rt/lib/RT/Interface/Web/Standalone/PreFork.pm
+++ /dev/null
@@ -1,103 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-use warnings;
-use strict;
-
-package RT::Interface::Web::Standalone::PreFork;
-use base qw/Net::Server::PreFork/;
-
-my %option_map = (
- min_servers => 'StandaloneMinServers',
- max_servers => 'StandaloneMaxServers',
- min_spare_servers => 'StandaloneMinSpareServers',
- max_spare_servers => 'StandaloneMaxSpareServers',
- max_requests => 'StandaloneMaxRequests',
-);
-
-=head2 default_values
-
-Produces the default values for L<Net::Server> configuration from RT's config
-files.
-
-=cut
-
-sub default_values {
- my %forking = (
- map { $_ => RT->Config->Get( $option_map{$_} ) }
- grep { defined( RT->Config->Get( $option_map{$_} ) ) }
- keys %option_map,
- );
-
- return {
- %forking,
- log_level => 1,
- RT->Config->Get('NetServerOptions')
- };
-}
-
-=head2 post_bind_hook
-
-After binding to the specified ports, let the user know that the server is
-prepared to handle connections.
-
-=cut
-
-sub post_bind_hook {
- my $self = shift;
- my @ports = @{ $self->{server}->{port} };
-
- print $0
- . ": You can connect to your server at "
- . (join ' , ', map { "http://localhost:$_/" } @ports)
- . "\n";
-
- $self->SUPER::post_bind_hook(@_);
-}
-
-1;
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-14 18:09:38 +0000