summaryrefslogtreecommitdiff
path: root/rt/bin
diff options
context:
space:
mode:
Diffstat (limited to 'rt/bin')
-rw-r--r--rt/bin/initacls.Oracle26
-rwxr-xr-xrt/bin/initacls.Pg28
-rwxr-xr-xrt/bin/initacls.mysql20
-rwxr-xr-xrt/bin/mason_handler.fcgi255
-rw-r--r--rt/bin/mason_handler.fcgi.in68
-rwxr-xr-xrt/bin/mason_handler.scgi218
-rw-r--r--rt/bin/mason_handler.scgi.in43
-rw-r--r--rt/bin/mason_handler.svc234
-rw-r--r--rt/bin/mason_handler.svc.in234
-rwxr-xr-xrt/bin/rt1391
-rw-r--r--rt/bin/rt-commit-handler846
-rw-r--r--rt/bin/rt-commit-handler.in846
-rw-r--r--rt/bin/rt-crontool220
-rw-r--r--rt/bin/rt-crontool.in220
-rwxr-xr-xrt/bin/rt-mailgate842
-rw-r--r--rt/bin/rt-mailgate.in648
-rw-r--r--rt/bin/rt.in1816
-rw-r--r--rt/bin/rtadmin1040
-rwxr-xr-xrt/bin/webmux.pl248
-rw-r--r--rt/bin/webmux.pl.in148
20 files changed, 3362 insertions, 6029 deletions
diff --git a/rt/bin/initacls.Oracle b/rt/bin/initacls.Oracle
new file mode 100644
index 000000000..8d05f45e1
--- /dev/null
+++ b/rt/bin/initacls.Oracle
@@ -0,0 +1,26 @@
+#!/bin/sh
+
+DATABASEHOME=$1
+HOSTNAME=$2
+PORT=$3
+DATABASEADMIN=$4
+DBAPASSWD=$5
+DATABASENAME=$6
+DATABASEACLS=$7
+
+BINDIR=${DATABASEHOME}/bin
+
+echo "DBHOME = $DATABASEHOME"
+echo "HOSTNAME = $HOSTNAME"
+echo "PORT = $PORT"
+echo "DATABASEADMIN = $DATABASEADMIN"
+echo "DBAPASSWD = $DBAPASSWD"
+echo "DATABASENAME = $DATABASENAME"
+
+PATH=$PATH:$BINDIR
+export PATH
+
+echo "Please enter ${DATABASEADMIN}'s password for the SID ${DATABASENAME} to create an rt user";
+
+$BINDIR/sqlplus ${DATABASEADMIN}@${DATABASENAME} @$DATABASEACLS
+
diff --git a/rt/bin/initacls.Pg b/rt/bin/initacls.Pg
new file mode 100755
index 000000000..82e32de74
--- /dev/null
+++ b/rt/bin/initacls.Pg
@@ -0,0 +1,28 @@
+#!/bin/sh
+
+DATABASEHOME=$1
+HOSTNAME=$2
+PORT=$3
+DATABASEADMIN=$4
+DBAPASSWD=$5
+DATABASENAME=$6
+DATABASEACLS=$7
+
+BINDIR=${DATABASEHOME}/bin
+
+
+PATH=$PATH:$BINDIR
+export PATH
+
+echo "Enter the postgres administrator's database password to create a new user for rt"
+
+if [ "fnord$PORT" != "fnord" ]; then
+ PORT="-p $PORT"
+fi;
+
+if [ "fnord$HOSTNAME" != "fnord" ]; then
+ HOSTNAME="-h $HOSTNAME"
+fi;
+
+psql $HOSTNAME $PORT -d $DATABASENAME -f $DATABASEACLS -U $DATABASEADMIN
+
diff --git a/rt/bin/initacls.mysql b/rt/bin/initacls.mysql
new file mode 100755
index 000000000..17e63f837
--- /dev/null
+++ b/rt/bin/initacls.mysql
@@ -0,0 +1,20 @@
+#!/bin/sh
+
+DATABASEHOME=$1
+HOSTNAME=$2
+PORT=$3
+DATABASEADMIN=$4
+DBAPASSWD=$5
+DATABASENAME=$6
+DATABASEACLS=$7
+
+BINDIR=${DATABASEHOME}/bin
+
+PATH=$PATH:$BINDIR
+export PATH
+
+echo "Enter the mysql administrator's database password to create a new user for RT"
+$BINDIR/mysql --host=${HOSTNAME} --port=${PORT} --user=${DATABASEADMIN} -p${DBAPASSWD} mysql < $DATABASEACLS
+
+echo "Enter the mysql administrator's database password to nondestructively reload the database"
+$BINDIR/mysqladmin --host=${HOSTNAME} --port=${PORT} --user=${DATABASEADMIN} -p${DBAPASSWD} reload
diff --git a/rt/bin/mason_handler.fcgi b/rt/bin/mason_handler.fcgi
index 431eccbd3..e8a4e128f 100755
--- a/rt/bin/mason_handler.fcgi
+++ b/rt/bin/mason_handler.fcgi
@@ -1,54 +1,221 @@
-#!/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
+#!!!PERL!!
+# $Header: /home/cvs/cvsroot/freeside/rt/bin/mason_handler.fcgi,v 1.1 2002-08-12 06:17:07 ivan Exp $
+# RT is (c) 1996-2001 Jesse Vincent (jesse@fsck.com);
use strict;
-use File::Basename;
-require ('/opt/rt3/bin/webmux.pl');
+$ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need
+$ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'};
+$ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'};
+$ENV{'ENV'} = '' if defined $ENV{'ENV'};
+$ENV{'IFS'} = '' if defined $ENV{'IFS'};
-my $h = &RT::Interface::Web::NewCGIHandler();
-# Enter CGI::Fast mode, which should also work as a vanilla CGI script.
-require CGI::Fast;
+# We really don't want apache to try to eat all vm
+# see http://perl.apache.org/guide/control.html#Preventing_mod_perl_Processes_Fr
+
+
+package RT::Mason;
+#use CGI qw(-private_tempfiles); # pull in CGI with the private tempfiles
+ #option predefined
+use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
+
+use vars qw($VERSION %session $Nobody $SystemUser $cgi);
+
+# List of modules that you want to use from components (see Admin
+# manual for details)
+
+#Clean up our umask...so that the session files aren't world readable, writable or executable
+umask(0077);
+
+
+
+$VERSION="!!RT_VERSION!!";
+
+use lib "!!RT_LIB_PATH!!";
+use lib "!!RT_ETC_PATH!!";
+
+#This drags in RT's config.pm
+use config;
+use Carp;
+
+{
+ package HTML::Mason::Commands;
+ use vars qw(%session $ContentType);
+
+ use RT;
+ use RT::Ticket;
+ use RT::Tickets;
+ use RT::Transaction;
+ use RT::Transactions;
+ use RT::User;
+ use RT::Users;
+ use RT::CurrentUser;
+ use RT::Template;
+ use RT::Templates;
+ use RT::Queue;
+ use RT::Queues;
+ use RT::ScripAction;
+ use RT::ScripActions;
+ use RT::ScripCondition;
+ use RT::ScripConditions;
+ use RT::Scrip;
+ use RT::Scrips;
+ use RT::Group;
+ use RT::Groups;
+ use RT::Keyword;
+ use RT::Keywords;
+ use RT::ObjectKeyword;
+ use RT::ObjectKeywords;
+ use RT::KeywordSelect;
+ use RT::KeywordSelects;
+ use RT::GroupMember;
+ use RT::GroupMembers;
+ use RT::Watcher;
+ use RT::Watchers;
+ use RT::Handle;
+ use RT::Interface::Web;
+ use MIME::Entity;
+ use CGI::Cookie;
+ use Date::Parse;
+ use HTML::Entities;
+ use Text::Wrapper;
+
+ #TODO: make this use DBI
+ use Apache::Session::File;
+ use CGI::Fast;
+
+ # set the page's content type.
+ # In this case, just save it to a variable that we can pull later;
+ sub SetContentType {
+ $ContentType = shift;
+ }
+ sub CGIObject {
+ return $RT::Mason::cgi;
+ }
+}
+
+
+my ($output, $parser, $interp);
+if ($HTML::Mason::VERSION < 1.0902) {
+ require HTML::Mason::ApacheHandler;
+
+ $parser = &RT::Interface::Web::NewParser(allow_globals => [%session]);
+
+ $interp = &RT::Interface::Web::NewInterp(parser=>$parser,
+ allow_recursive_autohandlers => 1,
+ out_method => \$output);
+}
+else {
+ $interp = &RT::Interface::Web::NewInterp(
+ allow_globals => [%session],
+ default_escape_flags => 'h',
+
+ out_method => \$output);
+}
+# 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 _ ));
+
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
- $ENV{'PATH'} = '/bin:/usr/bin';
- $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'};
-
- unless ($h->interp->comp_exists($cgi->path_info)) {
- $cgi->path_info($cgi->path_info . "/index.html");
+while ($RT::Mason::cgi = new CGI::Fast) {
+
+ $HTML::Mason::Commands::ContentType = 'text/html';
+
+ # This routine comes from ApacheHandler.pm:
+ my (%args, $cookie);
+ foreach my $key ( $cgi->param ) {
+ foreach my $value ( $cgi->param($key) ) {
+ if (exists($args{$key})) {
+ if (ref($args{$key})) {
+ $args{$key} = [@{$args{$key}}, $value];
+ } else {
+ $args{$key} = [$args{$key}, $value];
+ }
+ } else {
+ $args{$key} = $value;
+ }
+
+ }
+
}
- $h->handle_cgi_object($cgi);
- # _should_ always be tied
-}
+
-1;
+ my $comp = $ENV{'PATH_INFO'};
+
+ if ($comp =~ /^(.*)$/) { # untaint the path info. apache should
+ # never hand us a bogus path.
+ # We should be more careful here.
+ $comp = $1;
+ }
+
+ if ($comp =~ /\/$/) {
+ $comp .= "index.html";
+ }
+
+ #This is all largely cut and pasted from mason's session_handler.pl
+
+ # {{{ Cookies
+ my %cookies = fetch CGI::Cookie();
+
+ eval {
+ my $session_id = undef;
+
+ #Get the session id and untaint it
+ if ($cookies{'AF_SID'} && $cookies{'AF_SID'}->value() =~ /^(.*)$/) {
+ $session_id = $1;
+ }
+
+ tie %HTML::Mason::Commands::session, 'Apache::Session::File',
+ $session_id,
+ { Directory => $RT::MasonSessionDir,
+ LockDirectory => $RT::MasonSessionDir,
+ } ;
+ };
+
+ if ( $@ ) {
+ # If the session is invalid, create a new session.
+ if ( $@ =~ m#^Object does not exist in the data store# ) {
+ tie %HTML::Mason::Commands::session, 'Apache::Session::File', undef,
+ { Directory => $RT::MasonSessionDir,
+ LockDirectory => $RT::MasonSessionDir,
+ };
+ undef $cookies{'AF_SID'};
+ }
+ else {
+ die "$@ \nProbably means that RT Couldn't write to session directory '$RT::MasonSessionDir'. Check that this directory's permissions are correct.";
+ }
+ }
+
+ if ( !$cookies{'AF_SID'} ) {
+ $cookie = new CGI::Cookie
+ (-name=>'AF_SID',
+ -value=>$HTML::Mason::Commands::session{_session_id},
+ -path => '/',);
+
+ } else {
+ $cookie = undef;
+ }
+
+ # }}}
+
+ $output = '';
+ eval {
+ my $status = $interp->exec($comp, %args);
+ };
+
+ if ($@) {
+ $output = "<PRE>$@</PRE>";
+ }
+
+ print "Content-Type: $HTML::Mason::Commands::ContentType\r\n";
+ print "Set-Cookie: $cookie\r\n" if ($cookie);
+ print "\r\n";
+ print $output;
+ untie %HTML::Mason::Commands::session;
+
+}
diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in
deleted file mode 100644
index a009663b9..000000000
--- a/rt/bin/mason_handler.fcgi.in
+++ /dev/null
@@ -1,68 +0,0 @@
-#!@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;
-use File::Basename;
-require ('@RT_BIN_PATH@/webmux.pl');
-
-my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters);
-
-# 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
- $ENV{'PATH'} = '/bin:/usr/bin';
- $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'};
-
- 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") ;
- }
-
-
-}
-
-1;
diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi
index 8e1135c2f..b9846c898 100755
--- a/rt/bin/mason_handler.scgi
+++ b/rt/bin/mason_handler.scgi
@@ -1,41 +1,193 @@
-#!/usr/local/bin/speedy
-# 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
+#!!!PERL!! -w
+
+#!/usr/bin/speedy -- -t600 -M8
+# $Header: /home/cvs/cvsroot/freeside/rt/bin/mason_handler.scgi,v 1.1 2002-08-12 06:17:07 ivan Exp $
+# RT is (c) 1996-2001 Jesse Vincent (jesse@fsck.com);
+#
+# Contains code derived from mason.cgi
+# mason.cgi is Copyright December 2000 Joshua Kronengold (mneme@io.com,
+# mneme@cyberspace.org). All Rights Reserved.
use strict;
-require ('/opt/rt3/bin/webmux.pl');
+# {{{ Clean out the environment a little bit
+$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'};
+# }}}
+
+package RT::Mason;
+use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
+use vars qw($VERSION %session $Nobody $SystemUser);
+
+# List of modules that you want to use from components (see Admin
+# manual for details)
+
+$VERSION="!!RT_VERSION!!";
+
+use lib "!!RT_LIB_PATH!!";
+use lib "!!RT_ETC_PATH!!";
+
+
+#This drags in RT's config.pm
+use config;
+use Carp;
+
+use HTML::Mason::FakeApache;
+use CGI;
+
+# {{{ Set up CGI environment and grab CGI params:
-my $h = &RT::Interface::Web::NewCGIHandler();
+my $r=new HTML::Mason::FakeApache;
-require CGI;
+$|=1; # set output to non-buffered.
-RT::Init();
+my %cgi;
+CGI::ReadParse(\%cgi); # %cgi is now a tied hash containing our params.
-my $cgi = CGI->new;
-unless ($h->interp->comp_exists($cgi->path_info)) {
- $cgi->path_info($cgi->path_info . "/index.html");
+my $q=$cgi{CGI}; # $q now contains the object tied to %cgi.
+# }}}
+
+# {{{ require what we need
+{
+ package HTML::Mason::Commands;
+
+ use vars qw(%session);
+
+ use RT::Ticket;
+ use RT::Tickets;
+ use RT::Transaction;
+ use RT::Transactions;
+ use RT::User;
+ use RT::Users;
+ use RT::CurrentUser;
+ use RT::Template;
+ use RT::Templates;
+ use RT::Queue;
+ use RT::Queues;
+ use RT::ScripAction;
+ use RT::ScripActions;
+ use RT::ScripCondition;
+ use RT::ScripConditions;
+ use RT::Scrip;
+ use RT::Scrips;
+ use RT::Group;
+ use RT::Groups;
+ use RT::Keyword;
+ use RT::Keywords;
+ use RT::ObjectKeyword;
+ use RT::ObjectKeywords;
+ use RT::KeywordSelect;
+ use RT::KeywordSelects;
+ use RT::GroupMember;
+ use RT::GroupMembers;
+ use RT::Watcher;
+ use RT::Watchers;
+ use RT::Handle;
+ use RT::Interface::Web;
+ use MIME::Entity;
+ use CGI::Cookie;
+ use Date::Parse;
+ use HTML::Entities;
+
+
+ use Apache::Session::File;
+
+
}
-$h->handle_cgi_object($cgi);
+# }}}
+
+# {{{ RT Database setup
+ $RT::Handle = new RT::Handle;
+
+ $RT::Handle->Connect;
+
+ use RT::CurrentUser;
+
+ #RT's system user is a genuine database user. its id lives here
+ $RT::SystemUser = new RT::CurrentUser();
+ $RT::SystemUser->LoadByName('RT_System');
+
+ #RT's "nobody user" is a genuine database user. its ID lives here.
+ $RT::Nobody = new RT::CurrentUser();
+ $RT::Nobody->LoadByName('Nobody');
+
+
+# }}}
+
+
+
+
+# {{{ Deal with cookies
+
+my %cookies = fetch CGI::Cookie();
+eval {
+ tie %HTML::Mason::Commands::session, 'Apache::Session::File',
+ ( $cookies{'AF_SID'} ? $cookies{'AF_SID'}->value() : undef );
+};
+
+if ( $@ ) {
+ # If the session is invalid, create a new session.
+ if ( $@ =~ m#^Object does not exist in the data store# ) {
+ tie %HTML::Mason::Commands::session, 'Apache::Session::File', undef;
+ undef $cookies{'AF_SID'};
+ }
+}
+
+if ( !$cookies{'AF_SID'} ) {
+ my $cookie = new CGI::Cookie(
+ -name=>'AF_SID',
+ -value=>$HTML::Mason::Commands::session{_session_id},
+ -path => '/');
+ print 'Set-Cookie: '. $cookie."\r\n";
+}
+
+# }}}
+
+my $path=$ENV{PATH_INFO} || "/"; $path=~s/\'/\\\'/g;
+
+my $type=`/usr/bin/file '$RT::MasonComponentRoot/$path'`;
+
+# {{{ if it's a text file, handle it with mason.
+if($type=~/text|directory/) {
+ my ($out, %mason_params);
+ my $parser = RT::Interface::Web::NewParser(allow_globals=>[qw($r)]);
+ $mason_params{parser}=$parser;
+ $r->content_type('text/html');
+ # (get cookies line) ...
+ $r->access_hash('headers_in','Cookie',$ENV{HTTP_COOKIE});
+ $r->{'args@'}=[];
+ $mason_params{out_method}=\$out;
+
+ my $interp = RT::Interface::Web::NewInterp(%mason_params);
+
+ $interp->set_global(r=>$r);
+ $interp->exec($path,%cgi);
+ $r->send_http_header();
+ print $out;
+}
+# }}}
+
+# {{{ if it's not a text file, just stream it out.
+
+else { # file is binary, damn it
+ my $mime_type;
+ if ( $mime_type=
+ eval{ use MIME::Types;
+ my($type,$encoding)=MIME::Types::by_suffix($path);
+ $type; }) {
+ print $q->header($mime_type);
+ $path=~s/[\|\>\<\&]//g;
+ open F,"$RT::MasonComponentRoot/$path" or
+ die "couldn't open $path -- $!";
+ print while <F>;
+ close F;
+ } else {
+ die "couldn't resolve type of non-text file (!@; $type) -- install Mime::Types\n";
+ }
+ }
+
+# }}}
-1;
+untie %HTML::Mason::Commands::session;
diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in
deleted file mode 100644
index 614d4d47a..000000000
--- a/rt/bin/mason_handler.scgi.in
+++ /dev/null
@@ -1,43 +0,0 @@
-#!@SPEEDY_BIN@
-# 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;
-require ('@RT_BIN_PATH@/webmux.pl');
-
-my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters);
-
-require CGI;
-
-RT::Init();
-
-my $cgi = CGI->new;
-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.svc b/rt/bin/mason_handler.svc
deleted file mode 100644
index c05d21e69..000000000
--- a/rt/bin/mason_handler.svc
+++ /dev/null
@@ -1,234 +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
-
-=head1 NAME
-
-mason_handler.svc - Win32 IIS Service handler for RT
-
-=head1 SYNOPSIS
-
- perl mason_handler.svc --install # install as service
- perl mason_handler.svc --deinstall # deinstall this service
- perl mason_handler.svc --help # show this help
- perl mason_handler.svc # launch handler from command line
-
-=head1 DESCRIPTION
-
-This script manages a stand-alone FastCGI server, and populates the necessary
-registry settings to run it with Microsoft IIS Server 4.0 or above.
-
-Before running it, you need to install the B<FCGI> module from CPAN, as well as
-B<Win32::Daemon> from L<http://www.roth.net/perl/Daemon/> if you want to install
-itself as a service.
-
-This script will automatically create a virtual directory under the IIS root;
-its name is taken from C<$WebPath> in the F<RT_Config.pm> file. Additionally,
-please install the ISAPI binary from L<http://www.caraveo.com/fastcgi/> and set
-up an ISAPI Script Map that maps F<.html> files to F<isapi_fcgi.dll>.
-
-Once the service is launched (either via C<net start RTFastCGI> or by running
-C<perl mason_handler.svc>), a FCGI server will start and bind to port C<8284>
-(mnemonics: the ASCII value of C<R> and C<T>); the ISAPI handler's C<BindPath>
-registry setting will also be automatically populated.
-
-=cut
-
-use strict;
-use File::Basename;
-require (dirname(__FILE__) . '/webmux.pl');
-
-use Cwd;
-use File::Spec;
-
-use Win32;
-use Win32::Process;
-use Win32::Service;
-use Win32::TieRegistry;
-
-my $ProcessObj;
-
-BEGIN {
- my $runsvc = sub {
- Win32::Process::Create(
- $ProcessObj, $^X, "$^X $0 --run", 0, NORMAL_PRIORITY_CLASS, "."
- ) or do {
- die Win32::FormatMessage( Win32::GetLastError() );
- };
-
- chdir File::Basename::dirname($0);
- my $path = Cwd::cwd();
- $path =~ s|/|\\|g;
- $path =~ s|bin$|share\\html|;
-
- $Win32::TieRegistry::Registry->{
- 'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\\'.
- 'W3SVC\Parameters\Virtual Roots\\'
- }->{$RT::WebPath || '/'} = "$path,,205";
-
- $Win32::TieRegistry::Registry->{
- 'HKEY_LOCAL_MACHINE\Software\FASTCGI\.html\\'
- }->{'BindPath'} = $ENV{'FCGI_SOCKET_PATH'};
-
- Win32::Service::StartService(Win32::NodeName, 'W3SVC');
- };
-
- if ($ARGV[0] eq '--deinstall') {
- chdir File::Basename::dirname($0);
- my $path = Cwd::cwd();
- $path =~ s|/|\\|g;
-
- require Win32::Daemon;
- Win32::Daemon::DeleteService('RTFastCGI');
- warn "Service 'RTFastCGI' successfully deleted.\n";
- exit;
- }
- elsif ($ARGV[0] eq '--install') {
- chdir File::Basename::dirname($0);
- my $path = Cwd::cwd();
- $path =~ s|/|\\|g;
-
- require Win32::Daemon;
- Win32::Daemon::DeleteService('RTFastCGI');
-
- my $rv = Win32::Daemon::CreateService( {
- machine => '',
- name => 'RTFastCGI',
- display => 'RT FastCGI Handler',
- path => $^X,
- user => '',
- pwd => $path,
- description => 'Enables port 8284 as the RT FastCGI handler.',
- parameters => File::Spec->catfile(
- $path, File::Basename::basename($0)
- ) . ' --service',
- } );
-
- if ($rv) {
- warn "Service 'RTFastCGI' successfully created.\n";
- }
- else {
- warn "Failed to add service: " . Win32::FormatMessage(
- Win32::Daemon::GetLastError()
- ) . "\n";
- }
- exit;
- }
- elsif ($ARGV[0] eq '--service') {
- require Win32::Daemon;
-
- my $PrevState = Win32::Daemon::SERVICE_START_PENDING();
- Win32::Daemon::StartService() or die $^E;
-
- while ( 1 ) {
- my $State = Win32::Daemon::State();
- last if $State == Win32::Daemon::SERVICE_STOPPED();
-
- if ( $State == Win32::Daemon::SERVICE_START_PENDING() ) {
- $runsvc->();
- Win32::Daemon::State( Win32::Daemon::SERVICE_RUNNING() );
- $PrevState = Win32::Daemon::SERVICE_RUNNING();
- }
- elsif ( $State == Win32::Daemon::SERVICE_CONTINUE_PENDING() ) {
- $ProcessObj->Resume;
- Win32::Daemon::State( Win32::Daemon::SERVICE_RUNNING() );
- $PrevState = Win32::Daemon::SERVICE_RUNNING();
- }
- elsif ( $State == Win32::Daemon::SERVICE_STOP_PENDING() ) {
- $ProcessObj->Kill(0);
- Win32::Daemon::State( Win32::Daemon::SERVICE_STOPPED() );
- $PrevState = Win32::Daemon::SERVICE_STOPPED();
- }
- elsif ( $State == Win32::Daemon::SERVICE_RUNNING() ) {
- my $Message = Win32::Daemon::QueryLastMessage(1);
- if ( $Message == Win32::Daemon::SERVICE_CONTROL_INTERROGATE() ) {
- Win32::Daemon::State( $PrevState );
- }
- elsif ( $Message == Win32::Daemon::SERVICE_CONTROL_SHUTDOWN() ) {
- Win32::Daemon::State( Win32::Daemon::SERVICE_STOP_PENDING(), 15000 );
- }
- elsif ( $Message != Win32::Daemon::SERVICE_CONTROL_NONE() ) {
- Win32::Daemon::State( $PrevState );
- }
- }
-
- Win32::Sleep( 1000 );
- }
-
- Win32::Daemon::StopService();
- exit;
- }
- elsif ($ARGV[0] eq '--help') {
- system("perldoc $0");
- exit;
- }
- elsif ($ARGV[0] ne '--run') {
- $SIG{__DIE__} = sub { $ProcessObj->Kill(0) if $ProcessObj };
- $runsvc->();
- warn "RT FastCGI Handler launched. Press [Enter] to terminate...\n";
- <STDIN>;
- exit;
- }
-}
-
-###############################################################################
-
-warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n";
-
-require CGI::Fast;
-my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters);
-
-RT::Init();
-
-# Response loop
-while( my $cgi = CGI::Fast->new ) {
- my $comp = $ENV{'PATH_INFO'};
-
- $comp = $1 if ($comp =~ /^(.*)$/);
- $comp =~ s|^$RT::WebPath\b||i;
- $comp .= "index.html" if ($comp =~ /\/$/);
- $comp =~ s/.pl$/.html/g;
-
- warn "Serving $comp\n";
-
- $h->handle_cgi($comp);
- # _should_ always be tied
-}
-
-1;
-
-=head1 AUTHORS
-
-Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
-
-=head1 COPYRIGHT
-
-Copyright 2002 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>
-
-=cut
diff --git a/rt/bin/mason_handler.svc.in b/rt/bin/mason_handler.svc.in
deleted file mode 100644
index 0ba1f51b5..000000000
--- a/rt/bin/mason_handler.svc.in
+++ /dev/null
@@ -1,234 +0,0 @@
-#!@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
-
-=head1 NAME
-
-mason_handler.svc - Win32 IIS Service handler for RT
-
-=head1 SYNOPSIS
-
- perl mason_handler.svc --install # install as service
- perl mason_handler.svc --deinstall # deinstall this service
- perl mason_handler.svc --help # show this help
- perl mason_handler.svc # launch handler from command line
-
-=head1 DESCRIPTION
-
-This script manages a stand-alone FastCGI server, and populates the necessary
-registry settings to run it with Microsoft IIS Server 4.0 or above.
-
-Before running it, you need to install the B<FCGI> module from CPAN, as well as
-B<Win32::Daemon> from L<http://www.roth.net/perl/Daemon/> if you want to install
-itself as a service.
-
-This script will automatically create a virtual directory under the IIS root;
-its name is taken from C<$WebPath> in the F<RT_Config.pm> file. Additionally,
-please install the ISAPI binary from L<http://www.caraveo.com/fastcgi/> and set
-up an ISAPI Script Map that maps F<.html> files to F<isapi_fcgi.dll>.
-
-Once the service is launched (either via C<net start RTFastCGI> or by running
-C<perl mason_handler.svc>), a FCGI server will start and bind to port C<8284>
-(mnemonics: the ASCII value of C<R> and C<T>); the ISAPI handler's C<BindPath>
-registry setting will also be automatically populated.
-
-=cut
-
-use strict;
-use File::Basename;
-require (dirname(__FILE__) . '/webmux.pl');
-
-use Cwd;
-use File::Spec;
-
-use Win32;
-use Win32::Process;
-use Win32::Service;
-use Win32::TieRegistry;
-
-my $ProcessObj;
-
-BEGIN {
- my $runsvc = sub {
- Win32::Process::Create(
- $ProcessObj, $^X, "$^X $0 --run", 0, NORMAL_PRIORITY_CLASS, "."
- ) or do {
- die Win32::FormatMessage( Win32::GetLastError() );
- };
-
- chdir File::Basename::dirname($0);
- my $path = Cwd::cwd();
- $path =~ s|/|\\|g;
- $path =~ s|bin$|share\\html|;
-
- $Win32::TieRegistry::Registry->{
- 'HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\\'.
- 'W3SVC\Parameters\Virtual Roots\\'
- }->{$RT::WebPath || '/'} = "$path,,205";
-
- $Win32::TieRegistry::Registry->{
- 'HKEY_LOCAL_MACHINE\Software\FASTCGI\.html\\'
- }->{'BindPath'} = $ENV{'FCGI_SOCKET_PATH'};
-
- Win32::Service::StartService(Win32::NodeName, 'W3SVC');
- };
-
- if ($ARGV[0] eq '--deinstall') {
- chdir File::Basename::dirname($0);
- my $path = Cwd::cwd();
- $path =~ s|/|\\|g;
-
- require Win32::Daemon;
- Win32::Daemon::DeleteService('RTFastCGI');
- warn "Service 'RTFastCGI' successfully deleted.\n";
- exit;
- }
- elsif ($ARGV[0] eq '--install') {
- chdir File::Basename::dirname($0);
- my $path = Cwd::cwd();
- $path =~ s|/|\\|g;
-
- require Win32::Daemon;
- Win32::Daemon::DeleteService('RTFastCGI');
-
- my $rv = Win32::Daemon::CreateService( {
- machine => '',
- name => 'RTFastCGI',
- display => 'RT FastCGI Handler',
- path => $^X,
- user => '',
- pwd => $path,
- description => 'Enables port 8284 as the RT FastCGI handler.',
- parameters => File::Spec->catfile(
- $path, File::Basename::basename($0)
- ) . ' --service',
- } );
-
- if ($rv) {
- warn "Service 'RTFastCGI' successfully created.\n";
- }
- else {
- warn "Failed to add service: " . Win32::FormatMessage(
- Win32::Daemon::GetLastError()
- ) . "\n";
- }
- exit;
- }
- elsif ($ARGV[0] eq '--service') {
- require Win32::Daemon;
-
- my $PrevState = Win32::Daemon::SERVICE_START_PENDING();
- Win32::Daemon::StartService() or die $^E;
-
- while ( 1 ) {
- my $State = Win32::Daemon::State();
- last if $State == Win32::Daemon::SERVICE_STOPPED();
-
- if ( $State == Win32::Daemon::SERVICE_START_PENDING() ) {
- $runsvc->();
- Win32::Daemon::State( Win32::Daemon::SERVICE_RUNNING() );
- $PrevState = Win32::Daemon::SERVICE_RUNNING();
- }
- elsif ( $State == Win32::Daemon::SERVICE_CONTINUE_PENDING() ) {
- $ProcessObj->Resume;
- Win32::Daemon::State( Win32::Daemon::SERVICE_RUNNING() );
- $PrevState = Win32::Daemon::SERVICE_RUNNING();
- }
- elsif ( $State == Win32::Daemon::SERVICE_STOP_PENDING() ) {
- $ProcessObj->Kill(0);
- Win32::Daemon::State( Win32::Daemon::SERVICE_STOPPED() );
- $PrevState = Win32::Daemon::SERVICE_STOPPED();
- }
- elsif ( $State == Win32::Daemon::SERVICE_RUNNING() ) {
- my $Message = Win32::Daemon::QueryLastMessage(1);
- if ( $Message == Win32::Daemon::SERVICE_CONTROL_INTERROGATE() ) {
- Win32::Daemon::State( $PrevState );
- }
- elsif ( $Message == Win32::Daemon::SERVICE_CONTROL_SHUTDOWN() ) {
- Win32::Daemon::State( Win32::Daemon::SERVICE_STOP_PENDING(), 15000 );
- }
- elsif ( $Message != Win32::Daemon::SERVICE_CONTROL_NONE() ) {
- Win32::Daemon::State( $PrevState );
- }
- }
-
- Win32::Sleep( 1000 );
- }
-
- Win32::Daemon::StopService();
- exit;
- }
- elsif ($ARGV[0] eq '--help') {
- system("perldoc $0");
- exit;
- }
- elsif ($ARGV[0] ne '--run') {
- $SIG{__DIE__} = sub { $ProcessObj->Kill(0) if $ProcessObj };
- $runsvc->();
- warn "RT FastCGI Handler launched. Press [Enter] to terminate...\n";
- <STDIN>;
- exit;
- }
-}
-
-###############################################################################
-
-warn "Begin listening on $ENV{'FCGI_SOCKET_PATH'}\n";
-
-require CGI::Fast;
-my $h = &RT::Interface::Web::NewCGIHandler(@RT::MasonParameters);
-
-RT::Init();
-
-# Response loop
-while( my $cgi = CGI::Fast->new ) {
- my $comp = $ENV{'PATH_INFO'};
-
- $comp = $1 if ($comp =~ /^(.*)$/);
- $comp =~ s|^$RT::WebPath\b||i;
- $comp .= "index.html" if ($comp =~ /\/$/);
- $comp =~ s/.pl$/.html/g;
-
- warn "Serving $comp\n";
-
- $h->handle_cgi($comp);
- # _should_ always be tied
-}
-
-1;
-
-=head1 AUTHORS
-
-Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
-
-=head1 COPYRIGHT
-
-Copyright 2002 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>
-
-=cut
diff --git a/rt/bin/rt b/rt/bin/rt
new file mode 100755
index 000000000..41220bb56
--- /dev/null
+++ b/rt/bin/rt
@@ -0,0 +1,1391 @@
+#!!!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 b/rt/bin/rt-commit-handler
deleted file mode 100644
index 29e443ebd..000000000
--- a/rt/bin/rt-commit-handler
+++ /dev/null
@@ -1,846 +0,0 @@
-#!/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
-
-# {{{ Docs
-# -*-Perl-*-
-#
-#ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler,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 /opt/rt3/bin/rt-commit-handler --record-last-dir
-
-Stick the following in CVSROOT/loginfo
-
- ALL /opt/rt3/bin/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 ("/opt/rt3/lib", "/opt/rt3/local/lib");
-
-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-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
deleted file mode 100644
index cdbc3cbc9..000000000
--- a/rt/bin/rt-crontool
+++ /dev/null
@@ -1,220 +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;
-use Carp;
-
-use lib ("/opt/rt3/lib", "/opt/rt3/local/lib");
-
-package RT;
-
-use Getopt::Long;
-
-use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc);
-use RT::Tickets;
-use RT::Template;
-
-#Clean out all the nasties from the environment
-CleanEnv();
-
-# Load the config file
-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();
-
-unless ( $CurrentUser->Id ) {
- print loc("No RT user found. Please consult your RT administrator.\n");
- exit(1);
-}
-
-my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg,
- $template_id, $help, $verbose );
-GetOptions( "search=s" => \$search,
- "search-arg=s" => \$search_arg,
- "condition=s" => \$condition,
- "condition-arg=s" => \$condition_arg,
- "action-arg=s" => \$action_arg,
- "action=s" => \$action,
- "template-id=s" => \$template_id,
- "help" => \$help,
- "verbose|v" => \$verbose );
-
-help() if $help;
-
-# We _must_ have a search object
-load_module($search);
-load_module($action) if ($action);
-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);
-}
-
-#At the appointed time:
-
-#find a bunch of tickets
-my $tickets = RT::Tickets->new($CurrentUser);
-my $search = $search->new( TicketsObj => $tickets, Argument => $search_arg );
-
-$search->Prepare();
-
-# TicketsFound is an RT::Tickets object
-my $tickets = $search->TicketsObj;
-
-#for each ticket we've found
-while ( my $ticket = $tickets->Next() ) {
- print "\n" . $ticket->Id() . ": " if ($verbose);
-
- # perform some more advanced check
- if ($condition) {
- my $condition_obj = $condition->new( TicketObj => $ticket,
- Argument => $condition_arg );
-
- # if the condition doesn't apply, get out of here
-
- next unless ( $condition_obj->IsApplicable );
- print loc("Condition matches...") if ($verbose);
- }
-
- #prepare our action
- my $action_obj = $action->new( TicketObj => $ticket,
- TemplateObj => $template_obj,
- Argument => $action_arg );
-
- #if our preparation, move onto the next ticket
- next unless ( $action_obj->Prepare );
- print loc("Action prepared...") if ($verbose);
-
- #commit our action.
- next unless ( $action_obj->Commit );
- print loc("Action committed.") if ($verbose);
-}
-
-# {{{ load_module
-
-=head2 load_module
-
-Loads a perl module, dying nicely if it can't find it.
-
-=cut
-
-sub load_module {
- my $modname = shift;
- eval "require $modname";
- if ($@) {
- die loc( "Failed to load module [_1]. ([_2])", $modname, $@ );
- }
-
-}
-
-# }}}
-
-# {{{ loc
-
-=head2 loc LIST
-
-Localize this string, with the current user's currentuser object
-
-=cut
-
-sub loc {
- $CurrentUser->loc(@_);
-}
-
-# }}}
-
-sub help {
-
- print loc( "[_1] is a tool to act on tickets from an external scheduling tool, such as cron.", $0 )
- . "\n";
- print loc("It takes several arguments:") . "\n\n";
-
- print " "
- . loc( "[_1] - Specify the search module you want to use", "--search" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--search-argument", "--search" )
- . "\n";
-
- print " "
- . loc( "[_1] - Specify the condition module you want to use", "--condition" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--condition-argument", "--condition" )
- . "\n";
- print " "
- . loc( "[_1] - Specify the action module you want to use", "--action" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--action-argument", "--action" )
- . "\n";
- print " "
- . loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n";
- print "\n";
- print "\n";
- print loc("Security:")."\n";
- print loc("This tool allows the user to run arbitrary perl modules from within RT.")." ".
- loc("If this tool were setgid, a hostile local user could use this tool to gain administrative access to RT.")." ".
- loc("It is incredibly important that nonprivileged users not be allowed to run this tool."). " " .
- loc("It is suggested that you create a non-privileged unix user with the correct group membership and RT access to run this tool.")."\n";
- print "\n";
- print loc("Example:");
- print "\n";
- print " "
- . loc( "The following command will find all active tickets in the queue 'general' and set their priority to 99 if they haven't been touched in 4 hours:"
- )
- . "\n\n";
-
- print " bin/rt-cron-tool \\\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");
- 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
deleted file mode 100644
index 8ecc71826..000000000
--- a/rt/bin/rt-crontool.in
+++ /dev/null
@@ -1,220 +0,0 @@
-#!@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;
-use Carp;
-
-use lib ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
-
-package RT;
-
-use Getopt::Long;
-
-use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc);
-use RT::Tickets;
-use RT::Template;
-
-#Clean out all the nasties from the environment
-CleanEnv();
-
-# Load the config file
-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();
-
-unless ( $CurrentUser->Id ) {
- print loc("No RT user found. Please consult your RT administrator.\n");
- exit(1);
-}
-
-my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg,
- $template_id, $help, $verbose );
-GetOptions( "search=s" => \$search,
- "search-arg=s" => \$search_arg,
- "condition=s" => \$condition,
- "condition-arg=s" => \$condition_arg,
- "action-arg=s" => \$action_arg,
- "action=s" => \$action,
- "template-id=s" => \$template_id,
- "help" => \$help,
- "verbose|v" => \$verbose );
-
-help() if $help;
-
-# We _must_ have a search object
-load_module($search);
-load_module($action) if ($action);
-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);
-}
-
-#At the appointed time:
-
-#find a bunch of tickets
-my $tickets = RT::Tickets->new($CurrentUser);
-my $search = $search->new( TicketsObj => $tickets, Argument => $search_arg );
-
-$search->Prepare();
-
-# TicketsFound is an RT::Tickets object
-my $tickets = $search->TicketsObj;
-
-#for each ticket we've found
-while ( my $ticket = $tickets->Next() ) {
- print "\n" . $ticket->Id() . ": " if ($verbose);
-
- # perform some more advanced check
- if ($condition) {
- my $condition_obj = $condition->new( TicketObj => $ticket,
- Argument => $condition_arg );
-
- # if the condition doesn't apply, get out of here
-
- next unless ( $condition_obj->IsApplicable );
- print loc("Condition matches...") if ($verbose);
- }
-
- #prepare our action
- my $action_obj = $action->new( TicketObj => $ticket,
- TemplateObj => $template_obj,
- Argument => $action_arg );
-
- #if our preparation, move onto the next ticket
- next unless ( $action_obj->Prepare );
- print loc("Action prepared...") if ($verbose);
-
- #commit our action.
- next unless ( $action_obj->Commit );
- print loc("Action committed.") if ($verbose);
-}
-
-# {{{ load_module
-
-=head2 load_module
-
-Loads a perl module, dying nicely if it can't find it.
-
-=cut
-
-sub load_module {
- my $modname = shift;
- eval "require $modname";
- if ($@) {
- die loc( "Failed to load module [_1]. ([_2])", $modname, $@ );
- }
-
-}
-
-# }}}
-
-# {{{ loc
-
-=head2 loc LIST
-
-Localize this string, with the current user's currentuser object
-
-=cut
-
-sub loc {
- $CurrentUser->loc(@_);
-}
-
-# }}}
-
-sub help {
-
- print loc( "[_1] is a tool to act on tickets from an external scheduling tool, such as cron.", $0 )
- . "\n";
- print loc("It takes several arguments:") . "\n\n";
-
- print " "
- . loc( "[_1] - Specify the search module you want to use", "--search" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--search-argument", "--search" )
- . "\n";
-
- print " "
- . loc( "[_1] - Specify the condition module you want to use", "--condition" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--condition-argument", "--condition" )
- . "\n";
- print " "
- . loc( "[_1] - Specify the action module you want to use", "--action" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--action-argument", "--action" )
- . "\n";
- print " "
- . loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n";
- print "\n";
- print "\n";
- print loc("Security:")."\n";
- print loc("This tool allows the user to run arbitrary perl modules from within RT.")." ".
- loc("If this tool were setgid, a hostile local user could use this tool to gain administrative access to RT.")." ".
- loc("It is incredibly important that nonprivileged users not be allowed to run this tool."). " " .
- loc("It is suggested that you create a non-privileged unix user with the correct group membership and RT access to run this tool.")."\n";
- print "\n";
- print loc("Example:");
- print "\n";
- print " "
- . loc( "The following command will find all active tickets in the queue 'general' and set their priority to 99 if they haven't been touched in 4 hours:"
- )
- . "\n\n";
-
- print " bin/rt-cron-tool \\\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");
- 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-mailgate b/rt/bin/rt-mailgate
index b30443638..e6f0d95c5 100755
--- a/rt/bin/rt-mailgate
+++ b/rt/bin/rt-mailgate
@@ -1,587 +1,367 @@
-#!/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
-
-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, "|/opt/rt3/bin/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");
+#!!!PERL!! -w
-# }}}
-
-
-# {{{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 - $@");
-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, "|/opt/rt3/bin/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);
+# $Header: /home/cvs/cvsroot/freeside/rt/bin/rt-mailgate,v 1.1 2002-08-12 06:17:07 ivan Exp $
+# (c) 1996-2001 Jesse Vincent <jesse@fsck.com>
+# This software is redistributable under the terms of the GNU GPL
-$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");
+package RT;
+use strict;
+use vars qw($VERSION $Handle $Nobody $SystemUser);
+
+$VERSION="!!RT_VERSION!!";
+
+
+use lib "!!RT_LIB_PATH!!";
+use lib "!!RT_ETC_PATH!!";
+
+use RT::Interface::Email qw(CleanEnv LoadConfig DBConnect
+ GetCurrentUser
+ GetMessageContent
+ CheckForLoops
+ CheckForSuspiciousSender
+ CheckForAutoGenerated
+ ParseMIMEEntityFromSTDIN
+ ParseTicketId
+ MailError
+ ParseCcAddressesFromHead
+ ParseSenderAddressFromHead
+ ParseErrorsToAddressFromHead
+ );
+
+#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();
+
+use RT::Ticket;
+use RT::Queue;
+use MIME::Parser;
+use File::Temp;
+use Mail::Address;
+
+
+#Set some sensible defaults
+my $Queue = 1;
+my $time = time;
+my $Action = "correspond";
+
+my ($Verbose, $ReturnTid, $Debug);
+my ($From, $TicketId, $Subject,$SquelchReplies);
+
+# using --owner-from-extension, this will let you set ticket owner on create
+my $AssignTicketTo = undef;
+my ($status, $msg);
+
+# {{{ parse commandline
+
+while (my $flag = shift @ARGV) {
+ if (($flag eq '-v') or ($flag eq '--verbose')) {
+ $Verbose = 1;
+ }
+ if (($flag eq '-t') or ($flag eq '--ticketid')) {
+ $ReturnTid = 1;
+ }
+
+ if (($flag eq '-d') or ($flag eq '--debug')) {
+ $RT::Logger->debug("Debug mode enabled\n");
+ $Debug = 1;
+ }
+
+ if (($flag eq '-q') or ($flag eq '--queue')) {
+ $Queue = shift @ARGV;
+ }
+ if ($flag eq '--ticket-id-from-extension') {
+ $TicketId = $ENV{'EXTENSION'};
+ }
+ if ($flag eq '--queue-from-extension') {
+ $Queue = $ENV{'EXTENSION'};
+ }
+ if ($flag eq '--owner-from-extension') {
+ $AssignTicketTo = $ENV{'EXTENSION'};
+ }
+
+ if (($flag eq '-a') or ($flag eq '--action')) {
+ $Action = shift @ARGV;
+ }
+
+
+}
# }}}
+# get the current mime entity from stdin
+my ($entity, $head) = ParseMIMEEntityFromSTDIN();
-# {{{ 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, "|/opt/rt3/bin/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
+#Get someone to send runtime errors to;
+my $ErrorsTo = ParseErrorsToAddressFromHead($head);
+#Get us a current user object.
+my $CurrentUser = GetCurrentUser($head, $entity, $ErrorsTo);
-($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
+# We've already performed a warning and sent the mail off to somewhere safe ($RTOwner).
+# this is _exceedingly_ unlikely but we don't want to keep going if we don't have a current user
-ok(open(MAIL, "|/opt/rt3/bin/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
+unless ($CurrentUser->Id) {
+ exit(1);
+}
-Blah!
-Foob!
-EOF
-close (MAIL);
+my $MessageId = $head->get('Message-Id') ||
+ "<no-message-id-".time.rand(2000)."\@.$RT::Organization>";
+#Pull apart the subject line
+$Subject = $head->get('Subject') || "[no subject]";
+chomp $Subject;
-$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");
+# Get the ticket ID unless it's already set
+$TicketId = ParseTicketId($Subject) unless ($TicketId);
-# }}}
+#Set up a queue object
+my $QueueObj = RT::Queue->new($CurrentUser);
+$QueueObj->Load($Queue);
+unless ($QueueObj->id ) {
-# {{{ can another random comment on a ticket without being granted privs? answer should be no.
+ MailError(To => $RT::OwnerEmail,
+ Subject => "RT Bounce: $Subject",
+ Explanation => "RT couldn't find the queue: $Queue",
+ MIMEObj => $entity);
+}
-#($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
+# {{{ Lets check for mail loops of various sorts.
-ok(open(MAIL, "|/opt/rt3/bin/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
+my $IsAutoGenerated = CheckForAutoGenerated($head);
-Blah!
-Foob!
-EOF
-close (MAIL);
+my $IsSuspiciousSender = CheckForSuspiciousSender($head);
-$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");
+my $IsALoop = CheckForLoops($head);
-# }}}
-# {{{ can another random reply to a ticket after being granted privs? answer should be yes
+#If the message is autogenerated, we need to know, so we can not
+# send mail to the sender
+if ($IsSuspiciousSender || $IsAutoGenerated || $IsALoop) {
+ $SquelchReplies = 1;
-($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
+ $ErrorsTo = $RT::OwnerEmail;
+
+ #TODO: Is what we want to do here really
+ # "Make the requestor cease to get mail from RT"?
+ # This might wreak havoc with vacation-mailing users.
+ # Maybe have a "disabled for bouncing" state that gets
+ # turned off when we get a legit incoming message
-ok(open(MAIL, "|/opt/rt3/bin/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");
+# {{{ Warn someone if it's a loop
+
+# Warn someone if it's a loop, before we drop it on the ground
+if ($IsALoop) {
+ $RT::Logger->crit("RT Received mail ($MessageId) from itself.");
+
+ #Should we mail it to RTOwner?
+ if ($RT::LoopsToRTOwner) {
+ MailError(To => $RT::OwnerEmail,
+ Subject => "RT Bounce: $Subject",
+ Explanation => "RT thinks this message may be a bounce",
+ MIMEObj => $entity);
+
+ #Do we actually want to store it?
+ exit unless ($RT::StoreLoops);
+ }
+}
# }}}
-# {{{ Testing preservation of binary attachments
-# Get a binary blob (Best Practical logo)
+ #Don't let the user stuff the RT-Squelch-Replies-To header.
+ if ($head->get('RT-Squelch-Replies-To')) {
+ $head->add('RT-Relocated-Squelch-Replies-To',
+ $head->get('RT-Squelch-Replies-To'));
+ $head->delete('RT-Squelch-Replies-To')
+ }
-# 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']);
+if ($SquelchReplies) {
+ ## TODO: This is a hack. It should be some other way to
+ ## indicate that the transaction should be "silent".
-# 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, "|/opt/rt3/bin/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, "|/opt/rt3/bin/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, "|/opt/rt3/bin/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);
+ my ($Sender, $junk) = ParseSenderAddressFromHead($head);
+ $head->add('RT-Squelch-Replies-To', $Sender);
+}
# }}}
-($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket');
-ok ($val, $msg);
+# {{{ If we require that the sender be found in an external DB and they're not
+# forward this message to RTOwner
-=end testing
+if ($RT::LookupSenderInExternalDatabase &&
+ $RT::SenderMustExistInExternalDatabase ) {
-=cut
-
-
-use strict;
-use Getopt::Long;
-use LWP::UserAgent;
-
-use constant EX_TEMPFAIL => 75;
-
-my %opts;
-GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s" );
-
-if ( $opts{help} ) {
- require Pod::Usage;
- import Pod::Usage;
- pod2usage("RT Mail Gateway\n");
- exit 1; # Don't want to succeed if this is really an email!
+ MailError(To => $RT::OwnerEmail,
+ Subject => "RT Bounce: $Subject",
+ Explanation => "RT couldn't find requestor via its external database lookup",
+ MIMEObj => $entity);
+
}
-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
-);
-
+# }}}
-if ($opts{'extension'}) {
- $args{$opts{'extension'}} = $ENV{'EXTENSION'};
+# {{{ elsif we don't have a ticket Id, we're creating a new ticket
+
+
+
+elsif (!defined($TicketId)) {
+
+ # {{{ Create a new ticket
+ if ($Action =~ /correspond/) {
+
+ # open a new ticket
+ my @Requestors = ($CurrentUser->id);
+
+ my @Cc;
+ if ($RT::ParseNewMessageForTicketCcs) {
+ @Cc = ParseCcAddressesFromHead(Head => $head,
+ CurrentUser => $CurrentUser,
+ QueueObj => $QueueObj );
+ }
+
+ my $Ticket = new RT::Ticket($CurrentUser);
+ my ($id, $Transaction, $ErrStr) =
+ $Ticket->Create ( Queue => $Queue,
+ Subject => $Subject,
+ Owner => $AssignTicketTo,
+ Requestor => \@Requestors,
+ Cc => \@Cc,
+ MIMEObj => $entity
+ );
+ if ($id == 0 ) {
+ MailError( To => $ErrorsTo,
+ Subject => "Ticket creation failed",
+ Explanation => $ErrStr,
+ MIMEObj => $entity
+ );
+ $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr ");
+ }
+ }
+
+ # }}}
+
+ else {
+ #TODO Return an error message
+ MailError( To => $ErrorsTo,
+ Subject => "No ticket id specified",
+ Explanation => "$Action aliases require a TicketId to work on",
+ MIMEObj => $entity
+ );
+
+ $RT::Logger->crit("$Action aliases require a TicketId to work on ".
+ "(from ".$CurrentUser->UserObj->EmailAddress.") ".
+ $MessageId);
+ }
}
-# Set up cookie here.
-
-my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";
-warn "Connecting to $full_url" if $opts{'debug'};
-
-
-
-my $r = $ua->post( $full_url, {%args} );
-check_failure($r);
-
-my $content = $r->content;
-warn $content if ($opts{debug});
-
-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
-RT server error.
-
-The RT server which handled your email did not behave as expected. It
-said:
-
-$content
-EOF
-
-}
+# }}}
-sub check_failure {
- my $r = shift;
- return if $r->is_success();
-
- # This ordinarily oughtn't to be able to happen, suggests a bug in RT.
- # So only load these heavy modules when they're needed.
- require HTML::TreeBuilder;
- require HTML::FormatText;
-
- my $error = $r->error_as_HTML;
- my $tree = HTML::TreeBuilder->new->parse($error);
- $tree->eof;
-
- # It'll be a cold day in hell before RT sends out bounces in HTML
- my $formatter = HTML::FormatText->new( leftmargin => 0,
- rightmargin => 50 );
- warn $formatter->format($tree);
- warn "This is $0 exiting because of an undefined server error" if ($opts{debug});
- exit EX_TEMPFAIL;
+# {{{ If we've got a ticket ID, update the ticket
+
+else {
+
+ # If the action is comment, add a comment.
+ if ($Action =~ /comment/i){
+
+ my $Ticket = new RT::Ticket($CurrentUser);
+ $Ticket->Load($TicketId);
+ unless ($Ticket->Id) {
+ MailError( To => $ErrorsTo,
+ Subject => "Comment not recorded",
+ Explanation => "Could not find a ticket with id $TicketId",
+ MIMEObj => $entity
+ );
+ #Return an error message saying that Ticket "#foo" wasn't found.
+ }
+
+ ($status, $msg) = $Ticket->Comment(MIMEObj=>$entity);
+ unless ($status) {
+ #Warn the sender that we couldn't actually submit the comment.
+ MailError( To => $ErrorsTo,
+ Subject => "Comment not recorded",
+ Explanation => $msg,
+ MIMEObj => $entity
+ );
+ }
+ }
+
+ # If the message is correspondence, add it to the ticket
+ elsif ($Action =~ /correspond/i) {
+ my $Ticket = RT::Ticket->new($CurrentUser);
+ $Ticket->Load($TicketId);
+
+ #TODO: Check for error conditions
+ ($status, $msg) = $Ticket->Correspond(MIMEObj => $entity);
+ unless ($status) {
+
+ #Return mail to the sender with an error
+ MailError( To => $ErrorsTo,
+ Subject => "Correspondence not recorded",
+ Explanation => $msg,
+ MIMEObj => $entity
+ );
+ }
+ }
+
+ else {
+ #Return mail to the sender with an error
+ MailError( To => $ErrorsTo,
+ Subject => "RT Configuration error",
+ Explanation => "'$Action' not a recognized action.".
+ " Your RT administrator has misconfigured ".
+ "the mail aliases which invoke RT" ,
+ MIMEObj => $entity
+ );
+
+ $RT::Logger->crit("$Action type unknown for $MessageId");
+
+ }
+
}
+# }}}
-=head1 SYNOPSIS
-
- rt-mailgate --help : this text
-
-Usual invocation (from MTA):
-
- rt-mailgate --action (correspond|comment) --queue queuename
- --url http://your.rt.server/
- [ --extension (queue|action|ticket)
-
-See C<man rt-mailgate> for more.
-
-=head1 OPTIONS
-
-=over 3
-
-=item C<--action>
-
-Specifies whether this is a correspondence or comment address.
-
-=item C<--queue>
-
-Reflects which queue this address handles.
-
-=item C<--url>
-
-The location of the web server for your RT instance.
-
-
-=item C<--extension> OPTIONAL
-
-Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host
-and present "foo" in the environment variable $EXTENSION. By specifying
-the value "queue" for this parameter, the queue this message should be
-submitted to will be set to the value of $EXTENSION. By specifying
-"ticket", $EXTENSION will be interpreted as the id of the ticket this message
-is related to. "action" will allow the user to specify either "comment" or
-"correspond" in the address extension.
-
-
-=head1 DESCRIPTION
-
-The RT mail gateway is the primary mechanism for communicating with RT
-via email. This program simply directs the email to the RT web server,
-which handles filing correspondence and sending out any required mail.
-It is designed to be run as part of the mail delivery process, either
-called directly by the MTA or C<procmail>, or in a F<.forward> or
-equivalent.
-
-=head1 SETUP
-
-Much of the set up of the mail gateway depends on your MTA and mail
-routing configuration. However, you will need first of all to create an
-RT user for the mail gateway and assign it a password; this helps to
-ensure that mail coming into the web server did originate from the
-gateway.
-
-Next, you need to route mail to C<rt-mailgate> for the queues you're
-monitoring. For instance, if you're using F</etc/aliases> and you have a
-"bugs" queue, you will want something like this:
-
- bugs: "|/opt/rt3/bin/rt-mailgate --queue bugs --action correspond
- --url http://rt.mycorp.com/"
-
- bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment
- --url http://rt.mycorp.com/"
-
-Note that you don't have to run your RT server on your mail server, as
-the mail gateway will happily relay to a different machine.
-
-=head1 CUSTOMIZATION
-
-By default, the mail gateway will accept mail from anyone. However,
-there are situations in which you will want to authenticate users
-before allowing them to communicate with the system. You can do this
-via a plug-in mechanism in the RT configuration.
-
-You can set the array C<@RT::MailPlugins> to be a list of plugins. The
-default plugin, if this is not given, is C<Auth::MailFrom> - that is,
-authentication of the person is done based on the C<From> header of the
-email. If you have additional filters or authentication mechanisms, you
-can list them here and they will be called in order:
-
- @RT::MailPlugins = (
- "Filter::SpamAssassin",
- "Auth::LDAP",
- # ...
- );
-
-See the documentation for any additional plugins you have.
-
-You may also put Perl subroutines into the C<@RT::MailPlugins> array, if
-they behave as described below.
-
-=head1 WRITING PLUGINS
-
-What's actually going on in the above is that C<@RT::MailPlugins> is a
-list of Perl modules; RT prepends C<RT::Interface::Email::> to the name,
-to form a package name, and then C<use>'s this module. The module is
-expected to provide a C<GetCurrentUser> subroutine, which takes a hash of
-several parameters:
-
-=over 4
-
-=item Message
-
-A C<MIME::Entity> object representing the email
-=item CurrentUser
-
-An C<RT::CurrentUser> object
-
-=item AuthStat
-
-The authentication level returned from the previous plugin.
-
-=item Ticket [OPTIONAL]
-
-The ticket under discussion
-
-=item Queue [OPTIONAL]
-
-If we don't already have a ticket id, we need to know which queue we're talking about
+$RT::Handle->Disconnect();
-=item Action
-The action being performed. At the moment, it's one of "comment" or "correspond"
+# Everything below this line is a helper sub. most of them will eventually
+# move to Interface::Email
-=back 4
+#When we call die, trap it and log->crit with the value of the die.
+$SIG{__DIE__} = sub {
+ unless ($^S || !defined $^S ) {
+ $RT::Logger->crit("$_[0]");
+ MailError( To => $ErrorsTo,
+ Bcc => $RT::OwnerEmail,
+ Subject => "RT Critical error. Message not recorded!",
+ Explanation => "$_[0]",
+ MIMEObj => $entity
+ );
+ exit(-1);
+ }
+ else {
+ #Get out of here if we're in an eval
+ die $_[0];
+ }
+};
-It returns two values, the new C<RT::CurrentUser> object, and the new
-authentication level. The authentication level can be zero, not allowed
-to communicate with RT at all, (a "permission denied" error is mailed to
-the correspondent) or one, which is the normal mode of operation.
-Additionally, if C<-1> is returned, then the processing of the plug-ins
-stops immediately and the message is ignored.
-=cut
+1;
diff --git a/rt/bin/rt-mailgate.in b/rt/bin/rt-mailgate.in
deleted file mode 100644
index 2ddb604ec..000000000
--- a/rt/bin/rt-mailgate.in
+++ /dev/null
@@ -1,648 +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
-
-=head1 NAME
-
-rt-mailgate - Mail interface to RT3.
-
-=begin testing
-
-use RT::I18N;
-
-# Make sure that when we call the mailgate wrong, it tempfails
-
-ok(open(MAIL, "|@RT_BIN_PATH@/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, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost".$RT::WebPath."/ --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);
-
-#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');
-$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".$RT::WebPath."/ --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);
-#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');
-$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".$RT::WebPath."/ --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);
-#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');
-$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".$RT::WebPath."/ --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);
-#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');
-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".$RT::WebPath."/ --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);
-#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');
-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".$RT::WebPath."/ --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);
-
-#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");
-
-# }}}
-# {{{ 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".$RT::WebPath."/ --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);
-
-#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 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 => '@MASON_HTML_PATH@/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".$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');
- $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".$RT::WebPath."/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".$RT::WebPath."/ --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);
-
-#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');
-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".$RT::WebPath."/ --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);
-
-#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');
-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
-
-
-use strict;
-use Getopt::Long;
-use LWP::UserAgent;
-
-use constant EX_TEMPFAIL => 75;
-
-my %opts;
-GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" );
-
-if ( $opts{help} ) {
- require Pod::Usage;
- import Pod::Usage;
- pod2usage("RT Mail Gateway\n");
- exit 1; # Don't want to succeed if this is really an email!
-}
-
-for (qw(url)) {
- die "$0 invoked improperly\n\nNo $_ provided to mail gateway!\n" unless $opts{$_};
-}
-
-undef $/;
-my $ua = LWP::UserAgent->new();
-$ua->cookie_jar( { file => $opts{jar} } );
-
-my %args = (
- queue => $opts{queue},
- action => $opts{action},
- SessionType => 'REST', # Surpress login box
-);
-
-# Read the message in from STDIN
-$args{'message'} = <>;
-
-
-if ($opts{'extension'}) {
- $args{$opts{'extension'}} = $ENV{'EXTENSION'};
-}
-
-# Set up cookie here.
-
-my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";
-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);
-
-my $content = $r->content;
-warn $content if ($opts{debug});
-
-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.
- warn <<EOF;
-RT server error.
-
-The RT server which handled your email did not behave as expected. It
-said:
-
-$content
-EOF
-
-exit EX_TEMPFAIL;
-
-}
-
-exit;
-
-
-sub check_failure {
- my $r = shift;
- return if $r->is_success();
-
- # This ordinarily oughtn't to be able to happen, suggests a bug in RT.
- # So only load these heavy modules when they're needed.
- require HTML::TreeBuilder;
- require HTML::FormatText;
-
- my $error = $r->error_as_HTML;
- my $tree = HTML::TreeBuilder->new->parse($error);
- $tree->eof;
-
- # It'll be a cold day in hell before RT sends out bounces in HTML
- my $formatter = HTML::FormatText->new( leftmargin => 0,
- rightmargin => 50 );
- warn $formatter->format($tree);
- warn "This is $0 exiting because of an undefined server error" if ($opts{debug});
- exit EX_TEMPFAIL;
-}
-
-
-=head1 SYNOPSIS
-
- rt-mailgate --help : this text
-
-Usual invocation (from MTA):
-
- rt-mailgate --action (correspond|comment) --queue queuename
- --url http://your.rt.server/
- [ --debug ]
- [ --extension (queue|action|ticket) ]
- [ --timeout seconds ]
-
-
-
-See C<man rt-mailgate> for more.
-
-=head1 OPTIONS
-
-=over 3
-
-=item C<--action>
-
-Specifies whether this is a correspondence or comment address.
-
-=item C<--queue>
-
-Reflects which queue this address handles.
-
-=item C<--url>
-
-The location of the web server for your RT instance.
-
-
-=item C<--extension> OPTIONAL
-
-Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host
-and present "foo" in the environment variable $EXTENSION. By specifying
-the value "queue" for this parameter, the queue this message should be
-submitted to will be set to the value of $EXTENSION. By specifying
-"ticket", $EXTENSION will be interpreted as the id of the ticket this message
-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
-
-The RT mail gateway is the primary mechanism for communicating with RT
-via email. This program simply directs the email to the RT web server,
-which handles filing correspondence and sending out any required mail.
-It is designed to be run as part of the mail delivery process, either
-called directly by the MTA or C<procmail>, or in a F<.forward> or
-equivalent.
-
-=head1 SETUP
-
-Much of the set up of the mail gateway depends on your MTA and mail
-routing configuration. However, you will need first of all to create an
-RT user for the mail gateway and assign it a password; this helps to
-ensure that mail coming into the web server did originate from the
-gateway.
-
-Next, you need to route mail to C<rt-mailgate> for the queues you're
-monitoring. For instance, if you're using F</etc/aliases> and you have a
-"bugs" queue, you will want something like this:
-
- bugs: "|/opt/rt3/bin/rt-mailgate --queue bugs --action correspond
- --url http://rt.mycorp.com/"
-
- bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment
- --url http://rt.mycorp.com/"
-
-Note that you don't have to run your RT server on your mail server, as
-the mail gateway will happily relay to a different machine.
-
-=head1 CUSTOMIZATION
-
-By default, the mail gateway will accept mail from anyone. However,
-there are situations in which you will want to authenticate users
-before allowing them to communicate with the system. You can do this
-via a plug-in mechanism in the RT configuration.
-
-You can set the array C<@RT::MailPlugins> to be a list of plugins. The
-default plugin, if this is not given, is C<Auth::MailFrom> - that is,
-authentication of the person is done based on the C<From> header of the
-email. If you have additional filters or authentication mechanisms, you
-can list them here and they will be called in order:
-
- @RT::MailPlugins = (
- "Filter::SpamAssassin",
- "Auth::LDAP",
- # ...
- );
-
-See the documentation for any additional plugins you have.
-
-You may also put Perl subroutines into the C<@RT::MailPlugins> array, if
-they behave as described below.
-
-=head1 WRITING PLUGINS
-
-What's actually going on in the above is that C<@RT::MailPlugins> is a
-list of Perl modules; RT prepends C<RT::Interface::Email::> to the name,
-to form a package name, and then C<use>'s this module. The module is
-expected to provide a C<GetCurrentUser> subroutine, which takes a hash of
-several parameters:
-
-=over 4
-
-=item Message
-
-A C<MIME::Entity> object representing the email
-=item CurrentUser
-
-An C<RT::CurrentUser> object
-
-=item AuthStat
-
-The authentication level returned from the previous plugin.
-
-=item Ticket [OPTIONAL]
-
-The ticket under discussion
-
-=item Queue [OPTIONAL]
-
-If we don't already have a ticket id, we need to know which queue we're talking about
-
-=item Action
-
-The action being performed. At the moment, it's one of "comment" or "correspond"
-
-=back 4
-
-It returns two values, the new C<RT::CurrentUser> object, and the new
-authentication level. The authentication level can be zero, not allowed
-to communicate with RT at all, (a "permission denied" error is mailed to
-the correspondent) or one, which is the normal mode of operation.
-Additionally, if C<-1> is returned, then the processing of the plug-ins
-stops immediately and the message is ignored.
-
-=cut
-
diff --git a/rt/bin/rt.in b/rt/bin/rt.in
deleted file mode 100644
index 90369b5b3..000000000
--- a/rt/bin/rt.in
+++ /dev/null
@@ -1,1816 +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
-
-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 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/',
- ),
- 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"],
- 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"],
-);
-
-# Once we find and call an appropriate handler, we're done.
-
-my (%actions, $action);
-foreach my $fn (keys %handlers) {
- foreach my $alias (@{ $handlers{$fn} }) {
- $actions{$alias} = \&{"$fn"};
- }
-}
-if (@ARGV && exists $actions{$ARGV[0]}) {
- $action = shift @ARGV;
-}
-$actions{$action || "help"}->($action || ());
-exit;
-
-# Handler functions.
-# ------------------
-#
-# The following subs are handlers for each entry in %actions.
-
-sub version {
- print "rt $VERSION\n";
-}
-
-sub logout {
- submit("$REST/logout") if defined $session->cookie;
-}
-
-sub help {
- my ($action, $type) = @_;
- my (%help, $key);
-
- # What help topics do we know about?
- 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, $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$/) {
- $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;
- }
- }
-
- $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, orderby => $orderby || "" });
- 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;
- exit;
- }
-
- 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;
- exit -1;
- }
- }
- 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]'.";
- exit -1;
- }
- push @files, shift @ARGV;
- }
- elsif (/-([bc])/) {
- my $a = $_ eq "-b" ? \@bcc : \@cc;
- @$a = split /\s*,\s*/, shift @ARGV;
- }
- elsif (/-m/) { $msg = shift @ARGV }
- 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 || '',
- }
- ];
-
- my $text = Form::compose([ $form ]);
-
- if ($edit || !$msg) {
- my $error = 0;
- my ($c, $o, $k, $e);
-
- do {
- my $ntext = vi($text);
- exit 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) {
- exit;
- }
- @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 relationship '$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/;
-
- # "RT/3.0.1 401 Credentials required"
- if ($status !~ m#^RT/\d+(?:\.\d+)+(?:-?\w+)? (\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=([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+ [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") {
- 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) = @_;
-
- open(CFG, $file) && do {
- while (<CFG>) {
- chomp;
- next if (/^#/ || /^\s*$/);
-
- if (/^(user|passwd|server)\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.
-
- 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.
-
---
-
-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-20".
-
- 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 -t '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> <relationship> <id-B>
-
- Creates (or, with -d, deletes) a link between the specified tickets.
- The relationship 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 relationships, 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/rtadmin b/rt/bin/rtadmin
new file mode 100644
index 000000000..25ba1b06a
--- /dev/null
+++ b/rt/bin/rtadmin
@@ -0,0 +1,1040 @@
+#!!!PERL!! -w
+#
+# $Header: /home/cvs/cvsroot/freeside/rt/bin/Attic/rtadmin,v 1.1 2002-08-12 06:17:07 ivan Exp $
+# RT is (c) 1996-2001 Jesse Vincent <jesse@fsck.com>
+
+use strict;
+use Carp;
+use Getopt::Long qw(:config pass_through);
+
+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);
+}
+
+
+
+
+PickMode();
+
+
+# {{{ Help
+
+sub Help {
+
+ # {{{ help_acl
+my $help_acl ="
+ Access control
+ --grant-right <right>
+ --revoke-right <right>
+ --userid <user>
+ --groupid <group>
+ --list-rights";
+
+# }}}
+
+ # {{{ help_keyword_sel
+my $help_keyword_sel = "
+ Keyword Selections
+ --add-keyword-select
+ --modify-keyword-select <name>
+ --ks-name <name>
+ --ks-keyword <keyword>
+ --ks-single
+ --ks-multiple
+ --ks-depth <int>
+
+ --disable-keyword-select <name>";
+# }}}
+
+ # {{{ help_scrip
+my $help_scrip = "
+ Scrips
+ --create-scrip
+ --scrip-condition <condition name or id>
+ --scrip-action <action name or id>
+ --scrip-template <template name or id>
+
+ --delete-scrip <id>
+ --list-scrips";
+
+# }}}
+
+ # {{{ help_template
+my $help_template = "
+ Templates
+ --delete-template [<id>|<name>]
+ --display-template [<id>|<name>]
+
+ --create-template
+ --modify-template [<id>|<name>]
+ Flags for --create-template and --modify-template
+ --template-name
+ --template-description
+ --template-edit-content
+
+ --list-templates";
+
+# }}}
+
+
+print <<EOF;
+
+USAGE: rtadmin --user <userid> [Userflags]
+ rtadmin --list-users
+ rtadmin --queue <queueid> [Queueflags]
+ rtadmin --list-queues
+ rtadmin --group [groupflags]
+ rtadmin --list-groups
+ rtadmin --system [SystemFlags]
+ rtadmin --keyword [keywordflags]
+
+User configuration for --user <userid>
+
+ --disable
+ --create
+ --display
+
+ Core Attributes
+ --userid
+ --gecos
+ --password
+ --emailaddress
+ --privileged
+ --comments
+ --signature
+ --organization
+
+ Names
+ --realname
+ --nickname
+
+ Auth and external info
+ --externalcontactinfoid
+ --contactinfosystem
+ --externalauthid
+ --authsystem
+
+ Phone numbers
+ --pagerphone
+ --workphone
+ --mobilemphone
+ --homephone
+
+ Paper address
+ --address1
+ --address2
+ --city
+ --state
+ --zip
+ --country
+ --freeformcontactqinfo
+
+
+Group Configuration for --group <groupid>
+ --create
+ --delete
+ --display
+
+ --name <new name>
+ --description <new description>
+
+
+
+ --add-member <userid>
+ --delete-member <userid>
+ --list-members
+
+Queue Configuration for --queue <queueid>
+ --create
+ --disable
+ --display
+
+ --name <name>
+ --correspondaddress <email address>
+ --commentaddress <email address>
+ --initialpriority <int>
+ --finalpriority <int>
+ --defaultduein <days>
+
+ --add-cc <email address>
+ --delete-cc <email address>
+ --add-admincc <email address>
+ --delete-admincc <email address>
+ --list-watchers
+
+
+
+$help_acl
+
+$help_keyword_sel
+
+$help_template
+
+$help_scrip
+
+
+System configuration for --system
+
+$help_acl
+
+$help_keyword_sel
+
+$help_template
+
+$help_scrip
+
+
+Keyword configuration for --keyword <fully qualified name>
+ --list-children
+ --create-child <name>
+ --disable
+ --name <new name>
+ --description <new description>
+
+EOF
+
+
+
+}
+
+# }}}
+
+# {{{ PickMode
+
+sub PickMode {
+ my ($user,$group, $queue, $system, $keyword, $listusers,
+ $listgroups, $listqueues, $help);
+
+
+ GetOptions ('help|h|usage' => \$help,
+ 'user=s' => \$user,
+ 'queue=s' => \$queue,
+ 'group=s' => \$group,
+ 'system' => \$system,
+ 'keyword=s', => \$keyword,
+ 'list-users' => \$listusers,
+ 'list-queues' => \$listqueues,
+ 'list-groups' => \$listgroups,
+ );
+
+
+
+ if ($user) { AdminUser($user) }
+ elsif ($group) { AdminGroup($group) }
+ elsif ($queue) { AdminQueue($queue) }
+ elsif ($system) { AdminSystem($system) }
+ elsif ($keyword) { AdminKeywords($keyword) }
+ elsif ($listusers) { ListUsers() }
+ elsif ($listgroups) { ListGroups() }
+ elsif ($listqueues) { ListQueues() }
+ elsif ($help) { Help()}
+ else {
+ print "No command found\n";
+ }
+ exit(0);
+}
+
+# }}}
+
+# {{{ AdminUser
+
+sub AdminUser {
+ my $user=shift;
+ my %args;
+
+ GetOptions(\%args,
+ 'create', 'disable|delete', 'display',
+ 'Name=s', 'Gecos=s', 'Password=s',
+ 'EmailAddress=s', 'Privileged=s', 'Comments=s', 'Signature=s',
+ 'Organization=s', 'RealName=s', 'NickName=s',
+ 'ExternalContactInfoId=s', 'ContactInfoSystem=s',
+ 'ExternalAuthId=s', 'AuthSystem=s',
+ 'HomePhone=s', 'WorkPhone=s', 'MobilePhone=s', 'PagerPhone=s',
+ 'Address1=s', 'Address2=s', 'City=s', 'State=s', 'Zip=s',
+ 'Country=s', 'FreeformContactInfo=s');
+
+ my $user_obj = new RT::User($CurrentUser);
+
+
+ #Create the user if we need to
+ if ($args{'create'}) {
+ my ($status, $msg) =
+ $user_obj->Create( Name => ($args{'Name'} || $user),
+ Gecos => $args{'Gecos'},
+ Password => $args{'Password'},
+ EmailAddress => $args{'EmailAddress'},
+ Privileged => $args{'Privileged'},
+ Comments => $args{'Comments'},
+ Signature => $args{'Signature'},
+ Organization => $args{'Organization'},
+ RealName => $args{'RealName'},
+ NickName => $args{'NickName'},
+ ExternalContactInfoId => $args{'ExternalContactInfoId'},
+ ContactInfoSystem => $args{'ContactInfoSystem'},
+ ExternalAuthId => $args{'ExternalAuthId'},
+ AuthSystem => $args{'AuthSystem'},
+ HomePhone => $args{'HomePhone'},
+ WorkPhone => $args{'WorkPhone'},
+ MobilePhone => $args{'MobilePhone'},
+ PagerPhone => $args{'PagerPhone'},
+ Address1 => $args{'Address1'},
+ Address2 => $args{'Address2'},
+ City => $args{'City'},
+ State => $args{'State'},
+ Zip => $args{'Zip'},
+ FreeformContactInfo => $args{'FreeformContactInfo'}
+ );
+
+ print "$msg\n";
+ return();
+
+ }
+ else {
+
+
+ #Load the user
+ $user_obj->Load($user);
+
+ unless ($user_obj->id) {
+ print "User '$user' not found\n";
+ return();
+ }
+
+
+
+ #modify the user if we need to
+ my @attributes = ('Name', 'Gecos',
+ 'EmailAddress', 'Privileged', 'Comments', 'Signature',
+ 'Organization', 'RealName', 'NickName',
+ 'ExternalContactInfoId', 'ContactInfoSystem',
+ 'ExternalAuthId', 'AuthSystem',
+ 'HomePhone', 'WorkPhone', 'MobilePhone', 'PagerPhone',
+ 'Address1', 'Address2', 'City', 'State', 'Zip',
+ 'Country', 'FreeformContactInfo');
+ foreach my $attrib (@attributes) {
+ if ( (exists ($args{"$attrib"})) and
+ ($user_obj->$attrib() ne $args{"$attrib"})) {
+
+ my $method = "Set$attrib";
+ my ($val, $msg) = $user_obj->$method($args{"$attrib"});
+ print "User ".$user_obj->Name. " $attrib: $msg\n";
+
+ }
+ }
+
+ if (exists ($args{'Password'})) {
+ my ($code, $msg);
+ ($code, $msg) = $user_obj->SetPassword($args{'Password'});
+ print "User ". $user_obj->Name. ' Password: '. $msg . "\n";
+ }
+
+ #Check if we need to display the user
+ if ($args{'display'}) {
+ foreach my $attrib (@attributes) {
+ next if ($attrib eq 'Password'); #Can't see the password
+ printf("%22.22s %-64s\n",$attrib, ($user_obj->$attrib()||'(undefined)'));
+
+ }
+ }
+
+ #Check if we need to delete the user
+ if ($args{'disable'}) {
+ my ($val, $msg) = $user_obj->SetDisabled(1);
+ print "$msg\n";
+ }
+
+ }
+}
+
+# }}}
+
+# {{{ AdminQueue
+
+sub AdminQueue {
+ my $queue=shift;
+ my %args;
+
+ GetOptions(\%args,
+ 'create', 'disable|delete', 'display',
+ 'Name=s', 'CorrespondAddress=s', 'Description=s',
+ 'CommentAddress=s', 'InitialPriority=n', 'FinalPriority=n',
+ 'DefaultDueIn=n',
+
+ 'add-cc=s@', 'add-admincc=s@',
+ 'delete-cc=s@', 'delete-admincc=s@',
+ 'list-watchers', 'create-template'
+ );
+
+ use RT::Queue;
+ my $queue_obj = new RT::Queue($CurrentUser);
+
+ #Create the queue if we need to
+ if ($args{'create'}) {
+ my ($status, $msg) =
+ $queue_obj->Create(
+ Name => ($args{'Name'} || $queue) ,
+ CorrespondAddress => $args{'CorrespondAddress'},
+ Description => $args{'Description'},
+ CommentAddress => $args{'CommentAddress'},
+ InitialPriority => $args{'InitialPriority'},
+ FinalPriority => $args{'FinalPriority'},
+ DefaultDueIn => $args{'DefaultDueIn'}
+ );
+
+ print "$msg\n";
+ }
+ else {
+ #Load the queue
+ $queue_obj->Load($queue);
+
+ unless ($queue_obj->id) {
+ print "Queue '$queue' not found\n";
+ return();
+ }
+
+ #modify if we need to
+ my @attributes = qw(Name CorrespondAddress Description
+ CommentAddress InitialPriority FinalPriority
+ DefaultDueIn
+ );
+ foreach my $attrib (@attributes) {
+ if ( (exists ($args{"$attrib"})) and
+ ($queue_obj->$attrib() ne $args{"$attrib"})) {
+
+ my $method = "Set$attrib";
+ my ($val, $msg) = $queue_obj->$method($args{"$attrib"});
+ print "Queue ".$queue_obj->Name. " $attrib: $msg\n";
+
+ }
+ }
+
+
+ #Check if we need to display the queue
+ if ($args{'display'}) {
+ foreach my $attrib (@attributes) {
+ printf("%22.22s %-64s\n",$attrib, ($queue_obj->$attrib()||'(undefined)'));
+
+ }
+ }
+
+ foreach my $person (@{$args{'add-cc'}}) {
+ my ($val, $msg) = $queue_obj->AddCc(Email => $person);
+ print "$msg\n";
+ }
+ foreach my $person (@{$args{'add-admincc'}}) {
+ my ($val, $msg) = $queue_obj->AddAdminCc(Email => $person);
+ print "$msg\n";
+ }
+
+ foreach my $person (@{$args{'delete-cc'}}) {
+ my ($val, $msg) = $queue_obj->DeleteCc($person);
+ print "$msg\n";
+ }
+ foreach my $person (@{$args{'delete-admincc'}}) {
+ my ($val, $msg) = $queue_obj->DeleteAdminCc($person);
+ print "$msg\n";
+ }
+
+ if ($args{'list-watchers'}) {
+ require RT::Watchers;
+ my $watchers = new RT::Watchers($CurrentUser);
+ $watchers->LimitToQueue($queue_obj->id);
+ while (my $watcher = $watchers->Next()) {
+ printf("%10s %-60s\n",
+ $watcher->Type, $watcher->Email );
+ }
+ }
+
+ AdminTemplates($queue_obj->Id());
+ AdminScrips($queue_obj->Id());
+ AdminRights($queue_obj->Id());
+ AdminKeywordSelects($queue_obj->Id());
+
+ #Check if we need to delete the queue
+ if ($args{'disable'}) {
+ my ($val, $msg) = $queue_obj->SetDisabled(1);
+ print "$msg\n";
+ }
+
+ }
+}
+
+# }}}
+
+# {{{ AdminKeywords
+
+sub AdminKeywords {
+ my $keyword = shift;
+
+ my %args;
+ GetOptions(\%args, 'list-children', 'create-child=s', 'disable|delete', 'Name=s', 'Description=s');
+
+ use RT::Keyword;
+
+ my $key_obj = new RT::Keyword($CurrentUser);
+ my $key_id;
+
+ #If we're dealing with the root of the keyword list
+ if ($keyword eq '/') {
+ $key_id=0;
+ }
+ else {
+ my ($val, $msg) = $key_obj->LoadByPath( $keyword );
+ unless ($val) {
+ print $msg ."\n";
+ }
+ $key_id = $key_obj->Id();
+ }
+
+ if ($args{'create-child'}) {
+ my $child = new RT::Keyword($CurrentUser);
+
+ my ($val, $msg) = $child->Create( Parent => $key_id,
+ Name => $args{'create-child'},
+ );
+ print $msg ."\n";
+ }
+
+ elsif ($args{'list-children'}) {
+ my $keywords;
+ if ($key_obj->id) {
+ $keywords = $key_obj->Children();
+ }
+ #If we didn't actually have a keyword object, we need to create our own Keywords object.
+ else {
+ $keywords = new RT::Keywords($CurrentUser);
+ $keywords->LimitToParent(0);
+ }
+
+ while (my $key=$keywords->Next) {
+ print $key->Name;
+ if ($key->Description) {
+ print " (" . $key->Description .")";
+ }
+ print "\n";
+ }
+
+
+ }
+
+ #Else we wanna do some modification.
+ else {
+
+ #If we didn't load a keyword, get out
+ return(undef) unless ($key_obj->Id);
+
+
+ my @attributes = qw( Name Description );
+ foreach my $attrib (@attributes) {
+ if ( (exists ($args{"$attrib"})) and
+ ($key_obj->$attrib() ne $args{"$attrib"})) {
+
+ my $method = "Set$attrib";
+ my ($val, $msg) = $key_obj->$method($args{"$attrib"});
+
+ print "Keyword ".$key_obj->Name. " $attrib: $msg\n"; }
+ }
+
+ if ($args{'disable'}) {
+ $key_obj->SetDisabled(1);
+
+ }
+
+ }
+}
+
+# }}}
+
+# {{{ AdminKeywordSelects
+
+sub AdminKeywordSelects {
+ my $queue = shift;
+ # O for queue means global
+
+ my %args;
+ GetOptions(\%args, 'add-keyword-select','disable-keyword-select|delete-keyword-select=s',
+ 'modify-keyword-select=s',
+ 'keyword-select-Keyword|ks-keyword=s',
+ 'keyword-select-Single|ks-single',
+ 'keyword-select-Multiple|ks-multiple',
+ 'keyword-select-Depth|ks-depth=i',
+ 'keyword-select-Name|ks-name=s'
+ );
+
+ # sanitize single vs multiple.
+ if ($args{'keyword-select-Multiple'}) {
+ $args{'keyword-select-Single'} = 0;
+ }
+
+ use RT::KeywordSelect;
+ my $keysel_obj = new RT::KeywordSelect($CurrentUser);
+ if ($args{'add-keyword-select'}) {
+
+ my ($val, $msg) = $keysel_obj->Create( Keyword => $args{'keyword-select-Keyword'},
+ Depth => $args{'keyword-select-Depth'},
+ Single => $args{'keyword-select-Single'},
+ Name => $args{'keyword-select-Name'},
+ ObjectType => 'Ticket',
+ ObjectField => 'Queue',
+ ObjectValue => $queue);
+ print $msg ."\n";
+ }
+ elsif ($args{'modify-keyword-select'}) {
+ $keysel_obj->LoadByName(Name => $args{'modify-keyword-select'},
+ Queue => $queue
+ );
+
+ unless ($keysel_obj->Id()) {
+ print "Keyword select not found\n";
+ return();
+ }
+ my @attributes = qw( Name Keyword Single Depth );
+ foreach my $attrib (@attributes) {
+ if ( (exists ($args{"keyword-select-$attrib"})) and
+ ($keysel_obj->$attrib() ne $args{"keyword-select-$attrib"})) {
+
+ my $method = "Set$attrib";
+ my ($val, $msg) = $keysel_obj->$method($args{"keyword-select-$attrib"});
+
+ print "Keyword select ".$keysel_obj->Name. " $attrib: $msg\n"; }
+ }
+
+
+ }
+
+
+ elsif ($args{'disable-keyword-select'}) {
+ $keysel_obj->LoadByName(Name => $args{'disable-keyword-select'},
+ Queue => $queue);
+
+ $keysel_obj->SetDisabled(1);
+
+ }
+}
+
+# }}}
+
+# {{{ AdminGroup
+
+sub AdminGroup {
+ my $group = shift;
+
+ my (%args);
+
+ GetOptions(\%args,
+ 'create', 'delete', 'display',
+ 'Name=s', 'Description=s',
+
+ 'add-member=s@', 'delete-member=s@',
+ 'list-members'
+ );
+
+
+ use RT::Group;
+ my $group_obj = new RT::Group($CurrentUser);
+ unless ($group) {
+ print "Group not specified.\n";
+ return();
+ }
+
+
+ #Create the group if we need to
+ if ($args{'create'}) {
+ my ($val, $msg) = $group_obj->Create( Name => ($args{'Name'} || $group),
+ Description => $args{'Description'} );
+ print $msg ."\n";
+ }
+ #otherwise we load it
+ else {
+ $group_obj->Load($group);
+ }
+
+ #If we have no group object, get the hell out
+ unless ($group_obj->Id) {
+ print "Group not found.\n";
+ }
+
+ if ($args{'delete'}) {
+ my ($val, $msg) = $group_obj->Delete();
+ print $msg ."\n";
+ return();
+ }
+
+
+
+ #modify if we need to
+ my @attributes = qw(Name Description
+
+ );
+ foreach my $attrib (@attributes) {
+ if ( (exists ($args{"$attrib"})) and
+ ($group_obj->$attrib() ne $args{"$attrib"})) {
+
+ my $method = "Set$attrib";
+ my ($val, $msg) = $group_obj->$method($args{"$attrib"});
+ print "Group ".$group_obj->Name. " $attrib: $msg\n";
+
+ }
+ }
+
+ foreach my $user (@{$args{'add-member'}}) {
+ my ($val, $msg) = $group_obj->AddMember($user);
+ print $msg. "\n";
+ }
+ foreach my $user (@{$args{'delete-member'}}) {
+ my ($val, $msg) = $group_obj->DeleteMember($user);
+ print $msg ."\n";
+ }
+
+ if ($args{'list-members'}) {
+ my $members = $group_obj->MembersObj();
+ while (my $member = $members->Next()) {
+ print $member->UserObj->Name() ."\n";
+ }
+ }
+
+}
+
+# }}}
+
+# {{{ AdminSystem
+sub AdminSystem {
+ print "In AdminSystem\n";
+
+ AdminTemplates(0);
+ AdminScrips(0);
+ AdminRights(0);
+ AdminKeywordSelects(0);
+}
+# }}}
+
+# {{{ sub AdminTemplates
+
+sub AdminTemplates {
+ my $queue = shift;
+ #Queue = 0 means 'global';
+
+ my %args;
+
+
+ GetOptions(\%args, 'list-templates', 'create-template','modify-template=s',
+ 'delete-template=s', 'display-template=s',
+ 'template-Name=s', 'template-Description=s',
+ 'template-edit-content!');
+
+ # {{{ List templates
+ if ($args{'list-templates'}) {
+ print "Templates for $queue\n";
+ require RT::Templates;
+ my $templates = new RT::Templates($CurrentUser);
+ if ($queue != 0) {
+ $templates->LimitToQueue($queue);
+ }
+ else {
+ $templates->LimitToGlobal();
+ }
+ while (my $template = $templates->Next) {
+ print $template->Id.": ".$template->Name." - " . $template->Description ."\n";
+ }
+ }
+
+ # }}}
+
+ require RT::Template;
+ my $template = new RT::Template($CurrentUser);
+ if ($args{'delete-template'}) {
+ $template->Load($args{'delete-template'});
+ unless ($template->id) {
+ print "Couldn't load template";
+ return(undef);
+ }
+ my ($val, $msg) = $template->Delete();
+ print "$msg\n";
+ }
+ elsif ($args{'create-template'}) {
+ #TODO edit the template content
+ my $content;
+
+ my $linesref = GetMessageContent(CurrentUser => $CurrentUser,
+ Edit => 1);
+
+ $content = join("\n", @{$linesref});
+
+
+ my ($val, $msg) = $template->Create(Name => $args{'template-Name'},
+ Description => $args{'template-Description'},
+ Content => $content,
+ Queue => $queue);
+ print "$msg\n";
+ }
+ elsif ($args{'modify-template'}) {
+
+ $template->Load($args{'modify-template'});
+ unless ($template->Id()) {
+ print "Template not found\n";
+ return();
+ }
+ my @attributes = qw( Name Description );
+ foreach my $attrib (@attributes) {
+ if ( (exists ($args{"template-$attrib"})) and
+ ($template->$attrib() ne $args{"template-$attrib"})) {
+
+ my $method = "Set$attrib";
+ my $val = $template->$method($args{"template-$attrib"});
+
+ }
+ }
+ if ($args{'template-edit-content'}) {
+
+ my $linesref = GetMessageContent(CurrentUser => $CurrentUser,
+ Content => $template->Content,
+ Edit => 1);
+
+ my $content = join("\n", @{$linesref});
+ my ($val) = $template->SetContent($content);
+ print $val."\n";
+ }
+
+ }
+ if ($args{'display-template'}) {
+ $template->Load($args{'display-template'});
+ print $template->Name . "\n". $template->Description ."\n". $template->Content."\n";
+ }
+}
+
+# }}}
+
+# {{{ sub AdminScrips
+
+sub AdminScrips {
+ my $queue = shift;
+ #Queue = 0 means 'global';
+
+ my %args;
+
+
+ GetOptions(\%args, 'list-scrips', 'create-scrip','modify-scrip=s',
+ 'scrip-action=s', 'scrip-template=s', 'scrip-condition=s',
+ 'delete-scrip=s');
+
+
+ # {{{ List entries
+ if ($args{'list-scrips'}) {
+ print "Scrips for $queue\n";
+ require RT::Scrips;
+ my $scrips = new RT::Scrips($CurrentUser);
+ if ($queue != 0) {
+ $scrips->LimitToQueue($queue);
+ }
+ else {
+ $scrips->LimitToGlobal();
+ }
+ while (my $scrip = $scrips->Next) {
+ print $scrip->Id.": If ".
+ $scrip->ConditionObj->Name." then " .
+ $scrip->ActionObj->Name." with template " .
+ $scrip->TemplateObj->Name."\n";
+ }
+ }
+
+ # }}}
+
+ require RT::Scrip;
+ my $scrip = new RT::Scrip($CurrentUser);
+ if ($args{'delete-scrip'}) {
+ $scrip->Load($args{'delete-scrip'});
+ unless ($scrip->id) {
+ print "Couldn't load scrip";
+ return(undef);
+ }
+ my ($val, $msg) = $scrip->Delete();
+ print "$msg\n";
+ }
+ elsif ($args{'create-scrip'}) {
+ my ($val, $msg) = $scrip->Create( ScripAction => $args{'scrip-action'},
+ ScripCondition => $args{'scrip-condition'},
+ Template => $args{'scrip-template'},
+ Queue => $queue);
+
+ print "$msg\n";
+ }
+}
+
+# }}}
+
+# {{{ sub AdminRights
+
+sub AdminRights {
+ my $queue = shift;
+ #Queue = 0 means 'global';
+
+ my ($scope, $appliesto);
+ if ($queue == 0) {
+ $scope = 'System';
+ $appliesto = 0;
+ }
+ else {
+ $scope = 'Queue';
+ $appliesto = $queue;
+ }
+
+ my %args;
+ GetOptions(\%args,
+ 'grant-right|add-right|new-right|create-right=s@',
+ 'revoke-right|del-right|delete-right=s@',
+ 'list-rights', 'userid=s@', 'groupid=s@',
+ );
+
+
+ # {{{ List entries
+ if ($args{'list-rights'}) {
+ require RT::ACL;
+ my $acl = new RT::ACL($CurrentUser);
+ if ($queue != 0) {
+ $acl->LimitToQueue($queue);
+ }
+ else {
+ $acl->LimitToSystem();
+ }
+ while (my $ace = $acl->Next) {
+ print $ace->RightScope;
+
+ #Print the queue name if we have it.
+ print " " . $ace->AppliesToObj->Name if (defined $ace->AppliesToObj);
+
+ print ": ". $ace->PrincipalType . " " .$ace->PrincipalObj->Name .
+ " has right " . $ace->RightName ."\n";
+
+ }
+ }
+
+ # }}}
+
+ require RT::ACE;
+
+ # {{{ Build up an array of principals
+ my (@principals);
+ my $i = 0;
+ foreach my $group (@{$args{'groupid'}}) {
+
+
+ my $princ = new RT::Group($CurrentUser);
+ $princ->Load("$group");
+ if ($princ->id) {
+ $principals[$i]->{'type'} = 'Group';
+ $principals[$i]->{'id'} = $princ->id();
+ $i++;
+ }
+ else {
+ print "Could not find group $group\n";
+ }
+ }
+
+
+ foreach my $user (@{$args{'userid'}}) {
+ my $princ = new RT::User($CurrentUser);
+ $princ->Load("$user");
+ if ($princ->id) {
+ $principals[$i]->{'type'} = 'User';
+ $principals[$i]->{'id'} = $princ->id();
+ $i++;
+ }
+ else {
+ print "Could not find user $user.\n";
+ }
+ }
+ # }}}
+
+
+ foreach my $principal (@principals) {
+
+ # {{{ Delete rights that need deleting
+ foreach my $right (@{$args{'revoke-right'}}) {
+ my $ace = new RT::ACE($CurrentUser);
+ $RT::Logger->debug("Trying to delete a right: $right \n");
+ my ($val, $msg) = $ace->LoadByValues( RightName => $right,
+ RightScope => $scope,
+ PrincipalType => $principal->{'type'},
+ PrincipalId => $principal->{'id'},
+ RightAppliesTo => $appliesto);
+
+ unless ($val) {
+ print "Right $right not found for" . $principal->{'type'} . " " .
+ $principal->{'id'} . " in scope $scope ($appliesto)\n";
+ next;
+ }
+ my ($delval, $delmsg) =$ace->Delete;
+ print "$delmsg\n";
+
+
+ }
+
+ # }}}
+
+ # {{{ grant rights that need granting
+ foreach my $right (@{$args{'grant-right'}}) {
+ my $ace = new RT::ACE($CurrentUser);
+ my ($val, $msg) = $ace->Create(RightName => $right,
+ PrincipalType => $principal->{'type'},
+ PrincipalId => $principal->{'id'},
+ RightScope => $scope,
+ RightAppliesTo => $appliesto);
+
+ print $msg . "\n";
+ }
+
+ # }}}
+ }
+
+}
+
+# }}}
+
+
+sub ListUsers {
+ require RT::Users;
+ my $users = new RT::Users($CurrentUser);
+ $users->UnLimit();
+ while (my $user = $users->Next()) {
+ printf ("%16s %-16s\n",$user->Name(), $user->EmailAddress());
+ }
+}
+sub ListQueues {
+ require RT::Queues;
+ my $queues = new RT::Queues($CurrentUser);
+ $queues->UnLimit();
+ while (my $queue = $queues->Next()) {
+ printf ("%16s %-16s\n",$queue->Name(), $queue->Description());
+ }
+}
+
+sub ListGroups {
+ require RT::Groups;
+ my $groups = new RT::Groups($CurrentUser);
+ $groups->UnLimit();
+ while (my $group = $groups->Next()) {
+ printf ("%16s %-16s\n",$group->Name(), $group->Description());
+ }
+}
diff --git a/rt/bin/webmux.pl b/rt/bin/webmux.pl
index 21cb83f5e..6e1ae06de 100755
--- a/rt/bin/webmux.pl
+++ b/rt/bin/webmux.pl
@@ -1,125 +1,177 @@
-#!/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
+# $Header: /home/cvs/cvsroot/freeside/rt/bin/Attic/webmux.pl,v 1.1 2002-08-12 06:17:07 ivan Exp $
+# RT is (c) 1996-2000 Jesse Vincent (jesse@fsck.com);
use strict;
+$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'};
-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;
+# We really don't want apache to try to eat all vm
+# see http://perl.apache.org/guide/control.html#Preventing_mod_perl_Processes_Fr
+
package RT::Mason;
-use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we
- #set private_tempfiles
+use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we
+ #set private_tempfiles
+use HTML::Mason::ApacheHandler (args_method => 'CGI');
+use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
-BEGIN {
- if ($CGI::MOD_PERL) {
- require HTML::Mason::ApacheHandler;
- }
- else {
- require HTML::Mason::CGIHandler;
- }
-}
+use vars qw($VERSION %session $Nobody $SystemUser $r $m);
-use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
+# List of modules that you want to use from components (see Admin
+# manual for details)
-use vars qw($Nobody $SystemUser $r);
+#Clean up our umask...so that the session files aren't world readable, writable or executable
+umask(0077);
-#This drags in RT's config.pm
-RT::LoadConfig();
-use Carp;
+
+$VERSION="!!RT_VERSION!!";
-{
- 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;
-}
+use lib "!!RT_LIB_PATH!!";
+use lib "!!RT_ETC_PATH!!";
+#This drags in RT's config.pm
+use config;
+use Carp;
+{
+ package HTML::Mason::Commands;
+ use vars qw(%session $m);
+
+ use RT;
+ use RT::Ticket;
+ use RT::Tickets;
+ use RT::Transaction;
+ use RT::Transactions;
+ use RT::User;
+ use RT::Users;
+ use RT::CurrentUser;
+ use RT::Template;
+ use RT::Templates;
+ use RT::Queue;
+ use RT::Queues;
+ use RT::ScripAction;
+ use RT::ScripActions;
+ use RT::ScripCondition;
+ use RT::ScripConditions;
+ use RT::Scrip;
+ use RT::Scrips;
+ use RT::Group;
+ use RT::Groups;
+ use RT::Keyword;
+ use RT::Keywords;
+ use RT::ObjectKeyword;
+ use RT::ObjectKeywords;
+ use RT::KeywordSelect;
+ use RT::KeywordSelects;
+ use RT::GroupMember;
+ use RT::GroupMembers;
+ use RT::Watcher;
+ use RT::Watchers;
+ use RT::Handle;
+ use RT::Interface::Web;
+ use MIME::Entity;
+ use Text::Wrapper;
+ use Apache::Cookie;
+ use Date::Parse;
+ use HTML::Entities;
+
+ #TODO: make this use DBI
+ use Apache::Session::File;
+
+ # Set this page's content type to whatever we are called with
+ sub SetContentType {
+ my $type = shift;
+ $RT::Mason::r->content_type($type);
+ }
+
+ sub CGIObject {
+ $m->cgi_object();
+ }
+
+ }
+my ($parser, $interp, $ah);
+if ($HTML::Mason::VERSION < 1.0902) {
+ $parser = &RT::Interface::Web::NewParser(allow_globals => [%session]);
+
+ $interp = &RT::Interface::Web::NewInterp(parser=>$parser,
+ allow_recursive_autohandlers => 1,
+ );
+
+ $ah = &RT::Interface::Web::NewApacheHandler($interp);
+} else {
+ $ah = &RT::Interface::Web::NewMason11ApacheHandler();
+}
# 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 _ ) );
-}
+#
+chown (Apache->server->uid, Apache->server->gid,
+ [$RT::MasonSessionDir]);
+
+
+chown (Apache->server->uid, Apache->server->gid,
+ $ah->interp->files_written);
+
+# 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;
+ return -1 if defined($r->content_type) && $r->content_type !~ m|^text/|io;
+
+ #This is all largely cut and pasted from mason's session_handler.pl
+
+ my %cookies = Apache::Cookie::parse($r->header_in('Cookie'));
+
+ eval {
+ tie %HTML::Mason::Commands::session, 'Apache::Session::File',
+ ( $cookies{'AF_SID'} ? $cookies{'AF_SID'}->value() : undef ),
+ { Directory => $RT::MasonSessionDir,
+ LockDirectory => $RT::MasonSessionDir,
+ } ;
+ };
+
+ if ( $@ ) {
+ # If the session is invalid, create a new session.
+ if ( $@ =~ m#^Object does not exist in the data store# ) {
+ tie %HTML::Mason::Commands::session, 'Apache::Session::File', undef,
+ { Directory => $RT::MasonSessionDir,
+ LockDirectory => $RT::MasonSessionDir,
+ };
+ undef $cookies{'AF_SID'};
+ }
+ else {
+ die "RT Couldn't write to session directory '$RT::MasonSessionDir'. Check that this directory's permissions are correct.";
+ }
+ }
+
+ if ( !$cookies{'AF_SID'} ) {
+ my $cookie = new Apache::Cookie
+ ($r,
+ -name=>'AF_SID',
+ -value=>$HTML::Mason::Commands::session{_session_id},
+ -path => '/',);
+ $cookie->bake;
- 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;
+ untie %HTML::Mason::Commands::session;
+
return $status;
-}
-
+
+ }
1;
+
diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in
deleted file mode 100644
index dca5705e9..000000000
--- a/rt/bin/webmux.pl.in
+++ /dev/null
@@ -1,148 +0,0 @@
-#!@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'};
- @ORACLE_ENV_PREF@
-}
-
-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
-
-BEGIN {
- if ($mod_perl::VERSION >= 1.9908) {
- require Apache::RequestUtil;
- no warnings 'redefine';
- my $sub = *Apache::request{CODE};
- *Apache::request = sub {
- my $r;
- eval { $r = $sub->('Apache'); };
- # warn $@ if $@;
- return $r;
- };
- }
- 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(@RT::MasonParameters) if $CGI::MOD_PERL;
-
-sub handler {
- ($r) = @_;
-
- local $SIG{__WARN__};
- local $SIG{__DIE__};
-
- 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;
- eval { $status = $ah->handle_request($r) };
- if ($@) {
- $RT::Logger->crit($@);
- }
-
- undef (%session);
-
- if ($RT::Handle->TransactionDepth) {
- $RT::Handle->ForceRollback;
- $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") ;
- }
- return $status;
-}
-
-1;
generated by cgit v1.2.1 (git 2.18.0) at 2025-08-05 16:38:10 +0000