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.pm270
-rwxr-xr-xrt/lib/RT/Interface/Email.pm991
-rwxr-xr-xrt/lib/RT/Interface/Email/Auth/GnuPG.pm123
-rw-r--r--rt/lib/RT/Interface/Email/Auth/MailFrom.pm189
-rw-r--r--rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm96
-rw-r--r--rt/lib/RT/Interface/REST.pm288
-rw-r--r--rt/lib/RT/Interface/Web.pm1687
-rw-r--r--rt/lib/RT/Interface/Web/Handler.pm211
-rw-r--r--rt/lib/RT/Interface/Web/Menu.pm68
-rw-r--r--rt/lib/RT/Interface/Web/Menu/Item.pm86
-rwxr-xr-xrt/lib/RT/Interface/Web/QueryBuilder.pm58
-rwxr-xr-xrt/lib/RT/Interface/Web/QueryBuilder/Tree.pm247
-rwxr-xr-xrt/lib/RT/Interface/Web/Standalone.pm84
-rw-r--r--rt/lib/RT/Interface/Web_Vendor.pm201
14 files changed, 4599 insertions, 0 deletions
diff --git a/rt/lib/RT/Interface/CLI.pm b/rt/lib/RT/Interface/CLI.pm
new file mode 100644
index 000000000..c2b545468
--- /dev/null
+++ b/rt/lib/RT/Interface/CLI.pm
@@ -0,0 +1,270 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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 RT;
+package RT::Interface::CLI;
+
+
+
+BEGIN {
+ use Exporter ();
+ use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+ # set the version for version checking
+ $VERSION = do { my @r = (q$Revision: 1.1.1.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
+
+ @ISA = qw(Exporter);
+
+ # your exported package globals go here,
+ # as well as any optionally exported functions
+ @EXPORT_OK = qw(&CleanEnv
+ &GetCurrentUser &GetMessageContent &debug &loc);
+}
+
+=head1 NAME
+
+ RT::Interface::CLI - helper functions for creating a commandline RT interface
+
+=head1 SYNOPSIS
+
+ use lib "/path/to/rt/libraries/";
+
+ use RT::Interface::CLI qw(CleanEnv
+ GetCurrentUser GetMessageContent loc);
+
+ #Clean out all the nasties from the environment
+ CleanEnv();
+
+ #let's talk to RT'
+ use RT;
+
+ #Load RT's config file
+ RT::LoadConfig();
+
+ # Connect to the database. set up loggign
+ RT::Init();
+
+ #Get the current user all loaded
+ my $CurrentUser = GetCurrentUser();
+
+ print loc('Hello!'); # Synonym of $CuurentUser->loc('Hello!');
+
+=head1 DESCRIPTION
+
+
+=head1 METHODS
+
+=begin testing
+
+ok(require RT::Interface::CLI);
+
+=end testing
+
+=cut
+
+
+=head2 CleanEnv
+
+Removes some of the nastiest nasties from the user\'s environment.
+
+=cut
+
+sub CleanEnv {
+ $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need
+ $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'};
+ $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'};
+ $ENV{'ENV'} = '' if defined $ENV{'ENV'};
+ $ENV{'IFS'} = '' if defined $ENV{'IFS'};
+}
+
+
+
+
+{
+
+ my $CurrentUser; # shared betwen GetCurrentUser and loc
+
+# {{{ sub GetCurrentUser
+
+=head2 GetCurrentUser
+
+ Figures out the uid of the current user and returns an RT::CurrentUser object
+loaded with that user. if the current user isn't found, returns a copy of RT::Nobody.
+
+=cut
+
+sub GetCurrentUser {
+
+ require RT::CurrentUser;
+
+ #Instantiate a user object
+
+ my $Gecos= ($^O eq 'MSWin32') ? Win32::LoginName() : (getpwuid($<))[0];
+
+ #If the current user is 0, then RT will assume that the User object
+ #is that of the currentuser.
+
+ $CurrentUser = new RT::CurrentUser();
+ $CurrentUser->LoadByGecos($Gecos);
+
+ unless ($CurrentUser->Id) {
+ $RT::Logger->debug("No user with a unix login of '$Gecos' was found. ");
+ }
+
+ return($CurrentUser);
+}
+# }}}
+
+
+# {{{ sub loc
+
+=head2 loc
+
+ Synonym of $CurrentUser->loc().
+
+=cut
+
+sub loc {
+ die "No current user yet" unless $CurrentUser ||= RT::CurrentUser->new;
+ return $CurrentUser->loc(@_);
+}
+# }}}
+
+}
+
+
+# {{{ sub GetMessageContent
+
+=head2 GetMessageContent
+
+Takes two arguments a source file and a boolean "edit". If the source file
+is undef or "", assumes an empty file. Returns an edited file as an
+array of lines.
+
+=cut
+
+sub GetMessageContent {
+ my %args = ( Source => undef,
+ Content => undef,
+ Edit => undef,
+ CurrentUser => undef,
+ @_);
+ my $source = $args{'Source'};
+
+ my $edit = $args{'Edit'};
+
+ my $currentuser = $args{'CurrentUser'};
+ my @lines;
+
+ use File::Temp qw/ tempfile/;
+
+ #Load the sourcefile, if it's been handed to us
+ if ($source) {
+ open (SOURCE, "<$source");
+ @lines = (<SOURCE>);
+ close (SOURCE);
+ }
+ elsif ($args{'Content'}) {
+ @lines = split('\n',$args{'Content'});
+ }
+ #get us a tempfile.
+ my ($fh, $filename) = tempfile();
+
+ #write to a tmpfile
+ for (@lines) {
+ print $fh $_;
+ }
+ close ($fh);
+
+ #Edit the file if we need to
+ if ($edit) {
+
+ unless ($ENV{'EDITOR'}) {
+ $RT::Logger->crit('No $EDITOR variable defined'. "\n");
+ return undef;
+ }
+ system ($ENV{'EDITOR'}, $filename);
+ }
+
+ open (READ, "<$filename");
+ my @newlines = (<READ>);
+ close (READ);
+
+ unlink ($filename) unless (debug());
+ return(\@newlines);
+
+}
+
+# }}}
+
+# {{{ sub debug
+
+sub debug {
+ my $val = shift;
+ my ($debug);
+ if ($val) {
+ $RT::Logger->debug($val."\n");
+ if ($debug) {
+ print STDERR "$val\n";
+ }
+ }
+ if ($debug) {
+ return(1);
+ }
+}
+
+# }}}
+
+
+eval "require RT::Interface::CLI_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/CLI_Vendor.pm});
+eval "require RT::Interface::CLI_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/CLI_Local.pm});
+
+1;
diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm
new file mode 100755
index 000000000..dfbd4aeea
--- /dev/null
+++ b/rt/lib/RT/Interface/Email.pm
@@ -0,0 +1,991 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+package RT::Interface::Email;
+
+use strict;
+use Mail::Address;
+use MIME::Entity;
+use RT::EmailParser;
+use File::Temp;
+use UNIVERSAL::require;
+
+BEGIN {
+ use Exporter ();
+ use vars qw ( @ISA @EXPORT_OK);
+
+ # set the version for version checking
+ 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);
+
+}
+
+=head1 NAME
+
+ RT::Interface::Email - helper functions for parsing email sent to RT
+
+=head1 SYNOPSIS
+
+ use lib "!!RT_LIB_PATH!!";
+ use lib "!!RT_ETC_PATH!!";
+
+ use RT::Interface::Email qw(Gateway CreateUser);
+
+=head1 DESCRIPTION
+
+
+=begin testing
+
+ok(require RT::Interface::Email);
+
+=end testing
+
+
+=head1 METHODS
+
+=cut
+
+# {{{ sub CheckForLoops
+
+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);
+ }
+
+ # 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);
+}
+
+# }}}
+
+# {{{ sub CheckForSuspiciousSender
+
+sub CheckForSuspiciousSender {
+ my $head = shift;
+
+ #if it's from a postmaster or mailer daemon, it's likely a bounce.
+
+ #TODO: better algorithms needed here - there is no standards for
+ #bounces, so it's very difficult to separate them from anything
+ #else. At the other hand, the Return-To address is only ment to be
+ #used as an error channel, we might want to put up a separate
+ #Return-To address which is treated differently.
+
+ #TODO: search through the whole email and find the right Ticket ID.
+
+ my ( $From, $junk ) = ParseSenderAddressFromHead($head);
+
+ if ( ( $From =~ /^mailer-daemon\@/i )
+ or ( $From =~ /^postmaster\@/i ) )
+ {
+ return (1);
+
+ }
+
+ return (undef);
+
+}
+
+# }}}
+
+# {{{ sub CheckForAutoGenerated
+sub CheckForAutoGenerated {
+ my $head = shift;
+
+ 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 ) {
+ return (1);
+ }
+
+ return (0);
+}
+
+# }}}
+
+# {{{ sub CheckForBounce
+sub CheckForBounce {
+ my $head = shift;
+
+ my $ReturnPath = $head->get("Return-path") || "";
+ return ( $ReturnPath =~ /<>/ );
+}
+
+# }}}
+
+# {{{ IsRTAddress
+
+=head2 IsRTAddress ADDRESS
+
+Takes a single parameter, an email address.
+Returns true if that address matches the $RTAddressRegexp.
+Returns false, otherwise.
+
+=cut
+
+sub IsRTAddress {
+ my $address = shift || '';
+
+ # Example: the following rule would tell RT not to Cc
+ # "tickets@noc.example.com"
+ if ( defined($RT::RTAddressRegexp)
+ && $address =~ /$RT::RTAddressRegexp/i )
+ {
+ return (1);
+ } else {
+ return (undef);
+ }
+}
+
+# }}}
+
+# {{{ CullRTAddresses
+
+=head2 CullRTAddresses ARRAY
+
+Takes a single argument, an array of email addresses.
+Returns the same array with any IsRTAddress()es weeded out.
+
+=cut
+
+sub CullRTAddresses {
+ return grep !IsRTAddress($_), @_;
+}
+
+# }}}
+
+# {{{ 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',
+ @_
+ );
+
+ $RT::Logger->log(
+ level => $args{'LogLevel'},
+ message => $args{'Explanation'}
+ );
+ # the colons are necessary to make ->build include non-standard headers
+ 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,
+ 'In-Reply-To:' => $args{'MIMEObj'} ? $args{'MIMEObj'}->head->get('Message-Id') : undef
+ );
+
+ $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 ( $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 );
+ }
+}
+
+# }}}
+
+# {{{ Create User
+
+sub CreateUser {
+ my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
+ my $NewUser = RT::User->new($RT::SystemUser);
+
+ my ( $Val, $Message ) = $NewUser->Create(
+ Name => ( $Username || $Address ),
+ EmailAddress => $Address,
+ RealName => $Name,
+ Password => undef,
+ Privileged => 0,
+ Comments => 'Autocreated on ticket submission'
+ );
+
+ unless ($Val) {
+
+ # Deal with the race condition of two account creations at once
+ if ($Username) {
+ $NewUser->LoadByName($Username);
+ }
+
+ unless ( $NewUser->Id ) {
+ $NewUser->LoadByEmail($Address);
+ }
+
+ unless ( $NewUser->Id ) {
+ MailError(
+ To => $ErrorsTo,
+ Subject => "User could not be created",
+ Explanation =>
+ "User creation failed in mailgateway: $Message",
+ MIMEObj => $entity,
+ LogLevel => 'crit'
+ );
+ }
+ }
+
+ #Load the new user object
+ my $CurrentUser = RT::CurrentUser->new();
+ $CurrentUser->LoadByEmail($Address);
+
+ unless ( $CurrentUser->id ) {
+ $RT::Logger->warning(
+ "Couldn't load user '$Address'." . "giving up" );
+ MailError(
+ To => $ErrorsTo,
+ Subject => "User could not be loaded",
+ Explanation =>
+ "User '$Address' could not be loaded in the mail gateway",
+ MIMEObj => $entity,
+ LogLevel => 'crit'
+ );
+ }
+
+ return $CurrentUser;
+}
+
+# }}}
+
+# {{{ ParseCcAddressesFromHead
+
+=head2 ParseCcAddressesFromHead HASHREF
+
+Takes a hashref object containing QueueObj, Head and CurrentUser objects.
+Returns a list of all email addresses in the To and Cc
+headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
+email address and anything that the configuration sub RT::IsRTAddress matches.
+
+=cut
+
+sub ParseCcAddressesFromHead {
+ my %args = (
+ Head => undef,
+ QueueObj => undef,
+ CurrentUser => undef,
+ @_
+ );
+
+ my (@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 );
+ }
+ return (@Addresses);
+}
+
+# }}}
+
+# {{{ ParseSenderAdddressFromHead
+
+=head2 ParseSenderAddressFromHead
+
+Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
+of the From (evaluated in order of Reply-To:, From:, Sender)
+
+=cut
+
+sub ParseSenderAddressFromHead {
+ my $head = shift;
+
+ #Figure out who's sending this message.
+ foreach my $header ('Reply-To', 'From', 'Sender') {
+ my $From = $head->get($header);
+ my ($addr, $name) = ParseAddressFromHeader($From);
+ # only return if the address is not empty
+ return ($addr, $name) if $addr;
+ }
+
+ return (undef, undef);
+}
+# }}}
+
+# {{{ ParseErrorsToAdddressFromHead
+
+=head2 ParseErrorsToAddressFromHead
+
+Takes a MIME::Header object. Return a single value : user@host
+of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
+From:, Sender)
+
+=cut
+
+sub ParseErrorsToAddressFromHead {
+ my $head = shift;
+
+ #Figure out who's sending this message.
+
+ foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
+
+ # If there's a header of that name
+ my $headerobj = $head->get($header);
+ if ($headerobj) {
+ my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
+
+ # If it's got actual useful content...
+ return ($addr) if ($addr);
+ }
+ }
+}
+
+# }}}
+
+# {{{ ParseAddressFromHeader
+
+=head2 ParseAddressFromHeader ADDRESS
+
+Takes an address from $head->get('Line') and returns a tuple: user@host, friendly name
+
+=cut
+
+sub ParseAddressFromHeader {
+ my $Addr = shift;
+
+ # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
+ $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
+ my @Addresses = Mail::Address->parse($Addr);
+
+ my ($AddrObj) = grep ref $_, @Addresses;
+ unless ( $AddrObj ) {
+ return ( undef, undef );
+ }
+
+ my $Name = ( $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
+
+ #Lets take the from and load a user object.
+ my $Address = $AddrObj->address;
+
+ return ( $Address, $Name );
+}
+
+# }}}
+
+# {{{ sub ParseTicketId
+
+sub ParseTicketId {
+ my $Subject = shift;
+ my $id;
+
+ my $test_name = $RT::EmailSubjectTagRegex || qr/\Q$RT::rtname\E/i;
+
+ if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
+ my $id = $1;
+ $RT::Logger->debug("Found a ticket ID. It's $id");
+ return ($id);
+ } else {
+ return (undef);
+ }
+}
+
+# }}}
+
+=head2 Gateway ARGSREF
+
+
+Takes parameters:
+
+ action
+ queue
+ message
+
+
+This performs all the "guts" of the mail rt-mailgate program, and is
+designed to be called from the web interface with a message, user
+object, and so on.
+
+Can also take an optional 'ticket' parameter; this ticket id overrides
+any ticket id found in the subject.
+
+Returns:
+
+ An array of:
+
+ (status code, message, optional ticket object)
+
+ status code is a numeric value.
+
+ for temporary failures, the status code should be -75
+
+ for permanent failures which are handled by RT, the status code
+ should be 0
+
+ for succces, the status code should be 1
+
+
+
+=cut
+
+sub Gateway {
+ my $argsref = shift;
+ my %args = (
+ action => 'correspond',
+ queue => '1',
+ ticket => undef,
+ message => undef,
+ %$argsref
+ );
+
+ my $SystemTicket;
+ my $Right;
+
+ # Validate the action
+ my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
+ unless ($status) {
+ return (
+ -75,
+ "Invalid 'action' parameter "
+ . $actions[0]
+ . " for queue "
+ . $args{'queue'},
+ undef
+ );
+ }
+
+ my $parser = RT::EmailParser->new();
+ $parser->SmartParseMIMEEntityFromScalar( Message => $args{'message'} );
+ my $Message = $parser->Entity();
+
+ unless ($Message) {
+ MailError(
+ To => $RT::OwnerEmail,
+ Subject => "RT Bounce: Unparseable message",
+ Explanation => "RT couldn't process the message below",
+ Attach => $args{'message'}
+ );
+
+ return ( 0,
+ "Failed to parse this message. Something is likely badly wrong with the message"
+ );
+ }
+
+ my $head = $Message->head;
+
+ my $ErrorsTo = ParseErrorsToAddressFromHead($head);
+
+ my $MessageId = $head->get('Message-ID')
+ || "<no-message-id-" . time . rand(2000) . "\@.$RT::Organization>";
+
+ #Pull apart the subject line
+ my $Subject = $head->get('Subject') || '';
+ chomp $Subject;
+
+ # {{{ Lets check for mail loops of various sorts.
+ my ($should_store_machine_generated_message, $IsALoop, $result);
+ ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
+ _HandleMachineGeneratedMail(
+ Message => $Message,
+ ErrorsTo => $ErrorsTo,
+ Subject => $Subject,
+ MessageId => $MessageId
+ );
+
+ # Do not pass loop messages to MailPlugins, to make sure the loop
+ # is broken, unless $RT::StoreLoops is set.
+ if ($IsALoop && !$should_store_machine_generated_message) {
+ return ( 0, $result, undef );
+ }
+
+ $args{'ticket'} ||= ParseTicketId($Subject);
+
+ $SystemTicket = RT::Ticket->new($RT::SystemUser);
+ $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
+ if ( $SystemTicket->id ) {
+ $Right = 'ReplyToTicket';
+ } else {
+ $Right = 'CreateTicket';
+ }
+
+ #Set up a queue object
+ my $SystemQueueObj = RT::Queue->new($RT::SystemUser);
+ $SystemQueueObj->Load( $args{'queue'} );
+
+ # We can safely have no queue of we have a known-good ticket
+ unless ( $SystemTicket->id || $SystemQueueObj->id ) {
+ return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
+ }
+
+ # 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, $NewAuthStat);
+ if ( ref($_) eq "CODE" ) {
+ $Code = $_;
+ } 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';
+ unless ( defined( $Code = *{ $Class . "::GetCurrentUser" }{CODE} ) ) {
+ $RT::Logger->crit( "No 'GetCurrentUser' function found in '$Class' module");
+ next;
+ }
+ }
+
+ foreach my $action (@actions) {
+ ( $CurrentUser, $NewAuthStat ) = $Code->(
+ Message => $Message,
+ RawMessageRef => \$args{'message'},
+ 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 );
+
+ last if $AuthStat == -1;
+ $skip_action{$action}++ if $AuthStat == -2;
+ }
+
+ # strip actions we should skip
+ @actions = grep !$skip_action{$_}, @actions if $AuthStat == -2;
+ last unless @actions;
+
+ last if $AuthStat == -1;
+ }
+ # {{{ If authentication fails and no new user was created, get out.
+ if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
+
+ # If the plugins refused to create one, they lose.
+ unless ( $AuthStat == -1 ) {
+ _NoAuthorizedUserFound(
+ Right => $Right,
+ Message => $Message,
+ Requestor => $ErrorsTo,
+ Queue => $args{'queue'}
+ );
+
+ }
+ return ( 0, "Could not load a valid user", undef );
+ }
+
+ # If we got a user, but they don't have the right to say things
+ if ( $AuthStat == 0 ) {
+ MailError(
+ To => $ErrorsTo,
+ Subject => "Permission Denied",
+ Explanation =>
+ "You do not have permission to communicate with RT",
+ MIMEObj => $Message
+ );
+ return (
+ 0,
+ "$ErrorsTo tried to submit a message to "
+ . $args{'Queue'}
+ . " without permission.",
+ undef
+ );
+ }
+
+
+ unless ($should_store_machine_generated_message) {
+ return ( 0, $result, undef );
+ }
+
+ # if plugin's updated SystemTicket then update arguments
+ $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
+
+ my $Ticket = RT::Ticket->new($CurrentUser);
+
+ if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
+ {
+
+ my @Cc;
+ my @Requestors = ( $CurrentUser->id );
+
+ if ($RT::ParseNewMessageForTicketCcs) {
+ @Cc = ParseCcAddressesFromHead(
+ Head => $head,
+ CurrentUser => $CurrentUser,
+ QueueObj => $SystemQueueObj
+ );
+ }
+
+ my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
+ Queue => $SystemQueueObj->Id,
+ Subject => $Subject,
+ Requestor => \@Requestors,
+ Cc => \@Cc,
+ MIMEObj => $Message
+ );
+ if ( $id == 0 ) {
+ MailError(
+ To => $ErrorsTo,
+ Subject => "Ticket creation failed: $Subject",
+ Explanation => $ErrStr,
+ MIMEObj => $Message
+ );
+ return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
+ }
+
+ # strip comments&corresponds from the actions we don't need
+ # to record them if we've created the ticket just now
+ @actions = grep !/^(comment|correspond)$/, @actions;
+ $args{'ticket'} = $id;
+
+ } elsif ( $args{'ticket'} ) {
+
+ $Ticket->Load( $args{'ticket'} );
+ unless ( $Ticket->Id ) {
+ my $error = "Could not find a ticket with id " . $args{'ticket'};
+ MailError(
+ To => $ErrorsTo,
+ Subject => "Message not recorded: $Subject",
+ Explanation => $error,
+ MIMEObj => $Message
+ );
+
+ return ( 0, $error );
+ }
+ $args{'ticket'} = $Ticket->id;
+ } else {
+ return ( 1, "Success", $Ticket );
+ }
+
+ # }}}
+ foreach my $action (@actions) {
+
+ # If the action is comment, add a comment.
+ if ( $action =~ /^(?:comment|correspond)$/i ) {
+ my $method = ucfirst lc $action;
+ my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
+ unless ($status) {
+
+ #Warn the sender that we couldn't actually submit the comment.
+ MailError(
+ To => $ErrorsTo,
+ Subject => "Message not recorded: $Subject",
+ Explanation => $msg,
+ MIMEObj => $Message
+ );
+ 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;
+ }
+ }
+ 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 ( $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 ( 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.
+ if ($args{'Requestor'} ne $RT::OwnerEmail) {
+ MailError(
+ To => $args{'Requestor'},
+ Subject => "Could not load a valid user",
+ Explanation => <<EOT,
+RT could not load a valid user, and RT's configuration does not allow
+for the creation of a new user for your email.
+
+EOT
+ MIMEObj => $args{'Message'},
+ LogLevel => 'error'
+ );
+ }
+}
+
+=head2 _HandleMachineGeneratedMail
+
+Takes named params:
+ Message
+ ErrorsTo
+ Subject
+
+Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
+Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
+"This message appears to be a loop (boolean)" );
+
+=cut
+
+sub _HandleMachineGeneratedMail {
+ my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
+ my $head = $args{'Message'}->head;
+ my $ErrorsTo = $args{'ErrorsTo'};
+
+ my $IsBounce = CheckForBounce($head);
+
+ my $IsAutoGenerated = CheckForAutoGenerated($head);
+
+ my $IsSuspiciousSender = CheckForSuspiciousSender($head);
+
+ my $IsALoop = CheckForLoops($head);
+
+ my $SquelchReplies = 0;
+
+ #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 Received 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}
+ );
+ }
+
+ #Do we actually want to store it?
+ return ( 0, $ErrorsTo, "Message Bounced", $IsALoop ) 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", $IsALoop );
+}
+
+=head2 IsCorrectAction
+
+Returns a list of valid actions we've found for this message
+
+=cut
+
+sub IsCorrectAction {
+ my $action = shift;
+ my @actions = grep $_, split /-/, $action;
+ return ( 0, '(no value)' ) unless @actions;
+ foreach (@actions) {
+ return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
+ }
+ return ( 1, @actions );
+}
+
+eval "require RT::Interface::Email_Vendor";
+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} );
+
+1;
diff --git a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm
new file mode 100755
index 000000000..115080722
--- /dev/null
+++ b/rt/lib/RT/Interface/Email/Auth/GnuPG.pm
@@ -0,0 +1,123 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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::Auth::GnuPG;
+use Mail::GnuPG;
+
+=head2 GetCurrentUser
+
+To use the gnupg-secured mail gateway, you need to do the following:
+
+Set up a gnupgp key directory with a pubring containing only the keys
+you care about and specify the following in your SiteConfig.pm
+
+Set($RT::GPGKeyDir, "/path/to/keyring-directory");
+@RT::MailPlugins = qw(Auth::MailFrom Auth::GnuPG Filter::TakeAction);
+
+
+
+=cut
+
+
+
+sub GetCurrentUser {
+ my %args = (
+ Message => undef,
+ RawMessageRef => undef,
+ CurrentUser => undef,
+ AuthLevel => undef,
+ Ticket => undef,
+ Queue => undef,
+ Action => undef,
+ @_
+ );
+
+ my ( $val, $key, $address,$gpg );
+
+ eval {
+
+ my $parser = RT::EmailParser->new();
+ $parser->SmartParseMIMEEntityFromScalar(Message => ${$args{'RawMessageRef'}}, Decode => 0);
+ $gpg = Mail::GnuPG->new( keydir => $RT::GPGKeyDir );
+ my $entity = $parser->Entity;
+ ( $val, $key, $address ) = $gpg->verify( $parser->Entity);
+ $RT::Logger->crit("Got $val - $key - $address");
+ };
+
+ if ($@) {
+ $RT::Logger->crit($@);
+ }
+
+ unless ($address) {
+ $RT::Logger->crit( "Couldn't find a valid signature" . join ( "\n", @{ $gpg->{'last_message'} } ) );
+ return ( $args{'CurrentUser'}, $args{'AuthLevel'} );
+ }
+
+ my @addrs = Mail::Address->parse($address);
+ $address = $addrs[0]->address();
+
+ my $CurrentUser = RT::CurrentUser->new();
+ $CurrentUser->LoadByEmail($address);
+
+ if ( $CurrentUser->Id ) {
+ $RT::Logger->crit($address . " authenticated via PGP signature");
+ return ( $CurrentUser, 2 );
+ }
+
+}
+
+eval "require RT::Interface::Email::Auth::GnuPG_Vendor";
+die $@
+ if ( $@
+ && $@ !~ qr{^Can't locate RT/Interface/Email/Auth/GnuPG_Vendor.pm} );
+eval "require RT::Interface::Email::Auth::GnuPG_Local";
+die $@
+ if ( $@
+ && $@ !~ qr{^Can't locate RT/Interface/Email/Auth/GnuPG_Local.pm} );
+
+1;
diff --git a/rt/lib/RT/Interface/Email/Auth/MailFrom.pm b/rt/lib/RT/Interface/Email/Auth/MailFrom.pm
new file mode 100644
index 000000000..32009c372
--- /dev/null
+++ b/rt/lib/RT/Interface/Email/Auth/MailFrom.pm
@@ -0,0 +1,189 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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::Auth::MailFrom;
+use RT::Interface::Email qw(ParseSenderAddressFromHead CreateUser);
+
+# This is what the ordinary, non-enhanced gateway does at the moment.
+
+sub GetCurrentUser {
+ my %args = ( Message => undef,
+ CurrentUser => undef,
+ AuthLevel => undef,
+ Ticket => undef,
+ Queue => undef,
+ Action => undef,
+ @_ );
+
+
+ # We don't need to do any external lookups
+ my ( $Address, $Name ) = ParseSenderAddressFromHead( $args{'Message'}->head );
+
+ unless ($Address) {
+ return ( $args{'CurrentUser'}, -1 );
+ }
+
+ my $CurrentUser = RT::CurrentUser->new();
+ $CurrentUser->LoadByEmail($Address);
+
+ unless ( $CurrentUser->Id ) {
+ $CurrentUser->LoadByName($Address);
+ }
+
+ if ( $CurrentUser->Id ) {
+ return ( $CurrentUser, 1 );
+ }
+
+
+
+ # 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');
+ unless ( $unpriv->Id ) {
+ $RT::Logger->crit( "Auth::MailFrom couldn't find the 'Unprivileged' internal group" );
+ return ( $args{'CurrentUser'}, -1 );
+ }
+
+ my $everyone = RT::Group->new($RT::SystemUser);
+ $everyone->LoadSystemInternalGroup('Everyone');
+ unless ( $everyone->Id ) {
+ $RT::Logger->crit( "Auth::MailFrom couldn't find the 'Everyone' internal group");
+ return ( $args{'CurrentUser'}, -1 );
+ }
+
+ # but before we do that, we need to make sure that the created user would have the right
+ # to do what we're doing.
+ if ( $args{'Ticket'} && $args{'Ticket'}->Id ) {
+ # We have a ticket. that means we're commenting or corresponding
+ if ( $args{'Action'} =~ /^comment$/i ) {
+
+ # check to see whether "Everyone" or "Unprivileged users" can comment on tickets
+ unless ( $everyone->PrincipalObj->HasRight(
+ Object => $args{'Queue'},
+ Right => 'CommentOnTicket'
+ )
+ || $unpriv->PrincipalObj->HasRight(
+ Object => $args{'Queue'},
+ Right => 'CommentOnTicket'
+ )
+ ) {
+ return ( $args{'CurrentUser'}, 0 );
+ }
+ }
+ elsif ( $args{'Action'} =~ /^correspond$/i ) {
+
+ # check to see whether "Everybody" or "Unprivileged users" can correspond on tickets
+ unless ( $everyone->PrincipalObj->HasRight(Object => $args{'Queue'},
+ Right => 'ReplyToTicket'
+ )
+ || $unpriv->PrincipalObj->HasRight(
+ Object => $args{'Queue'},
+ Right => 'ReplyToTicket'
+ )
+ ) {
+ return ( $args{'CurrentUser'}, 0 );
+ }
+
+ }
+ elsif ( $args{'Action'} =~ /^take$/i ) {
+
+ # check to see whether "Everybody" or "Unprivileged users" can correspond on tickets
+ unless ( $everyone->PrincipalObj->HasRight(Object => $args{'Queue'},
+ Right => 'OwnTicket'
+ )
+ || $unpriv->PrincipalObj->HasRight(
+ Object => $args{'Queue'},
+ Right => 'OwnTicket'
+ )
+ ) {
+ return ( $args{'CurrentUser'}, 0 );
+ }
+
+ }
+ elsif ( $args{'Action'} =~ /^resolve$/i ) {
+
+ # check to see whether "Everybody" or "Unprivileged users" can correspond on tickets
+ unless ( $everyone->PrincipalObj->HasRight(Object => $args{'Queue'},
+ Right => 'ModifyTicket'
+ )
+ || $unpriv->PrincipalObj->HasRight(
+ Object => $args{'Queue'},
+ Right => 'ModifyTicket'
+ )
+ ) {
+ return ( $args{'CurrentUser'}, 0 );
+ }
+
+ }
+ else {
+ return ( $args{'CurrentUser'}, 0 );
+ }
+ }
+
+ # We're creating a ticket
+ elsif ( $args{'Queue'} && $args{'Queue'}->Id ) {
+
+ # check to see whether "Everybody" or "Unprivileged users" can create tickets in this queue
+ unless ( $everyone->PrincipalObj->HasRight( Object => $args{'Queue'},
+ Right => 'CreateTicket' )
+ ) {
+ return ( $args{'CurrentUser'}, 0 );
+ }
+
+ }
+
+ $CurrentUser = CreateUser( undef, $Address, $Name, $Address, $args{'Message'} );
+
+ return ( $CurrentUser, 1 );
+}
+
+eval "require RT::Interface::Email::Auth::MailFrom_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email/Auth/MailFrom_Vendor.pm});
+eval "require RT::Interface::Email::Auth::MailFrom_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email/Auth/MailFrom_Local.pm});
+
+1;
diff --git a/rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm b/rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm
new file mode 100644
index 000000000..2f8b61cdb
--- /dev/null
+++ b/rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm
@@ -0,0 +1,96 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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 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
+
+ @RT::MailPlugins = ("Filter::SpamAssassin", ...);
+
+=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
+
+eval "require RT::Interface::Email::Filter::SpamAssassin_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email/Filter/SpamAssassin_Vendor.pm});
+eval "require RT::Interface::Email::Filter::SpamAssassin_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email/Filter/SpamAssassin_Local.pm});
+
+1;
diff --git a/rt/lib/RT/Interface/REST.pm b/rt/lib/RT/Interface/REST.pm
new file mode 100644
index 000000000..bb2bf24bb
--- /dev/null
+++ b/rt/lib/RT/Interface/REST.pm
@@ -0,0 +1,288 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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 }}}
+# lib/RT/Interface/REST.pm
+#
+
+package RT::Interface::REST;
+use strict;
+use RT;
+
+BEGIN {
+ use Exporter ();
+ use vars qw($VERSION @ISA @EXPORT);
+
+ $VERSION = do { my @r = (q$Revision: 1.1.1.6 $ =~ /\d+/g); sprintf "%d."."%02d"x$#r, @r };
+
+ @ISA = qw(Exporter);
+ @EXPORT = qw(expand_list form_parse form_compose vpush vsplit);
+}
+
+my $field = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-(?:[a-z0-9_ -]|\s)+)';
+
+# WARN: this code is duplicated in bin/rt.in,
+# change both functions at once
+sub expand_list {
+ my ($list) = @_;
+
+ my @elts;
+ foreach (split /,/, $list) {
+ push @elts, /^(\d+)-(\d+)$/? ($1..$2): $_;
+ }
+
+ return map $_->[0], # schwartzian transform
+ sort {
+ defined $a->[1] && defined $b->[1]?
+ # both numbers
+ $a->[1] <=> $b->[1]
+ :!defined $a->[1] && !defined $b->[1]?
+ # both letters
+ $a->[2] cmp $b->[2]
+ # mix, number must be first
+ :defined $a->[1]? -1: 1
+ }
+ map [ $_, (defined( /^(\d+)$/ )? $1: undef), lc($_) ],
+ @elts;
+}
+
+# Returns a reference to an array of parsed forms.
+sub form_parse {
+ my $state = 0;
+ my @forms = ();
+ my @lines = split /\n/, $_[0];
+ my ($c, $o, $k, $e) = ("", [], {}, "");
+
+ LINE:
+ while (@lines) {
+ my $line = shift @lines;
+
+ next LINE if $line eq '';
+
+ if ($line eq '--') {
+ # We reached the end of one form. We'll ignore it if it was
+ # empty, and store it otherwise, errors and all.
+ if ($e || $c || @$o) {
+ push @forms, [ $c, $o, $k, $e ];
+ $c = ""; $o = []; $k = {}; $e = "";
+ }
+ $state = 0;
+ }
+ elsif ($state != -1) {
+ if ($state == 0 && $line =~ /^#/) {
+ # Read an optional block of comments (only) at the start
+ # of the form.
+ $state = 1;
+ $c = $line;
+ while (@lines && $lines[0] =~ /^#/) {
+ $c .= "\n".shift @lines;
+ }
+ $c .= "\n";
+ }
+ elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/i) {
+ # Read a field: value specification.
+ my $f = $1;
+ my @v = ($2 || ());
+
+ # Read continuation lines, if any.
+ while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) {
+ push @v, shift @lines;
+ }
+ pop @v while (@v && $v[-1] eq '');
+
+ # Strip longest common leading indent from text.
+ my ($ws, $ls) = ("");
+ foreach $ls (map {/^(\s+)/} @v[1..$#v]) {
+ $ws = $ls if (!$ws || length($ls) < length($ws));
+ }
+ s/^$ws// foreach @v;
+
+ push(@$o, $f) unless exists $k->{$f};
+ vpush($k, $f, join("\n", @v));
+
+ $state = 1;
+ }
+ elsif ($line !~ /^#/) {
+ # We've found a syntax error, so we'll reconstruct the
+ # form parsed thus far, and add an error marker. (>>)
+ $state = -1;
+ $e = form_compose([[ "", $o, $k, "" ]]);
+ $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n";
+ }
+ }
+ else {
+ # We saw a syntax error earlier, so we'll accumulate the
+ # contents of this form until the end.
+ $e .= "$line\n";
+ }
+ }
+ push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o);
+
+ my $l;
+ foreach $l (keys %$k) {
+ $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY');
+ }
+
+ return \@forms;
+}
+
+# Returns text representing a set of forms.
+sub form_compose {
+ my ($forms) = @_;
+ my (@text, $form);
+
+ foreach $form (@$forms) {
+ my ($c, $o, $k, $e) = @$form;
+ my $text = "";
+
+ if ($c) {
+ $c =~ s/\n*$/\n/;
+ $text = "$c\n";
+ }
+ if ($e) {
+ $text .= $e;
+ }
+ elsif ($o) {
+ my (@lines, $key);
+
+ foreach $key (@$o) {
+ my ($line, $sp, $v);
+ my @values = (ref $k->{$key} eq 'ARRAY') ?
+ @{ $k->{$key} } :
+ $k->{$key};
+
+ $sp = " "x(length("$key: "));
+ $sp = " "x4 if length($sp) > 16;
+
+ foreach $v (@values) {
+ if ($v =~ /\n/) {
+ $v =~ s/^/$sp/gm;
+ $v =~ s/^$sp//;
+
+ if ($line) {
+ push @lines, "$line\n\n";
+ $line = "";
+ }
+ elsif (@lines && $lines[-1] !~ /\n\n$/) {
+ $lines[-1] .= "\n";
+ }
+ push @lines, "$key: $v\n\n";
+ }
+ elsif ($line &&
+ length($line)+length($v)-rindex($line, "\n") >= 70)
+ {
+ $line .= ",\n$sp$v";
+ }
+ else {
+ $line = $line ? "$line, $v" : "$key: $v";
+ }
+ }
+
+ $line = "$key:" unless @values;
+ if ($line) {
+ if ($line =~ /\n/) {
+ if (@lines && $lines[-1] !~ /\n\n$/) {
+ $lines[-1] .= "\n";
+ }
+ $line .= "\n";
+ }
+ push @lines, "$line\n";
+ }
+ }
+
+ $text .= join "", @lines;
+ }
+ else {
+ chomp $text;
+ }
+ push @text, $text;
+ }
+
+ return join "\n--\n\n", @text;
+}
+
+# Add a value to a (possibly multi-valued) hash key.
+sub vpush {
+ my ($hash, $key, $val) = @_;
+ my @val = ref $val eq 'ARRAY' ? @$val : $val;
+
+ if (exists $hash->{$key}) {
+ unless (ref $hash->{$key} eq 'ARRAY') {
+ my @v = $hash->{$key} ne '' ? $hash->{$key} : ();
+ $hash->{$key} = \@v;
+ }
+ push @{ $hash->{$key} }, @val;
+ }
+ else {
+ $hash->{$key} = $val;
+ }
+}
+
+# "Normalise" a hash key that's known to be multi-valued.
+sub vsplit {
+ my ($val) = @_;
+ my ($line, $word, @words);
+
+ foreach $line (map {split /\n/} (ref $val eq 'ARRAY') ? @$val : $val)
+ {
+ # XXX: This should become a real parser, à la Text::ParseWords.
+ $line =~ s/^\s+//;
+ $line =~ s/\s+$//;
+ push @words, split /\s*,\s*/, $line;
+ }
+
+ return \@words;
+}
+
+1;
+
+=head1 NAME
+
+ RT::Interface::REST - helper functions for the REST interface.
+
+=head1 SYNOPSIS
+
+ Only the REST should use this module.
diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm
new file mode 100644
index 000000000..bc63f7cb5
--- /dev/null
+++ b/rt/lib/RT/Interface/Web.pm
@@ -0,0 +1,1687 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+## Portions Copyright 2000 Tobias Brox <tobix@fsck.com>
+
+## This is a library of static subs to be used by the Mason web
+## interface to RT
+
+
+=head1 NAME
+
+RT::Interface::Web
+
+=begin testing
+
+use_ok(RT::Interface::Web);
+
+=end testing
+
+=cut
+
+
+use strict;
+use warnings;
+
+package RT::Interface::Web;
+use HTTP::Date;
+use RT::SavedSearches;
+use URI;
+
+# {{{ EscapeUTF8
+
+=head2 EscapeUTF8 SCALARREF
+
+does a css-busting but minimalist escaping of whatever html you're passing in.
+
+=cut
+
+sub EscapeUTF8 {
+ my $ref = shift;
+ return unless defined $$ref;
+ my $val = $$ref;
+ use bytes;
+ $val =~ s/&/&#38;/g;
+ $val =~ s/</&lt;/g;
+ $val =~ s/>/&gt;/g;
+ $val =~ s/\(/&#40;/g;
+ $val =~ s/\)/&#41;/g;
+ $val =~ s/"/&#34;/g;
+ $val =~ s/'/&#39;/g;
+ $$ref = $val;
+ Encode::_utf8_on($$ref);
+
+
+}
+
+# }}}
+
+# {{{ EscapeURI
+
+=head2 EscapeURI SCALARREF
+
+Escapes URI component according to RFC2396
+
+=cut
+
+use Encode qw();
+sub EscapeURI {
+ my $ref = shift;
+ $$ref = Encode::encode_utf8( $$ref );
+ $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
+ Encode::_utf8_on( $$ref );
+}
+
+# }}}
+
+# {{{ WebCanonicalizeInfo
+
+=head2 WebCanonicalizeInfo();
+
+Different web servers set different environmental varibles. This
+function must return something suitable for REMOTE_USER. By default,
+just downcase $ENV{'REMOTE_USER'}
+
+=cut
+
+sub WebCanonicalizeInfo {
+ my $user;
+
+ if ( defined $ENV{'REMOTE_USER'} ) {
+ $user = lc ( $ENV{'REMOTE_USER'} ) if( length($ENV{'REMOTE_USER'}) );
+ }
+
+ return $user;
+}
+
+# }}}
+
+# {{{ WebExternalAutoInfo
+
+=head2 WebExternalAutoInfo($user);
+
+Returns a hash of user attributes, used when WebExternalAuto is set.
+
+=cut
+
+sub WebExternalAutoInfo {
+ my $user = shift;
+
+ my %user_info;
+
+ $user_info{'Privileged'} = 1;
+
+ if ($^O !~ /^(?:riscos|MacOS|MSWin32|dos|os2)$/) {
+ # Populate fields with information from Unix /etc/passwd
+
+ my ($comments, $realname) = (getpwnam($user))[5, 6];
+ $user_info{'Comments'} = $comments if defined $comments;
+ $user_info{'RealName'} = $realname if defined $realname;
+ }
+ elsif ($^O eq 'MSWin32' and eval 'use Net::AdminMisc; 1') {
+ # Populate fields with information from NT domain controller
+ }
+
+ # and return the wad of stuff
+ return {%user_info};
+}
+
+# }}}
+
+
+
+=head2 Redirect URL
+
+This routine ells the current user's browser to redirect to URL.
+Additionally, it unties the user's currently active session, helping to avoid
+A bug in Apache::Session 1.81 and earlier which clobbers sessions if we try to use
+a cached DBI statement handle twice at the same time.
+
+=cut
+
+
+sub Redirect {
+ my $redir_to = shift;
+ untie $HTML::Mason::Commands::session;
+ my $uri = URI->new($redir_to);
+ my $server_uri = URI->new($RT::WebURL);
+
+ # 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)
+ if ($uri->host eq $server_uri->host &&
+ $uri->port eq $server_uri->port) {
+ $uri->host($ENV{'HTTP_HOST'});
+ $uri->port($ENV{'SERVER_PORT'});
+ }
+
+ $HTML::Mason::Commands::m->redirect($uri->canonical);
+ $HTML::Mason::Commands::m->abort;
+}
+
+
+=head2 StaticFileHeaders
+
+Send the browser a few headers to try to get it to (somewhat agressively)
+cache RT's static Javascript and CSS files.
+
+This routine could really use _accurate_ heuristics. (XXX TODO)
+
+=cut
+
+sub StaticFileHeaders {
+ # make cache public
+ $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
+
+ # Expire things in a month.
+ $HTML::Mason::Commands::r->headers_out->{'Expires'} = HTTP::Date::time2str( time() + 2592000 );
+
+ # if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since'
+ # request, but we don't handle it and generate full reply again
+ # Last modified at server start time
+ #$HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = HTTP::Date::time2str($^T);
+
+}
+
+
+package HTML::Mason::Commands;
+use vars qw/$r $m %session/;
+
+
+# {{{ loc
+
+=head2 loc ARRAY
+
+loc is a nice clean global routine which calls $session{'CurrentUser'}->loc()
+with whatever it's called with. If there is no $session{'CurrentUser'},
+it creates a temporary user, so we have something to get a localisation handle
+through
+
+=cut
+
+sub loc {
+
+ if ($session{'CurrentUser'} &&
+ UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
+ return($session{'CurrentUser'}->loc(@_));
+ }
+ elsif ( my $u = eval { RT::CurrentUser->new($RT::SystemUser->Id) } ) {
+ return ($u->loc(@_));
+ }
+ else {
+ # pathetic case -- SystemUser is gone.
+ return $_[0];
+ }
+}
+
+# }}}
+
+
+# {{{ loc_fuzzy
+
+=head2 loc_fuzzy STRING
+
+loc_fuzzy is for handling localizations of messages that may already
+contain interpolated variables, typically returned from libraries
+outside RT's control. It takes the message string and extracts the
+variable array automatically by matching against the candidate entries
+inside the lexicon file.
+
+=cut
+
+sub loc_fuzzy {
+ my $msg = shift;
+
+ if ($session{'CurrentUser'} &&
+ UNIVERSAL::can($session{'CurrentUser'}, 'loc')){
+ return($session{'CurrentUser'}->loc_fuzzy($msg));
+ }
+ else {
+ my $u = RT::CurrentUser->new($RT::SystemUser->Id);
+ return ($u->loc_fuzzy($msg));
+ }
+}
+
+# }}}
+
+
+# {{{ sub Abort
+# Error - calls Error and aborts
+sub Abort {
+
+ if ($session{'ErrorDocument'} &&
+ $session{'ErrorDocumentType'}) {
+ $r->content_type($session{'ErrorDocumentType'});
+ $m->comp($session{'ErrorDocument'} , Why => shift);
+ $m->abort;
+ }
+ else {
+ $m->comp("/Elements/Error" , Why => shift);
+ $m->abort;
+ }
+}
+
+# }}}
+
+# {{{ sub CreateTicket
+
+=head2 CreateTicket ARGS
+
+Create a new ticket, using Mason's %ARGS. returns @results.
+
+=cut
+
+sub CreateTicket {
+ my %ARGS = (@_);
+
+ my (@Actions);
+
+ my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
+
+ my $Queue = new RT::Queue( $session{'CurrentUser'} );
+ unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
+ Abort('Queue not found');
+ }
+
+ unless ( $Queue->CurrentUserHasRight('CreateTicket') ) {
+ Abort('You have no permission to create tickets in that queue.');
+ }
+
+ my $due = new RT::Date( $session{'CurrentUser'} );
+ $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
+ my $starts = new RT::Date( $session{'CurrentUser'} );
+ $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
+
+ my $MIMEObj = MakeMIMEEntity(
+ Subject => $ARGS{'Subject'},
+ From => $ARGS{'From'},
+ Cc => $ARGS{'Cc'},
+ Body => $ARGS{'Content'},
+ Type => $ARGS{'ContentType'},
+ );
+
+ if ( $ARGS{'Attachments'} ) {
+ my $rv = $MIMEObj->make_multipart;
+ $RT::Logger->error("Couldn't make multipart message")
+ if !$rv || $rv !~ /^(?:DONE|ALREADY)$/;
+
+ foreach ( values %{$ARGS{'Attachments'}} ) {
+ unless ( $_ ) {
+ $RT::Logger->error("Couldn't add empty attachemnt");
+ next;
+ }
+ $MIMEObj->add_part($_);
+ }
+ }
+
+ my %create_args = (
+ Type => $ARGS{'Type'} || 'ticket',
+ Queue => $ARGS{'Queue'},
+ Owner => $ARGS{'Owner'},
+ InitialPriority => $ARGS{'InitialPriority'},
+ FinalPriority => $ARGS{'FinalPriority'},
+ TimeLeft => $ARGS{'TimeLeft'},
+ TimeEstimated => $ARGS{'TimeEstimated'},
+ TimeWorked => $ARGS{'TimeWorked'},
+ Subject => $ARGS{'Subject'},
+ Status => $ARGS{'Status'},
+ Due => $due->ISO,
+ Starts => $starts->ISO,
+ MIMEObj => $MIMEObj
+ );
+
+ my @temp_squelch;
+ foreach my $type (qw(Requestors Cc AdminCc)) {
+ my @tmp = map { $_->format } grep { $_->address} Mail::Address->parse( $ARGS{ $type } );
+
+ $create_args{ $type } = [
+ grep $_, map {
+ my $user = RT::User->new( $RT::SystemUser );
+ $user->LoadOrCreateByEmail( $_ );
+ # convert to ids to avoid work later
+ $user->id;
+ } @tmp
+ ];
+ $RT::Logger->debug(
+ "$type got ".join(',',@{$create_args{ $type }}) );
+
+ }
+ # XXX: workaround for name conflict :(
+ $create_args{'Requestor'} = delete $create_args{'Requestors'};
+
+ foreach my $arg (keys %ARGS) {
+ next if $arg =~ /-(?:Magic|Category)$/;
+
+ if ($arg =~ /^Object-RT::Transaction--CustomField-/) {
+ $create_args{$arg} = $ARGS{$arg};
+ }
+ # Object-RT::Ticket--CustomField-3-Values
+ elsif ($arg =~ /^Object-RT::Ticket--CustomField-(\d+)(.*?)$/) {
+ my $cfid = $1;
+ my $cf = RT::CustomField->new( $session{'CurrentUser'});
+ $cf->Load($cfid);
+
+ if ( $cf->Type eq 'Freeform' && ! $cf->SingleValue) {
+ $ARGS{$arg} =~ s/\r\n/\n/g;
+ $ARGS{$arg} = [split('\n', $ARGS{$arg})];
+ }
+
+ if ( $cf->Type =~ /text/i) { # Catch both Text and Wikitext
+ $ARGS{$arg} =~ s/\r//g;
+ }
+
+ if ( $arg =~ /-Upload$/ ) {
+ $create_args{"CustomField-".$cfid} = _UploadedFile($arg);
+ }
+ else {
+ $create_args{"CustomField-".$cfid} = $ARGS{"$arg"};
+ }
+ }
+ }
+
+
+ # XXX TODO This code should be about six lines. and badly needs refactoring.
+
+ # {{{ turn new link lists into arrays, and pass in the proper arguments
+ my (@dependson, @dependedonby, @parents, @children, @refersto, @referredtoby);
+
+ foreach my $luri ( split ( / /, $ARGS{"new-DependsOn"} ) ) {
+ $luri =~ s/\s*$//; # Strip trailing whitespace
+ push @dependson, $luri;
+ }
+ $create_args{'DependsOn'} = \@dependson;
+
+ foreach my $luri ( split ( / /, $ARGS{"DependsOn-new"} ) ) {
+ push @dependedonby, $luri;
+ }
+ $create_args{'DependedOnBy'} = \@dependedonby;
+
+ foreach my $luri ( split ( / /, $ARGS{"new-MemberOf"} ) ) {
+ $luri =~ s/\s*$//; # Strip trailing whitespace
+ push @parents, $luri;
+ }
+ $create_args{'Parents'} = \@parents;
+
+ foreach my $luri ( split ( / /, $ARGS{"MemberOf-new"} ) ) {
+ push @children, $luri;
+ }
+ $create_args{'Children'} = \@children;
+
+ foreach my $luri ( split ( / /, $ARGS{"new-RefersTo"} ) ) {
+ $luri =~ s/\s*$//; # Strip trailing whitespace
+ push @refersto, $luri;
+ }
+ $create_args{'RefersTo'} = \@refersto;
+
+ foreach my $luri ( split ( / /, $ARGS{"RefersTo-new"} ) ) {
+ push @referredtoby, $luri;
+ }
+ $create_args{'ReferredToBy'} = \@referredtoby;
+ # }}}
+
+
+ my ( $id, $Trans, $ErrMsg ) = $Ticket->Create(%create_args);
+ unless ( $id ) {
+ Abort($ErrMsg);
+ }
+
+ push ( @Actions, split("\n", $ErrMsg) );
+ unless ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
+ Abort( "No permission to view newly created ticket #"
+ . $Ticket->id . "." );
+ }
+ return ( $Ticket, @Actions );
+
+}
+
+# }}}
+
+# {{{ sub LoadTicket - loads a ticket
+
+=head2 LoadTicket id
+
+Takes a ticket id as its only variable. if it's handed an array, it takes
+the first value.
+
+Returns an RT::Ticket object as the current user.
+
+=cut
+
+sub LoadTicket {
+ my $id = shift;
+
+ if ( ref($id) eq "ARRAY" ) {
+ $id = $id->[0];
+ }
+
+ unless ($id) {
+ Abort("No ticket specified");
+ }
+
+ my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
+ $Ticket->Load($id);
+ unless ( $Ticket->id ) {
+ Abort("Could not load ticket $id");
+ }
+ return $Ticket;
+}
+
+# }}}
+
+# {{{ sub ProcessUpdateMessage
+
+sub ProcessUpdateMessage {
+
+ #TODO document what else this takes.
+ my %args = (
+ ARGSRef => undef,
+ Actions => undef,
+ TicketObj => undef,
+ @_
+ );
+
+ #Make the update content have no 'weird' newlines in it
+ if ( $args{ARGSRef}->{'UpdateTimeWorked'}
+ || $args{ARGSRef}->{'UpdateContent'}
+ || $args{ARGSRef}->{'UpdateAttachments'} )
+ {
+
+ if (
+ $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject() )
+ {
+ $args{ARGSRef}->{'UpdateSubject'} = undef;
+ }
+
+ my $Message = MakeMIMEEntity(
+ Subject => $args{ARGSRef}->{'UpdateSubject'},
+ Body => $args{ARGSRef}->{'UpdateContent'},
+ Type => $args{ARGSRef}->{'UpdateContentType'},
+ );
+
+ $Message->head->add( 'Message-ID' =>
+ "<rt-"
+ . $RT::VERSION . "-"
+ . $$ . "-"
+ . CORE::time() . "-"
+ . int(rand(2000)) . "."
+ . $args{'TicketObj'}->id . "-"
+ . "0" . "-" # Scrip
+ . "0" . "@" # Email sent
+ . $RT::Organization
+ . ">" );
+ my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
+ if ( $args{ARGSRef}->{'QuoteTransaction'} ) {
+ $old_txn->Load( $args{ARGSRef}->{'QuoteTransaction'} );
+ }
+ else {
+ $old_txn = $args{TicketObj}->Transactions->First();
+ }
+
+ if ( $old_txn->Message && $old_txn->Message->First ) {
+ my @in_reply_to = split(/\s+/m, $old_txn->Message->First->GetHeader('In-Reply-To') || '');
+ my @references = split(/\s+/m, $old_txn->Message->First->GetHeader('References') || '' );
+ my @msgid = split(/\s+/m,$old_txn->Message->First->GetHeader('Message-ID') || '');
+ my @rtmsgid = split(/\s+/m,$old_txn->Message->First->GetHeader('RT-Message-ID') || '');
+
+ $Message->head->replace( 'In-Reply-To', join (' ', @rtmsgid ? @rtmsgid : @msgid));
+ $Message->head->replace( 'References', join(' ', @references, @msgid, @rtmsgid));
+ }
+
+ if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
+ $Message->make_multipart;
+ $Message->add_part($_)
+ foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
+ }
+
+ ## TODO: Implement public comments
+ if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
+ my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(
+ CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
+ BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
+ MIMEObj => $Message,
+ TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
+ );
+ push( @{ $args{Actions} }, $Description );
+ $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
+ }
+ elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
+ my ( $Transaction, $Description, $Object ) =
+ $args{TicketObj}->Correspond(
+ CcMessageTo => $args{ARGSRef}->{'UpdateCc'},
+ BccMessageTo => $args{ARGSRef}->{'UpdateBcc'},
+ MIMEObj => $Message,
+ TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
+ );
+ push( @{ $args{Actions} }, $Description );
+ $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
+ }
+ else {
+ push(
+ @{ $args{'Actions'} },
+ loc("Update type was neither correspondence nor comment.") . " "
+ . loc("Update not recorded.")
+ );
+ }
+}
+}
+
+# }}}
+
+# {{{ sub MakeMIMEEntity
+
+=head2 MakeMIMEEntity PARAMHASH
+
+Takes a paramhash Subject, Body and AttachmentFieldName.
+
+Also takes Form, Cc and Type as optional paramhash keys.
+
+ Returns a MIME::Entity.
+
+=cut
+
+sub MakeMIMEEntity {
+
+ #TODO document what else this takes.
+ my %args = (
+ Subject => undef,
+ From => undef,
+ Cc => undef,
+ Body => undef,
+ AttachmentFieldName => undef,
+ Type => undef,
+# map Encode::encode_utf8($_), @_,
+ @_,
+ );
+
+ #Make the update content have no 'weird' newlines in it
+
+ $args{'Body'} =~ s/\r\n/\n/gs if $args{'Body'};
+ my $Message;
+ {
+ # MIME::Head is not happy in utf-8 domain. This only happens
+ # when processing an incoming email (so far observed).
+ no utf8;
+ use bytes;
+ $Message = MIME::Entity->build(
+ Subject => $args{'Subject'} || "",
+ From => $args{'From'},
+ Cc => $args{'Cc'},
+ Type => $args{'Type'} || 'text/plain',
+ 'Charset:' => 'utf8',
+ Data => [ $args{'Body'} ]
+ );
+ }
+
+ my $cgi_object = $m->cgi_object;
+
+ if (my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
+
+
+
+ use File::Temp qw(tempfile tempdir);
+
+ #foreach my $filehandle (@filenames) {
+
+ my ( $fh, $temp_file );
+ for ( 1 .. 10 ) {
+ # on NFS and NTFS, it is possible that tempfile() conflicts
+ # with other processes, causing a race condition. we try to
+ # accommodate this by pausing and retrying.
+ last if ($fh, $temp_file) = eval { tempfile( UNLINK => 1) };
+ sleep 1;
+ }
+
+ binmode $fh; #thank you, windows
+ my ($buffer);
+ while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
+ print $fh $buffer;
+ }
+
+ 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 =~ s#^.*[\\/]##;
+
+ $Message->attach(
+ Path => $temp_file,
+ Filename => Encode::decode_utf8($filename),
+ Type => $uploadinfo->{'Content-Type'},
+ );
+ close($fh);
+
+ # }
+
+ }
+
+ $Message->make_singlepart();
+ RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
+
+ return ($Message);
+
+}
+
+# }}}
+
+# {{{ sub ProcessSearchQuery
+
+=head2 ProcessSearchQuery
+
+ Takes a form such as the one filled out in webrt/Search/Elements/PickRestriction and turns it into something that RT::Tickets can understand.
+
+TODO Doc exactly what comes in the paramhash
+
+
+=cut
+
+sub ProcessSearchQuery {
+ my %args = @_;
+
+ ## TODO: The only parameter here is %ARGS. Maybe it would be
+ ## cleaner to load this parameter as $ARGS, and use $ARGS->{...}
+ ## instead of $args{ARGS}->{...} ? :)
+
+ #Searches are sticky.
+ if ( defined $session{'tickets'} ) {
+
+ # Reset the old search
+ $session{'tickets'}->GotoFirstItem;
+ }
+ else {
+
+ # Init a new search
+ $session{'tickets'} = RT::Tickets->new( $session{'CurrentUser'} );
+ }
+
+ #Import a bookmarked search if we have one
+ if ( defined $args{ARGS}->{'Bookmark'} ) {
+ $session{'tickets'}->ThawLimits( $args{ARGS}->{'Bookmark'} );
+ }
+
+ # {{{ Goto next/prev page
+ if ( $args{ARGS}->{'GotoPage'} eq 'Next' ) {
+ $session{'tickets'}->NextPage;
+ }
+ elsif ( $args{ARGS}->{'GotoPage'} eq 'Prev' ) {
+ $session{'tickets'}->PrevPage;
+ }
+ elsif ( $args{ARGS}->{'GotoPage'} > 0 ) {
+ $session{'tickets'}->GotoPage( $args{ARGS}->{GotoPage} - 1 );
+ }
+
+ # }}}
+
+ # {{{ Deal with limiting the search
+
+ if ( $args{ARGS}->{'RefreshSearchInterval'} ) {
+ $session{'tickets_refresh_interval'} =
+ $args{ARGS}->{'RefreshSearchInterval'};
+ }
+
+ if ( $args{ARGS}->{'TicketsSortBy'} ) {
+ $session{'tickets_sort_by'} = $args{ARGS}->{'TicketsSortBy'};
+ $session{'tickets_sort_order'} = $args{ARGS}->{'TicketsSortOrder'};
+ $session{'tickets'}->OrderBy(
+ FIELD => $args{ARGS}->{'TicketsSortBy'},
+ ORDER => $args{ARGS}->{'TicketsSortOrder'}
+ );
+ }
+
+ # }}}
+
+ # {{{ Set the query limit
+ if ( defined $args{ARGS}->{'RowsPerPage'} ) {
+ $RT::Logger->debug(
+ "limiting to " . $args{ARGS}->{'RowsPerPage'} . " rows" );
+
+ $session{'tickets_rows_per_page'} = $args{ARGS}->{'RowsPerPage'};
+ $session{'tickets'}->RowsPerPage( $args{ARGS}->{'RowsPerPage'} );
+ }
+
+ # }}}
+ # {{{ Limit priority
+ if ( $args{ARGS}->{'ValueOfPriority'} ne '' ) {
+ $session{'tickets'}->LimitPriority(
+ VALUE => $args{ARGS}->{'ValueOfPriority'},
+ OPERATOR => $args{ARGS}->{'PriorityOp'}
+ );
+ }
+
+ # }}}
+ # {{{ Limit owner
+ if ( $args{ARGS}->{'ValueOfOwner'} ne '' ) {
+ $session{'tickets'}->LimitOwner(
+ VALUE => $args{ARGS}->{'ValueOfOwner'},
+ OPERATOR => $args{ARGS}->{'OwnerOp'}
+ );
+ }
+
+ # }}}
+ # {{{ Limit requestor email
+ if ( $args{ARGS}->{'ValueOfWatcherRole'} ne '' ) {
+ $session{'tickets'}->LimitWatcher(
+ TYPE => $args{ARGS}->{'WatcherRole'},
+ VALUE => $args{ARGS}->{'ValueOfWatcherRole'},
+ OPERATOR => $args{ARGS}->{'WatcherRoleOp'},
+
+ );
+ }
+
+ # }}}
+ # {{{ Limit Queue
+ if ( $args{ARGS}->{'ValueOfQueue'} ne '' ) {
+ $session{'tickets'}->LimitQueue(
+ VALUE => $args{ARGS}->{'ValueOfQueue'},
+ OPERATOR => $args{ARGS}->{'QueueOp'}
+ );
+ }
+
+ # }}}
+ # {{{ Limit Status
+ if ( $args{ARGS}->{'ValueOfStatus'} ne '' ) {
+ if ( ref( $args{ARGS}->{'ValueOfStatus'} ) ) {
+ foreach my $value ( @{ $args{ARGS}->{'ValueOfStatus'} } ) {
+ $session{'tickets'}->LimitStatus(
+ VALUE => $value,
+ OPERATOR => $args{ARGS}->{'StatusOp'},
+ );
+ }
+ }
+ else {
+ $session{'tickets'}->LimitStatus(
+ VALUE => $args{ARGS}->{'ValueOfStatus'},
+ OPERATOR => $args{ARGS}->{'StatusOp'},
+ );
+ }
+
+ }
+
+ # }}}
+ # {{{ Limit Subject
+ if ( $args{ARGS}->{'ValueOfSubject'} ne '' ) {
+ my $val = $args{ARGS}->{'ValueOfSubject'};
+ if ($args{ARGS}->{'SubjectOp'} =~ /like/) {
+ $val = "%".$val."%";
+ }
+ $session{'tickets'}->LimitSubject(
+ VALUE => $val,
+ OPERATOR => $args{ARGS}->{'SubjectOp'},
+ );
+ }
+
+ # }}}
+ # {{{ Limit Dates
+ if ( $args{ARGS}->{'ValueOfDate'} ne '' ) {
+ my $date = ParseDateToISO( $args{ARGS}->{'ValueOfDate'} );
+ $args{ARGS}->{'DateType'} =~ s/_Date$//;
+
+ if ( $args{ARGS}->{'DateType'} eq 'Updated' ) {
+ $session{'tickets'}->LimitTransactionDate(
+ VALUE => $date,
+ OPERATOR => $args{ARGS}->{'DateOp'},
+ );
+ }
+ else {
+ $session{'tickets'}->LimitDate( FIELD => $args{ARGS}->{'DateType'},
+ VALUE => $date,
+ OPERATOR => $args{ARGS}->{'DateOp'},
+ );
+ }
+ }
+
+ # }}}
+ # {{{ Limit Content
+ if ( $args{ARGS}->{'ValueOfAttachmentField'} ne '' ) {
+ my $val = $args{ARGS}->{'ValueOfAttachmentField'};
+ if ($args{ARGS}->{'AttachmentFieldOp'} =~ /like/) {
+ $val = "%".$val."%";
+ }
+ $session{'tickets'}->Limit(
+ FIELD => $args{ARGS}->{'AttachmentField'},
+ VALUE => $val,
+ OPERATOR => $args{ARGS}->{'AttachmentFieldOp'},
+ );
+ }
+
+ # }}}
+
+ # {{{ Limit CustomFields
+
+ foreach my $arg ( keys %{ $args{ARGS} } ) {
+ my $id;
+ if ( $arg =~ /^CustomField(\d+)$/ ) {
+ $id = $1;
+ }
+ else {
+ next;
+ }
+ next unless ( $args{ARGS}->{$arg} );
+
+ my $form = $args{ARGS}->{$arg};
+ my $oper = $args{ARGS}->{ "CustomFieldOp" . $id };
+ foreach my $value ( ref($form) ? @{$form} : ($form) ) {
+ my $quote = 1;
+ if ($oper =~ /like/i) {
+ $value = "%".$value."%";
+ }
+ if ( $value =~ /^null$/i ) {
+
+ #Don't quote the string 'null'
+ $quote = 0;
+
+ # Convert the operator to something apropriate for nulls
+ $oper = 'IS' if ( $oper eq '=' );
+ $oper = 'IS NOT' if ( $oper eq '!=' );
+ }
+ $session{'tickets'}->LimitCustomField( CUSTOMFIELD => $id,
+ OPERATOR => $oper,
+ QUOTEVALUE => $quote,
+ VALUE => $value );
+ }
+ }
+
+ # }}}
+
+
+}
+
+# }}}
+
+# {{{ sub ParseDateToISO
+
+=head2 ParseDateToISO
+
+Takes a date in an arbitrary format.
+Returns an ISO date and time in GMT
+
+=cut
+
+sub ParseDateToISO {
+ my $date = shift;
+
+ my $date_obj = RT::Date->new($session{'CurrentUser'});
+ $date_obj->Set(
+ Format => 'unknown',
+ Value => $date
+ );
+ return ( $date_obj->ISO );
+}
+
+# }}}
+
+# {{{ sub ProcessACLChanges
+
+sub ProcessACLChanges {
+ my $ARGSref = shift;
+
+ my %ARGS = %$ARGSref;
+
+ my ( $ACL, @results );
+
+
+ foreach my $arg (keys %ARGS) {
+ if ($arg =~ /GrantRight-(\d+)-(.*?)-(\d+)$/) {
+ my $principal_id = $1;
+ my $object_type = $2;
+ my $object_id = $3;
+ my $rights = $ARGS{$arg};
+
+ 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);
+ } else {
+ push (@results, loc("System Error"). ': '.
+ loc("Rights could not be granted for [_1]", $object_type));
+ next;
+ }
+
+ my @rights = ref($ARGS{$arg}) eq 'ARRAY' ? @{$ARGS{$arg}} : ($ARGS{$arg});
+ foreach my $right (@rights) {
+ next unless ($right);
+ my ($val, $msg) = $principal->GrantRight(Object => $obj, Right => $right);
+ push (@results, $msg);
+ }
+ }
+ elsif ($arg =~ /RevokeRight-(\d+)-(.*?)-(\d+)-(.*?)$/) {
+ my $principal_id = $1;
+ my $object_type = $2;
+ my $object_id = $3;
+ my $right = $4;
+
+ my $principal = RT::Principal->new($session{'CurrentUser'});
+ $principal->Load($principal_id);
+ next unless ($right);
+ 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);
+ } else {
+ push (@results, loc("System Error"). ': '.
+ loc("Rights could not be revoked for [_1]", $object_type));
+ next;
+ }
+ my ($val, $msg) = $principal->RevokeRight(Object => $obj, Right => $right);
+ push (@results, $msg);
+ }
+
+
+ }
+
+ return (@results);
+
+ }
+
+# }}}
+
+# {{{ sub UpdateRecordObj
+
+=head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
+
+@attribs is a list of ticket fields to check and update if they differ from the B<Object>'s current values. ARGSRef is a ref to HTML::Mason's %ARGS.
+
+Returns an array of success/failure messages
+
+=cut
+
+sub UpdateRecordObject {
+ my %args = (
+ ARGSRef => undef,
+ AttributesRef => undef,
+ Object => undef,
+ AttributePrefix => undef,
+ @_
+ );
+
+ my $Object = $args{'Object'};
+ my @results = $Object->Update(AttributesRef => $args{'AttributesRef'},
+ ARGSRef => $args{'ARGSRef'},
+ AttributePrefix => $args{'AttributePrefix'}
+ );
+
+ return (@results);
+}
+
+# }}}
+
+# {{{ Sub ProcessCustomFieldUpdates
+
+sub ProcessCustomFieldUpdates {
+ my %args = (
+ CustomFieldObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $Object = $args{'CustomFieldObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ my @attribs = qw( Name Type Description Queue SortOrder);
+ my @results = UpdateRecordObject(
+ AttributesRef => \@attribs,
+ Object => $Object,
+ ARGSRef => $ARGSRef
+ );
+
+ if ( $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" } ) {
+
+ my ( $addval, $addmsg ) = $Object->AddValue(
+ Name =>
+ $ARGSRef->{ "CustomField-" . $Object->Id . "-AddValue-Name" },
+ Description => $ARGSRef->{ "CustomField-"
+ . $Object->Id
+ . "-AddValue-Description" },
+ SortOrder => $ARGSRef->{ "CustomField-"
+ . $Object->Id
+ . "-AddValue-SortOrder" },
+ );
+ push ( @results, $addmsg );
+ }
+ my @delete_values = (
+ ref $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } eq
+ 'ARRAY' )
+ ? @{ $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } }
+ : ( $ARGSRef->{ 'CustomField-' . $Object->Id . '-DeleteValue' } );
+ foreach my $id (@delete_values) {
+ next unless defined $id;
+ my ( $err, $msg ) = $Object->DeleteValue($id);
+ push ( @results, $msg );
+ }
+
+ my $vals = $Object->Values();
+ while (my $cfv = $vals->Next()) {
+ if (my $so = $ARGSRef->{ 'CustomField-' . $Object->Id . '-SortOrder' . $cfv->Id }) {
+ if ($cfv->SortOrder != $so) {
+ my ( $err, $msg ) = $cfv->SetSortOrder($so);
+ push ( @results, $msg );
+ }
+ }
+ }
+
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub ProcessTicketBasics
+
+=head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketBasics {
+
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $TicketObj = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ # {{{ Set basic fields
+ my @attribs = qw(
+ Subject
+ FinalPriority
+ Priority
+ TimeEstimated
+ TimeWorked
+ TimeLeft
+ Type
+ Status
+ 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();
+ }
+ }
+
+
+ # Status isn't a field that can be set to a null value.
+ # RT core complains if you try
+ delete $ARGSRef->{'Status'} unless ($ARGSRef->{'Status'});
+
+ my @results = UpdateRecordObject(
+ AttributesRef => \@attribs,
+ Object => $TicketObj,
+ ARGSRef => $ARGSRef
+ );
+
+ # We special case owner changing, so we can use ForceOwnerChange
+ if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
+ my ($ChownType);
+ if ( $ARGSRef->{'ForceOwnerChange'} ) {
+ $ChownType = "Force";
+ }
+ else {
+ $ChownType = "Give";
+ }
+
+ my ( $val, $msg ) =
+ $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
+ push ( @results, $msg );
+ }
+
+ # }}}
+
+ return (@results);
+}
+
+# }}}
+
+sub ProcessTicketCustomFieldUpdates {
+ my %args = @_;
+ $args{'Object'} = delete $args{'TicketObj'};
+ my $ARGSRef = { %{ $args{'ARGSRef'} } };
+
+ # Build up a list of objects that we want to work with
+ my %custom_fields_to_mod;
+ foreach my $arg ( keys %$ARGSRef ) {
+ if ( $arg =~ /^Ticket-(\d+-.*)/) {
+ $ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg};
+ }
+ elsif ( $arg =~ /^CustomField-(\d+-.*)/) {
+ $ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
+ }
+ }
+
+ return ProcessObjectCustomFieldUpdates(%args, ARGSRef => $ARGSRef);
+}
+
+sub ProcessObjectCustomFieldUpdates {
+ my %args = @_;
+ my $ARGSRef = $args{'ARGSRef'};
+ my @results;
+
+ # Build up a list of objects that we want to work with
+ my %custom_fields_to_mod;
+ foreach my $arg ( keys %$ARGSRef ) {
+ # format: Object-<object class>-<object id>-CustomField-<CF id>-<commands>
+ next unless $arg =~ /^Object-([\w:]+)-(\d*)-CustomField-(\d+)-(.*)$/;
+
+ # For each of those objects, find out what custom fields we want to work with.
+ $custom_fields_to_mod{ $1 }{ $2 || 0 }{ $3 }{ $4 } = $ARGSRef->{ $arg };
+ }
+
+ # For each of those objects
+ foreach my $class ( keys %custom_fields_to_mod ) {
+ foreach my $id ( keys %{$custom_fields_to_mod{$class}} ) {
+ my $Object = $args{'Object'};
+ $Object = $class->new( $session{'CurrentUser'} )
+ unless $Object && ref $Object eq $class;
+
+ $Object->Load( $id ) unless ($Object->id || 0) == $id;
+ unless ( $Object->id ) {
+ $RT::Logger->warning("Couldn't load object $class #$id");
+ next;
+ }
+
+ foreach my $cf ( keys %{ $custom_fields_to_mod{ $class }{ $id } } ) {
+ my $CustomFieldObj = RT::CustomField->new( $session{'CurrentUser'} );
+ $CustomFieldObj->LoadById( $cf );
+ unless ( $CustomFieldObj->id ) {
+ $RT::Logger->warning("Couldn't load custom field #$id");
+ next;
+ }
+ push @results, _ProcessObjectCustomFieldUpdates(
+ Prefix => "Object-$class-$id-CustomField-$cf-",
+ Object => $Object,
+ CustomField => $CustomFieldObj,
+ ARGS => $custom_fields_to_mod{$class}{$id}{$cf},
+ );
+ }
+ }
+ }
+ return @results;
+}
+
+sub _ProcessObjectCustomFieldUpdates {
+ my %args = @_;
+ my $cf = $args{'CustomField'};
+ my $cf_type = $cf->Type;
+
+ my @results;
+ foreach my $arg ( keys %{ $args{'ARGS'} } ) {
+
+ next if $arg =~ /Category$/;
+
+ # since http won't pass in a form element with a null value, we need
+ # to fake it
+ if ( $arg eq 'Values-Magic' ) {
+ # We don't care about the magic, if there's really a values element;
+ next if $args{'ARGS'}->{'Value'} || $args{'ARGS'}->{'Values'};
+
+ # "Empty" values does not mean anything for Image and Binary fields
+ next if $cf_type =~ /^(?:Image|Binary)$/;
+
+ $arg = 'Values';
+ $args{'ARGS'}->{'Values'} = undef;
+ }
+
+ my @values = ();
+ if ( ref $args{'ARGS'}->{ $arg } eq 'ARRAY' ) {
+ @values = @{ $args{'ARGS'}->{$arg} };
+ } elsif ( $cf_type =~ /text/i ) { # Both Text and Wikitext
+ @values = ($args{'ARGS'}->{$arg});
+ } elsif ( defined( $args{'ARGS'}->{ $arg } ) ) {
+ @values = split /\n/, $args{'ARGS'}->{ $arg };
+ }
+
+ if ( ( $cf_type eq 'Freeform' && !$cf->SingleValue ) || $cf_type =~ /text/i ) {
+ s/\r//g foreach @values;
+ }
+ @values = grep defined && $_ ne '', @values;
+
+ if ( $arg eq 'AddValue' || $arg eq 'Value' ) {
+ foreach my $value (@values) {
+ my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
+ Field => $cf->id,
+ Value => $value
+ );
+ push ( @results, $msg );
+ }
+ }
+ elsif ( $arg eq 'Upload' ) {
+ my $value_hash = _UploadedFile( $args{'Prefix'} . $arg ) or next;
+ my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
+ %$value_hash,
+ Field => $cf,
+ );
+ push ( @results, $msg );
+ }
+ elsif ( $arg eq 'DeleteValues' ) {
+ foreach my $value ( @values ) {
+ my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
+ Field => $cf,
+ Value => $value,
+ );
+ push ( @results, $msg );
+ }
+ }
+ elsif ( $arg eq 'DeleteValueIds' ) {
+ foreach my $value ( @values ) {
+ my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
+ Field => $cf,
+ ValueId => $value,
+ );
+ push ( @results, $msg );
+ }
+ }
+ elsif ( $arg eq 'Values' && !$cf->Repeated ) {
+ my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
+
+ my %values_hash;
+ foreach my $value ( @values ) {
+ # build up a hash of values that the new set has
+ $values_hash{$value} = 1;
+ next if $cf_values->HasEntry( $value );
+
+ my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
+ Field => $cf,
+ Value => $value
+ );
+ push ( @results, $msg );
+ }
+
+ $cf_values->RedoSearch;
+ while ( my $cf_value = $cf_values->Next ) {
+ next if $values_hash{ $cf_value->Content };
+
+ my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
+ Field => $cf,
+ Value => $cf_value->Content
+ );
+ push ( @results, $msg);
+ }
+ }
+ elsif ( $arg eq 'Values' ) {
+ my $cf_values = $args{'Object'}->CustomFieldValues( $cf->id );
+
+ # keep everything up to the point of difference, delete the rest
+ my $delete_flag;
+ foreach my $old_cf (@{$cf_values->ItemsArrayRef}) {
+ if (!$delete_flag and @values and $old_cf->Content eq $values[0]) {
+ shift @values;
+ next;
+ }
+
+ $delete_flag ||= 1;
+ $old_cf->Delete;
+ }
+
+ # now add/replace extra things, if any
+ foreach my $value ( @values ) {
+ my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
+ Field => $cf,
+ Value => $value
+ );
+ push ( @results, $msg );
+ }
+ }
+ else {
+ push ( @results,
+ loc("User asked for an unknown update type for custom field [_1] for [_2] object #[_3]",
+ $cf->Name, ref $args{'Object'}, $args{'Object'}->id )
+ );
+ }
+ }
+ return @results;
+}
+
+# {{{ sub ProcessTicketWatchers
+
+=head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketWatchers {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+ my (@results);
+
+ my $Ticket = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ # Munge watchers
+
+ foreach my $key ( keys %$ARGSRef ) {
+
+ # Delete deletable watchers
+ if ( ( $key =~ /^Ticket-DeleteWatcher-Type-(.*)-Principal-(\d+)$/ ) )
+ {
+ my ( $code, $msg ) = $Ticket->DeleteWatcher(
+ PrincipalId => $2,
+ Type => $1
+ );
+ push @results, $msg;
+ }
+
+ # Delete watchers in the simple style demanded by the bulk manipulator
+ elsif ( $key =~ /^Delete(Requestor|Cc|AdminCc)$/ ) {
+ my ( $code, $msg ) = $Ticket->DeleteWatcher(
+ Email => $ARGSRef->{$key},
+ Type => $1
+ );
+ push @results, $msg;
+ }
+
+ # Add new wathchers by email address
+ elsif ( ( $ARGSRef->{$key} =~ /^(AdminCc|Cc|Requestor)$/ )
+ and ( $key =~ /^WatcherTypeEmail(\d*)$/ ) )
+ {
+
+ #They're in this order because otherwise $1 gets clobbered :/
+ my ( $code, $msg ) = $Ticket->AddWatcher(
+ Type => $ARGSRef->{$key},
+ Email => $ARGSRef->{ "WatcherAddressEmail" . $1 }
+ );
+ push @results, $msg;
+ }
+
+ #Add requestors in the simple style demanded by the bulk manipulator
+ elsif ( $key =~ /^Add(Requestor|Cc|AdminCc)$/ ) {
+ my ( $code, $msg ) = $Ticket->AddWatcher(
+ Type => $1,
+ Email => $ARGSRef->{$key}
+ );
+ push @results, $msg;
+ }
+
+ # Add new watchers by owner
+ elsif ( $key =~ /^Ticket-AddWatcher-Principal-(\d*)$/ ) {
+ my $principal_id = $1;
+ my $form = $ARGSRef->{$key};
+ foreach my $value ( ref($form) ? @{$form} : ($form) ) {
+ next unless $value =~ /^(?:AdminCc|Cc|Requestor)$/i;
+
+ my ( $code, $msg ) = $Ticket->AddWatcher(
+ Type => $value,
+ PrincipalId => $principal_id
+ );
+ push @results, $msg;
+ }
+ }
+
+ }
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub ProcessTicketDates
+
+=head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketDates {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $Ticket = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ my (@results);
+
+ # {{{ Set date fields
+ my @date_fields = qw(
+ Told
+ Resolved
+ Starts
+ Started
+ Due
+ );
+
+ #Run through each field in this list. update the value if apropriate
+ foreach my $field (@date_fields) {
+ my ( $code, $msg );
+
+ my $DateObj = RT::Date->new( $session{'CurrentUser'} );
+
+ #If it's something other than just whitespace
+ if ( $ARGSRef->{ $field . '_Date' } && ($ARGSRef->{ $field . '_Date' } ne '') ) {
+ $DateObj->Set(
+ Format => 'unknown',
+ Value => $ARGSRef->{ $field . '_Date' }
+ );
+ my $obj = $field . "Obj";
+ if ( ( defined $DateObj->Unix )
+ and ( $DateObj->Unix ne $Ticket->$obj()->Unix() ) )
+ {
+ my $method = "Set$field";
+ my ( $code, $msg ) = $Ticket->$method( $DateObj->ISO );
+ push @results, "$msg";
+ }
+ }
+ }
+
+ # }}}
+ return (@results);
+}
+
+# }}}
+
+# {{{ sub ProcessTicketLinks
+
+=head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
+
+Returns an array of results messages.
+
+=cut
+
+sub ProcessTicketLinks {
+ my %args = ( TicketObj => undef,
+ ARGSRef => undef,
+ @_ );
+
+ my $Ticket = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+
+ my (@results) = ProcessRecordLinks(RecordObj => $Ticket,
+ ARGSRef => $ARGSRef);
+
+ #Merge if we need to
+ if ( $ARGSRef->{ $Ticket->Id . "-MergeInto" } ) {
+ my ( $val, $msg ) =
+ $Ticket->MergeInto( $ARGSRef->{ $Ticket->Id . "-MergeInto" } );
+ push @results, $msg;
+ }
+
+ return (@results);
+}
+
+# }}}
+
+sub ProcessRecordLinks {
+ my %args = ( RecordObj => undef,
+ ARGSRef => undef,
+ @_ );
+
+ my $Record = $args{'RecordObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ my (@results);
+
+ # Delete links that are gone gone gone.
+ foreach my $arg ( keys %$ARGSRef ) {
+ if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
+ my $base = $1;
+ my $type = $2;
+ my $target = $3;
+
+ push @results,
+ "Trying to delete: Base: $base Target: $target Type $type";
+ my ( $val, $msg ) = $Record->DeleteLink( Base => $base,
+ Type => $type,
+ Target => $target );
+
+ push @results, $msg;
+
+ }
+
+ }
+
+ my @linktypes = qw( DependsOn MemberOf RefersTo );
+
+ foreach my $linktype (@linktypes) {
+ if ( $ARGSRef->{ $Record->Id . "-$linktype" } ) {
+ for my $luri ( split ( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
+ $luri =~ s/\s*$//; # Strip trailing whitespace
+ my ( $val, $msg ) = $Record->AddLink( Target => $luri,
+ Type => $linktype );
+ push @results, $msg;
+ }
+ }
+ if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
+
+ for my $luri ( split ( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
+ my ( $val, $msg ) = $Record->AddLink( Base => $luri,
+ Type => $linktype );
+
+ push @results, $msg;
+ }
+ }
+ }
+
+ return (@results);
+}
+
+
+=head2 _UploadedFile ( $arg );
+
+Takes a CGI parameter name; if a file is uploaded under that name,
+return a hash reference suitable for AddCustomFieldValue's use:
+C<( Value => $filename, LargeContent => $content, ContentType => $type )>.
+
+Returns C<undef> if no files were uploaded in the C<$arg> field.
+
+=cut
+
+sub _UploadedFile {
+ my $arg = shift;
+ my $cgi_object = $m->cgi_object;
+ my $fh = $cgi_object->upload($arg) or return undef;
+ my $upload_info = $cgi_object->uploadInfo($fh);
+
+ my $filename = "$fh";
+ $filename =~ s#^.*[\\/]##;
+ binmode($fh);
+
+ return {
+ Value => $filename,
+ LargeContent => do { local $/; scalar <$fh> },
+ ContentType => $upload_info->{'Content-Type'},
+ };
+}
+
+=head2 _load_container_object ( $type, $id );
+
+Instantiate container object for saving searches.
+
+=cut
+
+sub _load_container_object {
+ my ($obj_type, $obj_id) = @_;
+ return RT::SavedSearch->new($session{'CurrentUser'})->_load_privacy_object($obj_type, $obj_id);
+}
+
+=head2 _parse_saved_search ( $arg );
+
+Given a serialization string for saved search, and returns the
+container object and the search id.
+
+=cut
+
+sub _parse_saved_search {
+ my $spec = shift;
+ return unless $spec;
+ if ($spec !~ /^(.*?)-(\d+)-SavedSearch-(\d+)$/ ) {
+ return;
+ }
+ my $obj_type = $1;
+ my $obj_id = $2;
+ my $search_id = $3;
+
+ return (_load_container_object ($obj_type, $obj_id), $search_id);
+}
+
+eval "require RT::Interface::Web_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm});
+eval "require RT::Interface::Web_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm});
+
+1;
diff --git a/rt/lib/RT/Interface/Web/Handler.pm b/rt/lib/RT/Interface/Web/Handler.pm
new file mode 100644
index 000000000..1e871ec59
--- /dev/null
+++ b/rt/lib/RT/Interface/Web/Handler.pm
@@ -0,0 +1,211 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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::Handler;
+
+use CGI qw/-private_tempfiles/;
+use MIME::Entity;
+use Text::Wrapper;
+use CGI::Cookie;
+use Time::ParseDate;
+use Time::HiRes;
+use HTML::Entities;
+use HTML::Scrubber;
+use RT::Interface::Web::Handler;
+use File::Path qw( rmtree );
+use File::Glob qw( bsd_glob );
+use File::Spec::Unix;
+
+sub DefaultHandlerArgs { (
+ comp_root => [
+ [ local => $RT::MasonLocalComponentRoot ],
+ [ standard => $RT::MasonComponentRoot ]
+ ],
+ default_escape_flags => 'h',
+ data_dir => "$RT::MasonDataDir",
+ allow_globals => [qw(%session)],
+ # Turn off static source if we're in developer mode.
+ static_source => ($RT::DevelMode ? '0' : '1'),
+ use_object_files => ($RT::DevelMode ? '0' : '1'),
+ autoflush => 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 ) {
+ goto &NewApacheHandler;
+ }
+ elsif ($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.
+ # Note that mysql uses DB for sessions, so there's no need to do this.
+ unless ( $RT::DatabaseType =~ /(?:mysql|Pg)/ ) {
+
+ # Clean up our umask to protect session files
+ umask(0077);
+
+ if ($CGI::MOD_PERL) { local $@; eval {
+
+ chown( Apache->server->uid, Apache->server->gid,
+ $RT::MasonSessionDir )
+ }}
+
+ # Die if WebSessionDir doesn't exist or we can't write to it
+ stat($RT::MasonSessionDir);
+ die "Can't read and write $RT::MasonSessionDir"
+ unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) );
+ }
+
+}
+
+# }}}
+
+# {{{ 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 NewApache2Handler
+
+=head2 NewApache2Handler
+
+ Takes extra options to pass to MasonX::Apache2Handler->new
+ Returns a new MasonX::Apache2Handler object
+
+=cut
+
+sub NewApache2Handler {
+ require MasonX::Apache2Handler;
+ return NewHandler('MasonX::Apache2Handler', 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', @_);
+}
+
+sub NewHandler {
+ my $class = shift;
+ my $handler = $class->new(
+ DefaultHandlerArgs(),
+ @_
+ );
+
+ $handler->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
+ $handler->interp->set_escape( u => \&RT::Interface::Web::EscapeURI );
+ return($handler);
+}
+
+=head2 CleanupRequest
+
+Rollback any uncommitted transaction.
+Flush the ACL cache
+Flush the searchbuilder query cache
+
+=cut
+
+sub CleanupRequest {
+
+ if ( $RT::Handle->TransactionDepth ) {
+ $RT::Handle->ForceRollback;
+ $RT::Logger->crit(
+ "Transaction not committed. Usually indicates a software fault."
+ . "Data loss may have occurred" );
+ }
+
+ # Clean out the ACL cache. the performance impact should be marginal.
+ # Consistency is imprived, too.
+ RT::Principal->InvalidateACLCache();
+ DBIx::SearchBuilder::Record::Cachable->FlushCache
+ if ( $RT::WebFlushDbCacheEveryRequest
+ and UNIVERSAL::can(
+ 'DBIx::SearchBuilder::Record::Cachable' => 'FlushCache' ) );
+
+}
+# }}}
+
+1;
diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm
new file mode 100644
index 000000000..f2d78ef6c
--- /dev/null
+++ b/rt/lib/RT/Interface/Web/Menu.pm
@@ -0,0 +1,68 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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;
+
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+ $self->{'root_node'} = RT::Interface::Web::Menu::Item->new();
+ return $self;
+}
+
+
+sub as_hash_of_hashes {
+
+}
+
+sub root {
+ my $self = shift;
+ return $self->{'root_node'};
+}
+
+1;
diff --git a/rt/lib/RT/Interface/Web/Menu/Item.pm b/rt/lib/RT/Interface/Web/Menu/Item.pm
new file mode 100644
index 000000000..5365db33a
--- /dev/null
+++ b/rt/lib/RT/Interface/Web/Menu/Item.pm
@@ -0,0 +1,86 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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;
+
+
+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
new file mode 100755
index 000000000..56c5b038c
--- /dev/null
+++ b/rt/lib/RT/Interface/Web/QueryBuilder.pm
@@ -0,0 +1,58 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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::QueryBuilder;
+
+use strict;
+use warnings;
+
+eval "require RT::Interface::Web::QueryBuilder_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder_Vendor.pm});
+eval "require RT::Interface::Web::QueryBuilder_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder_Local.pm});
+
+1;
diff --git a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
new file mode 100755
index 000000000..467627313
--- /dev/null
+++ b/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
@@ -0,0 +1,247 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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::QueryBuilder::Tree;
+
+use strict;
+use warnings;
+
+use base qw/Tree::Simple/;
+
+=head1 NAME
+
+ RT::Interface::Web::QueryBuilder::Tree - subclass of Tree::Simple used in Query Builder
+
+=head1 DESCRIPTION
+
+This class provides support functionality for the Query Builder (Search/Build.html).
+It is a subclass of L<Tree::Simple>.
+
+=head1 METHODS
+
+=head2 TraversePrePost PREFUNC POSTFUNC
+
+Traverses the tree depth-first. Before processing the node's children,
+calls PREFUNC with the node as its argument; after processing all of the
+children, calls POSTFUNC with the node as its argument.
+
+(Note that unlike Tree::Simple's C<traverse>, it actually calls its functions
+on the root node passed to it.)
+
+=cut
+
+sub TraversePrePost {
+ my ($self, $prefunc, $postfunc) = @_;
+
+ $prefunc->($self);
+
+ foreach my $child ($self->getAllChildren()) {
+ $child->TraversePrePost($prefunc, $postfunc);
+ }
+
+ $postfunc->($self);
+}
+
+=head2 GetReferencedQueues
+
+Returns a hash reference with keys each queue name referenced in a clause in
+the key (even if it's "Queue != 'Foo'"), and values all 1.
+
+=cut
+
+sub GetReferencedQueues {
+ my $self = shift;
+
+ my $queues = {};
+
+ $self->traverse(
+ sub {
+ my $node = shift;
+
+ return if $node->isRoot;
+
+ my $clause = $node->getNodeValue();
+
+ if ( ref($clause) and $clause->{Key} eq 'Queue' ) {
+ $queues->{ $clause->{Value} } = 1;
+ };
+ }
+ );
+
+ return $queues;
+}
+
+=head2 GetQueryAndOptionList SELECTED_NODES
+
+Given an array reference of tree nodes that have been selected by the user,
+traverses the tree and returns the equivalent SQL query and a list of hashes
+representing the "clauses" select option list. Each has contains the keys
+TEXT, INDEX, SELECTED, and DEPTH. TEXT is the displayed text of the option
+(including parentheses, not including indentation); INDEX is the 0-based
+index of the option in the list (also used as its CGI parameter); SELECTED
+is either 'SELECTED' or '', depending on whether the node corresponding
+to the select option was in the SELECTED_NODES list; and DEPTH is the
+level of indentation for the option.
+
+=cut
+
+sub GetQueryAndOptionList {
+ my $self = shift;
+ my $selected_nodes = shift;
+
+ my $optionlist = [];
+
+ my $i = 0;
+
+ $self->TraversePrePost(
+ sub { # This is called before recursing to the node's children.
+ my $node = shift;
+
+ return if $node->isRoot or $node->getParent->isRoot;
+
+ my $clause = $node->getNodeValue();
+ my $str = ' ';
+ my $aggregator_context = $node->getParent()->getNodeValue();
+ $str = $aggregator_context . " " if $node->getIndex() > 0;
+
+ if ( ref($clause) ) { # ie, it's a leaf
+ $str .=
+ $clause->{Key} . " " . $clause->{Op} . " " . $clause->{Value};
+ }
+
+ unless ($node->getParent->getParent->isRoot) {
+ # used to check !ref( $parent->getNodeValue() ) )
+ if ( $node->getIndex() == 0 ) {
+ $str = '( ' . $str;
+ }
+ }
+
+ push @$optionlist, {
+ TEXT => $str,
+ INDEX => $i,
+ SELECTED => (grep { $_ == $node } @$selected_nodes) ? 'SELECTED' : '',
+ DEPTH => $node->getDepth() - 1,
+ };
+
+ $i++;
+ }, sub {
+ # This is called after recursing to the node's children.
+ my $node = shift;
+
+ return if $node->isRoot or $node->getParent->isRoot or $node->getParent->getParent->isRoot;
+
+ # Only do this for the rightmost child.
+ return unless $node->getIndex == $node->getParent->getChildCount - 1;
+
+ $optionlist->[-1]{TEXT} .= ' )';
+ }
+ );
+
+ return (join ' ', map { $_->{TEXT} } @$optionlist), $optionlist;
+}
+
+=head2 PruneChildLessAggregators
+
+If tree manipulation has left it in a state where there are ANDs, ORs,
+or parenthesizations with no children, get rid of them.
+
+=cut
+
+sub PruneChildlessAggregators {
+ my $self = shift;
+
+ $self->TraversePrePost(
+ sub {
+ },
+ sub {
+ my $node = shift;
+
+ return if $node->isRoot or $node->getParent->isRoot;
+
+ # We're only looking for aggregators (AND/OR)
+ return if ref $node->getNodeValue;
+
+ return if $node->getChildCount != 0;
+
+ # OK, this is a childless aggregator. Remove self.
+
+ $node->getParent->removeChild($node);
+
+ # Deal with circular refs
+ $node->DESTROY;
+ }
+ );
+}
+
+=head2 GetDisplayedNodes
+
+This function returns a list of the nodes of the tree in depth-first
+order which correspond to options in the "clauses" multi-select box.
+In fact, it's all of them but the root and its child.
+
+=cut
+
+sub GetDisplayedNodes {
+ my $self = shift;
+ my @lines;
+
+ $self->traverse(sub {
+ my $node = shift;
+
+ push @lines, $node unless $node->isRoot or $node->getParent->isRoot;
+ });
+
+ return @lines;
+}
+
+
+eval "require RT::Interface::Web::QueryBuilder::Tree_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder/Tree_Vendor.pm});
+eval "require RT::Interface::Web::QueryBuilder::Tree_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Web/QueryBuilder/Tree_Local.pm});
+
+1;
diff --git a/rt/lib/RT/Interface/Web/Standalone.pm b/rt/lib/RT/Interface/Web/Standalone.pm
new file mode 100755
index 000000000..319e317b8
--- /dev/null
+++ b/rt/lib/RT/Interface/Web/Standalone.pm
@@ -0,0 +1,84 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse@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/copyleft/gpl.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::Standalone;
+
+use strict;
+use base 'HTTP::Server::Simple::Mason';
+use RT::Interface::Web::Handler;
+use RT::Interface::Web;
+
+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::MasonParameters;
+}
+
+sub handle_request {
+
+ my $self = shift;
+ my $cgi = shift;
+
+ Module::Refresh->refresh if $RT::DevelMode;
+
+ $self->SUPER::handle_request($cgi);
+ $RT::Logger->crit($@) if ($@);
+
+ RT::Interface::Web::Handler->CleanupRequest();
+
+}
+
+1;
diff --git a/rt/lib/RT/Interface/Web_Vendor.pm b/rt/lib/RT/Interface/Web_Vendor.pm
new file mode 100644
index 000000000..1999096a7
--- /dev/null
+++ b/rt/lib/RT/Interface/Web_Vendor.pm
@@ -0,0 +1,201 @@
+# Copyright (c) 2004 Ivan Kohler <ivan-rt@420.am>
+# Copyright (c) 2008 Freeside Internet Services, Inc.
+#
+# 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.
+
+=head1 NAME
+
+RT::Interface::Web_Vendor
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+Freeside vendor overlay for RT::Interface::Web.
+
+=begin testing
+
+use_ok(RT::Interface::Web_Vendor);
+
+=end testing
+
+=cut
+
+#package RT::Interface::Web;
+#use strict;
+
+package HTML::Mason::Commands;
+use strict;
+
+=head2 ProcessTicketCustomers
+
+=cut
+
+sub ProcessTicketCustomers {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ Debug => 0,
+ @_
+ );
+ my @results = ();
+
+ my $Ticket = $args{'TicketObj'};
+ my $ARGSRef = $args{'ARGSRef'};
+ my $Debug = $args{'Debug'};
+ my $me = 'ProcessTicketCustomers';
+
+ ### false laziness w/RT::Interface::Web::ProcessTicketLinks
+ # Delete links that are gone gone gone.
+ foreach my $arg ( keys %$ARGSRef ) {
+ if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
+ my $base = $1;
+ my $type = $2;
+ my $target = $3;
+
+ push @results,
+ "Trying to delete: Base: $base Target: $target Type $type";
+ my ( $val, $msg ) = $Ticket->DeleteLink( Base => $base,
+ Type => $type,
+ Target => $target );
+
+ push @results, $msg;
+
+ }
+
+ }
+ ###
+
+ ###
+ #find new customers
+ ###
+
+ my @custnums = map { /^Ticket-AddCustomer-(\d+)$/; $1 }
+ grep { /^Ticket-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
+ keys %$ARGSRef;
+
+ #my @delete_custnums =
+ # map { /^Ticket-AddCustomer-(\d+)$/; $1 }
+ # grep { /^Ticket-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
+ # keys %$ARGSRef;
+
+ ###
+ #figure out if we're going to auto-link requestors, and find them if so
+ ###
+
+ my $num_cur_cust = $Ticket->Customers->Count;
+ my $num_new_cust = scalar(@custnums);
+ warn "$me: $num_cur_cust current customers / $num_new_cust new customers\n"
+ if $Debug;
+
+ #if we're linking the first ticket to one customer
+ my $link_requestors = ( $num_cur_cust == 0 && $num_new_cust == 1 );
+ warn "$me: adding a single customer to a previously customerless".
+ " ticket, so linking customers to requestor too\n"
+ if $Debug && $link_requestors;
+
+ my @Requestors = ();
+ if ( $link_requestors ) {
+
+ #find any requestors without customers
+ @Requestors =
+ grep { ! $_->Customers->Count }
+ @{ $Ticket->Requestors->UserMembersObj->ItemsArrayRef };
+
+ warn "$me: found ". scalar(@Requestors). " requestors without".
+ " customers; linking them\n"
+ if $Debug;
+
+ }
+
+ ###
+ #link ticket (and requestors) to customers
+ ###
+
+ foreach my $custnum ( @custnums ) {
+
+ my @link = ( 'Type' => 'MemberOf',
+ 'Target' => "freeside://freeside/cust_main/$custnum",
+ );
+
+ my( $val, $msg ) = $Ticket->AddLink(@link);
+ push @results, $msg;
+
+ #add customer links to requestors
+ foreach my $Requestor ( @Requestors ) {
+ my( $val, $msg ) = $Requestor->AddLink(@link);
+ push @results, $msg;
+ warn "$me: linking requestor to custnum $custnum: $msg\n"
+ if $Debug > 1;
+ }
+
+ }
+
+ return @results;
+
+}
+
+#false laziness w/above... eventually it should go away in favor of this
+sub ProcessObjectCustomers {
+ my %args = (
+ Object => undef,
+ ARGSRef => undef,
+ @_
+ );
+ my @results = ();
+
+ my $Object = $args{'Object'};
+ my $ARGSRef = $args{'ARGSRef'};
+
+ ### false laziness w/RT::Interface::Web::ProcessTicketLinks
+ # Delete links that are gone gone gone.
+ foreach my $arg ( keys %$ARGSRef ) {
+ if ( $arg =~ /DeleteLink-(.*?)-(DependsOn|MemberOf|RefersTo)-(.*)$/ ) {
+ my $base = $1;
+ my $type = $2;
+ my $target = $3;
+
+ push @results,
+ "Trying to delete: Base: $base Target: $target Type $type";
+ my ( $val, $msg ) = $Object->DeleteLink( Base => $base,
+ Type => $type,
+ Target => $target );
+
+ push @results, $msg;
+
+ }
+
+ }
+ ###
+
+ #my @delete_custnums =
+ # map { /^Object-AddCustomer-(\d+)$/; $1 }
+ # grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
+ # keys %$ARGSRef;
+
+ my @custnums = map { /^Object-AddCustomer-(\d+)$/; $1 }
+ grep { /^Object-AddCustomer-(\d+)$/ && $ARGSRef->{$_} }
+ keys %$ARGSRef;
+
+ foreach my $custnum ( @custnums ) {
+ my( $val, $msg ) =
+ $Object->AddLink( 'Type' => 'MemberOf',
+ 'Target' => "freeside://freeside/cust_main/$custnum",
+ );
+ push @results, $msg;
+ }
+
+ return @results;
+
+}
+
+1;
+
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-15 18:13:14 +0000