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.pm246
-rwxr-xr-xrt/lib/RT/Interface/Email.pm648
-rwxr-xr-xrt/lib/RT/Interface/Email/Auth/GnuPG.pm263
-rw-r--r--rt/lib/RT/Interface/Email/Auth/MailFrom.pm182
-rw-r--r--rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm98
-rw-r--r--rt/lib/RT/Interface/REST.pm327
-rw-r--r--rt/lib/RT/Interface/Web.pm2108
-rw-r--r--rt/lib/RT/Interface/Web/Handler.pm229
-rw-r--r--rt/lib/RT/Interface/Web/Menu.pm69
-rw-r--r--rt/lib/RT/Interface/Web/Menu/Item.pm87
-rwxr-xr-xrt/lib/RT/Interface/Web/QueryBuilder.pm59
-rwxr-xr-xrt/lib/RT/Interface/Web/QueryBuilder/Tree.pm293
-rw-r--r--rt/lib/RT/Interface/Web/Request.pm207
-rw-r--r--rt/lib/RT/Interface/Web/Session.pm285
-rwxr-xr-xrt/lib/RT/Interface/Web/Standalone.pm117
-rw-r--r--rt/lib/RT/Interface/Web/Standalone/PreFork.pm103
-rw-r--r--rt/lib/RT/Interface/Web_Vendor.pm201
17 files changed, 0 insertions, 5522 deletions
diff --git a/rt/lib/RT/Interface/CLI.pm b/rt/lib/RT/Interface/CLI.pm
deleted file mode 100644
index ec0e877b4..000000000
--- a/rt/lib/RT/Interface/CLI.pm
+++ /dev/null
@@ -1,246 +0,0 @@
-# BEGIN LICENSE BLOCK
-#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
-#
-# (Except where explictly superceded by other copyright notices)
-#
-# 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.
-#
-# Unless otherwise specified, all modifications, corrections or
-# extensions to this work which alter its source code become the
-# property of Best Practical Solutions, LLC when submitted for
-# inclusion in the work.
-#
-#
-# END LICENSE 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.2 $ =~ /\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
deleted file mode 100755
index 7eec0502f..000000000
--- a/rt/lib/RT/Interface/Email.pm
+++ /dev/null
@@ -1,648 +0,0 @@
-# BEGIN LICENSE BLOCK
-#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
-#
-# (Except where explictly superceded by other copyright notices)
-#
-# 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.
-#
-# Unless otherwise specified, all modifications, corrections or
-# extensions to this work which alter its source code become the
-# property of Best Practical Solutions, LLC when submitted for
-# inclusion in the work.
-#
-#
-# END LICENSE BLOCK
-package RT::Interface::Email;
-
-use strict;
-use Mail::Address;
-use MIME::Entity;
-use RT::EmailParser;
-
-
-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.2 $ =~ /\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(
- &CreateUser
- &GetMessageContent
- &CheckForLoops
- &CheckForSuspiciousSender
- &CheckForAutoGenerated
- &MailError
- &ParseCcAddressesFromHead
- &ParseSenderAddressFromHead
- &ParseErrorsToAddressFromHead
- &ParseAddressFromHeader
- &Gateway);
-
-}
-
-=head1 NAME
-
- RT::Interface::CLI - helper functions for creating a commandline RT interface
-
-=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);
- }
- else {
- return (0);
- }
-}
-
-# }}}
-
-
-# {{{ 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,
- LogLevel => 'crit',
- @_);
-
-
- $RT::Logger->log(level => $args{'LogLevel'},
- message => $args{'Explanation'}
- );
- my $entity = MIME::Entity->build( Type =>"multipart/mixed",
- From => $args{'From'},
- Bcc => $args{'Bcc'},
- To => $args{'To'},
- Subject => $args{'Subject'},
- 'X-RT-Loop-Prevention' => $RT::rtname,
- );
-
- $entity->attach( Data => $args{'Explanation'}."\n");
-
- my $mimeobj = $args{'MIMEObj'};
- if ($mimeobj) {
- $mimeobj->sync_headers();
- $entity->add_part($mimeobj);
- }
-
- if ($RT::MailCommand eq 'sendmailpipe') {
- open (MAIL, "|$RT::SendmailPath $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);
-
- # This data is tainted by some Very Broken mailers.
- # (Sometimes they send raw ISO 8859-1 data here. fear that.
- require Encode;
- $Username = Encode::encode(utf8 => $Username, Encode::FB_PERLQQ()) if defined $Username;
- $Name = Encode::encode(utf8 => $Name, Encode::FB_PERLQQ()) if defined $Name;
-
- 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 =~ /^$Address$/i);
- next if ($args{'QueueObj'}->CorrespondAddress =~ /^$Address$/i);
- next if ($args{'QueueObj'}->CommentAddress =~ /^$Address$/i);
- next if (RT::EmailParser::IsRTAddress(undef, $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.
- my $From = $head->get('Reply-To') ||
- $head->get('From') ||
- $head->get('Sender');
- return (ParseAddressFromHeader($From));
-}
-# }}}
-
-# {{{ ParseErrorsToAdddressFromHead
-
-=head2 ParseErrorsToAddressFromHead
-
-Takes a MIME::Header object. Return a single value : user@host
-of the From (evaluated in order of 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;
-
- my @Addresses = Mail::Address->parse($Addr);
-
- my $AddrObj = $Addresses[0];
-
- unless (ref($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);
-}
-# }}}
-
-
-
-=head2 Gateway
-
-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.
-
-=cut
-
-sub Gateway {
- my %args = ( message => undef,
- queue => 1,
- action => 'correspond',
- ticket => undef,
- @_ );
-
- # Validate the action
- unless ( $args{'action'} =~ /^(comment|correspond|action)$/ ) {
-
- # Can't safely loc this. What object do we loc around?
- return ( 0, "Invalid 'action' parameter", undef );
- }
-
- my $parser = RT::EmailParser->new();
- $parser->ParseMIMEEntityFromScalar( $args{'message'} );
-
- my $Message = $parser->Entity();
- my $head = $Message->head;
-
- my ( $CurrentUser, $AuthStat, $status, $error );
-
- 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;
-
-
- $args{'ticket'} ||= $parser->ParseTicketId($Subject);
-
- my $SystemTicket;
- if ($args{'ticket'} ) {
- $SystemTicket = RT::Ticket->new($RT::SystemUser);
- $SystemTicket->Load($args{'ticket'});
- }
-
- #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 ( $args{'ticket'} || $SystemQueueObj->id ) {
- MailError(
- To => $RT::OwnerEmail,
- Subject => "RT Bounce: $Subject",
- Explanation => "RT couldn't find the queue: " . $args{'queue'},
- MIMEObj => $Message );
- return ( 0, "RT couldn't find the queue: " . $args{'queue'}, undef );
- }
-
- # Authentication Level
- # -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
-
- push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins;
- # Since this needs loading, no matter what
-
- for (@RT::MailPlugins) {
- my $Code;
- my $NewAuthStat;
- if ( ref($_) eq "CODE" ) {
- $Code = $_;
- }
- else {
- $_ = "RT::Interface::Email::$_" unless /^RT::Interface::Email::/;
- eval "require $_;";
- if ($@) {
- die ("Couldn't load module $_: $@");
- next;
- }
- no strict 'refs';
- if ( !defined( $Code = *{ $_ . "::GetCurrentUser" }{CODE} ) ) {
- die ("No GetCurrentUser code found in $_ module");
- next;
- }
- }
-
- ( $CurrentUser, $NewAuthStat ) = $Code->( Message => $Message,
- CurrentUser => $CurrentUser,
- AuthLevel => $AuthStat,
- Action => $args{'action'},
- Ticket => $SystemTicket,
- Queue => $SystemQueueObj );
-
- # You get the highest level of authentication you were assigned.
- last if $AuthStat == -1;
- $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
- }
-
- # {{{ If authentication fails and no new user was created, get out.
- if ( !$CurrentUser or !$CurrentUser->Id or $AuthStat == -1 ) {
-
- # If the plugins refused to create one, they lose.
- MailError(
- 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.
-
-Your RT administrator needs to grant 'Everyone' the right 'CreateTicket'
-for this queue.
-
-EOT
- MIMEObj => $Message,
- LogLevel => 'error' )
- unless $AuthStat == -1;
- return ( 0, "Could not load a valid user", undef );
- }
-
- # }}}
-
- # {{{ Lets check for mail loops of various sorts.
- 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 ( $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
- $SquelchReplies = 1;
- $ErrorsTo = $RT::OwnerEmail;
- }
-
- # }}}
-
- # {{{ Drop it if it's disallowed
- if ( $AuthStat == 0 ) {
- MailError(
- To => $ErrorsTo,
- Subject => "Permission Denied",
- Explanation => "You do not have permission to communicate with RT",
- MIMEObj => $Message );
- }
-
- # }}}
- # {{{ Warn someone if it's a loop
-
- # Warn someone if it's a loop, before we drop it on the ground
- if ($IsALoop) {
- $RT::Logger->crit("RT Recieved mail ($MessageId) from itself.");
-
- #Should we mail it to RTOwner?
- if ($RT::LoopsToRTOwner) {
- MailError( To => $RT::OwnerEmail,
- Subject => "RT Bounce: $Subject",
- Explanation => "RT thinks this message may be a bounce",
- MIMEObj => $Message );
-
- #Do we actually want to store it?
- return ( 0, "Message Bounced", undef ) unless ($RT::StoreLoops);
- }
- }
-
- # }}}
-
- # {{{ Squelch replies if necessary
- # Don't let the user stuff the RT-Squelch-Replies-To header.
- if ( $head->get('RT-Squelch-Replies-To') ) {
- $head->add( 'RT-Relocated-Squelch-Replies-To',
- $head->get('RT-Squelch-Replies-To') );
- $head->delete('RT-Squelch-Replies-To');
- }
-
- if ($SquelchReplies) {
- ## TODO: This is a hack. It should be some other way to
- ## indicate that the transaction should be "silent".
-
- my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
- $head->add( 'RT-Squelch-Replies-To', $Sender );
- }
-
- # }}}
-
- my $Ticket = RT::Ticket->new($CurrentUser);
-
- # {{{ If we don't have a ticket Id, we're creating a new ticket
- if ( !$args{'ticket'} ) {
-
- # {{{ Create a new ticket
-
- 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",
- Explanation => $ErrStr,
- MIMEObj => $Message );
- $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr ");
- return ( 0, "Ticket creation failed", $Ticket );
- }
-
- # }}}
- }
-
- # }}}
-
- # If the action is comment, add a comment.
- elsif ( $args{'action'} =~ /^(comment|correspond)$/i ) {
- $Ticket->Load($args{'ticket'});
- unless ( $Ticket->Id ) {
- my $message = "Could not find a ticket with id ".$args{'ticket'};
- MailError( To => $ErrorsTo,
- Subject => "Message not recorded",
- Explanation => $message,
- MIMEObj => $Message );
-
- return ( 0, $message);
- }
-
- my ( $status, $msg );
- if ( $args{'action'} =~ /^correspond$/ ) {
- ( $status, $msg ) = $Ticket->Correspond( MIMEObj => $Message );
- }
- else {
- ( $status, $msg ) = $Ticket->Comment( MIMEObj => $Message );
- }
- unless ($status) {
-
- #Warn the sender that we couldn't actually submit the comment.
- MailError( To => $ErrorsTo,
- Subject => "Message not recorded",
- Explanation => $msg,
- MIMEObj => $Message );
- return ( 0, "Message not recorded", $Ticket );
- }
- }
-
- else {
-
- #Return mail to the sender with an error
- MailError( To => $ErrorsTo,
- Subject => "RT Configuration error",
- Explanation => "'"
- . $args{'action'}
- . "' not a recognized action."
- . " Your RT administrator has misconfigured "
- . "the mail aliases which invoke RT",
- MIMEObj => $Message );
- $RT::Logger->crit( $args{'action'} . " type unknown for $MessageId" );
- return ( 0, "Configuration error: " . $args{'action'} . " not a recognized action", $Ticket );
-
- }
-
-
-return ( 1, "Success", $Ticket );
-}
-
-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
deleted file mode 100755
index f0fe2c917..000000000
--- a/rt/lib/RT/Interface/Email/Auth/GnuPG.pm
+++ /dev/null
@@ -1,263 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Email::Auth::GnuPG;
-
-use strict;
-use warnings;
-
-=head2 GetCurrentUser
-
-To use the gnupg-secured mail gateway, you need to do the following:
-
-Set up a GnuPG key directory with a pubring containing only the keys
-you care about and specify the following in your SiteConfig.pm
-
- Set(%GnuPGOptions, homedir => '/opt/rt3/var/data/GnuPG');
- Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);
-
-=cut
-
-sub ApplyBeforeDecode { return 1 }
-
-use RT::Crypt::GnuPG;
-use RT::EmailParser ();
-
-sub GetCurrentUser {
- my %args = (
- Message => undef,
- RawMessageRef => undef,
- @_
- );
-
- foreach my $p ( $args{'Message'}->parts_DFS ) {
- $p->head->delete($_) for qw(
- X-RT-GnuPG-Status X-RT-Incoming-Encrypton
- X-RT-Incoming-Signature X-RT-Privacy
- );
- }
-
- my $msg = $args{'Message'}->dup;
-
- my ($status, @res) = VerifyDecrypt(
- Entity => $args{'Message'}, AddStatus => 1,
- );
- if ( $status && !@res ) {
- $args{'Message'}->head->add(
- 'X-RT-Incoming-Encryption' => 'Not encrypted'
- );
-
- return 1;
- }
-
- # FIXME: Check if the message is encrypted to the address of
- # _this_ queue. send rejecting mail otherwise.
-
- unless ( $status ) {
- $RT::Logger->error("Had a problem during decrypting and verifying");
- my $reject = HandleErrors( Message => $args{'Message'}, Result => \@res );
- return (0, 'rejected because of problems during decrypting and verifying')
- if $reject;
- }
-
- # attach the original encrypted message
- $args{'Message'}->attach(
- Type => 'application/x-rt-original-message',
- Disposition => 'inline',
- Data => ${ $args{'RawMessageRef'} },
- );
-
- $args{'Message'}->head->add( 'X-RT-Privacy' => 'PGP' );
-
- foreach my $part ( $args{'Message'}->parts_DFS ) {
- my $decrypted;
-
- my $status = $part->head->get( 'X-RT-GnuPG-Status' );
- if ( $status ) {
- for ( RT::Crypt::GnuPG::ParseStatus( $status ) ) {
- if ( $_->{Operation} eq 'Decrypt' && $_->{Status} eq 'DONE' ) {
- $decrypted = 1;
- }
- if ( $_->{Operation} eq 'Verify' && $_->{Status} eq 'DONE' ) {
- $part->head->add(
- 'X-RT-Incoming-Signature' => $_->{UserString}
- );
- }
- }
- }
-
- $part->head->add(
- 'X-RT-Incoming-Encryption' =>
- $decrypted ? 'Success' : 'Not encrypted'
- );
- }
-
- return 1;
-}
-
-sub HandleErrors {
- my %args = (
- Message => undef,
- Result => [],
- @_
- );
-
- my $reject = 0;
-
- my %sent_once = ();
- foreach my $run ( @{ $args{'Result'} } ) {
- my @status = RT::Crypt::GnuPG::ParseStatus( $run->{'status'} );
- unless ( $sent_once{'NoPrivateKey'} ) {
- unless ( CheckNoPrivateKey( Message => $args{'Message'}, Status => \@status ) ) {
- $sent_once{'NoPrivateKey'}++;
- $reject = 1 if RT->Config->Get('GnuPG')->{'RejectOnMissingPrivateKey'};
- }
- }
- unless ( $sent_once{'BadData'} ) {
- unless ( CheckBadData( Message => $args{'Message'}, Status => \@status ) ) {
- $sent_once{'BadData'}++;
- $reject = 1 if RT->Config->Get('GnuPG')->{'RejectOnBadData'};
- }
- }
- }
- return $reject;
-}
-
-sub CheckNoPrivateKey {
- my %args = (Message => undef, Status => [], @_ );
- my @status = @{ $args{'Status'} };
-
- my @decrypts = grep $_->{'Operation'} eq 'Decrypt', @status;
- return 1 unless @decrypts;
- foreach my $action ( @decrypts ) {
- # if at least one secrete key exist then it's another error
- return 1 if
- grep !$_->{'User'}{'SecretKeyMissing'},
- @{ $action->{'EncryptedTo'} };
- }
-
- $RT::Logger->error("Couldn't decrypt a message: have no private key");
-
- my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0];
- my ($status) = RT::Interface::Email::SendEmailUsingTemplate(
- To => $address,
- Template => 'Error: no private key',
- Arguments => {
- Message => $args{'Message'},
- TicketObj => $args{'Ticket'},
- },
- InReplyTo => $args{'Message'},
- );
- unless ( $status ) {
- $RT::Logger->error("Couldn't send 'Error: no private key'");
- }
- return 0;
-}
-
-sub CheckBadData {
- my %args = (Message => undef, Status => [], @_ );
- my @bad_data_messages =
- map $_->{'Message'},
- grep $_->{'Status'} ne 'DONE' && $_->{'Operation'} eq 'Data',
- @{ $args{'Status'} };
- return 1 unless @bad_data_messages;
-
- $RT::Logger->error("Couldn't process a message: ". join ', ', @bad_data_messages );
-
- my $address = (RT::Interface::Email::ParseSenderAddressFromHead( $args{'Message'}->head ))[0];
- my ($status) = RT::Interface::Email::SendEmailUsingTemplate(
- To => $address,
- Template => 'Error: bad GnuPG data',
- Arguments => {
- Messages => [ @bad_data_messages ],
- TicketObj => $args{'Ticket'},
- },
- InReplyTo => $args{'Message'},
- );
- unless ( $status ) {
- $RT::Logger->error("Couldn't send 'Error: bad GnuPG data'");
- }
- return 0;
-}
-
-sub VerifyDecrypt {
- my %args = (
- Entity => undef,
- @_
- );
-
- my @res = RT::Crypt::GnuPG::VerifyDecrypt( %args );
- unless ( @res ) {
- $RT::Logger->debug("No more encrypted/signed parts");
- return 1;
- }
-
- $RT::Logger->debug('Found GnuPG protected parts');
-
- # return on any error
- if ( grep $_->{'exit_code'}, @res ) {
- $RT::Logger->debug("Error during verify/decrypt operation");
- return (0, @res);
- }
-
- # nesting
- my ($status, @nested) = VerifyDecrypt( %args );
- return $status, @res, @nested;
-}
-
-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
deleted file mode 100644
index 0673c735c..000000000
--- a/rt/lib/RT/Interface/Email/Auth/MailFrom.pm
+++ /dev/null
@@ -1,182 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Email::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 ) {
- $RT::Logger->error("Couldn't find sender's address");
- return ( $args{'CurrentUser'}, -1 );
- }
-
- my $CurrentUser = new RT::CurrentUser;
- $CurrentUser->LoadByEmail( $Address );
- $CurrentUser->LoadByName( $Address ) unless $CurrentUser->Id;
- if ( $CurrentUser->Id ) {
- $RT::Logger->debug("Mail from user #". $CurrentUser->Id ." ($Address)" );
- 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("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("Couldn't find the 'Everyone' internal group");
- return ( $args{'CurrentUser'}, -1 );
- }
-
- $RT::Logger->debug("Going to create user with address '$Address'" );
-
- # 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 ) {
- my $qname = $args{'Queue'}->Name;
- # 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' ) )
- {
- $RT::Logger->debug("Unprivileged users have no right to comment on ticket in queue '$qname'");
- 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' ) )
- {
- $RT::Logger->debug("Unprivileged users have no right to reply to ticket in queue '$qname'");
- 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' ) )
- {
- $RT::Logger->debug("Unprivileged users have no right to own ticket in queue '$qname'");
- 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' ) )
- {
- $RT::Logger->debug("Unprivileged users have no right to resolve ticket in queue '$qname'");
- return ( $args{'CurrentUser'}, 0 );
- }
-
- }
- else {
- $RT::Logger->warning("Action '". ($args{'Action'}||'') ."' is unknown");
- return ( $args{'CurrentUser'}, 0 );
- }
- }
-
- # We're creating a ticket
- elsif ( $args{'Queue'} && $args{'Queue'}->Id ) {
- my $qname = $args{'Queue'}->Name;
-
- # check to see whether "Everybody" or "Unprivileged users" can create tickets in this queue
- unless ( $everyone->PrincipalObj->HasRight( Object => $args{'Queue'},
- Right => 'CreateTicket' )
- || $unpriv->PrincipalObj->HasRight( Object => $args{'Queue'},
- Right => 'CreateTicket' ) )
- {
- $RT::Logger->debug("Unprivileged users have no right to create ticket in queue '$qname'");
- 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
deleted file mode 100644
index 49e89c570..000000000
--- a/rt/lib/RT/Interface/Email/Filter/SpamAssassin.pm
+++ /dev/null
@@ -1,98 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Email::Filter::SpamAssassin;
-
-use Mail::SpamAssassin;
-my $spamtest = Mail::SpamAssassin->new();
-
-sub GetCurrentUser {
- my %args = (
- Message => undef,
- CurrentUser => undef,
- AuthLevel => undef,
- @_
- );
- my $status = $spamtest->check( $args{'Message'} );
- return ( $args{'CurrentUser'}, $args{'AuthLevel'} )
- unless $status->is_spam();
-
- eval { $status->rewrite_mail() };
- if ( $status->get_hits > $status->get_required_hits() * 1.5 ) {
-
- # Spammy indeed
- return ( $args{'CurrentUser'}, -1 );
- }
- return ( $args{'CurrentUser'}, $args{'AuthLevel'} );
-
-}
-
-=head1 NAME
-
-RT::Interface::Email::Filter::SpamAssassin - Spam filter for RT
-
-=head1 SYNOPSIS
-
- # in RT config
- Set(@MailPlugins, 'Filter::SpamAssassin', ...other filters...);
-
-=head1 DESCRIPTION
-
-This plugin checks to see if an incoming mail is spam (using
-C<spamassassin>) and if so, rewrites its headers. If the mail is very
-definitely spam - 1.5x more hits than required - then it is dropped on
-the floor; otherwise, it is passed on as normal.
-
-=cut
-
-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
deleted file mode 100644
index e7689f4f8..000000000
--- a/rt/lib/RT/Interface/REST.pm
+++ /dev/null
@@ -1,327 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-# lib/RT/Interface/REST.pm
-#
-
-package RT::Interface::REST;
-use strict;
-use RT;
-
-BEGIN {
- use base 'Exporter';
- use vars qw($VERSION @EXPORT);
-
- $VERSION = do { my @r = (q$Revision: 1.1.1.8 $ =~ /\d+/g); sprintf "%d."."%02d"x$#r, @r };
-
- @EXPORT = qw(expand_list form_parse form_compose vpush vsplit);
-}
-
-sub custom_field_spec {
- my $self = shift;
- my $capture = shift;
-
- my $CF_char = '[\sa-z0-9_ :()/-]';
- my $CF_name = $CF_char . '+';
- $CF_name = '(' . $CF_name . ')' if $capture;
-
- my $new_style = 'CF\.\{'.$CF_name.'\}';
- my $old_style = 'C(?:ustom)?F(?:ield)?-'.$CF_name;
-
- return '(?i:' . join('|', $new_style, $old_style) . ')';
-}
-
-sub field_spec {
- my $self = shift;
- my $capture = shift;
-
- my $field = '[a-z][a-z0-9_-]*';
- $field = '(' . $field . ')' if $capture;
-
- my $custom_field = __PACKAGE__->custom_field_spec($capture);
-
- return '(?i:' . join('|', $field, $custom_field) . ')';
-}
-
-# 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) = ("", [], {}, "");
- my $field = __PACKAGE__->field_spec;
-
- 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);
- $v[0] = '' unless defined $v[0];
-
- # 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;
-
- shift @v while (@v && $v[0] eq '');
-
- 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) {
- $v = '' unless defined $v;
- 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;
-}
-
-eval "require RT::Interface::REST_Vendor";
-if ($@ && $@ !~ qr{^Can't locate RT/Interface/REST_Vendor.pm}) {
- die $@;
-};
-
-eval "require RT::Interface::REST_Local";
-if ($@ && $@ !~ qr{^Can't locate RT/Interface/REST_Local.pm}) {
- die $@;
-};
-
-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
deleted file mode 100644
index edb719df5..000000000
--- a/rt/lib/RT/Interface/Web.pm
+++ /dev/null
@@ -1,2108 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-## 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
-
-
-=cut
-
-use strict;
-use warnings;
-
-package RT::Interface::Web;
-
-use RT::SavedSearches;
-use URI qw();
-use RT::Interface::Web::Session;
-use Digest::MD5 ();
-use Encode qw();
-
-# {{{ 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;
-
- $$ref =~ s/&/&#38;/g;
- $$ref =~ s/</&lt;/g;
- $$ref =~ s/>/&gt;/g;
- $$ref =~ s/\(/&#40;/g;
- $$ref =~ s/\)/&#41;/g;
- $$ref =~ s/"/&#34;/g;
- $$ref =~ s/'/&#39;/g;
-}
-
-# }}}
-
-# {{{ EscapeURI
-
-=head2 EscapeURI SCALARREF
-
-Escapes URI component according to RFC2396
-
-=cut
-
-sub EscapeURI {
- my $ref = shift;
- return unless defined $$ref;
-
- use bytes;
- $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
-}
-
-# }}}
-
-# {{{ 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 {
- return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_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;
-
- # default to making Privileged users, even if they specify
- # some other default Attributes
- if ( !$RT::AutoCreate
- || ( ref($RT::AutoCreate) && not exists $RT::AutoCreate->{Privileged} ) )
- {
- $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};
-}
-
-# }}}
-
-sub HandleRequest {
- my $ARGS = shift;
-
- $HTML::Mason::Commands::r->content_type("text/html; charset=utf-8");
-
- $HTML::Mason::Commands::m->{'rt_base_time'} = [ Time::HiRes::gettimeofday() ];
-
- # Roll back any dangling transactions from a previous failed connection
- $RT::Handle->ForceRollback() if $RT::Handle->TransactionDepth;
-
- MaybeEnableSQLStatementLog();
-
- # avoid reentrancy, as suggested by masonbook
- local *HTML::Mason::Commands::session unless $HTML::Mason::Commands::m->is_subrequest;
-
- $HTML::Mason::Commands::m->autoflush( $HTML::Mason::Commands::m->request_comp->attr('AutoFlush') )
- if ( $HTML::Mason::Commands::m->request_comp->attr_exists('AutoFlush') );
-
- DecodeARGS($ARGS);
- PreprocessTimeUpdates($ARGS);
-
- MaybeShowInstallModePage();
-
- $HTML::Mason::Commands::m->comp( '/Elements/SetupSessionCookie', %$ARGS );
- SendSessionCookie();
- $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new() unless _UserLoggedIn();
-
- MaybeShowNoAuthPage($ARGS);
-
- AttemptExternalAuth($ARGS) if RT->Config->Get('WebExternalAuthContinuous') or not _UserLoggedIn();
-
- _ForceLogout() unless _UserLoggedIn();
-
- # Process per-page authentication callbacks
- $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' );
-
- unless ( _UserLoggedIn() ) {
- _ForceLogout();
-
- # If the user is logging in, let's authenticate
- if ( defined $ARGS->{user} && defined $ARGS->{pass} ) {
- AttemptPasswordAuthentication($ARGS);
- } else {
- # if no credentials then show him login page
- $HTML::Mason::Commands::m->comp( '/Elements/Login', %$ARGS );
- $HTML::Mason::Commands::m->abort;
- }
- }
-
- # now it applies not only to home page, but any dashboard that can be used as a workspace
- $HTML::Mason::Commands::session{'home_refresh_interval'} = $ARGS->{'HomeRefreshInterval'}
- if ( $ARGS->{'HomeRefreshInterval'} );
-
- # Process per-page global callbacks
- $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' );
-
- ShowRequestedPage($ARGS);
- LogRecordedSQLStatements();
-}
-
-sub _ForceLogout {
-
- delete $HTML::Mason::Commands::session{'CurrentUser'};
-}
-
-sub _UserLoggedIn {
- if ( $HTML::Mason::Commands::session{CurrentUser} && $HTML::Mason::Commands::session{'CurrentUser'}->id ) {
- return 1;
- } else {
- return undef;
- }
-
-}
-
-=head2 MaybeShowInstallModePage
-
-This function, called exclusively by RT's autohandler, dispatches
-a request to RT's Installation workflow, only if Install Mode is enabled in the configuration file.
-
-If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler
-
-=cut
-
-sub MaybeShowInstallModePage {
- return unless RT->InstallMode;
-
- my $m = $HTML::Mason::Commands::m;
- if ( $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) {
- $m->call_next();
- } elsif ( $m->request_comp->path !~ '^(/+)Install/' ) {
- RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "Install/index.html" );
- } else {
- $m->call_next();
- }
- $m->abort();
-}
-
-=head2 MaybeShowNoAuthPage \%ARGS
-
-This function, called exclusively by RT's autohandler, dispatches
-a request to the page a user requested (but only if it matches the "noauth" regex.
-
-If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler
-
-=cut
-
-sub MaybeShowNoAuthPage {
- my $ARGS = shift;
-
- my $m = $HTML::Mason::Commands::m;
-
- return unless $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex');
-
- # If it's a noauth file, don't ask for auth.
- SendSessionCookie();
- $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
- $m->abort;
-}
-
-=head2 ShowRequestedPage \%ARGS
-
-This function, called exclusively by RT's autohandler, dispatches
-a request to the page a user requested (making sure that unpriviled users
-can only see self-service pages.
-
-=cut
-
-sub ShowRequestedPage {
- my $ARGS = shift;
-
- my $m = $HTML::Mason::Commands::m;
-
- SendSessionCookie();
-
- # If the user isn't privileged, they can only see SelfService
- unless ( $HTML::Mason::Commands::session{'CurrentUser'}->Privileged ) {
-
- # if the user is trying to access a ticket, redirect them
- if ( $m->request_comp->path =~ '^(/+)Ticket/Display.html' && $ARGS->{'id'} ) {
- RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/Display.html?id=" . $ARGS->{'id'} );
- }
-
- # otherwise, drop the user at the SelfService default page
- elsif ( $m->base_comp->path !~ RT->Config->Get('SelfServiceRegex') ) {
- RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/" );
- }
-
- # if user is in SelfService dir let him do anything
- else {
- $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
- }
- } else {
- $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
- }
-
-}
-
-sub AttemptExternalAuth {
- my $ARGS = shift;
-
- return unless ( RT->Config->Get('WebExternalAuth') );
-
- my $user = $ARGS->{user};
- my $m = $HTML::Mason::Commands::m;
-
- # If RT is configured for external auth, let's go through and get REMOTE_USER
-
- # do we actually have a REMOTE_USER equivlent?
- if ( RT::Interface::Web::WebCanonicalizeInfo() ) {
- my $orig_user = $user;
-
- $user = RT::Interface::Web::WebCanonicalizeInfo();
- my $load_method = RT->Config->Get('WebExternalGecos') ? 'LoadByGecos' : 'Load';
-
- if ( $^O eq 'MSWin32' and RT->Config->Get('WebExternalGecos') ) {
- my $NodeName = Win32::NodeName();
- $user =~ s/^\Q$NodeName\E\\//i;
- }
-
- InstantiateNewSession() unless _UserLoggedIn;
- $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
- $HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user);
-
- if ( RT->Config->Get('WebExternalAuto') and not _UserLoggedIn() ) {
-
- # Create users on-the-fly
- my $UserObj = RT::User->new($RT::SystemUser);
- my ( $val, $msg ) = $UserObj->Create(
- %{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} },
- Name => $user,
- Gecos => $user,
- );
-
- if ($val) {
-
- # now get user specific information, to better create our user.
- my $new_user_info = RT::Interface::Web::WebExternalAutoInfo($user);
-
- # set the attributes that have been defined.
- foreach my $attribute ( $UserObj->WritableAttributes ) {
- $m->callback(
- Attribute => $attribute,
- User => $user,
- UserInfo => $new_user_info,
- CallbackName => 'NewUser',
- CallbackPage => '/autohandler'
- );
- my $method = "Set$attribute";
- $UserObj->$method( $new_user_info->{$attribute} ) if defined $new_user_info->{$attribute};
- }
- $HTML::Mason::Commands::session{'CurrentUser'}->Load($user);
- } else {
-
- # we failed to successfully create the user. abort abort abort.
- delete $HTML::Mason::Commands::session{'CurrentUser'};
- $m->comp( '/Elements/Login', %$ARGS, Error => HTML::Mason::Commands::loc( 'Cannot create user: [_1]', $msg ) )
- if RT->Config->Get('WebFallbackToInternalAuth');;
- $m->abort();
- }
- }
-
- if ( _UserLoggedIn() ) {
- $m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' );
- } else {
- delete $HTML::Mason::Commands::session{'CurrentUser'};
- $user = $orig_user;
-
- if ( RT->Config->Get('WebExternalOnly') ) {
- $m->comp( '/Elements/Login', %$ARGS, Error => HTML::Mason::Commands::loc('You are not an authorized user') );
- $m->abort();
- }
- }
- } elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) {
- unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) {
- # XXX unreachable due to prior defaulting in HandleRequest (check c34d108)
- $m->comp( '/Elements/Login', %$ARGS, Error => HTML::Mason::Commands::loc('You are not an authorized user') );
- $m->abort();
- }
- } else {
-
- # WebExternalAuth is set, but we don't have a REMOTE_USER. abort
- # XXX: we must return AUTH_REQUIRED status or we fallback to
- # internal auth here too.
- delete $HTML::Mason::Commands::session{'CurrentUser'}
- if defined $HTML::Mason::Commands::session{'CurrentUser'};
- }
-}
-
-sub AttemptPasswordAuthentication {
- my $ARGS = shift;
- my $user_obj = RT::CurrentUser->new();
- $user_obj->Load( $ARGS->{user} );
-
- my $m = $HTML::Mason::Commands::m;
-
- unless ( $user_obj->id && $user_obj->IsPassword( $ARGS->{pass} ) ) {
- $RT::Logger->error("FAILED LOGIN for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
- $m->comp( '/Elements/Login', %$ARGS, Error => HTML::Mason::Commands::loc('Your username or password is incorrect'), );
- $m->callback( %$ARGS, CallbackName => 'FailedLogin', CallbackPage => '/autohandler' );
- $m->abort;
- }
-
- $RT::Logger->info("Successful login for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
- InstantiateNewSession();
- $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;
- $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' );
-}
-
-=head2 LoadSessionFromCookie
-
-Load or setup a session cookie for the current user.
-
-=cut
-
-sub _SessionCookieName {
- my $cookiename = "RT_SID_" . RT->Config->Get('rtname');
- $cookiename .= "." . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'};
- return $cookiename;
-}
-
-sub LoadSessionFromCookie {
-
- my %cookies = CGI::Cookie->fetch;
- my $cookiename = _SessionCookieName();
- my $SessionCookie = ( $cookies{$cookiename} ? $cookies{$cookiename}->value : undef );
- tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', $SessionCookie;
- unless ( $SessionCookie && $HTML::Mason::Commands::session{'_session_id'} eq $SessionCookie ) {
- undef $cookies{$cookiename};
- }
- if ( int RT->Config->Get('AutoLogoff') ) {
- my $now = int( time / 60 );
- my $last_update = $HTML::Mason::Commands::session{'_session_last_update'} || 0;
-
- if ( $last_update && ( $now - $last_update - RT->Config->Get('AutoLogoff') ) > 0 ) {
- InstantiateNewSession();
- }
-
- # save session on each request when AutoLogoff is turned on
- $HTML::Mason::Commands::session{'_session_last_update'} = $now if $now != $last_update;
- }
-}
-
-sub InstantiateNewSession {
- tied(%HTML::Mason::Commands::session)->delete if tied(%HTML::Mason::Commands::session);
- tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', undef;
-}
-
-sub SendSessionCookie {
- my $cookie = CGI::Cookie->new(
- -name => _SessionCookieName(),
- -value => $HTML::Mason::Commands::session{_session_id},
- -path => RT->Config->Get('WebPath'),
- -secure => ( RT->Config->Get('WebSecureCookies') ? 1 : 0 )
- );
-
- $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string;
-}
-
-=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->Config->Get('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)
- # don't do this if $RT::CanoniaclRedirectURLs is true
- if ( !RT->Config->Get('CanonicalizeRedirectURLs')
- && $uri->host eq $server_uri->host
- && $uri->port eq $server_uri->port )
- {
- if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) {
- $uri->scheme('https');
- } else {
- $uri->scheme('http');
- }
-
- # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST
- $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} );
- $uri->port( $ENV{'SERVER_PORT'} );
- }
-
- # not sure why, but on some systems without this call mason doesn't
- # set status to 302, but 200 instead and people see blank pages
- $HTML::Mason::Commands::r->status(302);
-
- # Perlbal expects a status message, but Mason's default redirect status
- # doesn't provide one. See also rt.cpan.org #36689.
- $HTML::Mason::Commands::m->redirect( $uri->canonical, "302 Found" );
-
- $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 {
- my $date = RT::Date->new($RT::SystemUser);
-
- # make cache public
- $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
-
- # Expire things in a month.
- $date->Set( Value => time + 30 * 24 * 60 * 60 );
- $HTML::Mason::Commands::r->headers_out->{'Expires'} = $date->RFC2616;
-
- # 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
- # $date->Set( Value => $^T );
- # $HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = $date->RFC2616;
-}
-
-=head2 PathIsSafe
-
-Takes a C<< Path => path >> and returns a boolean indicating that
-the path is safely within RT's control or not. The path I<must> be
-relative.
-
-This function does not consult the filesystem at all; it is merely
-a logical sanity checking of the path. This explicitly does not handle
-symlinks; if you have symlinks in RT's webroot pointing outside of it,
-then we assume you know what you are doing.
-
-=cut
-
-sub PathIsSafe {
- my $self = shift;
- my %args = @_;
- my $path = $args{Path};
-
- # Get File::Spec to clean up extra /s, ./, etc
- my $cleaned_up = File::Spec->canonpath($path);
-
- if (!defined($cleaned_up)) {
- $RT::Logger->info("Rejecting path that canonpath doesn't understand: $path");
- return 0;
- }
-
- # Forbid too many ..s. We can't just sum then check because
- # "../foo/bar/baz" should be illegal even though it has more
- # downdirs than updirs. So as soon as we get a negative score
- # (which means "breaking out" of the top level) we reject the path.
-
- my @components = split '/', $cleaned_up;
- my $score = 0;
- for my $component (@components) {
- if ($component eq '..') {
- $score--;
- if ($score < 0) {
- $RT::Logger->info("Rejecting unsafe path: $path");
- return 0;
- }
- }
- elsif ($component eq '.' || $component eq '') {
- # these two have no effect on $score
- }
- else {
- $score++;
- }
- }
-
- return 1;
-}
-
-=head2 SendStaticFile
-
-Takes a File => path and a Type => Content-type
-
-If Type isn't provided and File is an image, it will
-figure out a sane Content-type, otherwise it will
-send application/octet-stream
-
-Will set caching headers using StaticFileHeaders
-
-=cut
-
-sub SendStaticFile {
- my $self = shift;
- my %args = @_;
- my $file = $args{File};
- my $type = $args{Type};
- my $relfile = $args{RelativeFile};
-
- if (defined($relfile) && !$self->PathIsSafe(Path => $relfile)) {
- $HTML::Mason::Commands::r->status(400);
- $HTML::Mason::Commands::m->abort;
- }
-
- $self->StaticFileHeaders();
-
- unless ($type) {
- if ( $file =~ /\.(gif|png|jpe?g)$/i ) {
- $type = "image/$1";
- $type =~ s/jpg/jpeg/gi;
- }
- $type ||= "application/octet-stream";
- }
- $HTML::Mason::Commands::r->content_type($type);
- open my $fh, "<$file" or die "couldn't open file: $!";
- binmode($fh);
- {
- local $/ = \16384;
- $HTML::Mason::Commands::m->out($_) while (<$fh>);
- $HTML::Mason::Commands::m->flush_buffer;
- }
- close $fh;
-}
-
-sub StripContent {
- my %args = @_;
- my $content = $args{Content};
- return '' unless $content;
-
- # Make the content have no 'weird' newlines in it
- $content =~ s/\r+\n/\n/g;
-
- my $return_content = $content;
-
- my $html = $args{ContentType} && $args{ContentType} eq "text/html";
- my $sigonly = $args{StripSignature};
-
- # massage content to easily detect if there's any real content
- $content =~ s/\s+//g; # yes! remove all the spaces
- if ( $html ) {
- # remove html version of spaces and newlines
- $content =~ s!&nbsp;!!g;
- $content =~ s!<br/?>!!g;
- }
-
- # Filter empty content when type is text/html
- return '' if $html && $content !~ /\S/;
-
- # If we aren't supposed to strip the sig, just bail now.
- return $return_content unless $sigonly;
-
- # Find the signature
- my $sig = $args{'CurrentUser'}->UserObj->Signature || '';
- $sig =~ s/\s+//g;
-
- # Check for plaintext sig
- return '' if not $html and $content =~ /^(--)?\Q$sig\E$/;
-
- # Check for html-formatted sig
- RT::Interface::Web::EscapeUTF8( \$sig );
- return ''
- if $html
- and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s;
-
- # Pass it through
- return $return_content;
-}
-
-sub DecodeARGS {
- my $ARGS = shift;
-
- %{$ARGS} = map {
-
- # if they've passed multiple values, they'll be an array. if they've
- # passed just one, a scalar whatever they are, mark them as utf8
- my $type = ref($_);
- ( !$type )
- ? Encode::is_utf8($_)
- ? $_
- : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ )
- : ( $type eq 'ARRAY' )
- ? [ map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
- @$_ ]
- : ( $type eq 'HASH' )
- ? { map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
- %$_ }
- : $_
- } %$ARGS;
-}
-
-sub PreprocessTimeUpdates {
- my $ARGS = shift;
-
- # Later in the code we use
- # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS );
- # instead of $m->call_next to avoid problems with UTF8 keys in arguments.
- # The call_next method pass through original arguments and if you have
- # an argument with unicode key then in a next component you'll get two
- # records in the args hash: one with key without UTF8 flag and another
- # with the flag, which may result into errors. "{ base_comp => $m->request_comp }"
- # is copied from mason's source to get the same results as we get from
- # call_next method, this feature is not documented, so we just leave it
- # here to avoid possible side effects.
-
- # This code canonicalizes time inputs in hours into minutes
- foreach my $field ( keys %$ARGS ) {
- next unless $field =~ /^(.*)-TimeUnits$/i && $ARGS->{$1};
- my $local = $1;
- $ARGS->{$local} =~ s{\b (?: (\d+) \s+ )? (\d+)/(\d+) \b}
- {($1 || 0) + $3 ? $2 / $3 : 0}xe;
- if ( $ARGS->{$field} && $ARGS->{$field} =~ /hours/i ) {
- $ARGS->{$local} *= 60;
- }
- delete $ARGS->{$field};
- }
-
-}
-
-sub MaybeEnableSQLStatementLog {
-
- my $log_sql_statements = RT->Config->Get('StatementLog');
-
- if ($log_sql_statements) {
- $RT::Handle->ClearSQLStatementLog;
- $RT::Handle->LogSQLStatements(1);
- }
-
-}
-
-sub LogRecordedSQLStatements {
- my $log_sql_statements = RT->Config->Get('StatementLog');
-
- return unless ($log_sql_statements);
-
- my @log = $RT::Handle->SQLStatementLog;
- $RT::Handle->ClearSQLStatementLog;
- for my $stmt (@log) {
- my ( $time, $sql, $bind, $duration ) = @{$stmt};
- my @bind;
- if ( ref $bind ) {
- @bind = @{$bind};
- } else {
-
- # Older DBIx-SB
- $duration = $bind;
- }
- $RT::Logger->log(
- level => $log_sql_statements,
- message => "SQL("
- . sprintf( "%.6f", $duration )
- . "s): $sql;"
- . ( @bind ? " [ bound values: @{[map{qq|'$_'|} @bind]} ]" : "" )
- );
- }
-
-}
-
-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();
- }
- )
- {
- 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 {
- my $why = shift;
- my %args = @_;
-
- if ( $session{'ErrorDocument'}
- && $session{'ErrorDocumentType'} )
- {
- $r->content_type( $session{'ErrorDocumentType'} );
- $m->comp( $session{'ErrorDocument'}, Why => $why, %args );
- $m->abort;
- } else {
- $m->comp( "/Elements/Error", Why => $why, %args );
- $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;
- if ( defined $ARGS{'Due'} and $ARGS{'Due'} =~ /\S/ ) {
- $due = new RT::Date( $session{'CurrentUser'} );
- $due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
- }
- my $starts;
- if ( defined $ARGS{'Starts'} and $ARGS{'Starts'} =~ /\S/ ) {
- $starts = new RT::Date( $session{'CurrentUser'} );
- $starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
- }
-
- my $sigless = RT::Interface::Web::StripContent(
- Content => $ARGS{Content},
- ContentType => $ARGS{ContentType},
- StripSignature => 1,
- CurrentUser => $session{'CurrentUser'},
- );
-
- my $MIMEObj = MakeMIMEEntity(
- Subject => $ARGS{'Subject'},
- From => $ARGS{'From'},
- Cc => $ARGS{'Cc'},
- Body => $sigless,
- 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($_);
- }
- }
-
- foreach my $argument (qw(Encrypt Sign)) {
- $MIMEObj->head->add(
- "X-RT-$argument" => Encode::encode_utf8( $ARGS{$argument} )
- ) if defined $ARGS{$argument};
- }
-
- my %create_args = (
- Type => $ARGS{'Type'} || 'ticket',
- Queue => $ARGS{'Queue'},
- Owner => $ARGS{'Owner'},
-
- # note: name change
- Requestor => $ARGS{'Requestors'},
- Cc => $ARGS{'Cc'},
- AdminCc => $ARGS{'AdminCc'},
- InitialPriority => $ARGS{'InitialPriority'},
- FinalPriority => $ARGS{'FinalPriority'},
- TimeLeft => $ARGS{'TimeLeft'},
- TimeEstimated => $ARGS{'TimeEstimated'},
- TimeWorked => $ARGS{'TimeWorked'},
- Subject => $ARGS{'Subject'},
- Status => $ARGS{'Status'},
- Due => $due ? $due->ISO : undef,
- Starts => $starts ? $starts->ISO : undef,
- MIMEObj => $MIMEObj
- );
-
- my @temp_squelch;
- foreach my $type (qw(Requestor Cc AdminCc)) {
- push @temp_squelch, map $_->address, Email::Address->parse( $create_args{$type} )
- if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] };
-
- }
-
- if (@temp_squelch) {
- require RT::Action::SendEmail;
- RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
- }
-
- if ( $ARGS{'AttachTickets'} ) {
- require RT::Action::SendEmail;
- RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets,
- ref $ARGS{'AttachTickets'}
- ? @{ $ARGS{'AttachTickets'} }
- : ( $ARGS{'AttachTickets'} ) );
- }
-
- 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);
- unless ( $cf->id ) {
- $RT::Logger->error( "Couldn't load custom field #" . $cfid );
- next;
- }
-
- if ( $arg =~ /-Upload$/ ) {
- $create_args{"CustomField-$cfid"} = _UploadedFile($arg);
- next;
- }
-
- my $type = $cf->Type;
-
- my @values = ();
- if ( ref $ARGS{$arg} eq 'ARRAY' ) {
- @values = @{ $ARGS{$arg} };
- } elsif ( $type =~ /text/i ) {
- @values = ( $ARGS{$arg} );
- } else {
- no warnings 'uninitialized';
- @values = split /\r*\n/, $ARGS{$arg};
- }
- @values = grep length, map {
- s/\r+\n/\n/g;
- s/^\s+//;
- s/\s+$//;
- $_;
- }
- grep defined, @values;
-
- $create_args{"CustomField-$cfid"} = \@values;
- }
- }
-
- # turn new link lists into arrays, and pass in the proper arguments
- my %map = (
- 'new-DependsOn' => 'DependsOn',
- 'DependsOn-new' => 'DependedOnBy',
- 'new-MemberOf' => 'Parents',
- 'MemberOf-new' => 'Children',
- 'new-RefersTo' => 'RefersTo',
- 'RefersTo-new' => 'ReferredToBy',
- );
- foreach my $key ( keys %map ) {
- next unless $ARGS{$key};
- $create_args{ $map{$key} } = [ grep $_, split ' ', $ARGS{$key} ];
-
- }
-
- 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
-
-=head2 ProcessUpdateMessage
-
-Takes paramhash with fields ARGSRef, TicketObj and SkipSignatureOnly.
-
-Don't write message if it only contains current user's signature and
-SkipSignatureOnly argument is true. Function anyway adds attachments
-and updates time worked field even if skips message. The default value
-is true.
-
-=cut
-
-sub ProcessUpdateMessage {
-
- my %args = (
- ARGSRef => undef,
- TicketObj => undef,
- SkipSignatureOnly => 1,
- @_
- );
-
- if ( $args{ARGSRef}->{'UpdateAttachments'}
- && !keys %{ $args{ARGSRef}->{'UpdateAttachments'} } )
- {
- delete $args{ARGSRef}->{'UpdateAttachments'};
- }
-
- # Strip the signature
- $args{ARGSRef}->{UpdateContent} = RT::Interface::Web::StripContent(
- Content => $args{ARGSRef}->{UpdateContent},
- ContentType => $args{ARGSRef}->{UpdateContentType},
- StripSignature => $args{SkipSignatureOnly},
- CurrentUser => $args{'TicketObj'}->CurrentUser,
- );
-
- # If, after stripping the signature, we have no message, move the
- # UpdateTimeWorked into adjusted TimeWorked, so that a later
- # ProcessBasics can deal -- then bail out.
- if ( not $args{ARGSRef}->{'UpdateAttachments'}
- and not length $args{ARGSRef}->{'UpdateContent'} )
- {
- if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
- $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + delete $args{ARGSRef}->{'UpdateTimeWorked'};
- }
- return;
- }
-
- 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' => Encode::encode_utf8(
- RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
- ) );
- 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 ( my $msg = $old_txn->Message->First ) {
- RT::Interface::Email::SetInReplyTo(
- Message => $Message,
- InReplyTo => $msg
- );
- }
-
- if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
- $Message->make_multipart;
- $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
- }
-
- if ( $args{ARGSRef}->{'AttachTickets'} ) {
- require RT::Action::SendEmail;
- RT::Action::SendEmail->AttachTickets( RT::Action::SendEmail->AttachTickets,
- ref $args{ARGSRef}->{'AttachTickets'}
- ? @{ $args{ARGSRef}->{'AttachTickets'} }
- : ( $args{ARGSRef}->{'AttachTickets'} ) );
- }
-
- my $bcc = $args{ARGSRef}->{'UpdateBcc'};
- my $cc = $args{ARGSRef}->{'UpdateCc'};
-
- my %message_args = (
- CcMessageTo => $cc,
- BccMessageTo => $bcc,
- Sign => $args{ARGSRef}->{'Sign'},
- Encrypt => $args{ARGSRef}->{'Encrypt'},
- MIMEObj => $Message,
- TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
- );
-
- my @temp_squelch;
- foreach my $type (qw(Cc AdminCc)) {
- if (grep $_ eq $type || $_ eq ( $type . 's' ), @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
- push @temp_squelch, map $_->address, Email::Address->parse( $message_args{$type} );
- push @temp_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
- push @temp_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
- }
- }
- if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
- push @temp_squelch, map $_->address, Email::Address->parse( $message_args{Requestor} );
- push @temp_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
- }
-
- if (@temp_squelch) {
- require RT::Action::SendEmail;
- RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
- }
-
- unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) {
- foreach my $key ( keys %{ $args{ARGSRef} } ) {
- next unless $key =~ /^Update(Cc|Bcc)-(.*)$/;
-
- my $var = ucfirst($1) . 'MessageTo';
- my $value = $2;
- if ( $message_args{$var} ) {
- $message_args{$var} .= ", $value";
- } else {
- $message_args{$var} = $value;
- }
- }
- }
-
- my @results;
- if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
- my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args);
- push( @results, $Description );
- $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
- } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
- my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args);
- push( @results, $Description );
- $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
- } else {
- push( @results,
- loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
- }
- return @results;
-}
-
-# }}}
-
-# {{{ sub 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,
- @_,
- );
- my $Message = MIME::Entity->build(
- Type => 'multipart/mixed',
- map { $_ => Encode::encode_utf8( $args{ $_} ) }
- grep defined $args{$_}, qw(Subject From Cc)
- );
-
- if ( defined $args{'Body'} && length $args{'Body'} ) {
-
- # Make the update content have no 'weird' newlines in it
- $args{'Body'} =~ s/\r\n/\n/gs;
-
- $Message->attach(
- Type => $args{'Type'} || 'text/plain',
- Charset => 'UTF-8',
- Data => $args{'Body'},
- );
- }
-
- if ( $args{'AttachmentFieldName'} ) {
-
- my $cgi_object = $m->cgi_object;
-
- if ( my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
-
- my ( @content, $buffer );
- while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
- push @content, $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 = Encode::encode_utf8( $filename );
- $filename =~ s{^.*[\\/]}{};
-
- $Message->attach(
- Type => $uploadinfo->{'Content-Type'},
- Filename => $filename,
- Data => \@content,
- );
- if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) {
- $Message->head->set( 'Subject' => $filename );
- }
- }
- }
-
- $Message->make_singlepart;
-
- RT::I18N::SetMIMEEntityToUTF8($Message); # convert text parts into utf-8
-
- return ($Message);
-
-}
-
-# }}}
-
-# {{{ 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;
-
- #XXX: why don't we get ARGSref like in other Process* subs?
-
- my @results;
-
- foreach my $arg ( keys %$ARGSref ) {
- next unless ( $arg =~ /^(GrantRight|RevokeRight)-(\d+)-(.+?)-(\d+)$/ );
-
- my ( $method, $principal_id, $object_type, $object_id ) = ( $1, $2, $3, $4 );
-
- my @rights;
- if ( UNIVERSAL::isa( $ARGSref->{$arg}, 'ARRAY' ) ) {
- @rights = @{ $ARGSref->{$arg} };
- } else {
- @rights = $ARGSref->{$arg};
- }
- @rights = grep $_, @rights;
- next unless @rights;
-
- my $principal = RT::Principal->new( $session{'CurrentUser'} );
- $principal->Load($principal_id);
-
- my $obj;
- if ( $object_type eq 'RT::System' ) {
- $obj = $RT::System;
- } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) {
- $obj = $object_type->new( $session{'CurrentUser'} );
- $obj->Load($object_id);
- unless ( $obj->id ) {
- $RT::Logger->error("couldn't load $object_type #$object_id");
- next;
- }
- } else {
- $RT::Logger->error("object type '$object_type' is incorrect");
- push( @results, loc("System Error") . ': ' . loc( "Rights could not be granted for [_1]", $object_type ) );
- next;
- }
-
- foreach my $right (@rights) {
- my ( $val, $msg ) = $principal->$method( 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
- );
-
- my $prefix = "CustomField-" . $Object->Id;
- if ( $ARGSRef->{"$prefix-AddValue-Name"} ) {
- my ( $addval, $addmsg ) = $Object->AddValue(
- Name => $ARGSRef->{"$prefix-AddValue-Name"},
- Description => $ARGSRef->{"$prefix-AddValue-Description"},
- SortOrder => $ARGSRef->{"$prefix-AddValue-SortOrder"},
- );
- push( @results, $addmsg );
- }
-
- my @delete_values
- = ( ref $ARGSRef->{"$prefix-DeleteValue"} eq 'ARRAY' )
- ? @{ $ARGSRef->{"$prefix-DeleteValue"} }
- : ( $ARGSRef->{"$prefix-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->{ "$prefix-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 #$cf");
- 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;
-
- # Remove blank Values since the magic field will take care of this. Sometimes
- # the browser gives you a blank value which causes CFs to be processed twice
- if ( defined $args{'ARGS'}->{'Values'}
- && !length $args{'ARGS'}->{'Values'}
- && $args{'ARGS'}->{'Values-Magic'} )
- {
- delete $args{'ARGS'}->{'Values'};
- }
-
- my @results;
- foreach my $arg ( keys %{ $args{'ARGS'} } ) {
-
- # skip category argument
- next if $arg eq '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 defined $args{'ARGS'}->{'Value'} && length $args{'ARGS'}->{'Value'};
- next if defined $args{'ARGS'}->{'Values'} && length $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} );
- } else {
- @values = split /\r*\n/, $args{'ARGS'}->{$arg}
- if defined $args{'ARGS'}->{$arg};
- }
- @values = grep length, map {
- s/\r+\n/\n/g;
- s/^\s+//;
- s/\s+$//;
- $_;
- }
- grep defined, @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) {
- if ( my $entry = $cf_values->HasEntry($value) ) {
- $values_hash{ $entry->id } = 1;
- next;
- }
-
- my ( $val, $msg ) = $args{'Object'}->AddCustomFieldValue(
- Field => $cf,
- Value => $value
- );
- push( @results, $msg );
- $values_hash{$val} = 1 if $val;
- }
-
- # For Date Cfs, @values is empty when there is no changes (no datas in form input)
- return @results if ( $cf->Type eq 'Date' && ! @values );
-
- $cf_values->RedoSearch;
- while ( my $cf_value = $cf_values->Next ) {
- next if $values_hash{ $cf_value->id };
-
- my ( $val, $msg ) = $args{'Object'}->DeleteCustomFieldValue(
- Field => $cf,
- ValueId => $cf_value->id
- );
- 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) {
- next unless exists $ARGSRef->{ $field . '_Date' };
- next if $ARGSRef->{ $field . '_Date' } eq '';
-
- my ( $code, $msg );
-
- my $DateObj = RT::Date->new( $session{'CurrentUser'} );
- $DateObj->Set(
- Format => 'unknown',
- Value => $ARGSRef->{ $field . '_Date' }
- );
-
- my $obj = $field . "Obj";
- if ( ( defined $DateObj->Unix )
- and ( $DateObj->Unix != $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" } ) {
- $ARGSRef->{ $Ticket->Id . "-MergeInto" } =~ s/\s+//g;
- 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;
-
- 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" } ) {
- $ARGSRef->{ $Record->Id . "-$linktype" } = join( ' ', @{ $ARGSRef->{ $Record->Id . "-$linktype" } } )
- if ref( $ARGSRef->{ $Record->Id . "-$linktype" } );
-
- for my $luri ( split( / /, $ARGSRef->{ $Record->Id . "-$linktype" } ) ) {
- next unless $luri;
- $luri =~ s/\s+$//; # Strip trailing whitespace
- my ( $val, $msg ) = $Record->AddLink(
- Target => $luri,
- Type => $linktype
- );
- push @results, $msg;
- }
- }
- if ( $ARGSRef->{ "$linktype-" . $Record->Id } ) {
- $ARGSRef->{ "$linktype-" . $Record->Id } = join( ' ', @{ $ARGSRef->{ "$linktype-" . $Record->Id } } )
- if ref( $ARGSRef->{ "$linktype-" . $Record->Id } );
-
- for my $luri ( split( / /, $ARGSRef->{ "$linktype-" . $Record->Id } ) ) {
- next unless $luri;
- 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'},
- };
-}
-
-sub GetColumnMapEntry {
- my %args = ( Map => {}, Name => '', Attribute => undef, @_ );
-
- # deal with the simplest thing first
- if ( $args{'Map'}{ $args{'Name'} } ) {
- return $args{'Map'}{ $args{'Name'} }{ $args{'Attribute'} };
- }
-
- # complex things
- elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.{(.+)}$/ ) {
- return undef unless $args{'Map'}->{$mainkey};
- return $args{'Map'}{$mainkey}{ $args{'Attribute'} }
- unless ref $args{'Map'}{$mainkey}{ $args{'Attribute'} } eq 'CODE';
-
- return sub { $args{'Map'}{$mainkey}{ $args{'Attribute'} }->( @_, $subkey ) };
- }
- return undef;
-}
-
-sub ProcessColumnMapValue {
- my $value = shift;
- my %args = ( Arguments => [], Escape => 1, @_ );
-
- if ( ref $value ) {
- if ( UNIVERSAL::isa( $value, 'CODE' ) ) {
- my @tmp = $value->( @{ $args{'Arguments'} } );
- return ProcessColumnMapValue( ( @tmp > 1 ? \@tmp : $tmp[0] ), %args );
- } elsif ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
- return join '', map ProcessColumnMapValue( $_, %args ), @$value;
- } elsif ( UNIVERSAL::isa( $value, 'SCALAR' ) ) {
- return $$value;
- }
- }
-
- return $m->interp->apply_escapes( $value, 'h' ) if $args{'Escape'};
- return $value;
-}
-
-=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
deleted file mode 100644
index 6a0660670..000000000
--- a/rt/lib/RT/Interface/Web/Handler.pm
+++ /dev/null
@@ -1,229 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Web::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 RT::Interface::Web::Request;
-use File::Path qw( rmtree );
-use File::Glob qw( bsd_glob );
-use File::Spec::Unix;
-
-sub DefaultHandlerArgs { (
- comp_root => [
- [ local => $RT::MasonLocalComponentRoot ],
- (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}),
- [ standard => $RT::MasonComponentRoot ]
- ],
- 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->Config->Get('DevelMode') ? '0' : '1'),
- use_object_files => (RT->Config->Get('DevelMode') ? '0' : '1'),
- autoflush => 0,
- error_format => (RT->Config->Get('DevelMode') ? 'html': 'brief'),
- request_class => 'RT::Interface::Web::Request',
- named_component_subs => $INC{'Devel/Cover.pm'} ? 1 : 0,
-) };
-
-# {{{ sub new
-
-=head2 new
-
- Constructs a web handler of the appropriate class.
- Takes options to pass to the constructor.
-
-=cut
-
-sub new {
- my $class = shift;
- $class->InitSessionDir;
-
- if ( ($mod_perl::VERSION && $mod_perl::VERSION >= 1.9908) || $CGI::MOD_PERL) {
- goto &NewApacheHandler;
- }
- else {
- goto &NewCGIHandler;
- }
-}
-
-sub InitSessionDir {
- # Activate the following if running httpd as root (the normal case).
- # Resets ownership of all files created by Mason at startup.
- # Note that mysql uses DB for sessions, so there's no need to do this.
- unless ( RT->Config->Get('DatabaseType') =~ /(?:mysql|Pg)/ ) {
-
- # Clean up our umask to protect session files
- umask(0077);
-
- if ($CGI::MOD_PERL and $CGI::MOD_PERL < 1.9908 ) {
-
- chown( Apache->server->uid, Apache->server->gid,
- $RT::MasonSessionDir )
- if Apache->server->can('uid');
- }
-
- # 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 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
-
-Clean ups globals, caches and other things that could be still
-there from previous requests:
-
-=over 4
-
-=item Rollback any uncommitted transaction(s)
-
-=item Flush the ACL cache
-
-=item Flush records cache of the L<DBIx::SearchBuilder> if
-WebFlushDbCacheEveryRequest option is enabled, what is true by default
-and is not recommended to change.
-
-=item Clean up state of RT::Action::SendEmail using 'CleanSlate' method
-
-=item Flush tmp GnuPG key preferences
-
-=back
-
-=cut
-
-sub CleanupRequest {
-
- if ( $RT::Handle && $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->Config->Get('WebFlushDbCacheEveryRequest')
- and UNIVERSAL::can(
- 'DBIx::SearchBuilder::Record::Cachable' => 'FlushCache' ) );
-
- # cleanup global squelching of the mails
- require RT::Action::SendEmail;
- RT::Action::SendEmail->CleanSlate;
-
- if (RT->Config->Get('GnuPG')->{'Enable'}) {
- require RT::Crypt::GnuPG;
- RT::Crypt::GnuPG::UseKeyForEncryption();
- RT::Crypt::GnuPG::UseKeyForSigning( undef );
- }
-
- %RT::Ticket::MERGE_CACHE = ( effective => {}, merged => {} );
-
- # Explicitly remove any tmpfiles that GPG opened, and close their
- # filehandles.
- File::Temp::cleanup;
-}
-# }}}
-
-1;
diff --git a/rt/lib/RT/Interface/Web/Menu.pm b/rt/lib/RT/Interface/Web/Menu.pm
deleted file mode 100644
index 35699429e..000000000
--- a/rt/lib/RT/Interface/Web/Menu.pm
+++ /dev/null
@@ -1,69 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Web::Menu;
-
-
-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
deleted file mode 100644
index 8eb4120c6..000000000
--- a/rt/lib/RT/Interface/Web/Menu/Item.pm
+++ /dev/null
@@ -1,87 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Web::Menu::Item;
-
-
-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
deleted file mode 100755
index 29d12b464..000000000
--- a/rt/lib/RT/Interface/Web/QueryBuilder.pm
+++ /dev/null
@@ -1,59 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Web::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
deleted file mode 100755
index e672d8e4c..000000000
--- a/rt/lib/RT/Interface/Web/QueryBuilder/Tree.pm
+++ /dev/null
@@ -1,293 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Web::QueryBuilder::Tree;
-
-use strict;
-use warnings;
-
-use Tree::Simple qw/use_weak_refs/;
-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) = @_;
-
- # XXX: if pre or post action changes siblings (delete or adds)
- # we could have problems
- $prefunc->($self) if $prefunc;
-
- foreach my $child ($self->getAllChildren()) {
- $child->TraversePrePost($prefunc, $postfunc);
- }
-
- $postfunc->($self) if $postfunc;
-}
-
-=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;
- return unless $node->isLeaf;
-
- my $clause = $node->getNodeValue();
-
- if ( $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 $list = $self->__LinearizeTree;
- foreach my $e( @$list ) {
- $e->{'DEPTH'} = $e->{'NODE'}->getDepth;
- $e->{'SELECTED'} = (grep $_ == $e->{'NODE'}, @$selected_nodes)? qq[ selected="selected"] : '';
- }
-
- return (join ' ', map $_->{'TEXT'}, @$list), $list;
-}
-
-=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(
- undef,
- sub {
- my $node = shift;
- return unless $node->isLeaf;
-
- # We're only looking for aggregators (AND/OR)
- return if ref $node->getNodeValue;
-
- return if $node->isRoot;
-
- # OK, this is a childless aggregator. Remove self.
- $node->getParent->removeChild($node);
- $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 {
- return map $_->{NODE}, @{ (shift)->__LinearizeTree };
-}
-
-
-sub __LinearizeTree {
- my $self = shift;
-
- my ($list, $i) = ([], 0);
-
- $self->TraversePrePost( sub {
- my $node = shift;
- return if $node->isRoot;
-
- my $str = '';
- if( $node->getIndex > 0 ) {
- $str .= " ". $node->getParent->getNodeValue ." ";
- }
-
- unless( $node->isLeaf ) {
- $str .= '( ';
- } else {
-
- my $clause = $node->getNodeValue;
- $str .= $clause->{Key};
- $str .= " ". $clause->{Op};
- $str .= " ". $clause->{Value};
-
- }
- $str =~ s/^\s+|\s+$//;
-
- push @$list, {
- NODE => $node,
- TEXT => $str,
- INDEX => $i,
- };
-
- $i++;
- }, sub {
- my $node = shift;
- return if $node->isRoot;
- return if $node->isLeaf;
- $list->[-1]->{'TEXT'} .= ' )';
- });
-
- return $list;
-}
-
-sub ParseSQL {
- my $self = shift;
- my %args = (
- Query => '',
- CurrentUser => '', #XXX: Hack
- @_
- );
- my $string = $args{'Query'};
-
- my @results;
-
- my %field = %{ RT::Tickets->new( $args{'CurrentUser'} )->FIELDS };
- my %lcfield = map { ( lc($_) => $_ ) } keys %field;
-
- my $node = $self;
-
- my %callback;
- $callback{'OpenParen'} = sub {
- $node = __PACKAGE__->new( 'AND', $node );
- };
- $callback{'CloseParen'} = sub { $node = $node->getParent };
- $callback{'EntryAggregator'} = sub { $node->setNodeValue( $_[0] ) };
- $callback{'Condition'} = sub {
- my ($key, $op, $value) = @_;
-
- my ($main_key) = split /[.]/, $key;
-
- my $class;
- if ( exists $lcfield{ lc $main_key } ) {
- $class = $field{ $main_key }->[0];
- $key =~ s/^[^.]+/ $lcfield{ lc $main_key } /e;
- }
- unless( $class ) {
- push @results, [ $args{'CurrentUser'}->loc("Unknown field: [_1]", $key), -1 ]
- }
-
- $value =~ s/'/\\'/g;
- if ( lc $op eq 'is' || lc $op eq 'is not' ) {
- $value = 'NULL'; # just fix possible mistakes here
- } elsif ( $value !~ /^[+-]?[0-9]+$/ ) {
- $value = "'$value'";
- }
- $key = "'$key'" if $key =~ /^CF./;
-
- my $clause = { Key => $key, Op => $op, Value => $value };
- $node->addChild( __PACKAGE__->new( $clause ) );
- };
- $callback{'Error'} = sub { push @results, @_ };
-
- require RT::SQL;
- RT::SQL::Parse($string, \%callback);
- return @results;
-}
-
-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/Request.pm b/rt/lib/RT/Interface/Web/Request.pm
deleted file mode 100644
index ba626a091..000000000
--- a/rt/lib/RT/Interface/Web/Request.pm
+++ /dev/null
@@ -1,207 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Web::Request;
-
-use strict;
-use warnings;
-
-our $VERSION = '0.30';
-use base qw(HTML::Mason::Request);
-
-sub new {
- my $class = shift;
-
- my $new_class = $HTML::Mason::ApacheHandler::VERSION ?
- 'HTML::Mason::Request::ApacheHandler' :
- $HTML::Mason::CGIHandler::VERSION ?
- 'HTML::Mason::Request::CGI' :
- 'HTML::Mason::Request';
-
- $class->alter_superclass( $new_class );
- $class->valid_params( %{ $new_class->valid_params } );
- return $class->SUPER::new(@_);
-}
-
-# XXX TODO: This alter_superclass replaces teh funcitonality in Mason 1.39
-# with code which doesn't trigger a bug in Perl 5.10.
-# (Perl 5.10.0 does NOT take kindly to having its @INC entries changed)
-# http://rt.perl.org/rt3/Public/Bug/Display.html?id=54566
-#
-# This routine can be removed when either:
-# * RT depends on a version of mason which contains this fix
-# * Perl 5.10.0 is not supported for running RT
-sub alter_superclass {
- my $class = shift;
- my $new_super = shift;
- my $isa_ref;
- { no strict 'refs'; my @entries = @{$class."::ISA"}; $isa_ref = \@entries; }
-
- # handles multiple inheritance properly and preserve
- # inheritance order
- for ( my $x = 0; $x <= $#{$isa_ref} ; $x++ ) {
- if ( $isa_ref->[$x]->isa('HTML::Mason::Request') ) {
- my $old_super = $isa_ref->[$x];
- $isa_ref->[$x] = $new_super
- if ( $old_super ne $new_super );
- last;
- }
- }
-
- { no strict 'refs'; @{$class."::ISA"} = @$isa_ref; }
- $class->valid_params( %{ $class->valid_params } );
-}
-
-
-=head2 callback
-
-Method replaces deprecated component C<Element/Callback>.
-
-Takes hash with optional C<CallbackPage>, C<CallbackName>
-and C<CallbackOnce> arguments, other arguments are passed
-throught to callback components.
-
-=over 4
-
-=item CallbackPage
-
-Page path relative to the root, leading slash is mandatory.
-By default is equal to path of the caller component.
-
-=item CallbackName
-
-Name of the callback. C<Default> is used unless specified.
-
-=item CallbackOnce
-
-By default is false, otherwise runs callbacks only once per
-process of the server. Such callbacks can be used to fill
-structures.
-
-=back
-
-Searches for callback components in
-F<< /Callbacks/<any dir>/CallbackPage/CallbackName >>, for
-example F</Callbacks/MyExtension/autohandler/Default> would
-be called as default callback for F</autohandler>.
-
-=cut
-
-{
-my %cache = ();
-my %called = ();
-sub callback {
- my ($self, %args) = @_;
-
- my $name = delete $args{'CallbackName'} || 'Default';
- my $page = delete $args{'CallbackPage'} || $self->callers(0)->path;
- unless ( $page ) {
- $RT::Logger->error("Couldn't get a page name for callbacks");
- return;
- }
-
- my $CacheKey = "$page--$name";
- return 1 if delete $args{'CallbackOnce'} && $called{ $CacheKey };
- $called{ $CacheKey } = 1;
-
- my $callbacks = $cache{ $CacheKey };
- unless ( $callbacks ) {
- $callbacks = [];
- my $path = "/Callbacks/*$page/$name";
- my @roots = map $_->[1],
- $HTML::Mason::VERSION <= 1.28
- ? $self->interp->resolver->comp_root_array
- : $self->interp->comp_root_array;
-
- my %seen;
- @$callbacks = (
- grep defined && length,
- # Skip backup files, files without a leading package name,
- # and files we've already seen
- grep !$seen{$_}++ && !m{/\.} && !m{~$} && m{^/Callbacks/[^/]+\Q$page/$name\E$},
- map { sort $self->interp->resolver->glob_path($path, $_) }
- @roots
- );
- foreach my $comp (keys %seen) {
- next unless $seen{$comp} > 1;
- $RT::Logger->error("Found more than one occurrence of the $comp callback. This may cause only one of the callbacks to run. Look for the duplicate Callback in your @roots");
- }
-
- $cache{ $CacheKey } = $callbacks unless RT->Config->Get('DevelMode');
- }
-
- my @rv;
- foreach my $cb ( @$callbacks ) {
- push @rv, scalar $self->comp( $cb, %args );
- }
- return @rv;
-}
-}
-
-=head2 request_path
-
-Returns path of the request.
-
-Very close to C<< $m->request_comp->path >>, but if called in a dhandler returns
-path of the request without dhandler name, but with dhandler arguments instead.
-
-=cut
-
-sub request_path {
- my $self = shift;
-
- my $path = $self->request_comp->path;
- # disabled dhandlers, not RT case, but anyway
- return $path unless my $dh_name = $self->dhandler_name;
- # not a dhandler
- return $path unless substr($path, -length("/$dh_name")) eq "/$dh_name";
- substr($path, -length $dh_name) = $self->dhandler_arg;
- return $path;
-}
-
-1;
diff --git a/rt/lib/RT/Interface/Web/Session.pm b/rt/lib/RT/Interface/Web/Session.pm
deleted file mode 100644
index 1e0e6d5f0..000000000
--- a/rt/lib/RT/Interface/Web/Session.pm
+++ /dev/null
@@ -1,285 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Interface::Web::Session;
-use warnings;
-use strict;
-
-use RT::CurrentUser;
-
-=head1 NAME
-
-RT::Interface::Web::Session - RT web session class
-
-=head1 SYNOPSYS
-
-
-=head1 DESCRIPTION
-
-RT session class and utilities.
-
-CLASS METHODS can be used without creating object instances,
-it's mainly utilities to clean unused session records.
-
-Object is tied hash and can be used to access session data.
-
-=head1 METHODS
-
-=head2 CLASS METHODS
-
-=head3 Class
-
-Returns name of the class that is used as sessions storage.
-
-=cut
-
-sub Class {
- my $self = shift;
-
- my $class = RT->Config->Get('WebSessionClass')
- || $self->Backends->{RT->Config->Get('DatabaseType')}
- || 'Apache::Session::File';
- eval "require $class";
- die $@ if $@;
- return $class;
-}
-
-=head3 Backends
-
-Returns hash reference with names of the databases as keys and
-sessions class names as values.
-
-=cut
-
-sub Backends {
- return {
- mysql => 'Apache::Session::MySQL',
- Pg => 'Apache::Session::Postgres',
- };
-}
-
-=head3 Attributes
-
-Returns hash reference with attributes that are used to create
-new session objects.
-
-=cut
-
-sub Attributes {
- my $class = $_[0]->Class;
- return !$class->isa('Apache::Session::File') ? {
- Handle => $RT::Handle->dbh,
- LockHandle => $RT::Handle->dbh,
- Transaction => 1,
- } : {
- Directory => $RT::MasonSessionDir,
- LockDirectory => $RT::MasonSessionDir,
- Transaction => 1,
- };
-}
-
-=head3 Ids
-
-Returns array ref with list of the session IDs.
-
-=cut
-
-sub Ids {
- my $self = shift || __PACKAGE__;
- my $attributes = $self->Attributes;
- if( $attributes->{Directory} ) {
- return $self->_IdsDir( $attributes->{Directory} );
- } else {
- return $self->_IdsDB( $RT::Handle->dbh );
- }
-}
-
-sub _IdsDir {
- my ($self, $dir) = @_;
- require File::Find;
- my %file;
- File::Find::find(
- sub { return unless /^[a-zA-Z0-9]+$/;
- $file{$_} = (stat($_))[9];
- },
- $dir,
- );
-
- return [ sort { $file{$a} <=> $file{$b} } keys %file ];
-}
-
-sub _IdsDB {
- my ($self, $dbh) = @_;
- my $ids = $dbh->selectcol_arrayref("SELECT id FROM sessions ORDER BY LastUpdated DESC");
- die "couldn't get ids: ". $dbh->errstr if $dbh->errstr;
- return $ids;
-}
-
-=head3 ClearOld
-
-Takes seconds and deletes all sessions that are older.
-
-=cut
-
-sub ClearOld {
- my $class = shift || __PACKAGE__;
- my $attributes = $class->Attributes;
- if( $attributes->{Directory} ) {
- return $class->_CleariOldDir( $attributes->{Directory}, @_ );
- } else {
- return $class->_ClearOldDB( $RT::Handle->dbh, @_ );
- }
-}
-
-sub _ClearOldDB {
- my ($self, $dbh, $older_than) = @_;
- my $rows;
- unless( int $older_than ) {
- $rows = $dbh->do("DELETE FROM sessions");
- die "couldn't delete sessions: ". $dbh->errstr unless defined $rows;
- } else {
- require POSIX;
- my $date = POSIX::strftime("%Y-%m-%d %H:%M", localtime( time - int $older_than ) );
-
- my $sth = $dbh->prepare("DELETE FROM sessions WHERE LastUpdated < ?");
- die "couldn't prepare query: ". $dbh->errstr unless $sth;
- $rows = $sth->execute( $date );
- die "couldn't execute query: ". $dbh->errstr unless defined $rows;
- }
-
- $RT::Logger->info("successfuly deleted $rows sessions");
- return;
-}
-
-sub _ClearOldDir {
- my ($self, $dir, $older_than) = @_;
-
- require File::Spec if int $older_than;
-
- my $now = time;
- my $class = $self->Class;
- my $attrs = $self->Attributes;
-
- foreach my $id( @{ $self->Ids } ) {
- if( int $older_than ) {
- my $ctime = (stat(File::Spec->catfile($dir,$id)))[9];
- if( $ctime > $now - $older_than ) {
- $RT::Logger->debug("skipped session '$id', isn't old");
- next;
- }
- }
-
- my %session;
- local $@;
- eval { tie %session, $class, $id, $attrs };
- if( $@ ) {
- $RT::Logger->debug("skipped session '$id', couldn't load: $@");
- next;
- }
- tied(%session)->delete;
- $RT::Logger->info("successfuly deleted session '$id'");
- }
- return;
-}
-
-=head3 ClearByUser
-
-Checks all sessions and if user has more then one session
-then leave only the latest one.
-
-=cut
-
-sub ClearByUser {
- my $self = shift || __PACKAGE__;
- my $class = $self->Class;
- my $attrs = $self->Attributes;
-
- my %seen = ();
- foreach my $id( @{ $self->Ids } ) {
- my %session;
- local $@;
- eval { tie %session, $class, $id, $attrs };
- if( $@ ) {
- $RT::Logger->debug("skipped session '$id', couldn't load: $@");
- next;
- }
- if( $session{'CurrentUser'} && $session{'CurrentUser'}->id ) {
- unless( $seen{ $session{'CurrentUser'}->id }++ ) {
- $RT::Logger->debug("skipped session '$id', first user's session");
- next;
- }
- }
- tied(%session)->delete;
- $RT::Logger->info("successfuly deleted session '$id'");
- }
-}
-
-sub TIEHASH {
- my $self = shift;
- my $id = shift;
-
- my $class = $self->Class;
- my $attrs = $self->Attributes;
-
- my %session;
-
- local $@;
- eval { tie %session, $class, $id, $attrs };
- eval { tie %session, $class, undef, $attrs } if $@;
- if ( $@ ) {
- die loc("RT couldn't store your session.") . "\n"
- . loc("This may mean that that the directory '[_1]' isn't writable or a database table is missing or corrupt.",
- $RT::MasonSessionDir)
- . "\n\n"
- . $@;
- }
-
- return tied %session;
-}
-
-1;
diff --git a/rt/lib/RT/Interface/Web/Standalone.pm b/rt/lib/RT/Interface/Web/Standalone.pm
deleted file mode 100755
index 12bd276e1..000000000
--- a/rt/lib/RT/Interface/Web/Standalone.pm
+++ /dev/null
@@ -1,117 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-use strict;
-use warnings;
-package RT::Interface::Web::Standalone;
-
-use base 'HTTP::Server::Simple::Mason';
-use RT::Interface::Web::Handler;
-use RT::Interface::Web;
-use URI;
-
-sub handler_class { "RT::Interface::Web::Handler" }
-
-sub setup_escapes {
- my $self = shift;
- my $handler = shift;
-
- # Override HTTP::Server::Simple::Mason's version of this method to do
- # nothing. (RT::Interface::Web::Handler does this already for us in
- # NewHandler.)
-}
-
-sub default_mason_config {
- return RT->Config->Get('MasonParameters');
-}
-
-sub handle_request {
-
- my $self = shift;
- my $cgi = shift;
-
- Module::Refresh->refresh if RT->Config->Get('DevelMode');
- RT::ConnectToDatabase() unless RT->InstallMode;
- $self->SUPER::handle_request($cgi);
- $RT::Logger->crit($@) if $@ && $RT::Logger;
- warn $@ if $@ && !$RT::Logger;
- RT::Interface::Web::Handler->CleanupRequest();
-}
-
-sub net_server {
- my $self = shift;
- $self->{rt_net_server} = shift if @_;
- return $self->{rt_net_server};
-}
-
-
-=head2 print_banner
-
-This routine prints a banner before the server request-handling loop
-starts.
-
-Methods below this point are probably not terribly useful to define
-yourself in subclasses.
-
-=cut
-
-sub print_banner {
- my $self = shift;
-
- my $url = URI->new( RT->Config->Get('WebBaseURL'));
- $url->host('127.0.0.1') if ($url->host() eq 'localhost');
- $url->port($self->port);
- print(
- "You can connect to your server at "
- . $url->canonical
- . "\n" );
-
-}
-
-
-1;
diff --git a/rt/lib/RT/Interface/Web/Standalone/PreFork.pm b/rt/lib/RT/Interface/Web/Standalone/PreFork.pm
deleted file mode 100644
index c00f8cd64..000000000
--- a/rt/lib/RT/Interface/Web/Standalone/PreFork.pm
+++ /dev/null
@@ -1,103 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-use warnings;
-use strict;
-
-package RT::Interface::Web::Standalone::PreFork;
-use base qw/Net::Server::PreFork/;
-
-my %option_map = (
- min_servers => 'StandaloneMinServers',
- max_servers => 'StandaloneMaxServers',
- min_spare_servers => 'StandaloneMinSpareServers',
- max_spare_servers => 'StandaloneMaxSpareServers',
- max_requests => 'StandaloneMaxRequests',
-);
-
-=head2 default_values
-
-Produces the default values for L<Net::Server> configuration from RT's config
-files.
-
-=cut
-
-sub default_values {
- my %forking = (
- map { $_ => RT->Config->Get( $option_map{$_} ) }
- grep { defined( RT->Config->Get( $option_map{$_} ) ) }
- keys %option_map,
- );
-
- return {
- %forking,
- log_level => 1,
- RT->Config->Get('NetServerOptions')
- };
-}
-
-=head2 post_bind_hook
-
-After binding to the specified ports, let the user know that the server is
-prepared to handle connections.
-
-=cut
-
-sub post_bind_hook {
- my $self = shift;
- my @ports = @{ $self->{server}->{port} };
-
- print $0
- . ": You can connect to your server at "
- . (join ' , ', map { "http://localhost:$_/" } @ports)
- . "\n";
-
- $self->SUPER::post_bind_hook(@_);
-}
-
-1;
diff --git a/rt/lib/RT/Interface/Web_Vendor.pm b/rt/lib/RT/Interface/Web_Vendor.pm
deleted file mode 100644
index 1999096a7..000000000
--- a/rt/lib/RT/Interface/Web_Vendor.pm
+++ /dev/null
@@ -1,201 +0,0 @@
-# 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-14 11:57:26 +0000