summaryrefslogtreecommitdiff
path: root/rt/bin
diff options
context:
space:
mode:
Diffstat (limited to 'rt/bin')
-rwxr-xr-xrt/bin/mason_handler.fcgi24
-rw-r--r--rt/bin/mason_handler.fcgi.in60
-rwxr-xr-xrt/bin/mason_handler.scgi8
-rw-r--r--rt/bin/mason_handler.scgi.in50
-rw-r--r--rt/bin/mason_handler.svc2
-rw-r--r--rt/bin/mason_handler.svc.in45
-rwxr-xr-xrt/bin/rt1391
-rw-r--r--rt/bin/rt-commit-handler.in846
-rw-r--r--rt/bin/rt-crontool12
-rw-r--r--rt/bin/rt-crontool.in90
-rwxr-xr-xrt/bin/rt-mailgate109
-rw-r--r--rt/bin/rt-mailgate.in443
-rw-r--r--rt/bin/rt.in1890
-rwxr-xr-xrt/bin/standalone_httpd.in66
-rwxr-xr-xrt/bin/webmux.pl125
-rw-r--r--rt/bin/webmux.pl.in156
16 files changed, 2427 insertions, 2890 deletions
diff --git a/rt/bin/mason_handler.fcgi b/rt/bin/mason_handler.fcgi
index 431eccbd3..93d1f8855 100755
--- a/rt/bin/mason_handler.fcgi
+++ b/rt/bin/mason_handler.fcgi
@@ -27,7 +27,7 @@ use strict;
use File::Basename;
require ('/opt/rt3/bin/webmux.pl');
-my $h = &RT::Interface::Web::NewCGIHandler();
+my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters);
# Enter CGI::Fast mode, which should also work as a vanilla CGI script.
require CGI::Fast;
@@ -44,11 +44,25 @@ while ( my $cgi = CGI::Fast->new ) {
$ENV{'ENV'} = '' if defined $ENV{'ENV'};
$ENV{'IFS'} = '' if defined $ENV{'IFS'};
- unless ($h->interp->comp_exists($cgi->path_info)) {
- $cgi->path_info($cgi->path_info . "/index.html");
+ RT::ConnectToDatabase();
+
+ if ( ( !$h->interp->comp_exists( $cgi->path_info ) )
+ && ( $h->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) {
+ $cgi->path_info( $cgi->path_info . "/index.html" );
+ }
+
+ eval { $h->handle_cgi_object($cgi); };
+ if ($@) {
+ $RT::Logger->crit($@);
+ }
+
+
+ if ($RT::Handle->TransactionDepth) {
+ $RT::Handle->ForceRollback;
+ $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") ;
}
- $h->handle_cgi_object($cgi);
- # _should_ always be tied
+
+
}
1;
diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in
index e932bfc29..193eaae57 100644
--- a/rt/bin/mason_handler.fcgi.in
+++ b/rt/bin/mason_handler.fcgi.in
@@ -1,9 +1,15 @@
#!@PERL@
-# BEGIN LICENSE BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
+# <jesse@bestpractical.com>
#
-# (Except where explictly superceded by other copyright notices)
+# (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
@@ -15,26 +21,41 @@
# 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.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# 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 LICENSE BLOCK
+# END BPS TAGGED BLOCK }}}
+package RT::Mason;
use strict;
+use vars '$Handler';
use File::Basename;
require ('@RT_BIN_PATH@/webmux.pl');
-my $h = &RT::Interface::Web::NewCGIHandler();
-
# Enter CGI::Fast mode, which should also work as a vanilla CGI script.
require CGI::Fast;
RT::Init();
-# Response loop
while ( my $cgi = CGI::Fast->new ) {
# the whole point of fastcgi requires the env to get reset here..
# So we must squash it again
@@ -44,11 +65,20 @@ while ( my $cgi = CGI::Fast->new ) {
$ENV{'ENV'} = '' if defined $ENV{'ENV'};
$ENV{'IFS'} = '' if defined $ENV{'IFS'};
- unless ($h->interp->comp_exists($cgi->path_info)) {
- $cgi->path_info($cgi->path_info . "/index.html");
+ Module::Refresh->refresh if $RT::DevelMode;
+ RT::ConnectToDatabase();
+
+ if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
+ && ( $Handler->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) {
+ $cgi->path_info( $cgi->path_info . "/index.html" );
}
- $h->handle_cgi_object($cgi);
- # _should_ always be tied
+
+ eval { $Handler->handle_cgi_object($cgi); };
+ if ($@) {
+ $RT::Logger->crit($@);
+ }
+ RT::Interface::Web::Handler->CleanupRequest();
+
}
1;
diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi
index 8e1135c2f..7774189ee 100755
--- a/rt/bin/mason_handler.scgi
+++ b/rt/bin/mason_handler.scgi
@@ -26,16 +26,18 @@
use strict;
require ('/opt/rt3/bin/webmux.pl');
-my $h = &RT::Interface::Web::NewCGIHandler();
+my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters);
require CGI;
RT::Init();
my $cgi = CGI->new;
-unless ($h->interp->comp_exists($cgi->path_info)) {
- $cgi->path_info($cgi->path_info . "/index.html");
+if ( ( !$h->interp->comp_exists( $cgi->path_info ) )
+ && ( $h->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) {
+ $cgi->path_info( $cgi->path_info . "/index.html" );
}
+
$h->handle_cgi_object($cgi);
1;
diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in
index 37d8380c2..2b38c9340 100644
--- a/rt/bin/mason_handler.scgi.in
+++ b/rt/bin/mason_handler.scgi.in
@@ -1,9 +1,15 @@
#!@SPEEDY_BIN@
-# BEGIN LICENSE BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
+# <jesse@bestpractical.com>
#
-# (Except where explictly superceded by other copyright notices)
+# (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
@@ -15,27 +21,45 @@
# 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.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
#
+# CONTRIBUTION SUBMISSION POLICY:
#
-# END LICENSE BLOCK
+# (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::Mason;
use strict;
+use vars '$Handler';
require ('@RT_BIN_PATH@/webmux.pl');
-my $h = &RT::Interface::Web::NewCGIHandler();
-
require CGI;
RT::Init();
my $cgi = CGI->new;
-unless ($h->interp->comp_exists($cgi->path_info)) {
- $cgi->path_info($cgi->path_info . "/index.html");
+if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
+ && ( $Handler->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) {
+ $cgi->path_info( $cgi->path_info . "/index.html" );
}
-$h->handle_cgi_object($cgi);
+$Handler->handle_cgi_object($cgi);
+RT::Interface::Web::Handler->CleanupRequest();
1;
diff --git a/rt/bin/mason_handler.svc b/rt/bin/mason_handler.svc
index e6d83784c..c05d21e69 100644
--- a/rt/bin/mason_handler.svc
+++ b/rt/bin/mason_handler.svc
@@ -197,7 +197,7 @@ BEGIN {
warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n";
require CGI::Fast;
-my $h = &RT::Interface::Web::NewCGIHandler();
+my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters);
RT::Init();
diff --git a/rt/bin/mason_handler.svc.in b/rt/bin/mason_handler.svc.in
index cc12c0ef0..7be566deb 100644
--- a/rt/bin/mason_handler.svc.in
+++ b/rt/bin/mason_handler.svc.in
@@ -1,9 +1,15 @@
#!@PERL@
-# BEGIN LICENSE BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
+# <jesse@bestpractical.com>
#
-# (Except where explictly superceded by other copyright notices)
+# (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
@@ -15,13 +21,29 @@
# 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.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
#
+# CONTRIBUTION SUBMISSION POLICY:
#
-# END LICENSE BLOCK
+# (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 }}}
=head1 NAME
@@ -55,8 +77,11 @@ registry setting will also be automatically populated.
=cut
+package RT::Mason;
+
use strict;
use File::Basename;
+use vars '$Handler';
require (dirname(__FILE__) . '/webmux.pl');
use Cwd;
@@ -197,7 +222,6 @@ BEGIN {
warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n";
require CGI::Fast;
-my $h = &RT::Interface::Web::NewCGIHandler();
RT::Init();
@@ -212,7 +236,8 @@ while( my $cgi = CGI::Fast->new ) {
warn "Serving $comp\n";
- $h->handle_cgi($comp);
+ $Handler->handle_cgi($comp);
+ RT::Interface::Web::Handler->CleanupRequest();
# _should_ always be tied
}
diff --git a/rt/bin/rt b/rt/bin/rt
deleted file mode 100755
index 41220bb56..000000000
--- a/rt/bin/rt
+++ /dev/null
@@ -1,1391 +0,0 @@
-#!!!PERL!! -w
-#
-# $Header: /home/cvs/cvsroot/freeside/rt/bin/Attic/rt,v 1.1 2002-08-12 06:17:07 ivan Exp $
-# RT is (c) 1996-2001 Jesse Vincent <jesse@bestpractical.com>
-
-use strict;
-use Carp;
-use Getopt::Long;
-
-use lib "!!RT_LIB_PATH!!";
-use lib "!!RT_ETC_PATH!!";
-
-use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect
- GetCurrentUser GetMessageContent);
-
-#Clean out all the nasties from the environment
-CleanEnv();
-
-#Load etc/config.pm and drop privs
-LoadConfig();
-
-#Connect to the database and get RT::SystemUser and RT::Nobody loaded
-DBConnect();
-
-#Drop setgid permissions
-RT::DropSetGIDPermissions();
-
-#Get the current user all loaded
-my $CurrentUser = GetCurrentUser();
-
-unless ($CurrentUser->Id) {
- print "No RT user found. Please consult your RT administrator.\n";
- exit(1);
-}
-
-
-# {{{ commandline flags
-
-my ( @id,
- @limit_queue,
- @limit_status,
- @limit_owner,
- @limit_priority,
- @limit_final_priority,
- @limit_requestor,
- @limit_subject,
- @limit_body,
- @limit_created,
- @limit_resolved,
- @limit_lastupdated,
- @limit_dependson,
- @limit_dependedonby,
- @limit_memberof,
- @limit_hasmember,
- @limit_refersto,
- @limit_referredtoby,
- @limit_keyword,
-
- @limit_due,
- @limit_starts,
- @limit_started,
- $limit_first,
- $limit_rows,
- $history,
- $summary,
- $create,
- @requestors,
- @cc,
- @admincc,
- $status,
- $subject,
- $owner,
- $steal,
- $queue,
- $time_left,
- $priority,
- $final_priority,
- $due,
- $starts,
- $started,
- $contacted,
- $comment,
- $reply,
- $source,
- $edit,
- @dependson,
- @memberof,
- @refersto,
- $mergeinto,
- @keywords,
- $time_taken,
- $verbose,
- $debug,
- $help,
- $version);
-
-# }}}
-
-# Set defaults for cli args
-
-$edit = 1; # Assume the user wants to edit replies and comments
- # unless they specify --noedit
-
-# {{{ args
-
-my @args =("id=s" => \@id,
- "limit-queue=s" => \@limit_queue,
- "limit-status=s" => \@limit_status,
- "limit-owner=s" => \@limit_owner,
- "limit-priority=s" => \@limit_priority,
- "limit-final-priority=s" => \@limit_final_priority,
- "limit-requestor=s" => \@limit_requestor,
- "limit-subject=s" => \@limit_subject,
- "limit-body=s", \@limit_body,
- "limit-created=s" => \@limit_created,
- "limit-due=s" => \@limit_due,
- "limit-last-updated=s" => \@limit_lastupdated,
- "limit-keyword=s" => \@limit_keyword,
-
- "limit-member-of=s" => \@limit_memberof,
- "limit-has-member=s" => \@limit_hasmember,
- "limit-depended-on-by=s" => \@limit_dependedonby,
- "limit-depends-on=s" => \@limit_dependson,
- "limit-referred-to-by=s" => \@limit_referredtoby,
- "limit-refers-to=s" => \@limit_refersto,
-
- "limit-starts=s" => \@limit_starts,
- "limit-started=s" => \@limit_started,
- "limit-first=i" => \$limit_first,
- "limit-rows=i" => \$limit_rows,
- "history|show" => \$history,
- "summary:s" => \$summary,
- "create" => \$create,
- "keywords=s" => \@keywords,
- "requestor|requestors=s" => \@requestors,
- "cc=s" => \@cc,
- "admincc=s" => \@admincc,
- "status=s" => \$status,
- "subject=s" => \$subject,
- "owner=s" => \$owner,
- "steal" => \$steal,
- "queue=s" => \$queue,
-
-
- "priority=i" => \$priority,
- "final-priority=i" => \$final_priority,
- "due=s" => \$due,
- "starts=s" => \$starts,
- "started=s" => \$started,
- "contacted=s" => \$contacted,
- "comment", \$comment,
- "reply|respond", \$reply,
- "source=s" => \$source,
- "edit!" => \$edit,
- "depends-on=s" => \@dependson,
- "member-of=s" => \@memberof,
- "merge-into=s" => \$mergeinto,
- "refers-to=s" => \@refersto,
- "time-left=i" => \$time_left,
- "time-taken=i" => \$time_taken,
- "verbose+" => \$verbose,
- "debug" => \$debug,
- "version" => \$version,
- "help|h|usage" => \$help
- );
-
-# }}}
-
-
-
-GetOptions(@args);
-
-print join(':',@keywords);
-# {{{ If they want it, print a usage message and get out
-
-if ($help) {
-
-
-print <<EOUSAGE;
-
-Limit the set of records returned:
-
---id=[first][-][last]
- Specify a single ticket, a range, or to start with (n-) or end with (-n)
-a specific ticket.
-
- --limit-queue=<queue>
- --limit-status=[!](new|open|stalled|resolved)
-
- --limit-owner=[!]<userid>
- --limit-priority=[starts][-][ends]
- --limit-final-priority=[starts][-][ends]
- starts is less than ends
- --limit-requestor=[!]<userid>|<email>
- --limit-subject=[!]<text>
- --limit-body=[!]<text>
- --limit-keyword=[!]<select>/<keyword>
-
- Links
- --limit-member-of=<ticketid>
- --limit-has-member=<ticketid>
- --limit-refers-to=<ticketid>
- --limit-referred-to-by=<ticketid>
- --limit-depends-on=<ticketid>
- --limit-depended-on-by=<ticketid>
-
-
- Dates
- --limit-created=[starts][-][ends]
- --limit-due=[starts][-][ends]
- --limit-starts=[starts][-][ends]
- --limit-started=[starts][-][ends]
- --limit-resolved=[starts][-][ends]
- --limit-last-updated=[starts][-][ends]
- starts and ends are dates. starts can not be less than ends
-
- --limit-first=<first row returned>
- --limit-rows=<row count>
-
- --history | --show
- show a history of the tickets found
-
-
- --summary [format-string]
- show a listing-style summary of the tickets found. If format string
- is ommitted, uses \$RT_SUMMARY_FORMAT or an internal default
-
-
- #TODO: doc summary
- format: <atom>%<format>
- atom: <name><size>
- size: <integer>
- name: (grep for # {{{ attribs for the array of ok values)
-
-
- --create
- create a new ticket. Any attributes that you can modify on an existing ticket
- can also be used for ticket creation.
-
-
-
-Attributes
- Basics
- --status=<new|open|stalled|resolved|dead>
- sets status
- --subject=<subject>
- sets subject
- --owner=<userid>
- set owner to
- --steal
- Become the owner, even if someone else owns the ticket
- --queue=<queueid>
- set queue to
-
- --priority=<int>
-
- --final-priority=<int>
-
- Watchers
- --requestors=[+|-]<userid|email address>
- add or remove this user as a ticket requestor
- --cc=[+|-]<userid|email address>
- add or remove this user as a ticket cc
- --admincc=[+|-]<userid|email address>
- add or remove this user as a ticket admincc
-
- (When creating tickets, just leave off the + or - )
-
- Keywords
- --keywords[+|-]<keyword_select>/<keyword>
- Add or remove a keyword.
-
-
-
- Dates
- --due=<date>
- --starts=<date>
- --started=<date>
- --contacted=<date>
-
- --time-left=<int>
-
- --time-taken=<int>
-
-
- Link related manipulation:
-
- --depends-on=[+|-]<ticketid>
- --member-of=[+|-]<ticketid>
- --refers-to=[+|-]<ticketid>
- --merge-into=<ticketid>
-
-Comments and replies
-
- --comment
- --reply|respond
- --source <path>
- Specify the path to the source file for this ticket update
-
- --noedit
- Don't invoke \$EDITOR to edit the content of this update
-
-
-
-
- Condiments
-
- --verbose
- --debug
- --version
- --help|h|usage
- You're reading it.
-
-EOUSAGE
-
- exit(0);
-}
-
-# Print version, and leave
-if ($version) {
- print "RT $RT::VERSION for $RT::rtname. Copyright 1996-2001 Jesse Vincent <jesse\@fsck.com>\n";
- exit(0);
-}
-
-# }}}
-
-# {{{ Validate any options that were passed in. normalize them.
-
-#if a queue was specified
-if ($queue) {
- # make sure that $queue is a valid queue and load it into $queue_obj
-}
-
-#For each date in: $due, $starts, $started
-
-# load up an RT::Date object and parse it into a normalized form
-# if it can't parse it, log an error and null out the variable
-
-# }}}
-
-# {{{ Check if we're creating, if so, create the ticket and be done
-
-if ($create) {
- $RT::Logger->debug("Creating a new ticket");
-
- #Make sure the current user can create tickets in this queue
-
- #Make sure that the owner specified can own tickets in this queue
-
-
-
- my $linesref = GetMessageContent( Edit => $edit, Source => $source,
- CurrentUser => $CurrentUser
- );
-
- require MIME::Entity;
- my $MIMEObj;
-
- if ($linesref) {
- $MIMEObj = MIME::Entity->build(Data => $linesref);
- }
-
- use RT::Ticket;
- my $Ticket=new RT::Ticket($CurrentUser);
- my ($ticket, $trans, $msg) =
- $Ticket->Create(Queue => $queue,
- Owner => $owner,
- Status => $status || 'new' ,
- Subject => $subject,
- Requestor => \@requestors,
- Cc => \@cc,
- AdminCc => \@admincc,
- Due => $due,
- Starts => $starts,
- Started => $started,
- TimeLeft => $time_left,
- InitialPriority => $priority,
- FinalPriority => $final_priority,
- MIMEObj => $MIMEObj
- );
- print $msg . "\n";
-}
-
-# }}}
-
-else {
- #Apply restrictions
- use RT::Tickets;
- my $Tickets = new RT::Tickets($CurrentUser);
-
- # {{{ Limit our search
- my $value; #to use when iterating through restrictions
- my $queue_id; #to use when limiting by keyword
-
- # {{{ limit on id
-
- foreach $value (@id) {
- if ($value =~ /^(\d+)$/) {
- $Tickets->LimitId ( VALUE => $1,
- OPERATOR => '=');
- }
- elsif ($value =~ /^(\d*)\D?(\d*)$/) {
- my $start = $1;
- my $end = $2;
- $Tickets->LimitId(
- VALUE => "$start",
- OPERATOR => '>=') if ($start);
- $Tickets->LimitId(
- VALUE => "$end",
- OPERATOR => '<=') if ($end);
- }
- }
-
-
- # }}}
-
- # {{{ limit on status
-
- foreach $value (@limit_status) {
- if ($value =~ /^(=|!=|!|)(.*)$/) {
- my $op = $1;
- my $val = $2;
-
-
- $op = ParseBooleanOp($op);
- $Tickets->LimitStatus(VALUE => "$val",
- OPERATOR => "$op");
- }
- }
-
- # }}}
-
-
-
- # {{{ limit on queue
- foreach $value (@limit_queue) {
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseBooleanOp($op);
-
- my $queue_obj = new RT::Queue($RT::SystemUser);
-
- unless ($queue_obj->Load($val)) {
- $RT::Logger->debug("Queue '$val' not found");
- print STDERR "Queue '$val' not found\n";
- exit(-1);
- }
- $RT::Logger->debug ("Limiting queue to $op ".$queue_obj->Name);
- $Tickets->LimitQueue(VALUE => $queue_obj->Name,
- OPERATOR => $op);
- $queue_id=$queue_obj->id;
- }
- }
-
- # {{{ limit on keyword
- foreach $value (@limit_keyword) {
- if ($value =~ /^(\W?)(.*?)\/(.*)$/i) {
- my $op = $1;
- my $select = $2;
- my $keyword = $3;
-
- $op = ParseBooleanOp($op);
-
- # load the keyword select
- my $keyselect = RT::KeywordSelect->new($RT::SystemUser);
- unless ($keyselect->LoadByName(Name=>$select, Queue=>$queue_id)) {
- $RT::Logger->debug("KeywordSelect '$select' not found");
- print STDERR "KeywordSelect '$select' not fount\n";
- exit(-1);
- }
-
- # load the keyword
- my $k = RT::Keyword->new($RT::SystemUser);
- unless ($k->LoadByNameAndParentId($keyword, $keyselect->Keyword)) {
- $RT::Logger->debug("Keyword '$keyword' not found");
- print STDERR "Keyword '$keyword' not found\n";
- exit(-1);
- }
- $Tickets->LimitKeyword(OPERATOR => $op,
- KEYWORDSELECT => $keyselect->id,
- KEYWORD => $k->id);
- $RT::Logger->debug ("Limiting keyword to $op ".$k->Path);
- }
- }
- # }}}
- # {{{ limit on owner
- foreach $value (@limit_owner) {
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseBooleanOp($op);
-
- my $user_obj = new RT::User($RT::SystemUser);
-
- unless ($user_obj->Load($val)) {
- $RT::Logger->debug("User '$val' not found");
- print STDERR "User '$val' not found\n";
- exit(-1);
- }
- $val = $user_obj->id();
-
- $RT::Logger->debug ("Limiting owner to $op $val");
- $Tickets->LimitOwner(VALUE => "$val",
- OPERATOR => "$op");
- }
- }
- # }}}
- # {{{ limt on priority
-
- foreach $value (@limit_priority) {
- my ($start, $end) = ParseRange($value);
- if ($start == $end) {
- $Tickets->LimitPriority( VALUE => $start,
- OPERATOR => '=');
- } elsif ($start) {
- $Tickets->LimitPriority( VALUE => $start,
- OPERATOR => '>=');
- } elsif ($end) {
- $Tickets->LimitPriority( VALUE => $end,
- OPERATOR => '<=');
- }
-
- }
- foreach $value (@limit_final_priority) {
- my ($start, $end) = ParseRange($value);
- if ($start == $end) {
- $Tickets->LimitFinalPriority( VALUE => $start,
- OPERATOR => '=');
- } elsif ($start) {
- $Tickets->LimitFinalPriority( VALUE => $start,
- OPERATOR => '>=');
- } elsif ($end) {
- $Tickets->LimitFinalPriority( VALUE => $end,
- OPERATOR => '<=');
- }
- }
- # }}}
-
- foreach $value (@limit_requestor) {
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseBooleanOp($op);
- $Tickets->LimitRequestor(VALUE => $val,
- OPERATOR => $op );
- }
-
- }
- foreach $value (@limit_subject) {
-
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseLikeOp($op);
-
- $Tickets->LimitSubject(VALUE => $val,
- OPERATOR => $op );
- }
- }
-
- foreach $value (@limit_body) {
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseLikeOp($op);
-
- $Tickets->LimitBody(VALUE => $val,
- OPERATOR => $op );
- }
-
- }
-
-
-
- # Dates
- foreach my $date (@limit_created) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitCreated ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitCreated ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_due) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitDue ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitDue ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_starts) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitStarts ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitStarts ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_started) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitStarted ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitStarted ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_resolved) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitResolved ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitResolved ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_lastupdated) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitLastUpdated( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitLastUpdated ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $link (@limit_memberof) {
- $Tickets->LimitMemberOf($link);
- }
-
- foreach my $link (@limit_hasmember) {
- $Tickets->LimitHasMember($link);
- }
-
- foreach my $link (@limit_dependson) {
- $Tickets->LimitDependsOn($link);
- }
-
- foreach my $link (@limit_dependedonby) {
- $Tickets->LimitDependedOnBy($link);
- }
- foreach my $link (@limit_refersto) {
- $Tickets->LimitRefersTo($link);
- }
-
- foreach my $link (@limit_referredtoby) {
- $Tickets->LimitReferredToBy($link);
- }
-
-
- if ($limit_first){
- }
- if ($limit_rows){
- }
-
-# }}}
-
- # {{{ Iterate through all tickets we found
-
-
- my ($format, $titles, $code);
-
- #Set up the summary format if we need to
- if (defined $summary) {
- my $format_string = $summary || $ENV{'RT_SUMMARY_FORMAT'} || "%id4%status4%queue7%subject40%requestor16";
-
- ($format, $titles, $code) = BuildListingFormat($format_string);
- printf "$format\n", eval "$titles";
- }
-
-
-
- while (my $Ticket = $Tickets->Next()) {
- $RT::Logger->debug ("Now working on ticket ". $Ticket->id);
-
- #Run through all the ticket modifications we might want to do
- #TODO: these are all insufficiently lazy and should be replaced with some
- # nice foreaches.
-
-
- # {{{ deal with watchers
-
- # add / delete requestors
- foreach $value (@requestors) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $addr = $2;
-
- $Ticket->AddRequestor(Email => $addr) if ($op eq '+');
- $Ticket->DeleteRequestor( $addr) if ($op eq '-');
- }
- }
-
- # add / delete ccs
- foreach $value (@cc) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $addr = $2;
- $Ticket->AddCc(Email => $addr) if ($op eq '+');
- $Ticket->DeleteCc($addr) if ($op eq '-');
- }
- }
-
- # add / delete adminccs
- $RT::Logger->debug("Looking at admin ccs");
- foreach $value (@admincc) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $addr = $2;
- $Ticket->AddAdminCc(Email => $addr) if ($op eq '+');
- $Ticket->DeleteAdminCc($addr) if ($op eq '-');
- }
- }
-
- # }}}
-
- # {{{ Deal with ticket keywords
-
- my $KeywordSelects = $Ticket->QueueObj->KeywordSelects();
- $RT::Logger->debug ("Looking at keywords");
- foreach $value (@keywords) {
- $RT::Logger->debug("Looking at --keyword=$value");
- if ($value =~ /^(\W?)(.*?)\/(.*)$/) {
- my $op = $1;
- my $select = $2;
- my $keyword = $3;
-
- $RT::Logger->debug("Going to $op Keyword $select / $keyword");
- while (my $ks = $KeywordSelects->Next) {
- $RT::Logger->debug("$select is select ".$ks->Name." is found");
- next unless ($ks->Name =~ /$select/i);
- $RT::Logger->debug ("Found a match for $select\n");
- my $kids = $ks->KeywordObj->Descendents;
-
- my ($kid);
- foreach $kid (keys %{$kids}) {
- $RT::Logger->debug("Now comparing $keyword with ".$kids->{$kid}. "\n");
- next unless ($kids->{$kid} =~ /^$keyword$/i);
- $RT::Logger->debug("Going to $op $select / $keyword (".$kids->{$kid} .")");
- $Ticket->DeleteKeyword(KeywordSelect => $ks->id,
- Keyword => $kid) if ($op eq '-');
-
- $Ticket->AddKeyword(KeywordSelect => $ks->id,
- Keyword => $kid) if ($op eq '+');
- }
-
- }
- }
- }
- # }}}
-
- # {{{ deal with links
-
- # Deal with merging {
- if ($mergeinto) {
- my ($trans, $msg) =$Ticket->MergeInto($mergeinto);
- print $msg."\n";
- }
- # add /delete depends-ons
-
- foreach my $value (@dependson) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $ticket = $2;
- if (!$op or ($op eq '+')) {
- my ($trans, $msg) =
- $Ticket->AddLink(Type => 'DependsOn', Target => $ticket);
- print $msg."\n";
- }
- elsif ($op eq '-') {
- my ($trans, $msg) =
- $Ticket->DeleteLink(Type => 'DependsOn', Target => $ticket);
- print $msg."\n";
- }
-
- }
- }
- # add /delete member-of
- foreach my $value (@memberof) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $ticket = $2;
- if ($op eq '+') {
- my ($trans, $msg) =
- $Ticket->AddLink(Type => 'MemberOf', Target => $ticket);
- print $msg;
- }
- elsif ($op eq '-') {
- my ($trans, $msg) =
- $Ticket->DeleteLink(Type => 'MemberOf', Target => $ticket);
- print $msg;
- }
-
- }
- }
- # add / delete refers-to
- foreach my $value (@refersto) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $ticket = $2;
- if ($op eq '+') {
- my ($trans, $msg) =
- $Ticket->AddLink(Type => 'RefersTo', Target => $ticket);
- print $msg;
- }
- elsif ($op eq '-') {
- my ($trans, $msg) =
- $Ticket->DeleteLink(Type => 'RefersTo', Target => $ticket);
- print $msg;
- }
-
- }
- }
-
- # }}}
-
- # {{{ deal with dates
-
- #set due
- if ($due) {
- my $iso = ParseDateToISO($due);
- if ($iso) {
- $RT::Logger->debug("Setting due date to $iso ($due)");
- my ($trans, $msg) =
- $Ticket->SetDue($iso);
- print $msg;
- }
- else {
- print "Due date '$due' could not be parsed";
- }
- }
-
- #set starts
- if ($starts) {
- my $iso = ParseDateToISO($due);
- if ($iso) {
- my ($trans, $msg) =
- $Ticket->SetStarts($iso);
- print $msg."\n";
- }
- else {
- print "Starts date '$starts' could not be parsed";
- }
- }
- #set started
- if ($started) {
- my $iso = ParseDateToISO($started);
- if ($iso) {
- my ($trans, $msg) =
- $Ticket->SetStarted($iso);
- print $msg."\n";
- }
- else {
- print "Started date '$started' could not be parsed";
- }
- }
- #set contacted
- if ($contacted) {
- my $iso = ParseDateToISO($contacted);
- if ($iso) {
- my ($trans, $msg) =
- $Ticket->SetContacted($iso);
- print $msg."\n";
- }
- else {
- print "Contacted date '$contacted' could not be parsed";
- }
- }
-
- # }}}
-
- # {{{ set other attributes
-
- #Set subject
- if ($subject) {
- my ($trans, $msg) = $Ticket->SetSubject($subject);
- print $msg."\n";
- }
-
- #Set priority
- if ($priority) {
- my ($trans, $msg) =
- $Ticket->SetPriority($priority);
- print $msg."\n";
- }
-
- #Set final priority
- if ($final_priority) {
- my ($trans, $msg) =
- $Ticket->SetFinalPriority($final_priority);
- print $msg."\n";
- }
-
- #Set status
- if ($status) {
- my ($trans, $msg) =
- $Ticket->SetStatus($status);
- print $msg."\n";
- }
-
- #Set time left
- if ($time_left) {
- my ($trans, $msg) =
- $Ticket->SetTimeLeft($time_left);
- print $msg."\n";
- }
-
- #Set time_taken
- if ($time_taken) {
- my ($trans, $msg) =
- $Ticket->SetTimeTaken($time_taken);
- print $msg."\n";
- }
-
- #Set owner
- if ($owner) {
- my ($trans, $msg) =
- $Ticket->SetOwner($owner);
- print $msg."\n";
- }
-
- # Steal
- if ($steal) {
- my ($trans, $msg) =
- $Ticket->Steal();
- print $msg . "\n";
- }
- #Set queue
- if ($queue) {
- my ($trans, $msg) =
- $Ticket->SetQueue($queue);
- print $msg."\n";
- }
-
- # }}}
-
-
-
- # {{{ Perform ticket comments/replies
- if ($reply) {
- $RT::Logger->debug("Replying to ticket ".$Ticket->Id);
-
- my $linesref = GetMessageContent( Edit => $edit, Source => $source,
- CurrentUser => $CurrentUser
- );
-
- #TODO build this entity
- require MIME::Entity;
- my $MIMEObj = MIME::Entity->build(Data => $linesref);
-
- $Ticket->Correspond( MIMEObj => $MIMEObj ,
- TimeTaken => $time_taken);
- }
-
- elsif ($comment) {
- $RT::Logger->debug("Commenting on ticket ".$Ticket->Id);
-
- my $linesref =GetMessageContent(Edit => $edit, Source => $source,
- CurrentUser => $CurrentUser);
- #TODO build this entity
- require MIME::Entity;
- my $MIMEObj = MIME::Entity->build(Data => $linesref);
-
- $Ticket->Comment( MIMEObj => $MIMEObj,
- TimeTaken => $time_taken);
- }
-
- # }}}
-
- # {{{ Display whatever we need to display
-
- # {{{ Display a full ticket listing and history
- if ($history) {
- #Display the history
- $RT::Logger->debug("Show history for ".$Ticket->id);
-
- if ($Ticket->CurrentUserHasRight("ShowTicket")) {
- &ShowSummary($Ticket);
- print "\n";
- &ShowHistory($Ticket);
- }
- else {
- print "You don't have permission to view that ticket.\n";
- }
- }
-
- # }}}
-
- # {{{ Display a summary if we need to
- if (defined $summary) {
- $RT::Logger->debug ("Show ticket summary with format $format");
-
- printf $format."\n", eval $code;
-
- }
- # }}}
-
- # }}}
-
- }
-
- # }}}
-
-}
-
-
-$RT::Handle->Disconnect();
-
-
-
-
-
-
-
-# {{{ sub ParseBooleanOp
-
-=head2 ParseBooleanOp
-
- Takes an option modifier. returns the apropriate SQL operator.
- If it's handed ! or -, returns !=. Otherwise returns =.
-
-=cut
-
-sub ParseBooleanOp {
-
- my $op = shift;
-
- #so that !new limits to not new, etc
- if ($op =~ /^(\!|-)/) {
- $op = "!=";
- }
- else {
- $op = "=";
- }
-
- return($op);
-}
-
-# }}}
-
-# {{{ sub ParseLikeOp
-=head2 ParseLikeOp
-
- Takes an option modifier. returns the apropriate SQL operator.
- If it's handed ! or -, returns NOT LIKE. Otherwise returns LIKE
-
-=cut
-
-sub ParseLikeOp {
-
- my $op = shift;
-
- #so that !new limits to not new, etc
- if ($op =~ /^(\!|-)/) {
- $op = "NOT LIKE";
- }
- else {
- $op = "LIKE";
- }
-
- return($op);
-}
-# }}}
-
-# {{{ 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 = new RT::Date($CurrentUser);
- $date_obj->Set( Format => 'unknown',
- Value => $date
- );
- return ($date_obj->ISO);
-}
-
-# }}}
-
-# {{{ sub ParseDateRange
-
-=head2 ParseDateRange [RANGE]
-
-Takes a range of dates of the form [<date>][-][<date>] and returns
-starting and ending dates (as ISOs) If a date is specified as neither a starting nor ending
-date, we parse it it as "midnight tonight to midnight tomorrow"
-
-=cut
-
-sub ParseDateRange {
- my $in = shift;
- my ($start, $end);
-
-
- use RT::Date;
- my $start_obj = new RT::Date($CurrentUser);
- my $end_obj = new RT::Date($CurrentUser);
-
- if ($in =~ /^(.*?)-(.*?)$/) {
- $start = $1;
- $end = $2;
-
- if ($start) {
- $start_obj->Set(Format => 'unknown',
- Value => $start);
- }
- if ($end) {
- $end_obj->Set(Format => 'unknown',
- Value => $end);
- }
- }
- else {
- $start = $in;
- $end = $in;
-
- $start_obj->Set(Format => 'unknown',
- Value => $start);
-
- $end_obj->Set(Format => 'unknown',
- Value => $end);
-
- $start_obj->SetToMidnight();
- $end_obj->SetToMidnight();
- $end_obj->AddDay();
- }
-
- if ($start) {
- $start = $start_obj->ISO;
- }
- if ($end) {
- $end = $end_obj->ISO;
- }
-
- return ($start, $end);
-}
-
-# }}}
-
-# {{{ ParseRange
-=head2 ParseRange [RANGE]
-
-Takes a range of the form [<int>][-][<int>] and returns
-a first and a last value. If the - is omitted, both $start and $end are the same.
-=cut
-
-sub ParseRange {
- my $in = shift;
- my ($start, $end);
-
- if ($in =~ /(.*?)-(.*?)/) {
- $start = $1;
- $end = $2;
- }
- else {
- $start = $in;
- $end = $in;
- }
-
- return ($start, $end);
-
-
-
-}
-
-# }}}
-
-# {{{ sub ShowSummary
-
-sub ShowSummary {
- my $Ticket = shift;
-
-
- print <<EOFORM;
-Serial Number: @{[$Ticket->Id]} Status:@{[$Ticket->Status]} Worked: @{[$Ticket->TimeWorked]} minutes Queue:@{[$Ticket->QueueObj->Name]}
- Subject: @{[$Ticket->Subject]}
- Requestors: @{[$Ticket->RequestorsAsString]}
- Cc: @{[$Ticket->CcAsString]}
- Admin Cc: @{[$Ticket->AdminCcAsString]}
- Owner: @{[$Ticket->OwnerObj->Name]}
- Priority: @{[$Ticket->Priority]} / @{[$Ticket->FinalPriority]}
- Due: @{[$Ticket->DueAsString]}
- Created: @{[$Ticket->CreatedAsString]} (@{[$Ticket->AgeAsString]})
- Last Contact: @{[$Ticket->ToldAsString]} (@{[$Ticket->LongSinceToldAsString]})
- Last Update: @{[$Ticket->LastUpdatedAsString]} by @{[$Ticket->LastUpdatedByObj->Name]}
-
-EOFORM
-
-my $selects = $Ticket->QueueObj->KeywordSelects();
- #get the keyword selects
- print "Keywords:\n";
- while (my $select = $selects->Next) {
- print "\t" .$select->Name .": ";
- my $keys = $Ticket->KeywordsObj($select->id);
- while (my $key = $keys->Next) {
- print $key->KeywordObj->RelativePath($select->KeywordObj) . " ";
-
- }
- print "\n";
- }
-
-#iterate through the keyword selects.
-#print the keyword select and all the related keywords
-
-
-
-#TODO: finish link descriptions
-print "Dependencies: \n";
- while (my $l=$Ticket->DependedOnBy->Next) {
- print $l->BaseObj->id," (",$l->BaseObj->Subject,") ",$l->Type," this ticket\n";
- }
- while (my $l=$Ticket->DependsOn->Next) {
- print "This ticket ",$l->Type," ",$l->TargetObj->Id," (",$l->TargetObj->Subject,")\n";
- }
-}
-
-# }}}
-
-# {{{ sub ShowHistory
-sub ShowHistory {
- my $Ticket = shift;
- my $Transaction;
- my $Transactions = $Ticket->Transactions;
-
- while ($Transaction = $Transactions->Next) {
- &ShowTransaction($Transaction);
- }
- }
-# }}}
-
-# {{{ sub ShowTransaction
-sub ShowTransaction {
- my $transaction = shift;
-
-print <<EOFORM;
-==========================================================================
-Date: @{[$transaction->CreatedAsString]} (@{[$transaction->TimeTaken]} minutes)
-@{[$transaction->Description]}
-EOFORM
- ;
- my $attachments=$transaction->Attachments();
- while (my $message=$attachments->Next) {
- print <<EOFORM;
---------------------------------------------------------------------------
-@{[$message->Headers]}
-EOFORM
-
- if ($message->ContentType =~ m{^(text/plain|message|text$)}) {
- print $message->Content;
- } else {
- print $message->ContentType, " not shown";
- }
- }
- print "\n";
- return();
-}
-# }}}
-
-
-# {{{ sub BuildListingFormat
-
-sub BuildListingFormat {
- my $format_string = shift;
-
- my ($id, @format, @code, @titles);
- my ($field,$titles,$length, $format);
-
- my $code = "";
-
- # {{{ attribs
- my $attribs = { id => { chars => '4',
- justify => 'r',
- title => 'id',
- value => '$Ticket->id',
- },
-
- queue => { chars => '8',
- justify => 'l',
- title => 'Queue',
- value => '$Ticket->QueueObj->Name'
- },
- subject => { chars => '30',
- justify => 'l',
- title => 'Subject',
- value => '$Ticket->Subject',
- },
- priority => { chars => '2',
- justify => 'r',
- title => 'Pri',
- value => '$Ticket->Priority',
- },
- final_priority => { chars => '2',
- justify => 'r',
- title => 'Fin',
- value => '$Ticket->FinalPriority',
- },
- time_worked => { chars => '6',
- justify => 'r',
- title => 'Worked',
- value => '$Ticket->TimeWorked',
- },
- time_left => { chars => '5',
- justify => 'r',
- title => 'Left',
- value => '$Ticket->TimeLeft',
-
- },
-
- status => { chars => '6',
- justify => 'r',
- title => 'Status',
- value => '$Ticket->Status',
- },
- owner => { chars => '10',
- justify => 'r',
- title => 'Owner',
- value => '$Ticket->OwnerObj->Name'
- },
- requestor => { chars => '10',
- justify => 'r',
- title => 'Requestor',
- value => '$Ticket->RequestorsAsString'
- },
- created => { chars => '12',
- justify => 'r',
- title => 'Created',
- value => '$Ticket->CreatedAsString'
- },
- updated => { chars => '12',
- justify => 'r',
- title => 'Updated',
- value => '$Ticket->LastUpdatedAsString'
- },
- due => { chars => '12',
- justify => 'r',
- title => 'Due',
- value => '$Ticket->DueAsString'
- },
- told => { chars => '12',
- justify => 'r',
- title => 'Told',
- value => '$Ticket->ToldAsString'
- },
-
-
-
- };
-
- # }}}
-
-
- foreach $field (split ('%',$format_string)) {
-
- if ($field =~ /^(\D*?)(\d*?)$/) {
- $id = $1;
- $length = $2;
- }
- else {
- $RT::Logger->debug ("Error parsing $field\n");
- }
- if ($length) {
- push (@format, "%".$length.".".$length."s ");
-
- push (@code, $attribs->{"$id"}->{'value'});
-
- push (@titles, "'". $attribs->{"$id"}->{title}. "'");
- }
-
-
- }
- $code = join (',', @code);
- $format = join (" ", @format);
- $titles = join (', ', @titles);
-
-
- return ($format, $titles, $code);
-}
-
-# }}}
-
-
-
-1;
diff --git a/rt/bin/rt-commit-handler.in b/rt/bin/rt-commit-handler.in
deleted file mode 100644
index 02b01abff..000000000
--- a/rt/bin/rt-commit-handler.in
+++ /dev/null
@@ -1,846 +0,0 @@
-#!@PERL@ -w
-# 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
-
-# {{{ Docs
-# -*-Perl-*-
-#
-#ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler.in,v 1.1 2003-07-15 13:16:15 ivan Exp $"
-#
-# Perl filter to handle the log messages from the checkin of files in multiple
-# directories. This script will group the lists of files by log message, and
-# send one piece of mail per unique message, no matter how many files are
-# committed.
-
-=head1 NAME rt-commit-handler
-
-=head1 USAGE
-
-
-
-=head2 Regular use
-
-Stick the following in in CVSROOT/commitinfo
-
- ALL @RT_BIN_PATH@/rt-commit-handler --record-last-dir
-
-Stick the following in CVSROOT/loginfo
-
- ALL @RT_BIN_PATH@/rt-commit-handler --cvs-root /pathtocvs/root --rt %{Vvts}
-
-=head2 Invocation (advanced use)
-
-rt-commit-handler --cvs-root /path/to/cvs/root [-d] [-D] [-r] [-M module] \
- [[-m mailto] ...] [[-R replyto] ...] [-f logfile]
-
-
- -d - turn on debugging
- -m mailto - send mail to "mailto" (multiple)
- -R replyto - set the "Reply-To:" to "replyto" (multiple)
- -M modulename - set module name to "modulename"
- -f logfile - write commit messages to logfile too
- -D - generate diff commands
- --rt - invoke RT commit handler
- --cvs-root - specify your CVS root
-
- --record-last-dir - Record the last directory with changes in
- pre-commit (commitinfo) mode
-
-
-=cut
-
-# }}}
-
-use strict;
-use Carp;
-use Getopt::Long;
-use Text::Wrap;
-use Digest::MD5;
-use MIME::Entity;
-
-use lib ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
-
-use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc);
-
-use vars
- qw(@MAILER $TMPDIR $FILE_PREFIX $LASTDIR_FILE $HASH_FILE $VERSION_FILE $MESSAGE_FILE $MAIL_FILE $DEBUG $MAILTO $REPLYTO $id $MODULE_NAME
- $LOGIN $COMMITLOG $CVS_ROOT $RT_HANDLER);
-
-#Clean out all the nasties from the environment
-CleanEnv();
-
-#Load etc/config.pm and drop privs
-RT::LoadConfig();
-
-#Drop setgid permissions
-RT::DropSetGIDPermissions();
-
-# {{{ Variable setup
-$TMPDIR = '/tmp';
-$FILE_PREFIX = $TMPDIR . '/#cvs.';
-
-# The root of your CVS install. we should get this from some smarter place.
-# It needs a trailing /
-
-$LASTDIR_FILE = $FILE_PREFIX . "lastdir";
-$HASH_FILE = $FILE_PREFIX . "hash";
-$VERSION_FILE = $FILE_PREFIX . "version";
-$MESSAGE_FILE = $FILE_PREFIX . "message";
-$MAIL_FILE = $FILE_PREFIX . "mail";
-
-$DEBUG = 0;
-$RT_HANDLER = 1;
-
-$MAILTO = '';
-
-my @files = ();
-my (@log_lines);
-my $do_diff = 0;
-my $id = getpgrp(); # note, you *must* use a shell which does setpgrp()
-$LOGIN = getpwuid($<);
-
-# }}}
-
-die "User could not be found" unless ($LOGIN);
-
-# {{{ parse command line arguments (file list is seen as one arg)
-#
-while ( my $arg = shift @ARGV ) {
-
- if ( $arg eq '-d' ) {
- $DEBUG = 1;
- warn "Debug turned on...\n";
- }
- elsif ( $arg =~ /^--record-last-dir$/i ) {
- record_last_dir( $id, $ARGV[0] );
- exit(0);
- }
- elsif ( $arg eq '-m' ) {
- $MAILTO .= ", " if $MAILTO;
- $MAILTO .= shift @ARGV;
- }
- elsif ( $arg eq '--rt' ) {
- $RT_HANDLER = 1;
- }
- elsif ( $arg eq '-R' ) {
- $REPLYTO .= ", " if $REPLYTO;
- $REPLYTO .= shift @ARGV;
- }
- elsif ( $arg eq '-M' ) {
- die ("too many '-M' args\n") if $MODULE_NAME;
- $MODULE_NAME = shift @ARGV;
- }
- elsif ( $arg eq '--cvs-root' ) {
- $CVS_ROOT = shift @ARGV;
- $CVS_ROOT .= "/" unless ( $CVS_ROOT =~ /\/$/ );
- }
- elsif ( $arg eq '-f' ) {
- die ("too many '-f' args\n") if $COMMITLOG;
- $COMMITLOG = shift @ARGV;
-
- # This is a disgusting hack to untaint $COMMITLOG if we're running from
- # setgid cvs.
- $COMMITLOG = untaint($COMMITLOG);
- }
- elsif ( $arg eq '-D' ) {
- $do_diff = 1;
- }
- else {
- @files = split ( ' ', $arg );
- last;
- }
-}
-
-# }}}
-
-$REPLYTO = $LOGIN unless ($REPLYTO);
-
-# for now, the first "file" is the repository directory being committed,
-# relative to the $CVSROOT location
-#
-my $dir = shift @files;
-
-# XXX there are some ugly assumptions in here about module names and
-# XXX directories relative to the $CVSROOT location -- really should
-# XXX read $CVSROOT/CVSROOT/modules, but that's not so easy to do, since
-# XXX we have to parse it backwards.
-#
-# XXX For now we set the `module' name to the top-level directory name.
-#
-unless ($MODULE_NAME) {
- ($MODULE_NAME) = split ( '/', $dir, 2 );
-}
-
-if ($DEBUG) {
- warn "module - ", $MODULE_NAME, "\n";
- warn "dir - ", $dir, "\n";
- warn "files - ", join ( " ", @files ), "\n";
- warn "id - ", $id, "\n";
-}
-
-# {{{ Check for a new directory or an import command.
-
-#
-# files[0] - "-"
-# files[1] - "New"
-# files[2] - "directory"
-#
-# files[0] - "-"
-# files[1] - "Imported"
-# files[2] - "sources"
-#
-if ( $files[0] eq "-" ) {
-
- #we just don't care about New Directory notes
- unless ( $files[1] eq "New" && $files[2] eq "directory" ) {
-
- my @text = ();
-
- push @text, build_header();
- push @text, "";
-
- while ( my $line = <STDIN> ) {
- chop $line; # Drop the newline
- push @text, $line;
- }
-
- append_logfile( $COMMITLOG, @text ) if ($COMMITLOG);
-
- mail_notification( $id, @text );
- }
-
- exit 0;
-}
-
-# }}}
-
-# {{{ Collect just the log message from stdin.
-#
-
-while ( my $line = <STDIN> ) {
- chop $line; # strip the newline
- last if ( $line =~ /^Log Message:$/ );
-}
-while ( my $line = <STDIN> ) {
- chop $line; # strip the newline
- $line =~ s/\s+$//; # strip trailing white space
- push @log_lines, $line;
-}
-
-my $md5 = Digest::MD5->new();
-foreach my $line (@log_lines) {
- $md5->add( $line . "\n" );
-}
-my $hash = $md5->hexdigest();
-
-warn "hash = $hash\n" if ($DEBUG);
-
-if ( !-e "$MESSAGE_FILE.$id.$hash" ) {
- append_logfile( "$HASH_FILE.$id", $hash );
- write_file( "$MESSAGE_FILE.$id.$hash", @log_lines );
-}
-
-# }}}
-
-# Spit out the information gathered in this pass.
-
-append_logfile( "$VERSION_FILE.$id.$hash", $dir . '/', @files );
-
-# {{{ Check whether this is the last directory. If not, quit.
-
-warn "Checking current dir against last dir $LASTDIR_FILE.$id\n" if ($DEBUG);
-
-my @last_dir = read_file("$LASTDIR_FILE.$id");
-
-unless ($CVS_ROOT) {
- die "No cvs root specified with --cvs-root. Can't continue.";
-}
-
-if ( $last_dir[0] ne $CVS_ROOT . $dir ) {
- warn "Current directory $CVS_ROOT$dir is not last directory $last_dir[0].\n"
- if ($DEBUG);
- exit 0;
-}
-
-# }}}
-
-# {{{ End Of Commits!
-#
-
-# This is it. The commits are all finished. Lump everything together
-# into a single message, fire a copy off to the mailing list, and drop
-# it on the end of the Changes file.
-#
-
-#
-# Produce the final compilation of the log messages
-#
-
-my @hashes = read_file("$HASH_FILE.$id");
-my (@text);
-
-push @text, build_header();
-push @text, "";
-
-my ( @added_files, @modified_files, @removed_files );
-
-foreach my $hash (@hashes) {
-
- # In case we're running setgid, make sure the hash file hasn't been hacked.
- $hash =~ m/([a-z0-9]*)/ || die "*** Hacking attempt detected\n";
- $hash = $1;
-
- my @files = read_file("$VERSION_FILE.$id.$hash");
- my @log_lines = read_file("$MESSAGE_FILE.$id.$hash");
-
- my $working_on_dir; # gets set as we iterate through the files.
- foreach my $file (@files) {
-
- #If we've entered a new directory, make a note of that and remove the trailing /
-
- if ( $file =~ s'\/$'' ) {
- $working_on_dir = $file;
- next;
- }
-
- my @file_entry = ( split ( ',', $file, 4 ), $working_on_dir );
-
- # file_entry looks like ths:
-
- # 0 1 2 3 4
- # Old rev : new rev : tag: file :directory
- my $entry = {};
- $entry->{'old'} = $file_entry[0];
- $entry->{'new'} = $file_entry[1];
- $entry->{'tag'} = $file_entry[2];
- $entry->{'file'} = $file_entry[3];
- $entry->{'dir'} = $file_entry[4];
-
- if ( $file_entry[0] eq 'NONE' ) {
- $entry->{'old'} = '0';
- push @added_files, $entry;
- }
- elsif ( $file_entry[1] eq 'NONE' ) {
- $entry->{'new'} = '0';
- push @removed_files, $entry;
- }
- else {
- push @modified_files, $entry;
- }
- }
-}
-
-# }}}
-
-# {{{ start building up the body
-
-# Strip leading and trailing blank lines from the log message. Also
-# compress multiple blank lines in the body of the message down to a
-# single blank line.
-#
-
-my $blank = 1;
-@log_lines = map {
- my $wasblank = $blank;
- $blank = $_ eq '';
- $blank && $wasblank ? () : $_;
-} @log_lines;
-
-pop @log_lines if $blank;
-
-@modified_files = order_and_summarize_diffs(@modified_files);
-@added_files = order_and_summarize_diffs(@added_files);
-@removed_files = order_and_summarize_diffs(@removed_files);
-
-push @text, "Modified Files:", format_lists(@modified_files)
- if (@modified_files);
-
-push @text, "Added Files:", format_lists(@added_files) if (@added_files);
-
-push @text, "Removed Files:", format_lists(@removed_files) if (@removed_files);
-
-push @text, "", "Log Message", @log_lines if (@log_lines);
-
-push @text, "";
-
-if ($RT_HANDLER) {
- rt_handler(
- @log_lines, "\n",
- loc("To generate a diff of this commit:\n"), "\n",
- format_diffs( @modified_files, @added_files, @removed_files )
- );
-}
-
-if ($COMMITLOG) {
- append_logfile( $COMMITLOG, @text );
-}
-
-if ($do_diff) {
- push @text, "";
- push @text, loc("To generate a diff of this commit:");
- push @text, format_diffs( @modified_files, @added_files, @removed_files );
- push @text, "";
-}
-
-# }}}
-
-# {{{ Mail out the notification.
-
-mail_notification( $id, @text );
-
-# }}}
-
-# {{{ clean up
-
-unless ($DEBUG) {
- $hash = untaint($hash);
- $id = untaint($id);
- unlink "$VERSION_FILE.$id.$hash";
- unlink "$MESSAGE_FILE.$id.$hash";
- unlink "$MAIL_FILE.$id";
- unlink "$LASTDIR_FILE.$id";
- unlink "$HASH_FILE.$id";
-}
-
-# }}}
-
-exit 0;
-
-# {{{ Subroutines
-#
-
-# {{{ append_logfile
-sub append_logfile {
- my $filename = shift;
- my (@lines) = @_;
-
- $filename = untaint($filename);
-
- open( FILE, ">>$filename" )
- || die ("Cannot open file $filename for append.\n");
- foreach my $line (@lines) {
- print FILE $line . "\n";
- }
- close(FILE);
-}
-
-# }}}
-
-# {{{ write_file
-sub write_file {
- my $filename = shift;
- my (@lines) = @_;
-
- $filename = untaint($filename);
-
- open( FILE, ">$filename" )
- || die ("Cannot open file $filename for write.\n");
- foreach my $line (@lines) {
- print FILE $line . "\n";
- }
- close(FILE);
-}
-
-# }}}
-
-# {{{ read_file
-sub read_file {
- my $filename = shift;
- my (@lines);
-
- open( FILE, "<$filename" )
- || die ("Cannot open file $filename for read.\n");
- while ( my $line = <FILE> ) {
- chop $line;
- push @lines, $line;
- }
- close(FILE);
-
- return (@lines);
-}
-
-# }}}
-
-# {{{ sub format_lists
-
-sub format_lists {
- my @items = (@_);
-
- my $files = "";
- map {
- $_->{'files'} && ( $files .= ' ' . join ( ' ', @{ $_->{'files'} } ) );
- } @items;
-
- my @lines = wrap( "\t", "\t\t", $files );
- return (@lines);
-
-}
-
-# }}}
-
-# {{{ sub format_diffs
-
-sub format_diffs {
- my @items = (@_);
-
- my @lines;
- foreach my $item (@items) {
- next unless ( $item->{'files'} );
- push ( @lines,
- "cvs diff -r"
- . $item->{'old'} . " -r"
- . $item->{'new'} . " "
- . join ( " ", @{ $item->{'files'} } ) . "\n" );
-
- }
-
- @lines = fill( "\t", "\t\t", @lines );
-
- return (@lines);
-}
-
-# }}}
-
-# {{{ sub order_and_summarize_diffs {
-
-# takes an array of file items
-# returns a sorted array of fileset items, which are like file items, except they can have an array of files, rather than
-# a singleton file.
-
-sub order_and_summarize_diffs {
-
- my @files = (@_);
-
- # Sort by tag, dir, file.
- @files = sort {
- $a->{'tag'} cmp $b->{'tag'}
- || $a->{'dir'} cmp $b->{'dir'}
- || $a->{'file'} cmp $b->{'file'};
- } @files;
-
- # Combine adjacent rows that are the same modulo the file name.
-
- my @items = (undef);
-
- foreach my $file (@files) {
- if ( $#items == -1 #if it's empty
- || ( !defined $items[-1]->{'old'}
- || $items[-1]->{'old'} ne $file->{'old'} )
- || ( !defined $items[-1]->{'new'}
- || $items[-1]->{'new'} ne $file->{'new'} )
- || ( !defined $items[-1]->{'tag'}
- || $items[-1]->{'tag'} ne $file->{'tag'} ) )
- {
-
- push ( @items, $file );
- }
- push ( @{ $items[-1]->{'files'} },
- $file->{'dir'} . "/" . $file->{'file'} );
- }
-
- return (@items);
-}
-
-# }}}
-
-# {{{ build_header
-
-sub build_header {
- my $now = gmtime;
- my $header =
- sprintf( "Module Name:\t%s\nCommitted By:\t%s\nDate:\t\t%s %s %s",
- $MODULE_NAME, $LOGIN, substr( $now, 0, 19 ), "UTC",
- substr( $now, 20, 4 ) );
- return ($header);
-}
-
-# }}}
-
-# {{{ mail_notification
-sub mail_notification {
- my $id = shift;
- my (@text) = @_;
- write_file( "$MAIL_FILE.$id", "From: " . $LOGIN,
- "Subject: CVS commit: " . $MODULE_NAME, "To: " . $MAILTO,
- "Reply-To: " . $REPLYTO, "", "", @text );
-
- my $entity = MIME::Entity->build(
- From => $LOGIN,
- To => $MAILTO,
- Subject => "CVS commit: " . $MODULE_NAME,
- 'Reply-To' => $REPLYTO,
- Data => join ( "\n", @text )
- );
- if ( $RT::MailCommand eq 'sendmailpipe' ) {
- open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" )
- || die "Couldn't send mail: " . $@ . "\n";
- print MAIL $entity->as_string;
- close(MAIL);
- }
- else {
- $entity->send( $RT::MailCommand, $RT::MailParams );
- }
-
-}
-
-# }}}
-
-# {{{ sub record_last_dir
-
-sub record_last_dir {
- my $id = shift;
- my $dir = shift;
-
- # make a note of this directory. later, we'll use this to
- # figure out if we've gone through the whole commit,
- # for something that is a bad mockery of attomic commits.
-
- warn "about to write $dir to $LASTDIR_FILE.$id" if ($DEBUG);
-
- write_file( "$LASTDIR_FILE.$id", $dir );
-}
-
-# }}}
-
-# {{{ Get the RT stuff set up
-
-# {{{ sub rt_handler
-
-sub rt_handler {
- my (@LogMessage) = (@_);
-
- #Connect to the database and get RT::SystemUser and RT::Nobody loaded
- RT::Init;
-
- require RT::Ticket;
-
- #Get the current user all loaded
- my $CurrentUser = GetCurrentUser();
-
- if ( !$CurrentUser->Id ) {
- print
-loc("No valid RT user found. RT cvs handler disengaged. Please consult your RT administrator.\n");
- return;
- }
-
- my (@commands) = find_commands( \@LogMessage );
-
- my ( @tickets, @errors );
-
- # Get the list of tickets we're working with out of commands
- grep { $_ =~ /^RT-Ticket:\s*(.*?)$/i && push ( @tickets, $1 ) } @commands;
-
- my $message = new MIME::Entity;
- $message->build(
- From => $CurrentUser->EmailAddress,
- Subject => 'CVS Commit',
- Data => \@LogMessage
- );
-
- # {{{ comment or correspond, as needed
-
- foreach my $ticket (@tickets) {
- my $TicketObj = RT::Ticket->new($CurrentUser);
- $TicketObj->Load($ticket);
- my ( $id, $msg );
- unless ( $TicketObj->Id ) {
- push ( @errors,
-"Couldn't load ticket #$ticket. Not adding commit log to ticket history.\n"
- );
- }
-
- if ( $LogMessage[0] =~ /^(comment|private)$/ ) {
- ( $id, $msg ) = $TicketObj->Comment( MIMEObj => $message );
-
- }
- else {
- ( $id, $msg ) = $TicketObj->Correspond( MIMEObj => $message );
- }
-
- push ( @errors, ">> Log message",
- "Ticket #" . $TicketObj->Id . ": " . $msg );
-
- }
-
- # }}}
-
- my ($reply) = ActOnPseudoHeaders( $CurrentUser, @commands );
- print "$reply\n" if ($reply);
- print join ( "\n", @errors );
- print "\n";
-
-}
-
-# }}}
-
-# {{{ sub find_commands
-
-sub find_commands {
- my $lines = shift;
- my (@pseudoheaders);
-
- while ( my $line = shift @{$lines} ) {
- next if $line =~ /^\s*?$/;
- if ( $line =~ /^RT-/i ) {
-
- push ( @pseudoheaders, $line );
- }
-
- #If we find a line that's not a command, get out.
- else {
- unshift ( @{$lines}, $line );
- last;
- }
- }
-
- return (@pseudoheaders);
-
-}
-
-# }}}
-
-# {{{ sub ActOnPseudoHeaders
-
-=item ActOnPseudoHeaders $PseudoHeaders
-
-Takes a string of pseudo-headers, iterates through them and does what they tell it to.
-
-=cut
-
-sub ActOnPseudoHeaders {
- my $CurrentUser = shift;
- my (@actions) = (@_);
-
- my $ResultsMessage = '';
- my $Ticket = RT::Ticket->new($CurrentUser);
-
- foreach my $action (@actions) {
- my ($val);
- my $msg = '';
-
- $ResultsMessage .= ">>> $action\n";
-
- if ( $action =~ /^RT-(.*?):\s*(.*)$/i ) {
- my $command = $1;
- my $args = $2;
-
- if ( $command =~ /^ticket$/i ) {
-
- $val = $Ticket->Load($args);
- unless ($val) {
- $ResultsMessage .=
- loc("ERROR: Couldn't load ticket '[_1]': [_2].\n", $1, $msg);
- . loc("Aborting to avoid unintended ticket modifications.\n")
- . loc("The following commands were not proccessed:\n\n")
- . join ( "\n", @actions );
- return ($ResultsMessage);
- }
- $ResultsMessage .= loc("Ticket [_1] loaded\n", $Ticket->Id);
- }
- else {
- unless ( $Ticket->Id ) {
- $ResultsMessage .= loc("No Ticket specified. Aborting ticket ")
- . loc("modifications\n\n")
- . loc("The following commands were not proccessed:\n\n")
- . join ( "\n", @actions );
- return ($ResultsMessage);
- }
-
- # Deal with the basics
- if ( $command =~ /^(Subject|Owner|Status|Queue)$/i ) {
- my $method = 'Set' . ucfirst( lc($1) );
- ( $val, $msg ) = $Ticket->$method($args);
- }
-
- # Deal with the dates
- elsif ( $command =~ /^(due|starts|started|resolved)$/i ) {
- my $method = 'Set' . ucfirst( lc($1) );
- my $date = new RT::Date($CurrentUser);
- $date->Set( Format => 'unknown', Value => $args );
- ( $val, $msg ) = $Ticket->$method( $date->ISO );
- }
-
- # Deal with the watchers
- elsif ( $command =~ /^(requestor|requestors|cc|admincc)$/i ) {
- my $operator = "+";
- my ($type);
- if ( $args =~ /^(\+|\-)(.*)$/ ) {
- $operator = $1;
- $args = $2;
- }
- $type = 'Requestor' if ( $command =~ /^requestor/i );
- $type = 'Cc' if ( $command =~ /^cc/i );
- $type = 'AdminCc' if ( $command =~ /^admincc/i );
-
- my $user = RT::User->new($CurrentUser);
- $user->Load($args);
-
- if ($operator eq '+') {
- ($val, $msg) = $Ticket->AddWatcher( Type => $type,
- PrincipalId => $user->PrincipalId);
- } elsif ($operator eq '-') {
- ($val, $msg) = $Ticket->DeleteWatcher( Type => $type,
- PrincipalId => $user->PrincipalId);
- }
-
- }
- $ResultsMessage .= $msg . "\n";
- }
-
- }
- return ($ResultsMessage);
-
-}
-
-# }}}
-
-# {{{ sub untaint
-sub untaint {
- my $val = shift;
-
- if ( $val =~ /^([-\#\/\w.]+)$/ ) {
- $val = $1; # $data now untainted
- }
- else {
- die loc("Bad data in [_1]", $val); # log this somewhere
- }
- return ($val);
-}
-
-# }}}
-
-=head1 AUTHOR
-
-
-
- rt-commit-handler is a rewritten version of the NetBSD commit handler,
- which was placed in the public domain by Charles Hannum. It bore the following
- authors statement:
-
- Contributed by David Hampton <hampton@cisco.com>
- Hacked greatly by Greg A. Woods <woods@planix.com>
- Rewritten by Charles M. Hannum <mycroft@netbsd.org>
-
-=cut
-
diff --git a/rt/bin/rt-crontool b/rt/bin/rt-crontool
index ede874a0c..cdbc3cbc9 100644
--- a/rt/bin/rt-crontool
+++ b/rt/bin/rt-crontool
@@ -197,7 +197,7 @@ sub help {
)
. "\n\n";
- print " sbin/cron_shim \\\n";
+ print " bin/rt-cron-tool \\\n";
print
" --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n";
print
@@ -205,6 +205,16 @@ sub help {
print " --action RT::Action::SetPriority --action-arg 99 \\\n";
print " --verbose\n";
+ print "\n";
+ print loc("Escalate tickets");
+ print "rt-crontool \\\n";
+ print " --search RT::Search::ActiveTicketsInQueue --search-arg thequeuename \\\n";
+ print " --action RT::Action::EscalatePriority \\\n";
+
+
+
+
+
exit(0);
}
diff --git a/rt/bin/rt-crontool.in b/rt/bin/rt-crontool.in
index 73b80aa90..76b08c344 100644
--- a/rt/bin/rt-crontool.in
+++ b/rt/bin/rt-crontool.in
@@ -1,9 +1,15 @@
#!@PERL@
-# BEGIN LICENSE BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
+# <jesse@bestpractical.com>
#
-# (Except where explictly superceded by other copyright notices)
+# (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
@@ -15,18 +21,33 @@
# 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.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
-# END LICENSE BLOCK
-
+# 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 Carp;
-use lib ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+use lib ("@LOCAL_LIB_PATH@", "@RT_LIB_PATH@");
package RT;
@@ -45,9 +66,6 @@ RT::LoadConfig();
#Connect to the database and get RT::SystemUser and RT::Nobody loaded
RT::Init();
-#Drop setgid permissions
-RT::DropSetGIDPermissions();
-
#Get the current user all loaded
my $CurrentUser = GetCurrentUser();
@@ -68,7 +86,7 @@ GetOptions( "search=s" => \$search,
"help" => \$help,
"verbose|v" => \$verbose );
-help() if $help;
+help() if $help or not $search or not $action;
# We _must_ have a search object
load_module($search);
@@ -78,15 +96,19 @@ load_module($condition) if ($condition);
# load template if specified
my $template_obj;
if ($template_id) {
- $template_obj = RT::Template->new($RT::Nobody);
- $template_obj->LoadById($template_id);
+ $template_obj = RT::Template->new($CurrentUser);
+ $template_obj->Load($template_id);
}
#At the appointed time:
#find a bunch of tickets
my $tickets = RT::Tickets->new($CurrentUser);
-my $search = $search->new( TicketsObj => $tickets, Argument => $search_arg );
+my $search = $search->new(
+ TicketsObj => $tickets,
+ Argument => $search_arg,
+ CurrentUser => $CurrentUser
+);
$search->Prepare();
@@ -95,12 +117,13 @@ my $tickets = $search->TicketsObj;
#for each ticket we've found
while ( my $ticket = $tickets->Next() ) {
- print "\n" . $ticket->Id() . ": " if ($verbose);
+ print $ticket->Id() . ": " if ($verbose);
# perform some more advanced check
if ($condition) {
my $condition_obj = $condition->new( TicketObj => $ticket,
- Argument => $condition_arg );
+ Argument => $condition_arg,
+ CurrentUser => $CurrentUser );
# if the condition doesn't apply, get out of here
@@ -109,9 +132,12 @@ while ( my $ticket = $tickets->Next() ) {
}
#prepare our action
- my $action_obj = $action->new( TicketObj => $ticket,
- TemplateObj => $template_obj,
- Argument => $action_arg );
+ my $action_obj = $action->new(
+ TicketObj => $ticket,
+ TemplateObj => $template_obj,
+ Argument => $action_arg,
+ CurrentUser => $CurrentUser
+ );
#if our preparation, move onto the next ticket
next unless ( $action_obj->Prepare );
@@ -119,7 +145,7 @@ while ( my $ticket = $tickets->Next() ) {
#commit our action.
next unless ( $action_obj->Commit );
- print loc("Action committed.") if ($verbose);
+ print loc("Action committed.\n") if ($verbose);
}
# {{{ load_module
@@ -197,14 +223,22 @@ sub help {
)
. "\n\n";
- print " sbin/cron_shim \\\n";
- print
- " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n";
- print
- " --condition RT::Condition::UntouchedInHours --condition-arg 4 \\\n";
+ print " bin/rt-crontool \\\n";
+ print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n";
+ print " --condition RT::Condition::UntouchedInHours --condition-arg 4 \\\n";
print " --action RT::Action::SetPriority --action-arg 99 \\\n";
print " --verbose\n";
+ print "\n";
+ print loc("Escalate tickets"). "\n";
+ print " bin/rt-crontool \\\n";
+ print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n";
+ print " --action RT::Action::EscalatePriority\n";
+
+
+
+
+
exit(0);
}
diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate
index b30443638..8af800227 100755
--- a/rt/bin/rt-mailgate
+++ b/rt/bin/rt-mailgate
@@ -1,26 +1,26 @@
#!/usr/bin/perl -w
# 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
=head1 NAME
@@ -31,10 +31,25 @@ rt-mailgate - Mail interface to RT3.
use RT::I18N;
+# Make sure that when we call the mailgate wrong, it tempfails
+
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://bad.address"), "Opened the mailgate - The error below is expected - $@");
+print MAIL <<EOF;
+From: root\@localhost
+To: rt\@example.com
+Subject: This is a test of new ticket creation
+
+Foob!
+EOF
+close (MAIL);
+
+# Check the return value
+is ( $? >> 8, 75, "The error message above is expected The mail gateway exited with a failure. yay");
+
# {{{ Test new ticket creation by root who is privileged and superuser
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: root\@localhost
To: rt\@example.com
@@ -45,6 +60,9 @@ Foob!
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
use RT::Tickets;
my $tickets = RT::Tickets->new($RT::SystemUser);
$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
@@ -59,7 +77,7 @@ ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the tick
# {{{This is a test of new ticket creation as an unknown user
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: doesnotexist\@example.com
To: rt\@example.com
@@ -69,6 +87,8 @@ Blah!
Foob!
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
$tickets = RT::Tickets->new($RT::SystemUser);
$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
@@ -94,7 +114,7 @@ ok ($val, "Granted everybody the right to create tickets - $msg");
sleep(60); # gotta sleep so the remote process' ACL cache times out
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: doesnotexist\@example.com
To: rt\@example.com
@@ -104,6 +124,8 @@ Blah!
Foob!
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
$tickets = RT::Tickets->new($RT::SystemUser);
@@ -126,7 +148,7 @@ ok( $u->Id != 0, " user does not exist and was created by ticket submission");
#ok ($val, "Granted everybody the right to create tickets - $msg");
#sleep(60); # gotta sleep so the remote process' ACL cache times out
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: doesnotexist-2\@example.com
To: rt\@example.com
@@ -136,6 +158,8 @@ Blah!
Foob!
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
$u = RT::User->new($RT::SystemUser);
$u->Load('doesnotexist-2@example.com');
@@ -148,7 +172,7 @@ ok( $u->Id == 0, " user does not exist and was not created by ticket corresponde
ok ($val, "Granted everybody the right to reply to tickets - $msg");
sleep(60); # gotta sleep so the remote process' ACL cache times out
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: doesnotexist-2\@example.com
To: rt\@example.com
@@ -158,6 +182,8 @@ Blah!
Foob!
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
$u = RT::User->new($RT::SystemUser);
@@ -173,7 +199,7 @@ ok( $u->Id != 0, " user exists and was created by ticket correspondence submissi
#ok ($val, "Granted everybody the right to create tickets - $msg");
#sleep(60); # gotta sleep so the remote process' ACL cache times out
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: doesnotexist-3\@example.com
To: rt\@example.com
@@ -184,6 +210,9 @@ Foob!
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
$u = RT::User->new($RT::SystemUser);
$u->Load('doesnotexist-3@example.com');
ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission");
@@ -196,7 +225,7 @@ ok( $u->Id == 0, " user does not exist and was not created by ticket comment sub
ok ($val, "Granted everybody the right to reply to tickets - $msg");
sleep(60); # gotta sleep so the remote process' ACL cache times out
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action comment"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: doesnotexist-3\@example.com
To: rt\@example.com
@@ -207,6 +236,8 @@ Foob!
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
$u = RT::User->new($RT::SystemUser);
$u->Load('doesnotexist-3@example.com');
@@ -227,17 +258,20 @@ my $entity = MIME::Entity->build( From => 'root@localhost',
Data => ['This is a test of a binary attachment']);
# currently in lib/t/autogen
-$entity->attach(Path => '../../../html/NoAuth/images/spacer.gif',
+$entity->attach(Path => '/opt/rt3/share/html/NoAuth/images/spacer.gif',
Type => 'image/gif',
Encoding => 'base64');
# Create a ticket with a binary attachment
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
$entity->print(\*MAIL);
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
my $tickets = RT::Tickets->new($RT::SystemUser);
$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
@@ -273,7 +307,7 @@ use LWP::UserAgent;
# Grab the binary attachment via the web ui
my $ua = LWP::UserAgent->new();
-my $full_url = "http://localhost/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password";
+my $full_url = "http://localhost".$RT::WebPath."/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password";
my $r = $ua->get( $full_url);
@@ -286,7 +320,7 @@ is($file, $r->content, 'The attachment isn\'t screwed up in download');
# {{{ Simple I18N testing
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: root\@localhost
@@ -301,6 +335,9 @@ bye
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
my $unitickets = RT::Tickets->new($RT::SystemUser);
$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
@@ -317,7 +354,7 @@ is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attac
ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id);
# supposedly I18N fails on the second message sent in.
-ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+ok(open(MAIL, "|/opt/rt3/bin/rt-mailgate --url http://localhost".$RT::WebPath."/ --queue general --action correspond"), "Opened the mailgate - $@");
print MAIL <<EOF;
From: root\@localhost
@@ -332,6 +369,9 @@ bye
EOF
close (MAIL);
+#Check the return value
+is ($? >> 8, 0, "The mail gateway exited normally. yay");
+
my $tickets2 = RT::Tickets->new($RT::SystemUser);
$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC');
$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
@@ -367,7 +407,7 @@ use LWP::UserAgent;
use constant EX_TEMPFAIL => 75;
my %opts;
-GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s" );
+GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
if ( $opts{help} ) {
require Pod::Usage;
@@ -381,17 +421,18 @@ for (qw(url)) {
}
undef $/;
-my $message = <>;
my $ua = LWP::UserAgent->new();
$ua->cookie_jar( { file => $opts{jar} } );
my %args = (
queue => $opts{queue},
action => $opts{action},
- message => $message,
SessionType => 'REST', # Surpress login box
);
+# Read the message in from STDIN
+$args{'message'} = <>;
+
if ($opts{'extension'}) {
$args{$opts{'extension'}} = $ENV{'EXTENSION'};
@@ -404,6 +445,7 @@ warn "Connecting to $full_url" if $opts{'debug'};
+$ua->timeout(exists($opts{'timeout'}) ? $opts{'timeout'} : 180);
my $r = $ua->post( $full_url, {%args} );
check_failure($r);
@@ -414,7 +456,7 @@ if ( $content !~ /^(ok|not ok)/ ) {
# It's not the server's fault if the mail is bogus. We just want to know that
# *something* came out of the server.
- die <<EOF
+ warn <<EOF;
RT server error.
The RT server which handled your email did not behave as expected. It
@@ -423,8 +465,13 @@ said:
$content
EOF
+exit EX_TEMPFAIL;
+
}
+exit;
+
+
sub check_failure {
my $r = shift;
return if $r->is_success();
@@ -455,7 +502,11 @@ Usual invocation (from MTA):
rt-mailgate --action (correspond|comment) --queue queuename
--url http://your.rt.server/
- [ --extension (queue|action|ticket)
+ [ --debug ]
+ [ --extension (queue|action|ticket) ]
+ [ --timeout seconds ]
+
+
See C<man rt-mailgate> for more.
@@ -486,6 +537,16 @@ submitted to will be set to the value of $EXTENSION. By specifying
is related to. "action" will allow the user to specify either "comment" or
"correspond" in the address extension.
+=item C<--debug> OPTIONAL
+
+Print debugging output to standard error
+
+
+=item C<--timeout> OPTIONAL
+
+Configure the timeout for posting the message to the web server. The
+default timeout is 3 minutes (180 seconds).
+
=head1 DESCRIPTION
diff --git a/rt/bin/rt-mailgate.in b/rt/bin/rt-mailgate.in
index 304fcbcd6..5ac9469d8 100644
--- a/rt/bin/rt-mailgate.in
+++ b/rt/bin/rt-mailgate.in
@@ -1,362 +1,54 @@
#!@PERL@ -w
-# BEGIN LICENSE BLOCK
-#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
-#
-# (Except where explictly superceded by other copyright notices)
-#
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 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.
-#
-# 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
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# 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 }}}
=head1 NAME
rt-mailgate - Mail interface to RT3.
-=begin testing
-
-use RT::I18N;
-
-
-# {{{ Test new ticket creation by root who is privileged and superuser
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: root\@localhost
-To: rt\@example.com
-Subject: This is a test of new ticket creation
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-use RT::Tickets;
-my $tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
-my $tick = $tickets->First();
-ok (UNIVERSAL::isa($tick,'RT::Ticket'));
-ok ($tick->Id, "found ticket ".$tick->Id);
-ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the ticket");
-
-# }}}
-
-
-# {{{This is a test of new ticket creation as an unknown user
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist\@example.com
-To: rt\@example.com
-Subject: This is a test of new ticket creation as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-$tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
-$tick = $tickets->First();
-ok ($tick->Id, "found ticket ".$tick->Id);
-ok ($tick->Subject ne 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
-my $u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist@example.com');
-ok( $u->Id == 0, " user does not exist and was not created by failed ticket submission");
-
-
-# }}}
-
-# {{{ now everybody can create tickets. can a random unkown user create tickets?
-
-my $g = RT::Group->new($RT::SystemUser);
-$g->LoadSystemInternalGroup('Everyone');
-ok( $g->Id, "Found 'everybody'");
-
-my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
-ok ($val, "Granted everybody the right to create tickets - $msg");
-
-sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist\@example.com
-To: rt\@example.com
-Subject: This is a test of new ticket creation as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-
-$tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
-$tick = $tickets->First();
-ok ($tick->Id, "found ticket ".$tick->Id);
-ok ($tick->Subject eq 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
-my $u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist@example.com');
-ok( $u->Id != 0, " user does not exist and was created by ticket submission");
-
-# }}}
-
-
-# {{{ can another random reply to a ticket without being granted privs? answer should be no.
-
-
-#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
-#ok ($val, "Granted everybody the right to create tickets - $msg");
-#sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist-2\@example.com
-To: rt\@example.com
-Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-$u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist-2@example.com');
-ok( $u->Id == 0, " user does not exist and was not created by ticket correspondence submission");
-# }}}
-# {{{ can another random reply to a ticket after being granted privs? answer should be yes
-
-
-($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'ReplyToTicket');
-ok ($val, "Granted everybody the right to reply to tickets - $msg");
-sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist-2\@example.com
-To: rt\@example.com
-Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-
-$u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist-2@example.com');
-ok( $u->Id != 0, " user exists and was created by ticket correspondence submission");
-
-# }}}
-
-# {{{ can another random comment on a ticket without being granted privs? answer should be no.
-
-
-#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
-#ok ($val, "Granted everybody the right to create tickets - $msg");
-#sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist-3\@example.com
-To: rt\@example.com
-Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-$u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist-3@example.com');
-ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission");
-
-# }}}
-# {{{ can another random reply to a ticket after being granted privs? answer should be yes
-
-
-($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CommentOnTicket');
-ok ($val, "Granted everybody the right to reply to tickets - $msg");
-sleep(60); # gotta sleep so the remote process' ACL cache times out
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@");
-print MAIL <<EOF;
-From: doesnotexist-3\@example.com
-To: rt\@example.com
-Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
-
-Blah!
-Foob!
-EOF
-close (MAIL);
-
-
-$u = RT::User->new($RT::SystemUser);
-$u->Load('doesnotexist-3@example.com');
-ok( $u->Id != 0, " user exists and was created by ticket comment submission");
-
-# }}}
-
-# {{{ Testing preservation of binary attachments
-
-# Get a binary blob (Best Practical logo)
-
-# Create a mime entity with an attachment
-
-use MIME::Entity;
-my $entity = MIME::Entity->build( From => 'root@localhost',
- To => 'rt@localhost',
- Subject => 'binary attachment test',
- Data => ['This is a test of a binary attachment']);
-
-# currently in lib/t/autogen
-$entity->attach(Path => '../../../html/NoAuth/images/spacer.gif',
- Type => 'image/gif',
- Encoding => 'base64');
-
-# Create a ticket with a binary attachment
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
-
-$entity->print(\*MAIL);
-
-close (MAIL);
-
-my $tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
- $tick = $tickets->First();
-ok (UNIVERSAL::isa($tick,'RT::Ticket'));
-ok ($tick->Id, "found ticket ".$tick->Id);
-ok ($tick->Subject eq 'binary attachment test', "Created the ticket - ".$tick->Id);
-
-my $file = `cat ../../../html/NoAuth/images/spacer.gif`;
-ok ($file, "Read in the logo image");
-
-
- use Digest::MD5;
-warn "for the raw file the content is ".Digest::MD5::md5_base64($file);
-
-
-
-# Verify that the binary attachment is valid in the database
-my $attachments = RT::Attachments->new($RT::SystemUser);
-$attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif');
-ok ($attachments->Count == 1, 'Found only one gif in the database');
-my $attachment = $attachments->First;
-my $acontent = $attachment->Content;
-
- warn "coming from the database, the content is ".Digest::MD5::md5_base64($acontent);
-
-is( $acontent, $file, 'The attachment isn\'t screwed up in the database.');
-# Log in as root
-use Getopt::Long;
-use LWP::UserAgent;
-
-
-# Grab the binary attachment via the web ui
-my $ua = LWP::UserAgent->new();
-
-my $full_url = "http://localhost/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password";
-my $r = $ua->get( $full_url);
-
-
-# Verify that the downloaded attachment is the same as what we uploaded.
-is($file, $r->content, 'The attachment isn\'t screwed up in download');
-
-
-
-# }}}
-
-# {{{ Simple I18N testing
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
-
-print MAIL <<EOF;
-From: root\@localhost
-To: rtemail\@example.com
-Subject: This is a test of I18N ticket creation
-Content-Type: text/plain; charset="utf-8"
-
-2 accented lines
-\303\242\303\252\303\256\303\264\303\273
-\303\241\303\251\303\255\303\263\303\272
-bye
-EOF
-close (MAIL);
-
-my $unitickets = RT::Tickets->new($RT::SystemUser);
-$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
-my $unitick = $unitickets->First();
-ok (UNIVERSAL::isa($unitick,'RT::Ticket'));
-ok ($unitick->Id, "found ticket ".$unitick->Id);
-ok ($unitick->Subject eq 'This is a test of I18N ticket creation', "Created the ticket - ". $unitick->Subject);
-
-
-
-my $unistring = "\303\241\303\251\303\255\303\263\303\272";
-Encode::_utf8_on($unistring);
-is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attachments->First->Content, "Content is ". $unitick->Transactions->First->Attachments->First->Content);
-ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id);
-# supposedly I18N fails on the second message sent in.
-
-ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
-
-print MAIL <<EOF;
-From: root\@localhost
-To: rtemail\@example.com
-Subject: This is a test of I18N ticket creation
-Content-Type: text/plain; charset="utf-8"
-
-2 accented lines
-\303\242\303\252\303\256\303\264\303\273
-\303\241\303\251\303\255\303\263\303\272
-bye
-EOF
-close (MAIL);
-
-my $tickets2 = RT::Tickets->new($RT::SystemUser);
-$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
-my $tick2 = $tickets2->First();
-ok (UNIVERSAL::isa($tick2,'RT::Ticket'));
-ok ($tick2->Id, "found ticket ".$tick2->Id);
-ok ($tick2->Subject eq 'This is a test of I18N ticket creation', "Created the ticket");
-
-
-
-my $unistring = "\303\241\303\251\303\255\303\263\303\272";
-Encode::_utf8_on($unistring);
-
-ok ($tick2->Transactions->First->Content =~ $unistring, "It appears to be unicode - ".$tick2->Transactions->First->Content);
-
-# }}}
-
-
-($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket');
-ok ($val, $msg);
-
-
-
-=end testing
-
=cut
@@ -367,7 +59,7 @@ use LWP::UserAgent;
use constant EX_TEMPFAIL => 75;
my %opts;
-GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s" );
+GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
if ( $opts{help} ) {
require Pod::Usage;
@@ -380,18 +72,22 @@ for (qw(url)) {
die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_};
}
-undef $/;
-my $message = <>;
my $ua = LWP::UserAgent->new();
$ua->cookie_jar( { file => $opts{jar} } );
my %args = (
queue => $opts{queue},
action => $opts{action},
- message => $message,
SessionType => 'REST', # Surpress login box
);
+# Read the message in from STDIN
+$args{'message'} = do { local (@ARGV, $/); <> };
+
+unless ( $args{message} =~ /\S/ ) {
+ print STDERR "$0: no message passed on STDIN!\n";
+ exit 0;
+}
if ($opts{'extension'}) {
$args{$opts{'extension'}} = $ENV{'EXTENSION'};
@@ -404,6 +100,7 @@ warn "Connecting to $full_url" if $opts{'debug'};
+$ua->timeout(exists($opts{'timeout'}) ? $opts{'timeout'} : 180);
my $r = $ua->post( $full_url, {%args} );
check_failure($r);
@@ -414,7 +111,7 @@ if ( $content !~ /^(ok|not ok)/ ) {
# It's not the server's fault if the mail is bogus. We just want to know that
# *something* came out of the server.
- die <<EOF
+ warn <<EOF;
RT server error.
The RT server which handled your email did not behave as expected. It
@@ -423,8 +120,13 @@ said:
$content
EOF
+exit EX_TEMPFAIL;
+
}
+exit;
+
+
sub check_failure {
my $r = shift;
return if $r->is_success();
@@ -453,9 +155,13 @@ sub check_failure {
Usual invocation (from MTA):
- rt-mailgate --action (correspond|comment) --queue queuename
+ rt-mailgate --action (correspond|comment|...) --queue queuename
--url http://your.rt.server/
- [ --extension (queue|action|ticket)
+ [ --debug ]
+ [ --extension (queue|action|ticket) ]
+ [ --timeout seconds ]
+
+
See C<man rt-mailgate> for more.
@@ -465,15 +171,31 @@ See C<man rt-mailgate> for more.
=item C<--action>
-Specifies whether this is a correspondence or comment address.
+Specifies what happens to email sent to this alias. The avaliable
+basic actions are: C<correspond>, C<comment>.
+
+
+If you've set the RT configuration variable B<$RT::UnsafeEmailCommands>,
+C<take> and C<resolve> are also available. You can execute two or more
+actions on a single message using a C<-> separated list. RT will execute
+the actions in the listed order. For example you can use C<take-comment>,
+C<correspond-resolve> or C<take-comment-resolve> as actions.
+
+Note that C<take> and C<resolve> actions ignore message text if used
+alone. Include a C<comment> or C<correspond> action if you want RT
+to record the incoming message.
+
+The default action is C<correspond>.
=item C<--queue>
-Reflects which queue this address handles.
+This flag determines which queue this alias should create a ticket in if no ticket identifier
+is found.
=item C<--url>
-The location of the web server for your RT instance.
+This flag tells the mail gateway where it can find your RT server. You should
+probably use the same URL that users use to log into RT.
=item C<--extension> OPTIONAL
@@ -486,6 +208,16 @@ submitted to will be set to the value of $EXTENSION. By specifying
is related to. "action" will allow the user to specify either "comment" or
"correspond" in the address extension.
+=item C<--debug> OPTIONAL
+
+Print debugging output to standard error
+
+
+=item C<--timeout> OPTIONAL
+
+Configure the timeout for posting the message to the web server. The
+default timeout is 3 minutes (180 seconds).
+
=head1 DESCRIPTION
@@ -554,6 +286,7 @@ several parameters:
=item Message
A C<MIME::Entity> object representing the email
+
=item CurrentUser
An C<RT::CurrentUser> object
diff --git a/rt/bin/rt.in b/rt/bin/rt.in
new file mode 100644
index 000000000..d12460b06
--- /dev/null
+++ b/rt/bin/rt.in
@@ -0,0 +1,1890 @@
+#!@PERL@ -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# 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 }}}
+
+# Designed and implemented for Best Practical Solutions, LLC by
+# Abhijit Menon-Sen <ams@wiw.org>
+
+use strict;
+
+# This program is intentionally written to have as few non-core module
+# dependencies as possible. It should stay that way.
+
+use Cwd;
+use LWP;
+use Text::ParseWords;
+use HTTP::Request::Common;
+
+# We derive configuration information from hardwired defaults, dotfiles,
+# and the RT* environment variables (in increasing order of precedence).
+# Session information is stored in ~/.rt_sessions.
+
+my $VERSION = 0.02;
+my $HOME = eval{(getpwuid($<))[7]}
+ || $ENV{HOME} || $ENV{LOGDIR} || $ENV{HOMEPATH}
+ || ".";
+my %config = (
+ (
+ debug => 0,
+ user => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME},
+ passwd => undef,
+ server => 'http://localhost/rt/',
+ query => undef,
+ orderby => undef,
+ ),
+ config_from_file($ENV{RTCONFIG} || ".rtrc"),
+ config_from_env()
+);
+my $session = new Session("$HOME/.rt_sessions");
+my $REST = "$config{server}/REST/1.0";
+
+sub whine;
+sub DEBUG { warn @_ if $config{debug} >= shift }
+
+# These regexes are used by command handlers to parse arguments.
+# (XXX: Ask Autrijus how i18n changes these definitions.)
+
+my $name = '[\w.-]+';
+my $field = '[a-zA-Z][a-zA-Z0-9_-]*';
+my $label = '[a-zA-Z0-9@_.+-]+';
+my $labels = "(?:$label,)*$label";
+my $idlist = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
+
+# Our command line looks like this:
+#
+# rt <action> [options] [arguments]
+#
+# We'll parse just enough of it to decide upon an action to perform, and
+# leave the rest to per-action handlers to interpret appropriately.
+
+my %handlers = (
+# handler => [ ...aliases... ],
+ version => ["version", "ver"],
+ shell => ["shell"],
+ logout => ["logout"],
+ help => ["help", "man"],
+ show => ["show", "cat"],
+ edit => ["create", "edit", "new", "ed"],
+ list => ["search", "list", "ls"],
+ comment => ["comment", "correspond"],
+ link => ["link", "ln"],
+ merge => ["merge"],
+ grant => ["grant", "revoke"],
+);
+
+my %actions;
+foreach my $fn (keys %handlers) {
+ foreach my $alias (@{ $handlers{$fn} }) {
+ $actions{$alias} = \&{"$fn"};
+ }
+}
+
+# Once we find and call an appropriate handler, we're done.
+
+sub handler {
+ my $action;
+
+ if (@ARGV && exists $actions{$ARGV[0]}) {
+ $action = shift @ARGV;
+ }
+ $actions{$action || "help"}->($action || ());
+}
+
+handler();
+exit;
+
+# Handler functions.
+# ------------------
+#
+# The following subs are handlers for each entry in %actions.
+
+sub shell {
+ $|=1;
+ print "rt> ";
+ while (<>) {
+ chomp;
+ next if /^#/ || /^\s*$/;
+
+ @ARGV = shellwords($_);
+ handler();
+ print "rt> ";
+ }
+ print "\n";
+}
+
+sub version {
+ print "rt $VERSION\n";
+}
+
+sub logout {
+ submit("$REST/logout") if defined $session->cookie;
+}
+
+my %help;
+sub help {
+ my ($action, $type) = @_;
+ my $key;
+
+ # What help topics do we know about?
+ if (!%help) {
+ local $/ = undef;
+ foreach my $item (@{ Form::parse(<DATA>) }) {
+ my $title = $item->[2]{Title};
+ my @titles = ref $title eq 'ARRAY' ? @$title : $title;
+
+ foreach $title (grep $_, @titles) {
+ $help{$title} = $item->[2]{Text};
+ }
+ }
+ }
+
+ # What does the user want help with?
+ undef $action if ($action && $actions{$action} eq \&help);
+ unless ($action || $type) {
+ # If we don't know, we'll look for clues in @ARGV.
+ foreach (@ARGV) {
+ if (exists $help{$_}) { $key = $_; last; }
+ }
+ unless ($key) {
+ # Tolerate possibly plural words.
+ foreach (@ARGV) {
+ if ($_ =~ s/s$// && exists $help{$_}) { $key = $_; last; }
+ }
+ }
+ }
+
+ if ($type && $action) {
+ $key = "$type.$action";
+ }
+ $key ||= $type || $action || "introduction";
+
+ # Find a suitable topic to display.
+ while (!exists $help{$key}) {
+ if ($type && $action) {
+ if ($key eq "$type.$action") { $key = $action; }
+ elsif ($key eq $action) { $key = $type; }
+ else { $key = "introduction"; }
+ }
+ else {
+ $key = "introduction";
+ }
+ }
+
+ print STDERR $help{$key}, "\n\n";
+}
+
+# Displays a list of objects that match some specified condition.
+
+sub list {
+ my ($q, $type, %data);
+ my $orderby = $config{orderby};
+
+ if ($config{orderby}) {
+ $data{orderby} = $config{orderby};
+ }
+ my $bad = 0;
+
+ while (@ARGV) {
+ $_ = shift @ARGV;
+
+ if (/^-t$/) {
+ $bad = 1, last unless defined($type = get_type_argument());
+ }
+ elsif (/^-S$/) {
+ $bad = 1, last unless get_var_argument(\%data);
+ }
+ elsif (/^-o$/) {
+ $data{'orderby'} = shift @ARGV;
+ }
+ elsif (/^-([isl])$/) {
+ $data{format} = $1;
+ }
+ elsif (/^-f$/) {
+ if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
+ whine "No valid field list in '-f $ARGV[0]'.";
+ $bad = 1; last;
+ }
+ $data{fields} = shift @ARGV;
+ }
+ elsif (!defined $q && !/^-/) {
+ $q = $_;
+ }
+ else {
+ my $datum = /^-/ ? "option" : "argument";
+ whine "Unrecognised $datum '$_'.";
+ $bad = 1; last;
+ }
+ }
+ if (!defined $q) {
+ $q = $config{query};
+ }
+
+ $type ||= "ticket";
+ unless ($type && defined $q) {
+ my $item = $type ? "query string" : "object type";
+ whine "No $item specified.";
+ $bad = 1;
+ }
+ return help("list", $type) if $bad;
+
+ my $r = submit("$REST/search/$type", { query => $q, %data });
+ print $r->content;
+}
+
+# Displays selected information about a single object.
+
+sub show {
+ my ($type, @objects, %data);
+ my $slurped = 0;
+ my $bad = 0;
+
+ while (@ARGV) {
+ $_ = shift @ARGV;
+
+ if (/^-t$/) {
+ $bad = 1, last unless defined($type = get_type_argument());
+ }
+ elsif (/^-S$/) {
+ $bad = 1, last unless get_var_argument(\%data);
+ }
+ elsif (/^-([isl])$/) {
+ $data{format} = $1;
+ }
+ elsif (/^-$/ && !$slurped) {
+ chomp(my @lines = <STDIN>);
+ foreach (@lines) {
+ unless (is_object_spec($_, $type)) {
+ whine "Invalid object on STDIN: '$_'.";
+ $bad = 1; last;
+ }
+ push @objects, $_;
+ }
+ $slurped = 1;
+ }
+ elsif (/^-f$/) {
+ if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
+ whine "No valid field list in '-f $ARGV[0]'.";
+ $bad = 1; last;
+ }
+ $data{fields} = shift @ARGV;
+ }
+ elsif (my $spec = is_object_spec($_, $type)) {
+ push @objects, $spec;
+ }
+ else {
+ my $datum = /^-/ ? "option" : "argument";
+ whine "Unrecognised $datum '$_'.";
+ $bad = 1; last;
+ }
+ }
+
+ unless (@objects) {
+ whine "No objects specified.";
+ $bad = 1;
+ }
+ return help("show", $type) if $bad;
+
+ my $r = submit("$REST/show", { id => \@objects, %data });
+ print $r->content;
+}
+
+# To create a new object, we ask the server for a form with the defaults
+# filled in, allow the user to edit it, and send the form back.
+#
+# To edit an object, we must ask the server for a form representing that
+# object, make changes requested by the user (either on the command line
+# or interactively via $EDITOR), and send the form back.
+
+sub edit {
+ my ($action) = @_;
+ my (%data, $type, @objects);
+ my ($cl, $text, $edit, $input, $output);
+
+ use vars qw(%set %add %del);
+ %set = %add = %del = ();
+ my $slurped = 0;
+ my $bad = 0;
+
+ while (@ARGV) {
+ $_ = shift @ARGV;
+
+ if (/^-e$/) { $edit = 1 }
+ elsif (/^-i$/) { $input = 1 }
+ elsif (/^-o$/) { $output = 1 }
+ elsif (/^-t$/) {
+ $bad = 1, last unless defined($type = get_type_argument());
+ }
+ elsif (/^-S$/) {
+ $bad = 1, last unless get_var_argument(\%data);
+ }
+ elsif (/^-$/ && !($slurped || $input)) {
+ chomp(my @lines = <STDIN>);
+ foreach (@lines) {
+ unless (is_object_spec($_, $type)) {
+ whine "Invalid object on STDIN: '$_'.";
+ $bad = 1; last;
+ }
+ push @objects, $_;
+ }
+ $slurped = 1;
+ }
+ elsif (/^set$/i) {
+ my $vars = 0;
+
+ while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/) {
+ my ($key, $op, $val) = ($1, $2, $3);
+ my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del;
+
+ vpush($hash, lc $key, $val);
+ shift @ARGV;
+ $vars++;
+ }
+ unless ($vars) {
+ whine "No variables to set.";
+ $bad = 1; last;
+ }
+ $cl = $vars;
+ }
+ elsif (/^(?:add|del)$/i) {
+ my $vars = 0;
+ my $hash = ($_ eq "add") ? \%add : \%del;
+
+ while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/) {
+ my ($key, $val) = ($1, $2);
+
+ vpush($hash, lc $key, $val);
+ shift @ARGV;
+ $vars++;
+ }
+ unless ($vars) {
+ whine "No variables to set.";
+ $bad = 1; last;
+ }
+ $cl = $vars;
+ }
+ elsif (my $spec = is_object_spec($_, $type)) {
+ push @objects, $spec;
+ }
+ else {
+ my $datum = /^-/ ? "option" : "argument";
+ whine "Unrecognised $datum '$_'.";
+ $bad = 1; last;
+ }
+ }
+
+ if ($action =~ /^ed(?:it)?$/) {
+ unless (@objects) {
+ whine "No objects specified.";
+ $bad = 1;
+ }
+ }
+ else {
+ if (@objects) {
+ whine "You shouldn't specify objects as arguments to $action.";
+ $bad = 1;
+ }
+ unless ($type) {
+ whine "What type of object do you want to create?";
+ $bad = 1;
+ }
+ @objects = ("$type/new");
+ }
+ return help($action, $type) if $bad;
+
+ # We need a form to make changes to. We usually ask the server for
+ # one, but we can avoid that if we are fed one on STDIN, or if the
+ # user doesn't want to edit the form by hand, and the command line
+ # specifies only simple variable assignments.
+
+ if ($input) {
+ local $/ = undef;
+ $text = <STDIN>;
+ }
+ elsif ($edit || %add || %del || !$cl) {
+ my $r = submit("$REST/show", { id => \@objects, format => 'l' });
+ $text = $r->content;
+ }
+
+ # If any changes were specified on the command line, apply them.
+ if ($cl) {
+ if ($text) {
+ # We're updating forms from the server.
+ my $forms = Form::parse($text);
+
+ foreach my $form (@$forms) {
+ my ($c, $o, $k, $e) = @$form;
+ my ($key, $val);
+
+ next if ($e || !@$o);
+
+ local %add = %add;
+ local %del = %del;
+ local %set = %set;
+
+ # Make changes to existing fields.
+ foreach $key (@$o) {
+ if (exists $add{lc $key}) {
+ $val = delete $add{lc $key};
+ vpush($k, $key, $val);
+ $k->{$key} = vsplit($k->{$key}) if $val =~ /[,\n]/;
+ }
+ if (exists $del{lc $key}) {
+ $val = delete $del{lc $key};
+ my %val = map {$_=>1} @{ vsplit($val) };
+ $k->{$key} = vsplit($k->{$key});
+ @{$k->{$key}} = grep {!exists $val{$_}} @{$k->{$key}};
+ }
+ if (exists $set{lc $key}) {
+ $k->{$key} = delete $set{lc $key};
+ }
+ }
+
+ # Then update the others.
+ foreach $key (keys %set) { vpush($k, $key, $set{$key}) }
+ foreach $key (keys %add) {
+ vpush($k, $key, $add{$key});
+ $k->{$key} = vsplit($k->{$key});
+ }
+ push @$o, (keys %add, keys %set);
+ }
+
+ $text = Form::compose($forms);
+ }
+ else {
+ # We're rolling our own set of forms.
+ my @forms;
+ foreach (@objects) {
+ my ($type, $ids, $args) =
+ m{^($name)/($idlist|$labels)(?:(/.*))?$}o;
+
+ $args ||= "";
+ foreach my $obj (expand_list($ids)) {
+ my %set = (%set, id => "$type/$obj$args");
+ push @forms, ["", [keys %set], \%set];
+ }
+ }
+ $text = Form::compose(\@forms);
+ }
+ }
+
+ if ($output) {
+ print $text;
+ return;
+ }
+
+ my $synerr = 0;
+
+EDIT:
+ # We'll let the user edit the form before sending it to the server,
+ # unless we have enough information to submit it non-interactively.
+ if ($edit || (!$input && !$cl)) {
+ my $newtext = vi($text);
+ # We won't resubmit a bad form unless it was changed.
+ $text = ($synerr && $newtext eq $text) ? undef : $newtext;
+ }
+
+ if ($text) {
+ my $r = submit("$REST/edit", {content => $text, %data});
+ if ($r->code == 409) {
+ # If we submitted a bad form, we'll give the user a chance
+ # to correct it and resubmit.
+ if ($edit || (!$input && !$cl)) {
+ $text = $r->content;
+ $synerr = 1;
+ goto EDIT;
+ }
+ else {
+ print $r->content;
+ return;
+ }
+ }
+ print $r->content;
+ }
+}
+
+# We roll "comment" and "correspond" into the same handler.
+
+sub comment {
+ my ($action) = @_;
+ my (%data, $id, @files, @bcc, @cc, $msg, $wtime, $edit);
+ my $bad = 0;
+
+ while (@ARGV) {
+ $_ = shift @ARGV;
+
+ if (/^-e$/) {
+ $edit = 1;
+ }
+ elsif (/^-[abcmw]$/) {
+ unless (@ARGV) {
+ whine "No argument specified with $_.";
+ $bad = 1; last;
+ }
+
+ if (/-a/) {
+ unless (-f $ARGV[0] && -r $ARGV[0]) {
+ whine "Cannot read attachment: '$ARGV[0]'.";
+ return;
+ }
+ push @files, shift @ARGV;
+ }
+ elsif (/-([bc])/) {
+ my $a = $_ eq "-b" ? \@bcc : \@cc;
+ @$a = split /\s*,\s*/, shift @ARGV;
+ }
+ elsif (/-m/) {
+ $msg = shift @ARGV;
+ if ( $msg =~ /^-$/ ) {
+ undef $msg;
+ while (<STDIN>) { $msg .= $_ }
+ }
+ }
+
+ elsif (/-w/) { $wtime = shift @ARGV }
+ }
+ elsif (!$id && m|^(?:ticket/)?($idlist)$|) {
+ $id = $1;
+ }
+ else {
+ my $datum = /^-/ ? "option" : "argument";
+ whine "Unrecognised $datum '$_'.";
+ $bad = 1; last;
+ }
+ }
+
+ unless ($id) {
+ whine "No object specified.";
+ $bad = 1;
+ }
+ return help($action, "ticket") if $bad;
+
+ my $form = [
+ "",
+ [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Text" ],
+ {
+ Ticket => $id,
+ Action => $action,
+ Cc => [ @cc ],
+ Bcc => [ @bcc ],
+ Attachment => [ @files ],
+ TimeWorked => $wtime || '',
+ Text => $msg || '',
+ Status => ''
+ }
+ ];
+
+ my $text = Form::compose([ $form ]);
+
+ if ($edit || !$msg) {
+ my $error = 0;
+ my ($c, $o, $k, $e);
+
+ do {
+ my $ntext = vi($text);
+ return if ($error && $ntext eq $text);
+ $text = $ntext;
+ $form = Form::parse($text);
+ $error = 0;
+
+ ($c, $o, $k, $e) = @{ $form->[0] };
+ if ($e) {
+ $error = 1;
+ $c = "# Syntax error.";
+ goto NEXT;
+ }
+ elsif (!@$o) {
+ return;
+ }
+ @files = @{ vsplit($k->{Attachment}) };
+
+ NEXT:
+ $text = Form::compose([[$c, $o, $k, $e]]);
+ } while ($error);
+ }
+
+ my $i = 1;
+ foreach my $file (@files) {
+ $data{"attachment_$i"} = bless([ $file ], "Attachment");
+ $i++;
+ }
+ $data{content} = $text;
+
+ my $r = submit("$REST/ticket/comment/$id", \%data);
+ print $r->content;
+}
+
+# Merge one ticket into another.
+
+sub merge {
+ my @id;
+ my $bad = 0;
+
+ while (@ARGV) {
+ $_ = shift @ARGV;
+
+ if (/^\d+$/) {
+ push @id, $_;
+ }
+ else {
+ whine "Unrecognised argument: '$_'.";
+ $bad = 1; last;
+ }
+ }
+
+ unless (@id == 2) {
+ my $evil = @id > 2 ? "many" : "few";
+ whine "Too $evil arguments specified.";
+ $bad = 1;
+ }
+ return help("merge", "ticket") if $bad;
+
+ my $r = submit("$REST/ticket/merge/$id[0]", {into => $id[1]});
+ print $r->content;
+}
+
+# Link one ticket to another.
+
+sub link {
+ my ($bad, $del, %data) = (0, 0, ());
+ my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo
+ ReferredToBy HasMember MemberOf);
+
+ while (@ARGV && $ARGV[0] =~ /^-/) {
+ $_ = shift @ARGV;
+
+ if (/^-d$/) {
+ $del = 1;
+ }
+ else {
+ whine "Unrecognised option: '$_'.";
+ $bad = 1; last;
+ }
+ }
+
+ if (@ARGV == 3) {
+ my ($from, $rel, $to) = @ARGV;
+ if ($from !~ /^\d+$/ || $to !~ /^\d+$/) {
+ my $bad = $from =~ /^\d+$/ ? $to : $from;
+ whine "Invalid ticket ID '$bad' specified.";
+ $bad = 1;
+ }
+ unless (exists $ltypes{lc $rel}) {
+ whine "Invalid link '$rel' specified.";
+ $bad = 1;
+ }
+ %data = (id => $from, rel => $rel, to => $to, del => $del);
+ }
+ else {
+ my $bad = @ARGV < 3 ? "few" : "many";
+ whine "Too $bad arguments specified.";
+ $bad = 1;
+ }
+ return help("link", "ticket") if $bad;
+
+ my $r = submit("$REST/ticket/link", \%data);
+ print $r->content;
+}
+
+# Grant/revoke a user's rights.
+
+sub grant {
+ my ($cmd) = @_;
+
+ my $revoke = 0;
+ while (@ARGV) {
+ }
+
+ $revoke = 1 if $cmd->{action} eq 'revoke';
+}
+
+# Client <-> Server communication.
+# --------------------------------
+#
+# This function composes and sends an HTTP request to the RT server, and
+# interprets the response. It takes a request URI, and optional request
+# data (a string, or a reference to a set of key-value pairs).
+
+sub submit {
+ my ($uri, $content) = @_;
+ my ($req, $data);
+ my $ua = new LWP::UserAgent(agent => "RT/3.0b", env_proxy => 1);
+
+ # Did the caller specify any data to send with the request?
+ $data = [];
+ if (defined $content) {
+ unless (ref $content) {
+ # If it's just a string, make sure LWP handles it properly.
+ # (By pretending that it's a file!)
+ $content = [ content => [undef, "", Content => $content] ];
+ }
+ elsif (ref $content eq 'HASH') {
+ my @data;
+ foreach my $k (keys %$content) {
+ if (ref $content->{$k} eq 'ARRAY') {
+ foreach my $v (@{ $content->{$k} }) {
+ push @data, $k, $v;
+ }
+ }
+ else { push @data, $k, $content->{$k} }
+ }
+ $content = \@data;
+ }
+ $data = $content;
+ }
+
+ # Should we send authentication information to start a new session?
+ if (!defined $session->cookie) {
+ push @$data, ( user => $config{user} );
+ push @$data, ( pass => $config{passwd} || read_passwd() );
+ }
+
+ # Now, we construct the request.
+ if (@$data) {
+ $req = POST($uri, $data, Content_Type => 'form-data');
+ }
+ else {
+ $req = GET($uri);
+ }
+ $session->add_cookie_header($req);
+
+ # Then we send the request and parse the response.
+ DEBUG(3, $req->as_string);
+ my $res = $ua->request($req);
+ DEBUG(3, $res->as_string);
+
+ if ($res->is_success) {
+ # The content of the response we get from the RT server consists
+ # of an HTTP-like status line followed by optional header lines,
+ # a blank line, and arbitrary text.
+
+ my ($head, $text) = split /\n\n/, $res->content, 2;
+ my ($status, @headers) = split /\n/, $head;
+ $text =~ s/\n*$/\n/ if ($text);
+
+ # "RT/3.0.1 401 Credentials required"
+ if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) {
+ warn "rt: Malformed RT response from $config{server}.\n";
+ warn "(Rerun with RTDEBUG=3 for details.)\n" if $config{debug} < 3;
+ exit -1;
+ }
+
+ # Our caller can pretend that the server returned a custom HTTP
+ # response code and message. (Doing that directly is apparently
+ # not sufficiently portable and uncomplicated.)
+ $res->code($1);
+ $res->message($2);
+ $res->content($text);
+ $session->update($res) if ($res->is_success || $res->code != 401);
+
+ if (!$res->is_success) {
+ # We can deal with authentication failures ourselves. Either
+ # we sent invalid credentials, or our session has expired.
+ if ($res->code == 401) {
+ my %d = @$data;
+ if (exists $d{user}) {
+ warn "rt: Incorrect username or password.\n";
+ exit -1;
+ }
+ elsif ($req->header("Cookie")) {
+ # We'll retry the request with credentials, unless
+ # we only wanted to logout in the first place.
+ $session->delete;
+ return submit(@_) unless $uri eq "$REST/logout";
+ }
+ }
+ # Conflicts should be dealt with by the handler and user.
+ # For anything else, we just die.
+ elsif ($res->code != 409) {
+ warn "rt: ", $res->content;
+ exit;
+ }
+ }
+ }
+ else {
+ warn "rt: Server error: ", $res->message, " (", $res->code, ")\n";
+ exit -1;
+ }
+
+ return $res;
+}
+
+# Session management.
+# -------------------
+#
+# Maintains a list of active sessions in the ~/.rt_sessions file.
+{
+ package Session;
+ my ($s, $u);
+
+ # Initialises the session cache.
+ sub new {
+ my ($class, $file) = @_;
+ my $self = {
+ file => $file || "$HOME/.rt_sessions",
+ sids => { }
+ };
+
+ # The current session is identified by the currently configured
+ # server and user.
+ ($s, $u) = @config{"server", "user"};
+
+ bless $self, $class;
+ $self->load();
+
+ return $self;
+ }
+
+ # Returns the current session cookie.
+ sub cookie {
+ my ($self) = @_;
+ my $cookie = $self->{sids}{$s}{$u};
+ return defined $cookie ? "RT_SID_$cookie" : undef;
+ }
+
+ # Deletes the current session cookie.
+ sub delete {
+ my ($self) = @_;
+ delete $self->{sids}{$s}{$u};
+ }
+
+ # Adds a Cookie header to an outgoing HTTP request.
+ sub add_cookie_header {
+ my ($self, $request) = @_;
+ my $cookie = $self->cookie();
+
+ $request->header(Cookie => $cookie) if defined $cookie;
+ }
+
+ # Extracts the Set-Cookie header from an HTTP response, and updates
+ # session information accordingly.
+ sub update {
+ my ($self, $response) = @_;
+ my $cookie = $response->header("Set-Cookie");
+
+ if (defined $cookie && $cookie =~ /^RT_SID_(.[^;,\s]+=[0-9A-Fa-f]+);/) {
+ $self->{sids}{$s}{$u} = $1;
+ }
+ }
+
+ # Loads the session cache from the specified file.
+ sub load {
+ my ($self, $file) = @_;
+ $file ||= $self->{file};
+ local *F;
+
+ open(F, $file) && do {
+ $self->{file} = $file;
+ my $sids = $self->{sids} = {};
+ while (<F>) {
+ chomp;
+ next if /^$/ || /^#/;
+ next unless m#^https?://[^ ]+ \w+ [^;,\s]+=[0-9A-Fa-f]+$#;
+ my ($server, $user, $cookie) = split / /, $_;
+ $sids->{$server}{$user} = $cookie;
+ }
+ return 1;
+ };
+ return 0;
+ }
+
+ # Writes the current session cache to the specified file.
+ sub save {
+ my ($self, $file) = shift;
+ $file ||= $self->{file};
+ local *F;
+
+ open(F, ">$file") && do {
+ my $sids = $self->{sids};
+ foreach my $server (keys %$sids) {
+ foreach my $user (keys %{ $sids->{$server} }) {
+ my $sid = $sids->{$server}{$user};
+ if (defined $sid) {
+ print F "$server $user $sid\n";
+ }
+ }
+ }
+ close(F);
+ chmod 0600, $file;
+ return 1;
+ };
+ return 0;
+ }
+
+ sub DESTROY {
+ my $self = shift;
+ $self->save;
+ }
+}
+
+# Form handling.
+# --------------
+#
+# Forms are RFC822-style sets of (field, value) specifications with some
+# initial comments and interspersed blank lines allowed for convenience.
+# Sets of forms are separated by --\n (in a cheap parody of MIME).
+#
+# Each form is parsed into an array with four elements: commented text
+# at the start of the form, an array with the order of keys, a hash with
+# key/value pairs, and optional error text if the form syntax was wrong.
+
+# Returns a reference to an array of parsed forms.
+sub Form::parse {
+ my $state = 0;
+ my @forms = ();
+ my @lines = split /\n/, $_[0];
+ my ($c, $o, $k, $e) = ("", [], {}, "");
+
+ LINE:
+ while (@lines) {
+ my $line = shift @lines;
+
+ next LINE if $line eq '';
+
+ if ($line eq '--') {
+ # We reached the end of one form. We'll ignore it if it was
+ # empty, and store it otherwise, errors and all.
+ if ($e || $c || @$o) {
+ push @forms, [ $c, $o, $k, $e ];
+ $c = ""; $o = []; $k = {}; $e = "";
+ }
+ $state = 0;
+ }
+ elsif ($state != -1) {
+ if ($state == 0 && $line =~ /^#/) {
+ # Read an optional block of comments (only) at the start
+ # of the form.
+ $state = 1;
+ $c = $line;
+ while (@lines && $lines[0] =~ /^#/) {
+ $c .= "\n".shift @lines;
+ }
+ $c .= "\n";
+ }
+ elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/) {
+ # Read a field: value specification.
+ my $f = $1;
+ my @v = ($2 || ());
+
+ # Read continuation lines, if any.
+ while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) {
+ push @v, shift @lines;
+ }
+ pop @v while (@v && $v[-1] eq '');
+
+ # Strip longest common leading indent from text.
+ my $ws = "";
+ foreach my $ls (map {/^(\s+)/} @v[1..$#v]) {
+ $ws = $ls if (!$ws || length($ls) < length($ws));
+ }
+ s/^$ws// foreach @v;
+
+ push(@$o, $f) unless exists $k->{$f};
+ vpush($k, $f, join("\n", @v));
+
+ $state = 1;
+ }
+ elsif ($line !~ /^#/) {
+ # We've found a syntax error, so we'll reconstruct the
+ # form parsed thus far, and add an error marker. (>>)
+ $state = -1;
+ $e = Form::compose([[ "", $o, $k, "" ]]);
+ $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n";
+ }
+ }
+ else {
+ # We saw a syntax error earlier, so we'll accumulate the
+ # contents of this form until the end.
+ $e .= "$line\n";
+ }
+ }
+ push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o);
+
+ foreach my $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;
+
+ foreach my $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;
+
+ foreach my $key (@$o) {
+ my ($line, $sp);
+ my $v = $k->{$key};
+ my @values = ref $v eq 'ARRAY' ? @$v : $v;
+
+ $sp = " "x(length("$key: "));
+ $sp = " "x4 if length($sp) > 16;
+
+ foreach $v (@values) {
+ if ($v =~ /\n/) {
+ $v =~ s/^/$sp/gm;
+ $v =~ s/^$sp//;
+
+ if ($line) {
+ push @lines, "$line\n\n";
+ $line = "";
+ }
+ elsif (@lines && $lines[-1] !~ /\n\n$/) {
+ $lines[-1] .= "\n";
+ }
+ push @lines, "$key: $v\n\n";
+ }
+ elsif ($line &&
+ length($line)+length($v)-rindex($line, "\n") >= 70)
+ {
+ $line .= ",\n$sp$v";
+ }
+ else {
+ $line = $line ? "$line, $v" : "$key: $v";
+ }
+ }
+
+ $line = "$key:" unless @values;
+ if ($line) {
+ if ($line =~ /\n/) {
+ if (@lines && $lines[-1] !~ /\n\n$/) {
+ $lines[-1] .= "\n";
+ }
+ $line .= "\n";
+ }
+ push @lines, "$line\n";
+ }
+ }
+
+ $text .= join "", @lines;
+ }
+ else {
+ chomp $text;
+ }
+ push @text, $text;
+ }
+
+ return join "\n--\n\n", @text;
+}
+
+# Configuration.
+# --------------
+
+# Returns configuration information from the environment.
+sub config_from_env {
+ my %env;
+
+ foreach my $k ("DEBUG", "USER", "PASSWD", "SERVER", "QUERY", "ORDERBY") {
+ if (exists $ENV{"RT$k"}) {
+ $env{lc $k} = $ENV{"RT$k"};
+ }
+ }
+
+ return %env;
+}
+
+# Finds a suitable configuration file and returns information from it.
+sub config_from_file {
+ my ($rc) = @_;
+
+ if ($rc =~ m#^/#) {
+ # We'll use an absolute path if we were given one.
+ return parse_config_file($rc);
+ }
+ else {
+ # Otherwise we'll use the first file we can find in the current
+ # directory, or in one of its (increasingly distant) ancestors.
+
+ my @dirs = split /\//, cwd;
+ while (@dirs) {
+ my $file = join('/', @dirs, $rc);
+ if (-r $file) {
+ return parse_config_file($file);
+ }
+
+ # Remove the last directory component each time.
+ pop @dirs;
+ }
+
+ # Still nothing? We'll fall back to some likely defaults.
+ for ("$HOME/$rc", "/etc/rt.conf") {
+ return parse_config_file($_) if (-r $_);
+ }
+ }
+
+ return ();
+}
+
+# Makes a hash of the specified configuration file.
+sub parse_config_file {
+ my %cfg;
+ my ($file) = @_;
+ local $_; # $_ may be aliased to a constant, from line 1163
+
+ open(CFG, $file) && do {
+ while (<CFG>) {
+ chomp;
+ next if (/^#/ || /^\s*$/);
+
+ if (/^(user|passwd|server|query|orderby)\s+(.*)\s?$/) {
+ $cfg{$1} = $2;
+ }
+ else {
+ die "rt: $file:$.: unknown configuration directive.\n";
+ }
+ }
+ };
+
+ return %cfg;
+}
+
+# Helper functions.
+# -----------------
+
+sub whine {
+ my $sub = (caller(1))[3];
+ $sub =~ s/^main:://;
+ warn "rt: $sub: @_\n";
+ return;
+}
+
+sub read_passwd {
+ eval 'require Term::ReadKey';
+ if ($@) {
+ die "No password specified (and Term::ReadKey not installed).\n";
+ }
+
+ print "Password: ";
+ Term::ReadKey::ReadMode('noecho');
+ chomp(my $passwd = Term::ReadKey::ReadLine(0));
+ Term::ReadKey::ReadMode('restore');
+ print "\n";
+
+ return $passwd;
+}
+
+sub vi {
+ my ($text) = @_;
+ my $file = "/tmp/rt.form.$$";
+ my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi";
+
+ local *F;
+ local $/ = undef;
+
+ open(F, ">$file") || die "$file: $!\n"; print F $text; close(F);
+ system($editor, $file) && die "Couldn't run $editor.\n";
+ open(F, $file) || die "$file: $!\n"; $text = <F>; close(F);
+ unlink($file);
+
+ return $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 ($word, @words);
+ my @values = ref $val eq 'ARRAY' ? @$val : $val;
+
+ foreach my $line (map {split /\n/} @values) {
+ # XXX: This should become a real parser, à la Text::ParseWords.
+ $line =~ s/^\s+//;
+ $line =~ s/\s+$//;
+ push @words, split /\s*,\s*/, $line;
+ }
+
+ return \@words;
+}
+
+sub expand_list {
+ my ($list) = @_;
+ my ($elt, @elts, %elts);
+
+ foreach $elt (split /,/, $list) {
+ if ($elt =~ /^(\d+)-(\d+)$/) { push @elts, ($1..$2) }
+ else { push @elts, $elt }
+ }
+
+ @elts{@elts}=();
+ return sort {$a<=>$b} keys %elts;
+}
+
+sub get_type_argument {
+ my $type;
+
+ if (@ARGV) {
+ $type = shift @ARGV;
+ unless ($type =~ /^[A-Za-z0-9_.-]+$/) {
+ # We want whine to mention our caller, not us.
+ @_ = ("Invalid type '$type' specified.");
+ goto &whine;
+ }
+ }
+ else {
+ @_ = ("No type argument specified with -t.");
+ goto &whine;
+ }
+
+ $type =~ s/s$//; # "Plural". Ugh.
+ return $type;
+}
+
+sub get_var_argument {
+ my ($data) = @_;
+
+ if (@ARGV) {
+ my $kv = shift @ARGV;
+ if (my ($k, $v) = $kv =~ /^($field)=(.*)$/) {
+ push @{ $data->{$k} }, $v;
+ }
+ else {
+ @_ = ("Invalid variable specification: '$kv'.");
+ goto &whine;
+ }
+ }
+ else {
+ @_ = ("No variable argument specified with -S.");
+ goto &whine;
+ }
+}
+
+sub is_object_spec {
+ my ($spec, $type) = @_;
+
+ $spec =~ s|^(?:$type/)?|$type/| if defined $type;
+ return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o);
+ return;
+}
+
+__DATA__
+
+Title: intro
+Title: introduction
+Text:
+
+ ** THIS IS AN UNSUPPORTED PREVIEW RELEASE **
+ ** PLEASE REPORT BUGS TO rt-bugs@fsck.com **
+
+ This is a command-line interface to RT 3.
+
+ It allows you to interact with an RT server over HTTP, and offers an
+ interface to RT's functionality that is better-suited to automation
+ and integration with other tools.
+
+ In general, each invocation of this program should specify an action
+ to perform on one or more objects, and any other arguments required
+ to complete the desired action.
+
+ For more information:
+
+ - rt help actions (a list of possible actions)
+ - rt help objects (how to specify objects)
+ - rt help usage (syntax information)
+
+ - rt help config (configuration details)
+ - rt help examples (a few useful examples)
+ - rt help topics (a list of help topics)
+
+--
+
+Title: usage
+Title: syntax
+Text:
+
+ Syntax:
+
+ rt <action> [options] [arguments]
+
+ Each invocation of this program must specify an action (e.g. "edit",
+ "create"), options to modify behaviour, and other arguments required
+ by the specified action. (For example, most actions expect a list of
+ numeric object IDs to act upon.)
+
+ The details of the syntax and arguments for each action are given by
+ "rt help <action>". Some actions may be referred to by more than one
+ name ("create" is the same as "new", for example).
+
+ Objects are identified by a type and an ID (which can be a name or a
+ number, depending on the type). For some actions, the object type is
+ implied (you can only comment on tickets); for others, the user must
+ specify it explicitly. See "rt help objects" for details.
+
+ In syntax descriptions, mandatory arguments that must be replaced by
+ appropriate value are enclosed in <>, and optional arguments are
+ indicated by [] (for example, <action> and [options] above).
+
+ For more information:
+
+ - rt help objects (how to specify objects)
+ - rt help actions (a list of actions)
+ - rt help types (a list of object types)
+
+--
+
+Title: conf
+Title: config
+Title: configuration
+Text:
+
+ This program has two major sources of configuration information: its
+ configuration files, and the environment.
+
+ The program looks for configuration directives in a file named .rtrc
+ (or $RTCONFIG; see below) in the current directory, and then in more
+ distant ancestors, until it reaches /. If no suitable configuration
+ files are found, it will also check for ~/.rtrc and /etc/rt.conf.
+
+ Configuration directives:
+
+ The following directives may occur, one per line:
+
+ - server <URL> URL to RT server.
+ - user <username> RT username.
+ - passwd <passwd> RT user's password.
+ - query <RT Query> Default RT Query for list action
+ - orderby <order> Default RT order for list action
+
+ Blank and #-commented lines are ignored.
+
+ Environment variables:
+
+ The following environment variables override any corresponding
+ values defined in configuration files:
+
+ - RTUSER
+ - RTPASSWD
+ - RTSERVER
+ - RTDEBUG Numeric debug level. (Set to 3 for full logs.)
+ - RTCONFIG Specifies a name other than ".rtrc" for the
+ configuration file.
+ - RTQUERY Default RT Query for rt list
+ - RTORDERBY Default order for rt list
+
+--
+
+Title: objects
+Text:
+
+ Syntax:
+
+ <type>/<id>[/<attributes>]
+
+ Every object in RT has a type (e.g. "ticket", "queue") and a numeric
+ ID. Some types of objects can also be identified by name (like users
+ and queues). Furthermore, objects may have named attributes (such as
+ "ticket/1/history").
+
+ An object specification is like a path in a virtual filesystem, with
+ object types as top-level directories, object IDs as subdirectories,
+ and named attributes as further subdirectories.
+
+ A comma-separated list of names, numeric IDs, or numeric ranges can
+ be used to specify more than one object of the same type. Note that
+ the list must be a single argument (i.e., no spaces). For example,
+ "user/root,1-3,5,7-10,ams" is a list of ten users; the same list
+ can also be written as "user/ams,root,1,2,3,5,7,8-10".
+
+ Examples:
+
+ ticket/1
+ ticket/1/attachments
+ ticket/1/attachments/3
+ ticket/1/attachments/3/content
+ ticket/1-3/links
+ ticket/1-3,5-7/history
+
+ user/ams
+ user/ams/rights
+ user/ams,rai,1/rights
+
+ For more information:
+
+ - rt help <action> (action-specific details)
+ - rt help <type> (type-specific details)
+
+--
+
+Title: actions
+Title: commands
+Text:
+
+ You can currently perform the following actions on all objects:
+
+ - list (list objects matching some condition)
+ - show (display object details)
+ - edit (edit object details)
+ - create (create a new object)
+
+ Each type may define actions specific to itself; these are listed in
+ the help item about that type.
+
+ For more information:
+
+ - rt help <action> (action-specific details)
+ - rt help types (a list of possible types)
+
+--
+
+Title: types
+Text:
+
+ You can currently operate on the following types of objects:
+
+ - tickets
+ - users
+ - groups
+ - queues
+
+ For more information:
+
+ - rt help <type> (type-specific details)
+ - rt help objects (how to specify objects)
+ - rt help actions (a list of possible actions)
+
+--
+
+Title: ticket
+Text:
+
+ Tickets are identified by a numeric ID.
+
+ The following generic operations may be performed upon tickets:
+
+ - list
+ - show
+ - edit
+ - create
+
+ In addition, the following ticket-specific actions exist:
+
+ - link
+ - merge
+ - comment
+ - correspond
+
+ Attributes:
+
+ The following attributes can be used with "rt show" or "rt edit"
+ to retrieve or edit other information associated with tickets:
+
+ links A ticket's relationships with others.
+ history All of a ticket's transactions.
+ history/type/<type> Only a particular type of transaction.
+ history/id/<id> Only the transaction of the specified id.
+ attachments A list of attachments.
+ attachments/<id> The metadata for an individual attachment.
+ attachments/<id>/content The content of an individual attachment.
+
+--
+
+Title: user
+Title: group
+Text:
+
+ Users and groups are identified by name or numeric ID.
+
+ The following generic operations may be performed upon them:
+
+ - list
+ - show
+ - edit
+ - create
+
+ In addition, the following type-specific actions exist:
+
+ - grant
+ - revoke
+
+ Attributes:
+
+ The following attributes can be used with "rt show" or "rt edit"
+ to retrieve or edit other information associated with users and
+ groups:
+
+ rights Global rights granted to this user.
+ rights/<queue> Queue rights for this user.
+
+--
+
+Title: queue
+Text:
+
+ Queues are identified by name or numeric ID.
+
+ Currently, they can be subjected to the following actions:
+
+ - show
+ - edit
+ - create
+
+--
+
+Title: logout
+Text:
+
+ Syntax:
+
+ rt logout
+
+ Terminates the currently established login session. You will need to
+ provide authentication credentials before you can continue using the
+ server. (See "rt help config" for details about authentication.)
+
+--
+
+Title: ls
+Title: list
+Title: search
+Text:
+
+ Syntax:
+
+ rt <ls|list|search> [options] "query string"
+
+ Displays a list of objects matching the specified conditions.
+ ("ls", "list", and "search" are synonyms.)
+
+ Conditions are expressed in the SQL-like syntax used internally by
+ RT3. (For more information, see "rt help query".) The query string
+ must be supplied as one argument.
+
+ (Right now, the server doesn't support listing anything but tickets.
+ Other types will be supported in future; this client will be able to
+ take advantage of that support without any changes.)
+
+ Options:
+
+ The following options control how much information is displayed
+ about each matching object:
+
+ -i Numeric IDs only. (Useful for |rt edit -; see examples.)
+ -s Short description.
+ -l Longer description.
+
+ In addition,
+
+ -o +/-<field> Orders the returned list by the specified field.
+ -S var=val Submits the specified variable with the request.
+ -t type Specifies the type of object to look for. (The
+ default is "ticket".)
+
+ Examples:
+
+ rt ls "Priority > 5 and Status='new'"
+ rt ls -o +Subject "Priority > 5 and Status='new'"
+ rt ls -o -Created "Priority > 5 and Status='new'"
+ rt ls -i "Priority > 5"|rt edit - set status=resolved
+ rt ls -t ticket "Subject like '[PATCH]%'"
+
+--
+
+Title: show
+Text:
+
+ Syntax:
+
+ rt show [options] <object-ids>
+
+ Displays details of the specified objects.
+
+ For some types, object information is further classified into named
+ attributes (for example, "1-3/links" is a valid ticket specification
+ that refers to the links for tickets 1-3). Consult "rt help <type>"
+ and "rt help objects" for further details.
+
+ This command writes a set of forms representing the requested object
+ data to STDOUT.
+
+ Options:
+
+ - Read IDs from STDIN instead of the command-line.
+ -t type Specifies object type.
+ -f a,b,c Restrict the display to the specified fields.
+ -S var=val Submits the specified variable with the request.
+
+ Examples:
+
+ rt show -t ticket -f id,subject,status 1-3
+ rt show ticket/3/attachments/29
+ rt show ticket/3/attachments/29/content
+ rt show ticket/1-3/links
+ rt show -t user 2
+
+--
+
+Title: new
+Title: edit
+Title: create
+Text:
+
+ Syntax:
+
+ rt edit [options] <object-ids> set field=value [field=value] ...
+ add field=value [field=value] ...
+ del field=value [field=value] ...
+
+ Edits information corresponding to the specified objects.
+
+ If, instead of "edit", an action of "new" or "create" is specified,
+ then a new object is created. In this case, no numeric object IDs
+ may be specified, but the syntax and behaviour remain otherwise
+ unchanged.
+
+ This command typically starts an editor to allow you to edit object
+ data in a form for submission. If you specified enough information
+ on the command-line, however, it will make the submission directly.
+
+ The command line may specify field-values in three different ways.
+ "set" sets the named field to the given value, "add" adds a value
+ to a multi-valued field, and "del" deletes the corresponding value.
+ Each "field=value" specification must be given as a single argument.
+
+ For some types, object information is further classified into named
+ attributes (for example, "1-3/links" is a valid ticket specification
+ that refers to the links for tickets 1-3). These attributes may also
+ be edited. Consult "rt help <type>" and "rt help object" for further
+ details.
+
+ Options:
+
+ - Read numeric IDs from STDIN instead of the command-line.
+ (Useful with rt ls ... | rt edit -; see examples below.)
+ -i Read a completed form from STDIN before submitting.
+ -o Dump the completed form to STDOUT instead of submitting.
+ -e Allows you to edit the form even if the command-line has
+ enough information to make a submission directly.
+ -S var=val
+ Submits the specified variable with the request.
+ -t type Specifies object type.
+
+ Examples:
+
+ # Interactive (starts $EDITOR with a form).
+ rt edit ticket/3
+ rt create -t ticket
+
+ # Non-interactive.
+ rt edit ticket/1-3 add cc=foo@example.com set priority=3
+ rt ls -t tickets -i 'Priority > 5' | rt edit - set status=resolved
+ rt edit ticket/4 set priority=3 owner=bar@example.com \
+ add cc=foo@example.com bcc=quux@example.net
+ rt create -t ticket subject='new ticket' priority=10 \
+ add cc=foo@example.com
+
+--
+
+Title: comment
+Title: correspond
+Text:
+
+ Syntax:
+
+ rt <comment|correspond> [options] <ticket-id>
+
+ Adds a comment (or correspondence) to the specified ticket (the only
+ difference being that comments aren't sent to the requestors.)
+
+ This command will typically start an editor and allow you to type a
+ comment into a form. If, however, you specified all the necessary
+ information on the command line, it submits the comment directly.
+
+ (See "rt help forms" for more information about forms.)
+
+ Options:
+
+ -m <text> Specify comment text.
+ -a <file> Attach a file to the comment. (May be used more
+ than once to attach multiple files.)
+ -c <addrs> A comma-separated list of Cc addresses.
+ -b <addrs> A comma-separated list of Bcc addresses.
+ -w <time> Specify the time spent working on this ticket.
+ -e Starts an editor before the submission, even if
+ arguments from the command line were sufficient.
+
+ Examples:
+
+ rt comment -m 'Not worth fixing.' -a stddisclaimer.h 23
+
+--
+
+Title: merge
+Text:
+
+ Syntax:
+
+ rt merge <from-id> <to-id>
+
+ Merges the two specified tickets.
+
+--
+
+Title: link
+Text:
+
+ Syntax:
+
+ rt link [-d] <id-A> <link> <id-B>
+
+ Creates (or, with -d, deletes) a link between the specified tickets.
+ The link can (irrespective of case) be any of:
+
+ DependsOn/DependedOnBy: A depends upon B (or vice versa).
+ RefersTo/ReferredToBy: A refers to B (or vice versa).
+ MemberOf/HasMember: A is a member of B (or vice versa).
+
+ To view a ticket's links, use "rt show ticket/3/links". (See
+ "rt help ticket" and "rt help show".)
+
+ Options:
+
+ -d Deletes the specified link.
+
+ Examples:
+
+ rt link 2 dependson 3
+ rt link -d 4 referredtoby 6 # 6 no longer refers to 4
+
+--
+
+Title: grant
+Title: revoke
+Text:
+
+--
+
+Title: query
+Text:
+
+ RT3 uses an SQL-like syntax to specify object selection constraints.
+ See the <RT:...> documentation for details.
+
+ (XXX: I'm going to have to write it, aren't I?)
+
+--
+
+Title: form
+Title: forms
+Text:
+
+ This program uses RFC822 header-style forms to represent object data
+ in a form that's suitable for processing both by humans and scripts.
+
+ A form is a set of (field, value) specifications, with some initial
+ commented text and interspersed blank lines allowed for convenience.
+ Field names may appear more than once in a form; a comma-separated
+ list of multiple field values may also be specified directly.
+
+ Field values can be wrapped as in RFC822, with leading whitespace.
+ The longest sequence of leading whitespace common to all the lines
+ is removed (preserving further indentation). There is no limit on
+ the length of a value.
+
+ Multiple forms are separated by a line containing only "--\n".
+
+ (XXX: A more detailed specification will be provided soon. For now,
+ the server-side syntax checking will suffice.)
+
+--
+
+Title: topics
+Text:
+
+ Use "rt help <topic>" for help on any of the following subjects:
+
+ - tickets, users, groups, queues.
+ - show, edit, ls/list/search, new/create.
+
+ - query (search query syntax)
+ - forms (form specification)
+
+ - objects (how to specify objects)
+ - types (a list of object types)
+ - actions/commands (a list of actions)
+ - usage/syntax (syntax details)
+ - conf/config/configuration (configuration details)
+ - examples (a few useful examples)
+
+--
+
+Title: example
+Title: examples
+Text:
+
+ This section will be filled in with useful examples, once it becomes
+ more clear what examples may be useful.
+
+ For the moment, please consult examples provided with each action.
+
+--
diff --git a/rt/bin/standalone_httpd.in b/rt/bin/standalone_httpd.in
new file mode 100755
index 000000000..6ba799833
--- /dev/null
+++ b/rt/bin/standalone_httpd.in
@@ -0,0 +1,66 @@
+#!@PERL@ -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# 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;
+
+BEGIN {
+ use lib( "@LOCAL_LIB_PATH@", "@RT_LIB_PATH@");
+ use RT;
+ RT::LoadConfig();
+ if ($RT::DevelMode) { require Module::Refresh; }
+}
+
+RT::Init();
+
+use RT::Interface::Web::Standalone;
+
+my $server = RT::Interface::Web::Standalone->new;
+$server->port(shift @ARGV) if ($ARGV[0]);
+$server->run();
+
+
diff --git a/rt/bin/webmux.pl b/rt/bin/webmux.pl
deleted file mode 100755
index 21cb83f5e..000000000
--- a/rt/bin/webmux.pl
+++ /dev/null
@@ -1,125 +0,0 @@
-#!/usr/bin/perl
-# 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;
-
-BEGIN {
- $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'};
-}
-
-use lib ("/opt/rt3/local/lib", "/opt/rt3/lib");
-use RT;
-
-package RT::Mason;
-
-use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we
- #set private_tempfiles
-
-BEGIN {
- if ($CGI::MOD_PERL) {
- require HTML::Mason::ApacheHandler;
- }
- else {
- require HTML::Mason::CGIHandler;
- }
-}
-
-use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
-
-use vars qw($Nobody $SystemUser $r);
-
-#This drags in RT's config.pm
-RT::LoadConfig();
-
-use Carp;
-
-{
- package HTML::Mason::Commands;
- use vars qw(%session);
-
- use RT::Tickets;
- use RT::Transactions;
- use RT::Users;
- use RT::CurrentUser;
- use RT::Templates;
- use RT::Queues;
- use RT::ScripActions;
- use RT::ScripConditions;
- use RT::Scrips;
- use RT::Groups;
- use RT::GroupMembers;
- use RT::CustomFields;
- use RT::CustomFieldValues;
- use RT::TicketCustomFieldValues;
-
- use RT::Interface::Web;
- use MIME::Entity;
- use Text::Wrapper;
- use CGI::Cookie;
- use Time::ParseDate;
- use HTML::Entities;
-}
-
-
-# Activate the following if running httpd as root (the normal case).
-# Resets ownership of all files created by Mason at startup.
-# Note that mysql uses DB for sessions, so there's no need to do this.
-unless ($RT::DatabaseType =~ /(mysql|Pg)/) {
- # Clean up our umask to protect session files
- umask(0077);
-
-if ( $CGI::MOD_PERL) {
- 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 _ ) );
-}
-
-my $ah = &RT::Interface::Web::NewApacheHandler() if $CGI::MOD_PERL;
-
-sub handler {
- ($r) = @_;
-
- RT::Init();
-
- # We don't need to handle non-text items
- return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io;
-
- my %session;
- my $status = $ah->handle_request($r);
- undef (%session);
-
- $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") if $RT::Handle->TransactionDepth;
- return $status;
-}
-
-1;
diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in
index 12aad85b3..73b10143d 100644
--- a/rt/bin/webmux.pl.in
+++ b/rt/bin/webmux.pl.in
@@ -1,9 +1,15 @@
#!@PERL@
-# BEGIN LICENSE BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
+# <jesse@bestpractical.com>
#
-# (Except where explictly superceded by other copyright notices)
+# (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
@@ -15,110 +21,114 @@
# 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.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
-# END LICENSE BLOCK
-
+# 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;
BEGIN {
- $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need
+ $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'};
+
+ use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we
+ #set private_tempfiles
+
+ die "RT does not support mod_perl 1.99. Please upgrade to mod_perl 2.0"
+ if $ENV{'MOD_PERL'}
+ and $ENV{'MOD_PERL'} =~ m{mod_perl/(?:1\.9)};
+
}
-use lib ("@LOCAL_LIB_PATH@", "@RT_LIB_PATH@");
+use lib ( "@LOCAL_LIB_PATH@", "@RT_LIB_PATH@" );
use RT;
package RT::Mason;
-use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we
- #set private_tempfiles
+use vars qw($Nobody $SystemUser $Handler $r);
+#This drags in RT's config.pm
BEGIN {
- if ($CGI::MOD_PERL) {
- require HTML::Mason::ApacheHandler;
- }
- else {
- require HTML::Mason::CGIHandler;
- }
+ RT::LoadConfig();
+ if ($RT::DevelMode) { require Module::Refresh; }
}
-use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
-
-use vars qw($Nobody $SystemUser $r);
-
-#This drags in RT's config.pm
-RT::LoadConfig();
-
-use Carp;
{
+
package HTML::Mason::Commands;
use vars qw(%session);
-
- use RT::Tickets;
- use RT::Transactions;
- use RT::Users;
- use RT::CurrentUser;
- use RT::Templates;
- use RT::Queues;
- use RT::ScripActions;
- use RT::ScripConditions;
- use RT::Scrips;
- use RT::Groups;
- use RT::GroupMembers;
- use RT::CustomFields;
- use RT::CustomFieldValues;
- use RT::TicketCustomFieldValues;
-
- use RT::Interface::Web;
- use MIME::Entity;
- use Text::Wrapper;
- use CGI::Cookie;
- use Time::ParseDate;
- use HTML::Entities;
}
-
-# Activate the following if running httpd as root (the normal case).
-# Resets ownership of all files created by Mason at startup.
-# Note that mysql uses DB for sessions, so there's no need to do this.
-unless ($RT::DatabaseType =~ /(mysql|Pg)/) {
- # Clean up our umask to protect session files
- umask(0077);
-
-if ( $CGI::MOD_PERL) {
- 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 _ ) );
+use RT::Interface::Web;
+use RT::Interface::Web::Handler;
+$Handler = RT::Interface::Web::Handler->new(@RT::MasonParameters);
+
+if ($ENV{'MOD_PERL'} && !$RT::DevelMode) {
+ # Under static_source, we need to purge the component cache
+ # each time we restart, so newer components may be reloaded.
+ #
+ # We can't do this in FastCGI or we'll blow away the component root _every_ time a new server starts
+ # which happens every few hits.
+
+ use File::Path qw( rmtree );
+ use File::Glob qw( bsd_glob );
+ rmtree([ bsd_glob("$RT::MasonDataDir/obj/*") ], 0, 1);
}
-my $ah = &RT::Interface::Web::NewApacheHandler() if $CGI::MOD_PERL;
-
sub handler {
($r) = @_;
- RT::Init();
+ local $SIG{__WARN__};
+ local $SIG{__DIE__};
- # We don't need to handle non-text items
- return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io;
+ # We don't need to handle non-text, non-xml items
+ if ($r->content_type =~ m/^httpd\b.*\bdirectory/i) {
+ use File::Spec::Unix;
+ # Our DirectoryIndex is always index.html, regardless of httpd settings
+ $r->filename( File::Spec::Unix->catfile( $r->filename, 'index.html' ) );
+ }
+ elsif (defined( $r->content_type )) {
+ $r->content_type =~ m!(^text/|\bxml\b)!i or return -1;
+ }
+
+ Module::Refresh->refresh if $RT::DevelMode;
+
+ RT::Init();
my %session;
- my $status = $ah->handle_request($r);
- undef (%session);
+ my $status;
+ eval { $status = $Handler->handle_request($r) };
+ if ($@) {
+ $RT::Logger->crit($@);
+ }
+
+ undef(%session);
+
+ RT::Interface::Web::Handler->CleanupRequest();
- $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") if $RT::Handle->TransactionDepth;
return $status;
}
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-19 04:04:00 +0000