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.in54
-rwxr-xr-xrt/bin/mason_handler.scgi218
-rw-r--r--rt/bin/mason_handler.scgi.in41
-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-crontool210
-rw-r--r--rt/bin/rt-crontool.in210
-rwxr-xr-xrt/bin/rt-mailgate842
-rw-r--r--rt/bin/rt-mailgate.in587
-rw-r--r--rt/bin/rtadmin1040
-rwxr-xr-xrt/bin/webmux.pl248
-rw-r--r--rt/bin/webmux.pl.in125
19 files changed, 4093 insertions, 3362 deletions
diff --git a/rt/bin/initacls.Oracle b/rt/bin/initacls.Oracle
deleted file mode 100644
index 8d05f45e1..000000000
--- a/rt/bin/initacls.Oracle
+++ /dev/null
@@ -1,26 +0,0 @@
-#!/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
deleted file mode 100755
index 82e32de74..000000000
--- a/rt/bin/initacls.Pg
+++ /dev/null
@@ -1,28 +0,0 @@
-#!/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
deleted file mode 100755
index 17e63f837..000000000
--- a/rt/bin/initacls.mysql
+++ /dev/null
@@ -1,20 +0,0 @@
-#!/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 e8a4e128f..431eccbd3 100755
--- a/rt/bin/mason_handler.fcgi
+++ b/rt/bin/mason_handler.fcgi
@@ -1,221 +1,54 @@
-#!!!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);
+#!/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;
-$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 File::Basename;
+require ('/opt/rt3/bin/webmux.pl');
+my $h = &RT::Interface::Web::NewCGIHandler();
-# 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 _ ));
-
+# Enter CGI::Fast mode, which should also work as a vanilla CGI script.
+require CGI::Fast;
RT::Init();
# Response loop
-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;
- }
-
- }
-
- }
-
-
- 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.";
- }
+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");
}
-
- 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;
-
+ $h->handle_cgi_object($cgi);
+ # _should_ always be tied
}
+
+1;
diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in
new file mode 100644
index 000000000..e932bfc29
--- /dev/null
+++ b/rt/bin/mason_handler.fcgi.in
@@ -0,0 +1,54 @@
+#!@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();
+
+# 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'};
+
+ unless ($h->interp->comp_exists($cgi->path_info)) {
+ $cgi->path_info($cgi->path_info . "/index.html");
+ }
+ $h->handle_cgi_object($cgi);
+ # _should_ always be tied
+}
+
+1;
diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi
index b9846c898..8e1135c2f 100755
--- a/rt/bin/mason_handler.scgi
+++ b/rt/bin/mason_handler.scgi
@@ -1,193 +1,41 @@
-#!!!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.
+#!/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
use strict;
-# {{{ 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:
+require ('/opt/rt3/bin/webmux.pl');
-my $r=new HTML::Mason::FakeApache;
+my $h = &RT::Interface::Web::NewCGIHandler();
-$|=1; # set output to non-buffered.
+require CGI;
-my %cgi;
-CGI::ReadParse(\%cgi); # %cgi is now a tied hash containing our params.
+RT::Init();
-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;
-
-
+my $cgi = CGI->new;
+unless ($h->interp->comp_exists($cgi->path_info)) {
+ $cgi->path_info($cgi->path_info . "/index.html");
}
-# }}}
-
-# {{{ 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";
- }
- }
-
-# }}}
+$h->handle_cgi_object($cgi);
-untie %HTML::Mason::Commands::session;
+1;
diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in
new file mode 100644
index 000000000..37d8380c2
--- /dev/null
+++ b/rt/bin/mason_handler.scgi.in
@@ -0,0 +1,41 @@
+#!@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();
+
+require CGI;
+
+RT::Init();
+
+my $cgi = CGI->new;
+unless ($h->interp->comp_exists($cgi->path_info)) {
+ $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
new file mode 100644
index 000000000..e6d83784c
--- /dev/null
+++ b/rt/bin/mason_handler.svc
@@ -0,0 +1,234 @@
+#!/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::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
new file mode 100644
index 000000000..cc12c0ef0
--- /dev/null
+++ b/rt/bin/mason_handler.svc.in
@@ -0,0 +1,234 @@
+#!@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::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
deleted file mode 100755
index 41220bb56..000000000
--- a/rt/bin/rt
+++ /dev/null
@@ -1,1391 +0,0 @@
-#!!!PERL!! -w
-#
-# $Header: /home/cvs/cvsroot/freeside/rt/bin/Attic/rt,v 1.1 2002-08-12 06:17:07 ivan Exp $
-# RT is (c) 1996-2001 Jesse Vincent <jesse@bestpractical.com>
-
-use strict;
-use Carp;
-use Getopt::Long;
-
-use lib "!!RT_LIB_PATH!!";
-use lib "!!RT_ETC_PATH!!";
-
-use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect
- GetCurrentUser GetMessageContent);
-
-#Clean out all the nasties from the environment
-CleanEnv();
-
-#Load etc/config.pm and drop privs
-LoadConfig();
-
-#Connect to the database and get RT::SystemUser and RT::Nobody loaded
-DBConnect();
-
-#Drop setgid permissions
-RT::DropSetGIDPermissions();
-
-#Get the current user all loaded
-my $CurrentUser = GetCurrentUser();
-
-unless ($CurrentUser->Id) {
- print "No RT user found. Please consult your RT administrator.\n";
- exit(1);
-}
-
-
-# {{{ commandline flags
-
-my ( @id,
- @limit_queue,
- @limit_status,
- @limit_owner,
- @limit_priority,
- @limit_final_priority,
- @limit_requestor,
- @limit_subject,
- @limit_body,
- @limit_created,
- @limit_resolved,
- @limit_lastupdated,
- @limit_dependson,
- @limit_dependedonby,
- @limit_memberof,
- @limit_hasmember,
- @limit_refersto,
- @limit_referredtoby,
- @limit_keyword,
-
- @limit_due,
- @limit_starts,
- @limit_started,
- $limit_first,
- $limit_rows,
- $history,
- $summary,
- $create,
- @requestors,
- @cc,
- @admincc,
- $status,
- $subject,
- $owner,
- $steal,
- $queue,
- $time_left,
- $priority,
- $final_priority,
- $due,
- $starts,
- $started,
- $contacted,
- $comment,
- $reply,
- $source,
- $edit,
- @dependson,
- @memberof,
- @refersto,
- $mergeinto,
- @keywords,
- $time_taken,
- $verbose,
- $debug,
- $help,
- $version);
-
-# }}}
-
-# Set defaults for cli args
-
-$edit = 1; # Assume the user wants to edit replies and comments
- # unless they specify --noedit
-
-# {{{ args
-
-my @args =("id=s" => \@id,
- "limit-queue=s" => \@limit_queue,
- "limit-status=s" => \@limit_status,
- "limit-owner=s" => \@limit_owner,
- "limit-priority=s" => \@limit_priority,
- "limit-final-priority=s" => \@limit_final_priority,
- "limit-requestor=s" => \@limit_requestor,
- "limit-subject=s" => \@limit_subject,
- "limit-body=s", \@limit_body,
- "limit-created=s" => \@limit_created,
- "limit-due=s" => \@limit_due,
- "limit-last-updated=s" => \@limit_lastupdated,
- "limit-keyword=s" => \@limit_keyword,
-
- "limit-member-of=s" => \@limit_memberof,
- "limit-has-member=s" => \@limit_hasmember,
- "limit-depended-on-by=s" => \@limit_dependedonby,
- "limit-depends-on=s" => \@limit_dependson,
- "limit-referred-to-by=s" => \@limit_referredtoby,
- "limit-refers-to=s" => \@limit_refersto,
-
- "limit-starts=s" => \@limit_starts,
- "limit-started=s" => \@limit_started,
- "limit-first=i" => \$limit_first,
- "limit-rows=i" => \$limit_rows,
- "history|show" => \$history,
- "summary:s" => \$summary,
- "create" => \$create,
- "keywords=s" => \@keywords,
- "requestor|requestors=s" => \@requestors,
- "cc=s" => \@cc,
- "admincc=s" => \@admincc,
- "status=s" => \$status,
- "subject=s" => \$subject,
- "owner=s" => \$owner,
- "steal" => \$steal,
- "queue=s" => \$queue,
-
-
- "priority=i" => \$priority,
- "final-priority=i" => \$final_priority,
- "due=s" => \$due,
- "starts=s" => \$starts,
- "started=s" => \$started,
- "contacted=s" => \$contacted,
- "comment", \$comment,
- "reply|respond", \$reply,
- "source=s" => \$source,
- "edit!" => \$edit,
- "depends-on=s" => \@dependson,
- "member-of=s" => \@memberof,
- "merge-into=s" => \$mergeinto,
- "refers-to=s" => \@refersto,
- "time-left=i" => \$time_left,
- "time-taken=i" => \$time_taken,
- "verbose+" => \$verbose,
- "debug" => \$debug,
- "version" => \$version,
- "help|h|usage" => \$help
- );
-
-# }}}
-
-
-
-GetOptions(@args);
-
-print join(':',@keywords);
-# {{{ If they want it, print a usage message and get out
-
-if ($help) {
-
-
-print <<EOUSAGE;
-
-Limit the set of records returned:
-
---id=[first][-][last]
- Specify a single ticket, a range, or to start with (n-) or end with (-n)
-a specific ticket.
-
- --limit-queue=<queue>
- --limit-status=[!](new|open|stalled|resolved)
-
- --limit-owner=[!]<userid>
- --limit-priority=[starts][-][ends]
- --limit-final-priority=[starts][-][ends]
- starts is less than ends
- --limit-requestor=[!]<userid>|<email>
- --limit-subject=[!]<text>
- --limit-body=[!]<text>
- --limit-keyword=[!]<select>/<keyword>
-
- Links
- --limit-member-of=<ticketid>
- --limit-has-member=<ticketid>
- --limit-refers-to=<ticketid>
- --limit-referred-to-by=<ticketid>
- --limit-depends-on=<ticketid>
- --limit-depended-on-by=<ticketid>
-
-
- Dates
- --limit-created=[starts][-][ends]
- --limit-due=[starts][-][ends]
- --limit-starts=[starts][-][ends]
- --limit-started=[starts][-][ends]
- --limit-resolved=[starts][-][ends]
- --limit-last-updated=[starts][-][ends]
- starts and ends are dates. starts can not be less than ends
-
- --limit-first=<first row returned>
- --limit-rows=<row count>
-
- --history | --show
- show a history of the tickets found
-
-
- --summary [format-string]
- show a listing-style summary of the tickets found. If format string
- is ommitted, uses \$RT_SUMMARY_FORMAT or an internal default
-
-
- #TODO: doc summary
- format: <atom>%<format>
- atom: <name><size>
- size: <integer>
- name: (grep for # {{{ attribs for the array of ok values)
-
-
- --create
- create a new ticket. Any attributes that you can modify on an existing ticket
- can also be used for ticket creation.
-
-
-
-Attributes
- Basics
- --status=<new|open|stalled|resolved|dead>
- sets status
- --subject=<subject>
- sets subject
- --owner=<userid>
- set owner to
- --steal
- Become the owner, even if someone else owns the ticket
- --queue=<queueid>
- set queue to
-
- --priority=<int>
-
- --final-priority=<int>
-
- Watchers
- --requestors=[+|-]<userid|email address>
- add or remove this user as a ticket requestor
- --cc=[+|-]<userid|email address>
- add or remove this user as a ticket cc
- --admincc=[+|-]<userid|email address>
- add or remove this user as a ticket admincc
-
- (When creating tickets, just leave off the + or - )
-
- Keywords
- --keywords[+|-]<keyword_select>/<keyword>
- Add or remove a keyword.
-
-
-
- Dates
- --due=<date>
- --starts=<date>
- --started=<date>
- --contacted=<date>
-
- --time-left=<int>
-
- --time-taken=<int>
-
-
- Link related manipulation:
-
- --depends-on=[+|-]<ticketid>
- --member-of=[+|-]<ticketid>
- --refers-to=[+|-]<ticketid>
- --merge-into=<ticketid>
-
-Comments and replies
-
- --comment
- --reply|respond
- --source <path>
- Specify the path to the source file for this ticket update
-
- --noedit
- Don't invoke \$EDITOR to edit the content of this update
-
-
-
-
- Condiments
-
- --verbose
- --debug
- --version
- --help|h|usage
- You're reading it.
-
-EOUSAGE
-
- exit(0);
-}
-
-# Print version, and leave
-if ($version) {
- print "RT $RT::VERSION for $RT::rtname. Copyright 1996-2001 Jesse Vincent <jesse\@fsck.com>\n";
- exit(0);
-}
-
-# }}}
-
-# {{{ Validate any options that were passed in. normalize them.
-
-#if a queue was specified
-if ($queue) {
- # make sure that $queue is a valid queue and load it into $queue_obj
-}
-
-#For each date in: $due, $starts, $started
-
-# load up an RT::Date object and parse it into a normalized form
-# if it can't parse it, log an error and null out the variable
-
-# }}}
-
-# {{{ Check if we're creating, if so, create the ticket and be done
-
-if ($create) {
- $RT::Logger->debug("Creating a new ticket");
-
- #Make sure the current user can create tickets in this queue
-
- #Make sure that the owner specified can own tickets in this queue
-
-
-
- my $linesref = GetMessageContent( Edit => $edit, Source => $source,
- CurrentUser => $CurrentUser
- );
-
- require MIME::Entity;
- my $MIMEObj;
-
- if ($linesref) {
- $MIMEObj = MIME::Entity->build(Data => $linesref);
- }
-
- use RT::Ticket;
- my $Ticket=new RT::Ticket($CurrentUser);
- my ($ticket, $trans, $msg) =
- $Ticket->Create(Queue => $queue,
- Owner => $owner,
- Status => $status || 'new' ,
- Subject => $subject,
- Requestor => \@requestors,
- Cc => \@cc,
- AdminCc => \@admincc,
- Due => $due,
- Starts => $starts,
- Started => $started,
- TimeLeft => $time_left,
- InitialPriority => $priority,
- FinalPriority => $final_priority,
- MIMEObj => $MIMEObj
- );
- print $msg . "\n";
-}
-
-# }}}
-
-else {
- #Apply restrictions
- use RT::Tickets;
- my $Tickets = new RT::Tickets($CurrentUser);
-
- # {{{ Limit our search
- my $value; #to use when iterating through restrictions
- my $queue_id; #to use when limiting by keyword
-
- # {{{ limit on id
-
- foreach $value (@id) {
- if ($value =~ /^(\d+)$/) {
- $Tickets->LimitId ( VALUE => $1,
- OPERATOR => '=');
- }
- elsif ($value =~ /^(\d*)\D?(\d*)$/) {
- my $start = $1;
- my $end = $2;
- $Tickets->LimitId(
- VALUE => "$start",
- OPERATOR => '>=') if ($start);
- $Tickets->LimitId(
- VALUE => "$end",
- OPERATOR => '<=') if ($end);
- }
- }
-
-
- # }}}
-
- # {{{ limit on status
-
- foreach $value (@limit_status) {
- if ($value =~ /^(=|!=|!|)(.*)$/) {
- my $op = $1;
- my $val = $2;
-
-
- $op = ParseBooleanOp($op);
- $Tickets->LimitStatus(VALUE => "$val",
- OPERATOR => "$op");
- }
- }
-
- # }}}
-
-
-
- # {{{ limit on queue
- foreach $value (@limit_queue) {
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseBooleanOp($op);
-
- my $queue_obj = new RT::Queue($RT::SystemUser);
-
- unless ($queue_obj->Load($val)) {
- $RT::Logger->debug("Queue '$val' not found");
- print STDERR "Queue '$val' not found\n";
- exit(-1);
- }
- $RT::Logger->debug ("Limiting queue to $op ".$queue_obj->Name);
- $Tickets->LimitQueue(VALUE => $queue_obj->Name,
- OPERATOR => $op);
- $queue_id=$queue_obj->id;
- }
- }
-
- # {{{ limit on keyword
- foreach $value (@limit_keyword) {
- if ($value =~ /^(\W?)(.*?)\/(.*)$/i) {
- my $op = $1;
- my $select = $2;
- my $keyword = $3;
-
- $op = ParseBooleanOp($op);
-
- # load the keyword select
- my $keyselect = RT::KeywordSelect->new($RT::SystemUser);
- unless ($keyselect->LoadByName(Name=>$select, Queue=>$queue_id)) {
- $RT::Logger->debug("KeywordSelect '$select' not found");
- print STDERR "KeywordSelect '$select' not fount\n";
- exit(-1);
- }
-
- # load the keyword
- my $k = RT::Keyword->new($RT::SystemUser);
- unless ($k->LoadByNameAndParentId($keyword, $keyselect->Keyword)) {
- $RT::Logger->debug("Keyword '$keyword' not found");
- print STDERR "Keyword '$keyword' not found\n";
- exit(-1);
- }
- $Tickets->LimitKeyword(OPERATOR => $op,
- KEYWORDSELECT => $keyselect->id,
- KEYWORD => $k->id);
- $RT::Logger->debug ("Limiting keyword to $op ".$k->Path);
- }
- }
- # }}}
- # {{{ limit on owner
- foreach $value (@limit_owner) {
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseBooleanOp($op);
-
- my $user_obj = new RT::User($RT::SystemUser);
-
- unless ($user_obj->Load($val)) {
- $RT::Logger->debug("User '$val' not found");
- print STDERR "User '$val' not found\n";
- exit(-1);
- }
- $val = $user_obj->id();
-
- $RT::Logger->debug ("Limiting owner to $op $val");
- $Tickets->LimitOwner(VALUE => "$val",
- OPERATOR => "$op");
- }
- }
- # }}}
- # {{{ limt on priority
-
- foreach $value (@limit_priority) {
- my ($start, $end) = ParseRange($value);
- if ($start == $end) {
- $Tickets->LimitPriority( VALUE => $start,
- OPERATOR => '=');
- } elsif ($start) {
- $Tickets->LimitPriority( VALUE => $start,
- OPERATOR => '>=');
- } elsif ($end) {
- $Tickets->LimitPriority( VALUE => $end,
- OPERATOR => '<=');
- }
-
- }
- foreach $value (@limit_final_priority) {
- my ($start, $end) = ParseRange($value);
- if ($start == $end) {
- $Tickets->LimitFinalPriority( VALUE => $start,
- OPERATOR => '=');
- } elsif ($start) {
- $Tickets->LimitFinalPriority( VALUE => $start,
- OPERATOR => '>=');
- } elsif ($end) {
- $Tickets->LimitFinalPriority( VALUE => $end,
- OPERATOR => '<=');
- }
- }
- # }}}
-
- foreach $value (@limit_requestor) {
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseBooleanOp($op);
- $Tickets->LimitRequestor(VALUE => $val,
- OPERATOR => $op );
- }
-
- }
- foreach $value (@limit_subject) {
-
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseLikeOp($op);
-
- $Tickets->LimitSubject(VALUE => $val,
- OPERATOR => $op );
- }
- }
-
- foreach $value (@limit_body) {
- if ($value =~ /^(\W?)(.*?)$/i) {
- my $op = $1;
- my $val = $2;
-
- $op = ParseLikeOp($op);
-
- $Tickets->LimitBody(VALUE => $val,
- OPERATOR => $op );
- }
-
- }
-
-
-
- # Dates
- foreach my $date (@limit_created) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitCreated ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitCreated ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_due) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitDue ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitDue ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_starts) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitStarts ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitStarts ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_started) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitStarted ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitStarted ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_resolved) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitResolved ( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitResolved ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $date (@limit_lastupdated) {
- my ($start, $end) = ParseDateRange($date);
- $Tickets->LimitLastUpdated( VALUE => $start,
- OPERATOR => '>=' ) if ($start);
- $Tickets->LimitLastUpdated ( VALUE => $end,
- OPERATOR => '<=' ) if ($end);
- }
-
- foreach my $link (@limit_memberof) {
- $Tickets->LimitMemberOf($link);
- }
-
- foreach my $link (@limit_hasmember) {
- $Tickets->LimitHasMember($link);
- }
-
- foreach my $link (@limit_dependson) {
- $Tickets->LimitDependsOn($link);
- }
-
- foreach my $link (@limit_dependedonby) {
- $Tickets->LimitDependedOnBy($link);
- }
- foreach my $link (@limit_refersto) {
- $Tickets->LimitRefersTo($link);
- }
-
- foreach my $link (@limit_referredtoby) {
- $Tickets->LimitReferredToBy($link);
- }
-
-
- if ($limit_first){
- }
- if ($limit_rows){
- }
-
-# }}}
-
- # {{{ Iterate through all tickets we found
-
-
- my ($format, $titles, $code);
-
- #Set up the summary format if we need to
- if (defined $summary) {
- my $format_string = $summary || $ENV{'RT_SUMMARY_FORMAT'} || "%id4%status4%queue7%subject40%requestor16";
-
- ($format, $titles, $code) = BuildListingFormat($format_string);
- printf "$format\n", eval "$titles";
- }
-
-
-
- while (my $Ticket = $Tickets->Next()) {
- $RT::Logger->debug ("Now working on ticket ". $Ticket->id);
-
- #Run through all the ticket modifications we might want to do
- #TODO: these are all insufficiently lazy and should be replaced with some
- # nice foreaches.
-
-
- # {{{ deal with watchers
-
- # add / delete requestors
- foreach $value (@requestors) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $addr = $2;
-
- $Ticket->AddRequestor(Email => $addr) if ($op eq '+');
- $Ticket->DeleteRequestor( $addr) if ($op eq '-');
- }
- }
-
- # add / delete ccs
- foreach $value (@cc) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $addr = $2;
- $Ticket->AddCc(Email => $addr) if ($op eq '+');
- $Ticket->DeleteCc($addr) if ($op eq '-');
- }
- }
-
- # add / delete adminccs
- $RT::Logger->debug("Looking at admin ccs");
- foreach $value (@admincc) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $addr = $2;
- $Ticket->AddAdminCc(Email => $addr) if ($op eq '+');
- $Ticket->DeleteAdminCc($addr) if ($op eq '-');
- }
- }
-
- # }}}
-
- # {{{ Deal with ticket keywords
-
- my $KeywordSelects = $Ticket->QueueObj->KeywordSelects();
- $RT::Logger->debug ("Looking at keywords");
- foreach $value (@keywords) {
- $RT::Logger->debug("Looking at --keyword=$value");
- if ($value =~ /^(\W?)(.*?)\/(.*)$/) {
- my $op = $1;
- my $select = $2;
- my $keyword = $3;
-
- $RT::Logger->debug("Going to $op Keyword $select / $keyword");
- while (my $ks = $KeywordSelects->Next) {
- $RT::Logger->debug("$select is select ".$ks->Name." is found");
- next unless ($ks->Name =~ /$select/i);
- $RT::Logger->debug ("Found a match for $select\n");
- my $kids = $ks->KeywordObj->Descendents;
-
- my ($kid);
- foreach $kid (keys %{$kids}) {
- $RT::Logger->debug("Now comparing $keyword with ".$kids->{$kid}. "\n");
- next unless ($kids->{$kid} =~ /^$keyword$/i);
- $RT::Logger->debug("Going to $op $select / $keyword (".$kids->{$kid} .")");
- $Ticket->DeleteKeyword(KeywordSelect => $ks->id,
- Keyword => $kid) if ($op eq '-');
-
- $Ticket->AddKeyword(KeywordSelect => $ks->id,
- Keyword => $kid) if ($op eq '+');
- }
-
- }
- }
- }
- # }}}
-
- # {{{ deal with links
-
- # Deal with merging {
- if ($mergeinto) {
- my ($trans, $msg) =$Ticket->MergeInto($mergeinto);
- print $msg."\n";
- }
- # add /delete depends-ons
-
- foreach my $value (@dependson) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $ticket = $2;
- if (!$op or ($op eq '+')) {
- my ($trans, $msg) =
- $Ticket->AddLink(Type => 'DependsOn', Target => $ticket);
- print $msg."\n";
- }
- elsif ($op eq '-') {
- my ($trans, $msg) =
- $Ticket->DeleteLink(Type => 'DependsOn', Target => $ticket);
- print $msg."\n";
- }
-
- }
- }
- # add /delete member-of
- foreach my $value (@memberof) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $ticket = $2;
- if ($op eq '+') {
- my ($trans, $msg) =
- $Ticket->AddLink(Type => 'MemberOf', Target => $ticket);
- print $msg;
- }
- elsif ($op eq '-') {
- my ($trans, $msg) =
- $Ticket->DeleteLink(Type => 'MemberOf', Target => $ticket);
- print $msg;
- }
-
- }
- }
- # add / delete refers-to
- foreach my $value (@refersto) {
- if ($value =~ /^(\W?)(.*)$/) {
- my $op = $1;
- my $ticket = $2;
- if ($op eq '+') {
- my ($trans, $msg) =
- $Ticket->AddLink(Type => 'RefersTo', Target => $ticket);
- print $msg;
- }
- elsif ($op eq '-') {
- my ($trans, $msg) =
- $Ticket->DeleteLink(Type => 'RefersTo', Target => $ticket);
- print $msg;
- }
-
- }
- }
-
- # }}}
-
- # {{{ deal with dates
-
- #set due
- if ($due) {
- my $iso = ParseDateToISO($due);
- if ($iso) {
- $RT::Logger->debug("Setting due date to $iso ($due)");
- my ($trans, $msg) =
- $Ticket->SetDue($iso);
- print $msg;
- }
- else {
- print "Due date '$due' could not be parsed";
- }
- }
-
- #set starts
- if ($starts) {
- my $iso = ParseDateToISO($due);
- if ($iso) {
- my ($trans, $msg) =
- $Ticket->SetStarts($iso);
- print $msg."\n";
- }
- else {
- print "Starts date '$starts' could not be parsed";
- }
- }
- #set started
- if ($started) {
- my $iso = ParseDateToISO($started);
- if ($iso) {
- my ($trans, $msg) =
- $Ticket->SetStarted($iso);
- print $msg."\n";
- }
- else {
- print "Started date '$started' could not be parsed";
- }
- }
- #set contacted
- if ($contacted) {
- my $iso = ParseDateToISO($contacted);
- if ($iso) {
- my ($trans, $msg) =
- $Ticket->SetContacted($iso);
- print $msg."\n";
- }
- else {
- print "Contacted date '$contacted' could not be parsed";
- }
- }
-
- # }}}
-
- # {{{ set other attributes
-
- #Set subject
- if ($subject) {
- my ($trans, $msg) = $Ticket->SetSubject($subject);
- print $msg."\n";
- }
-
- #Set priority
- if ($priority) {
- my ($trans, $msg) =
- $Ticket->SetPriority($priority);
- print $msg."\n";
- }
-
- #Set final priority
- if ($final_priority) {
- my ($trans, $msg) =
- $Ticket->SetFinalPriority($final_priority);
- print $msg."\n";
- }
-
- #Set status
- if ($status) {
- my ($trans, $msg) =
- $Ticket->SetStatus($status);
- print $msg."\n";
- }
-
- #Set time left
- if ($time_left) {
- my ($trans, $msg) =
- $Ticket->SetTimeLeft($time_left);
- print $msg."\n";
- }
-
- #Set time_taken
- if ($time_taken) {
- my ($trans, $msg) =
- $Ticket->SetTimeTaken($time_taken);
- print $msg."\n";
- }
-
- #Set owner
- if ($owner) {
- my ($trans, $msg) =
- $Ticket->SetOwner($owner);
- print $msg."\n";
- }
-
- # Steal
- if ($steal) {
- my ($trans, $msg) =
- $Ticket->Steal();
- print $msg . "\n";
- }
- #Set queue
- if ($queue) {
- my ($trans, $msg) =
- $Ticket->SetQueue($queue);
- print $msg."\n";
- }
-
- # }}}
-
-
-
- # {{{ Perform ticket comments/replies
- if ($reply) {
- $RT::Logger->debug("Replying to ticket ".$Ticket->Id);
-
- my $linesref = GetMessageContent( Edit => $edit, Source => $source,
- CurrentUser => $CurrentUser
- );
-
- #TODO build this entity
- require MIME::Entity;
- my $MIMEObj = MIME::Entity->build(Data => $linesref);
-
- $Ticket->Correspond( MIMEObj => $MIMEObj ,
- TimeTaken => $time_taken);
- }
-
- elsif ($comment) {
- $RT::Logger->debug("Commenting on ticket ".$Ticket->Id);
-
- my $linesref =GetMessageContent(Edit => $edit, Source => $source,
- CurrentUser => $CurrentUser);
- #TODO build this entity
- require MIME::Entity;
- my $MIMEObj = MIME::Entity->build(Data => $linesref);
-
- $Ticket->Comment( MIMEObj => $MIMEObj,
- TimeTaken => $time_taken);
- }
-
- # }}}
-
- # {{{ Display whatever we need to display
-
- # {{{ Display a full ticket listing and history
- if ($history) {
- #Display the history
- $RT::Logger->debug("Show history for ".$Ticket->id);
-
- if ($Ticket->CurrentUserHasRight("ShowTicket")) {
- &ShowSummary($Ticket);
- print "\n";
- &ShowHistory($Ticket);
- }
- else {
- print "You don't have permission to view that ticket.\n";
- }
- }
-
- # }}}
-
- # {{{ Display a summary if we need to
- if (defined $summary) {
- $RT::Logger->debug ("Show ticket summary with format $format");
-
- printf $format."\n", eval $code;
-
- }
- # }}}
-
- # }}}
-
- }
-
- # }}}
-
-}
-
-
-$RT::Handle->Disconnect();
-
-
-
-
-
-
-
-# {{{ sub ParseBooleanOp
-
-=head2 ParseBooleanOp
-
- Takes an option modifier. returns the apropriate SQL operator.
- If it's handed ! or -, returns !=. Otherwise returns =.
-
-=cut
-
-sub ParseBooleanOp {
-
- my $op = shift;
-
- #so that !new limits to not new, etc
- if ($op =~ /^(\!|-)/) {
- $op = "!=";
- }
- else {
- $op = "=";
- }
-
- return($op);
-}
-
-# }}}
-
-# {{{ sub ParseLikeOp
-=head2 ParseLikeOp
-
- Takes an option modifier. returns the apropriate SQL operator.
- If it's handed ! or -, returns NOT LIKE. Otherwise returns LIKE
-
-=cut
-
-sub ParseLikeOp {
-
- my $op = shift;
-
- #so that !new limits to not new, etc
- if ($op =~ /^(\!|-)/) {
- $op = "NOT LIKE";
- }
- else {
- $op = "LIKE";
- }
-
- return($op);
-}
-# }}}
-
-# {{{ sub ParseDateToISO
-
-=head2 ParseDateToISO
-
-Takes a date in an arbitrary format.
-Returns an ISO date and time in GMT
-
-=cut
-
-sub ParseDateToISO {
- my $date = shift;
-
- my $date_obj = new RT::Date($CurrentUser);
- $date_obj->Set( Format => 'unknown',
- Value => $date
- );
- return ($date_obj->ISO);
-}
-
-# }}}
-
-# {{{ sub ParseDateRange
-
-=head2 ParseDateRange [RANGE]
-
-Takes a range of dates of the form [<date>][-][<date>] and returns
-starting and ending dates (as ISOs) If a date is specified as neither a starting nor ending
-date, we parse it it as "midnight tonight to midnight tomorrow"
-
-=cut
-
-sub ParseDateRange {
- my $in = shift;
- my ($start, $end);
-
-
- use RT::Date;
- my $start_obj = new RT::Date($CurrentUser);
- my $end_obj = new RT::Date($CurrentUser);
-
- if ($in =~ /^(.*?)-(.*?)$/) {
- $start = $1;
- $end = $2;
-
- if ($start) {
- $start_obj->Set(Format => 'unknown',
- Value => $start);
- }
- if ($end) {
- $end_obj->Set(Format => 'unknown',
- Value => $end);
- }
- }
- else {
- $start = $in;
- $end = $in;
-
- $start_obj->Set(Format => 'unknown',
- Value => $start);
-
- $end_obj->Set(Format => 'unknown',
- Value => $end);
-
- $start_obj->SetToMidnight();
- $end_obj->SetToMidnight();
- $end_obj->AddDay();
- }
-
- if ($start) {
- $start = $start_obj->ISO;
- }
- if ($end) {
- $end = $end_obj->ISO;
- }
-
- return ($start, $end);
-}
-
-# }}}
-
-# {{{ ParseRange
-=head2 ParseRange [RANGE]
-
-Takes a range of the form [<int>][-][<int>] and returns
-a first and a last value. If the - is omitted, both $start and $end are the same.
-=cut
-
-sub ParseRange {
- my $in = shift;
- my ($start, $end);
-
- if ($in =~ /(.*?)-(.*?)/) {
- $start = $1;
- $end = $2;
- }
- else {
- $start = $in;
- $end = $in;
- }
-
- return ($start, $end);
-
-
-
-}
-
-# }}}
-
-# {{{ sub ShowSummary
-
-sub ShowSummary {
- my $Ticket = shift;
-
-
- print <<EOFORM;
-Serial Number: @{[$Ticket->Id]} Status:@{[$Ticket->Status]} Worked: @{[$Ticket->TimeWorked]} minutes Queue:@{[$Ticket->QueueObj->Name]}
- Subject: @{[$Ticket->Subject]}
- Requestors: @{[$Ticket->RequestorsAsString]}
- Cc: @{[$Ticket->CcAsString]}
- Admin Cc: @{[$Ticket->AdminCcAsString]}
- Owner: @{[$Ticket->OwnerObj->Name]}
- Priority: @{[$Ticket->Priority]} / @{[$Ticket->FinalPriority]}
- Due: @{[$Ticket->DueAsString]}
- Created: @{[$Ticket->CreatedAsString]} (@{[$Ticket->AgeAsString]})
- Last Contact: @{[$Ticket->ToldAsString]} (@{[$Ticket->LongSinceToldAsString]})
- Last Update: @{[$Ticket->LastUpdatedAsString]} by @{[$Ticket->LastUpdatedByObj->Name]}
-
-EOFORM
-
-my $selects = $Ticket->QueueObj->KeywordSelects();
- #get the keyword selects
- print "Keywords:\n";
- while (my $select = $selects->Next) {
- print "\t" .$select->Name .": ";
- my $keys = $Ticket->KeywordsObj($select->id);
- while (my $key = $keys->Next) {
- print $key->KeywordObj->RelativePath($select->KeywordObj) . " ";
-
- }
- print "\n";
- }
-
-#iterate through the keyword selects.
-#print the keyword select and all the related keywords
-
-
-
-#TODO: finish link descriptions
-print "Dependencies: \n";
- while (my $l=$Ticket->DependedOnBy->Next) {
- print $l->BaseObj->id," (",$l->BaseObj->Subject,") ",$l->Type," this ticket\n";
- }
- while (my $l=$Ticket->DependsOn->Next) {
- print "This ticket ",$l->Type," ",$l->TargetObj->Id," (",$l->TargetObj->Subject,")\n";
- }
-}
-
-# }}}
-
-# {{{ sub ShowHistory
-sub ShowHistory {
- my $Ticket = shift;
- my $Transaction;
- my $Transactions = $Ticket->Transactions;
-
- while ($Transaction = $Transactions->Next) {
- &ShowTransaction($Transaction);
- }
- }
-# }}}
-
-# {{{ sub ShowTransaction
-sub ShowTransaction {
- my $transaction = shift;
-
-print <<EOFORM;
-==========================================================================
-Date: @{[$transaction->CreatedAsString]} (@{[$transaction->TimeTaken]} minutes)
-@{[$transaction->Description]}
-EOFORM
- ;
- my $attachments=$transaction->Attachments();
- while (my $message=$attachments->Next) {
- print <<EOFORM;
---------------------------------------------------------------------------
-@{[$message->Headers]}
-EOFORM
-
- if ($message->ContentType =~ m{^(text/plain|message|text$)}) {
- print $message->Content;
- } else {
- print $message->ContentType, " not shown";
- }
- }
- print "\n";
- return();
-}
-# }}}
-
-
-# {{{ sub BuildListingFormat
-
-sub BuildListingFormat {
- my $format_string = shift;
-
- my ($id, @format, @code, @titles);
- my ($field,$titles,$length, $format);
-
- my $code = "";
-
- # {{{ attribs
- my $attribs = { id => { chars => '4',
- justify => 'r',
- title => 'id',
- value => '$Ticket->id',
- },
-
- queue => { chars => '8',
- justify => 'l',
- title => 'Queue',
- value => '$Ticket->QueueObj->Name'
- },
- subject => { chars => '30',
- justify => 'l',
- title => 'Subject',
- value => '$Ticket->Subject',
- },
- priority => { chars => '2',
- justify => 'r',
- title => 'Pri',
- value => '$Ticket->Priority',
- },
- final_priority => { chars => '2',
- justify => 'r',
- title => 'Fin',
- value => '$Ticket->FinalPriority',
- },
- time_worked => { chars => '6',
- justify => 'r',
- title => 'Worked',
- value => '$Ticket->TimeWorked',
- },
- time_left => { chars => '5',
- justify => 'r',
- title => 'Left',
- value => '$Ticket->TimeLeft',
-
- },
-
- status => { chars => '6',
- justify => 'r',
- title => 'Status',
- value => '$Ticket->Status',
- },
- owner => { chars => '10',
- justify => 'r',
- title => 'Owner',
- value => '$Ticket->OwnerObj->Name'
- },
- requestor => { chars => '10',
- justify => 'r',
- title => 'Requestor',
- value => '$Ticket->RequestorsAsString'
- },
- created => { chars => '12',
- justify => 'r',
- title => 'Created',
- value => '$Ticket->CreatedAsString'
- },
- updated => { chars => '12',
- justify => 'r',
- title => 'Updated',
- value => '$Ticket->LastUpdatedAsString'
- },
- due => { chars => '12',
- justify => 'r',
- title => 'Due',
- value => '$Ticket->DueAsString'
- },
- told => { chars => '12',
- justify => 'r',
- title => 'Told',
- value => '$Ticket->ToldAsString'
- },
-
-
-
- };
-
- # }}}
-
-
- foreach $field (split ('%',$format_string)) {
-
- if ($field =~ /^(\D*?)(\d*?)$/) {
- $id = $1;
- $length = $2;
- }
- else {
- $RT::Logger->debug ("Error parsing $field\n");
- }
- if ($length) {
- push (@format, "%".$length.".".$length."s ");
-
- push (@code, $attribs->{"$id"}->{'value'});
-
- push (@titles, "'". $attribs->{"$id"}->{title}. "'");
- }
-
-
- }
- $code = join (',', @code);
- $format = join (" ", @format);
- $titles = join (', ', @titles);
-
-
- return ($format, $titles, $code);
-}
-
-# }}}
-
-
-
-1;
diff --git a/rt/bin/rt-commit-handler b/rt/bin/rt-commit-handler
new file mode 100644
index 000000000..29e443ebd
--- /dev/null
+++ b/rt/bin/rt-commit-handler
@@ -0,0 +1,846 @@
+#!/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
new file mode 100644
index 000000000..02b01abff
--- /dev/null
+++ b/rt/bin/rt-commit-handler.in
@@ -0,0 +1,846 @@
+#!@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
new file mode 100644
index 000000000..ede874a0c
--- /dev/null
+++ b/rt/bin/rt-crontool
@@ -0,0 +1,210 @@
+#!/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 " sbin/cron_shim \\\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";
+
+
+ exit(0);
+}
diff --git a/rt/bin/rt-crontool.in b/rt/bin/rt-crontool.in
new file mode 100644
index 000000000..73b80aa90
--- /dev/null
+++ b/rt/bin/rt-crontool.in
@@ -0,0 +1,210 @@
+#!@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 " sbin/cron_shim \\\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";
+
+
+ exit(0);
+}
diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate
index e6f0d95c5..b30443638 100755
--- a/rt/bin/rt-mailgate
+++ b/rt/bin/rt-mailgate
@@ -1,367 +1,587 @@
-#!!!PERL!! -w
+#!/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");
-# $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
+# }}}
-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;
- }
-
-
-}
+# {{{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");
+
# }}}
-# get the current mime entity from stdin
-my ($entity, $head) = ParseMIMEEntityFromSTDIN();
+# {{{ now everybody can create tickets. can a random unkown user create tickets?
-#Get someone to send runtime errors to;
-my $ErrorsTo = ParseErrorsToAddressFromHead($head);
+my $g = RT::Group->new($RT::SystemUser);
+$g->LoadSystemInternalGroup('Everyone');
+ok( $g->Id, "Found 'everybody'");
-#Get us a current user object.
-my $CurrentUser = GetCurrentUser($head, $entity, $ErrorsTo);
+my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+ok ($val, "Granted everybody the right to create tickets - $msg");
-# 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
+sleep(60); # gotta sleep so the remote process' ACL cache times out
-unless ($CurrentUser->Id) {
- exit(1);
-}
+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
-my $MessageId = $head->get('Message-Id') ||
- "<no-message-id-".time.rand(2000)."\@.$RT::Organization>";
+Blah!
+Foob!
+EOF
+close (MAIL);
-#Pull apart the subject line
-$Subject = $head->get('Subject') || "[no subject]";
-chomp $Subject;
-# Get the ticket ID unless it's already set
-$TicketId = ParseTicketId($Subject) unless ($TicketId);
+$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");
-#Set up a queue object
-my $QueueObj = RT::Queue->new($CurrentUser);
-$QueueObj->Load($Queue);
-unless ($QueueObj->id ) {
+# }}}
- MailError(To => $RT::OwnerEmail,
- Subject => "RT Bounce: $Subject",
- Explanation => "RT couldn't find the queue: $Queue",
- MIMEObj => $entity);
-}
+# {{{ can another random reply to a ticket without being granted privs? answer should be no.
-# {{{ Lets check for mail loops of various sorts.
-my $IsAutoGenerated = CheckForAutoGenerated($head);
+#($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
-my $IsSuspiciousSender = CheckForSuspiciousSender($head);
+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
-my $IsALoop = CheckForLoops($head);
+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
-#If the message is autogenerated, we need to know, so we can not
-# send mail to the sender
-if ($IsSuspiciousSender || $IsAutoGenerated || $IsALoop) {
- $SquelchReplies = 1;
- $ErrorsTo = $RT::OwnerEmail;
-
- #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
+($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, "|/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);
-# {{{ 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);
- }
-}
+
+$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.
- #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')
- }
+#($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
-if ($SquelchReplies) {
- ## TODO: This is a hack. It should be some other way to
- ## indicate that the transaction should be "silent".
+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 ($Sender, $junk) = ParseSenderAddressFromHead($head);
- $head->add('RT-Squelch-Replies-To', $Sender);
-}
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-3@example.com');
+ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission");
# }}}
+# {{{ can another random reply to a ticket after being granted privs? answer should be yes
-# {{{ If we require that the sender be found in an external DB and they're not
-# forward this message to RTOwner
+($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, "|/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);
-if ($RT::LookupSenderInExternalDatabase &&
- $RT::SenderMustExistInExternalDatabase ) {
- MailError(To => $RT::OwnerEmail,
- Subject => "RT Bounce: $Subject",
- Explanation => "RT couldn't find requestor via its external database lookup",
- MIMEObj => $entity);
-
-}
+$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");
# }}}
-# {{{ 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);
- }
-}
+# {{{ Testing preservation of binary attachments
+
+# Get a binary blob (Best Practical logo)
+
+# Create a mime entity with an attachment
+
+use MIME::Entity;
+my $entity = MIME::Entity->build( From => 'root@localhost',
+ To => 'rt@localhost',
+ Subject => 'binary attachment test',
+ Data => ['This is a test of a binary attachment']);
+
+# currently in lib/t/autogen
+$entity->attach(Path => '../../../html/NoAuth/images/spacer.gif',
+ Type => 'image/gif',
+ Encoding => 'base64');
+
+# Create a ticket with a binary attachment
+ok(open(MAIL, "|/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');
+
+
# }}}
-# {{{ 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");
-
- }
-
-}
+# {{{ 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);
# }}}
-$RT::Handle->Disconnect();
+($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" );
+
+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 $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'};
+}
+
+# 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;
+}
+
+
+=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
+
+=item Action
-# Everything below this line is a helper sub. most of them will eventually
-# move to Interface::Email
+The action being performed. At the moment, it's one of "comment" or "correspond"
-#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];
- }
-};
+=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
-1;
diff --git a/rt/bin/rt-mailgate.in b/rt/bin/rt-mailgate.in
new file mode 100644
index 000000000..304fcbcd6
--- /dev/null
+++ b/rt/bin/rt-mailgate.in
@@ -0,0 +1,587 @@
+#!@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, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: root\@localhost
+To: rt\@example.com
+Subject: This is a test of new ticket creation
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+use RT::Tickets;
+my $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $tick = $tickets->First();
+ok (UNIVERSAL::isa($tick,'RT::Ticket'));
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'This is a test of new ticket creation', "Created the ticket");
+
+# }}}
+
+
+# {{{This is a test of new ticket creation as an unknown user
+
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist\@example.com
+To: rt\@example.com
+Subject: This is a test of new ticket creation as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject ne 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
+my $u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist@example.com');
+ok( $u->Id == 0, " user does not exist and was not created by failed ticket submission");
+
+
+# }}}
+
+# {{{ now everybody can create tickets. can a random unkown user create tickets?
+
+my $g = RT::Group->new($RT::SystemUser);
+$g->LoadSystemInternalGroup('Everyone');
+ok( $g->Id, "Found 'everybody'");
+
+my ($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+ok ($val, "Granted everybody the right to create tickets - $msg");
+
+sleep(60); # gotta sleep so the remote process' ACL cache times out
+
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist\@example.com
+To: rt\@example.com
+Subject: This is a test of new ticket creation as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+
+$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
+$tick = $tickets->First();
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account");
+my $u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist@example.com');
+ok( $u->Id != 0, " user does not exist and was created by ticket submission");
+
+# }}}
+
+
+# {{{ can another random reply to a ticket without being granted privs? answer should be no.
+
+
+#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+#ok ($val, "Granted everybody the right to create tickets - $msg");
+#sleep(60); # gotta sleep so the remote process' ACL cache times out
+
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-2\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-2@example.com');
+ok( $u->Id == 0, " user does not exist and was not created by ticket correspondence submission");
+# }}}
+# {{{ can another random reply to a ticket after being granted privs? answer should be yes
+
+
+($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'ReplyToTicket');
+ok ($val, "Granted everybody the right to reply to tickets - $msg");
+sleep(60); # gotta sleep so the remote process' ACL cache times out
+
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-2\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a reply as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-2@example.com');
+ok( $u->Id != 0, " user exists and was created by ticket correspondence submission");
+
+# }}}
+
+# {{{ can another random comment on a ticket without being granted privs? answer should be no.
+
+
+#($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CreateTicket');
+#ok ($val, "Granted everybody the right to create tickets - $msg");
+#sleep(60); # gotta sleep so the remote process' ACL cache times out
+
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-3\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-3@example.com');
+ok( $u->Id == 0, " user does not exist and was not created by ticket comment submission");
+
+# }}}
+# {{{ can another random reply to a ticket after being granted privs? answer should be yes
+
+
+($val,$msg) = $g->PrincipalObj->GrantRight(Right => 'CommentOnTicket');
+ok ($val, "Granted everybody the right to reply to tickets - $msg");
+sleep(60); # gotta sleep so the remote process' ACL cache times out
+
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action comment"), "Opened the mailgate - $@");
+print MAIL <<EOF;
+From: doesnotexist-3\@example.com
+To: rt\@example.com
+Subject: [example.com #@{[$tick->Id]}] This is a test of a comment as an unknown user
+
+Blah!
+Foob!
+EOF
+close (MAIL);
+
+
+$u = RT::User->new($RT::SystemUser);
+$u->Load('doesnotexist-3@example.com');
+ok( $u->Id != 0, " user exists and was created by ticket comment submission");
+
+# }}}
+
+# {{{ Testing preservation of binary attachments
+
+# Get a binary blob (Best Practical logo)
+
+# Create a mime entity with an attachment
+
+use MIME::Entity;
+my $entity = MIME::Entity->build( From => 'root@localhost',
+ To => 'rt@localhost',
+ Subject => 'binary attachment test',
+ Data => ['This is a test of a binary attachment']);
+
+# currently in lib/t/autogen
+$entity->attach(Path => '../../../html/NoAuth/images/spacer.gif',
+ Type => 'image/gif',
+ Encoding => 'base64');
+
+# Create a ticket with a binary attachment
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+
+$entity->print(\*MAIL);
+
+close (MAIL);
+
+my $tickets = RT::Tickets->new($RT::SystemUser);
+$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+ $tick = $tickets->First();
+ok (UNIVERSAL::isa($tick,'RT::Ticket'));
+ok ($tick->Id, "found ticket ".$tick->Id);
+ok ($tick->Subject eq 'binary attachment test', "Created the ticket - ".$tick->Id);
+
+my $file = `cat ../../../html/NoAuth/images/spacer.gif`;
+ok ($file, "Read in the logo image");
+
+
+ use Digest::MD5;
+warn "for the raw file the content is ".Digest::MD5::md5_base64($file);
+
+
+
+# Verify that the binary attachment is valid in the database
+my $attachments = RT::Attachments->new($RT::SystemUser);
+$attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif');
+ok ($attachments->Count == 1, 'Found only one gif in the database');
+my $attachment = $attachments->First;
+my $acontent = $attachment->Content;
+
+ warn "coming from the database, the content is ".Digest::MD5::md5_base64($acontent);
+
+is( $acontent, $file, 'The attachment isn\'t screwed up in the database.');
+# Log in as root
+use Getopt::Long;
+use LWP::UserAgent;
+
+
+# Grab the binary attachment via the web ui
+my $ua = LWP::UserAgent->new();
+
+my $full_url = "http://localhost/Ticket/Attachment/".$attachment->TransactionId."/".$attachment->id."/spacer.gif?&user=root&pass=password";
+my $r = $ua->get( $full_url);
+
+
+# Verify that the downloaded attachment is the same as what we uploaded.
+is($file, $r->content, 'The attachment isn\'t screwed up in download');
+
+
+
+# }}}
+
+# {{{ Simple I18N testing
+
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+
+print MAIL <<EOF;
+From: root\@localhost
+To: rtemail\@example.com
+Subject: This is a test of I18N ticket creation
+Content-Type: text/plain; charset="utf-8"
+
+2 accented lines
+\303\242\303\252\303\256\303\264\303\273
+\303\241\303\251\303\255\303\263\303\272
+bye
+EOF
+close (MAIL);
+
+my $unitickets = RT::Tickets->new($RT::SystemUser);
+$unitickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$unitickets->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $unitick = $unitickets->First();
+ok (UNIVERSAL::isa($unitick,'RT::Ticket'));
+ok ($unitick->Id, "found ticket ".$unitick->Id);
+ok ($unitick->Subject eq 'This is a test of I18N ticket creation', "Created the ticket - ". $unitick->Subject);
+
+
+
+my $unistring = "\303\241\303\251\303\255\303\263\303\272";
+Encode::_utf8_on($unistring);
+is ($unitick->Transactions->First->Content, $unitick->Transactions->First->Attachments->First->Content, "Content is ". $unitick->Transactions->First->Attachments->First->Content);
+ok($unitick->Transactions->First->Attachments->First->Content =~ /$unistring/i, $unitick->Id." appears to be unicode ". $unitick->Transactions->First->Attachments->First->Id);
+# supposedly I18N fails on the second message sent in.
+
+ok(open(MAIL, "|@RT_BIN_PATH@/rt-mailgate --url http://localhost/ --queue general --action correspond"), "Opened the mailgate - $@");
+
+print MAIL <<EOF;
+From: root\@localhost
+To: rtemail\@example.com
+Subject: This is a test of I18N ticket creation
+Content-Type: text/plain; charset="utf-8"
+
+2 accented lines
+\303\242\303\252\303\256\303\264\303\273
+\303\241\303\251\303\255\303\263\303\272
+bye
+EOF
+close (MAIL);
+
+my $tickets2 = RT::Tickets->new($RT::SystemUser);
+$tickets2->OrderBy(FIELD => 'id', ORDER => 'DESC');
+$tickets2->Limit(FIELD => 'id', OPERATOR => '>', VALUE => '0');
+my $tick2 = $tickets2->First();
+ok (UNIVERSAL::isa($tick2,'RT::Ticket'));
+ok ($tick2->Id, "found ticket ".$tick2->Id);
+ok ($tick2->Subject eq 'This is a test of I18N ticket creation', "Created the ticket");
+
+
+
+my $unistring = "\303\241\303\251\303\255\303\263\303\272";
+Encode::_utf8_on($unistring);
+
+ok ($tick2->Transactions->First->Content =~ $unistring, "It appears to be unicode - ".$tick2->Transactions->First->Content);
+
+# }}}
+
+
+($val,$msg) = $g->PrincipalObj->RevokeRight(Right => 'CreateTicket');
+ok ($val, $msg);
+
+
+
+=end testing
+
+=cut
+
+
+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!
+}
+
+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'};
+}
+
+# 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;
+}
+
+
+=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
+
+=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/rtadmin b/rt/bin/rtadmin
deleted file mode 100644
index 25ba1b06a..000000000
--- a/rt/bin/rtadmin
+++ /dev/null
@@ -1,1040 +0,0 @@
-#!!!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 6e1ae06de..21cb83f5e 100755
--- a/rt/bin/webmux.pl
+++ b/rt/bin/webmux.pl
@@ -1,177 +1,125 @@
-# $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);
+#!/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;
-$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'};
+}
-# 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
-
+use lib ("/opt/rt3/local/lib", "/opt/rt3/lib");
+use RT;
package RT::Mason;
-use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we
- #set private_tempfiles
-use HTML::Mason::ApacheHandler (args_method => 'CGI');
-use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
-
-use vars qw($VERSION %session $Nobody $SystemUser $r $m);
+use CGI qw(-private_tempfiles); #bring this in before mason, to make sure we
+ #set private_tempfiles
-# 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);
+BEGIN {
+ if ($CGI::MOD_PERL) {
+ require HTML::Mason::ApacheHandler;
+ }
+ else {
+ require HTML::Mason::CGIHandler;
+ }
+}
+use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
-
-$VERSION="!!RT_VERSION!!";
+use vars qw($Nobody $SystemUser $r);
-use lib "!!RT_LIB_PATH!!";
-use lib "!!RT_ETC_PATH!!";
+#This drags in RT's config.pm
+RT::LoadConfig();
-#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();
+{
+ 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.
-#
-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 _ ));
+# Activate the following if running httpd as root (the normal case).
+# Resets ownership of all files created by Mason at startup.
+# Note that mysql uses DB for sessions, so there's no need to do this.
+unless ($RT::DatabaseType =~ /(mysql|Pg)/) {
+ # Clean up our umask to protect session files
+ umask(0077);
+
+if ( $CGI::MOD_PERL) {
+ chown( Apache->server->uid, Apache->server->gid, [$RT::MasonSessionDir] )
+ if Apache->server->can('uid');
+ }
+ # Die if WebSessionDir doesn't exist or we can't write to it
+ stat($RT::MasonSessionDir);
+ die "Can't read and write $RT::MasonSessionDir"
+ unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) );
+}
+my $ah = &RT::Interface::Web::NewApacheHandler() if $CGI::MOD_PERL;
sub handler {
($r) = @_;
-
+
RT::Init();
-
+
# We don't need to handle non-text items
- return -1 if defined($r->content_type) && $r->content_type !~ m|^text/|io;
-
- #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;
+ return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io;
- }
+ my %session;
my $status = $ah->handle_request($r);
- untie %HTML::Mason::Commands::session;
-
+ undef (%session);
+
+ $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") if $RT::Handle->TransactionDepth;
return $status;
-
- }
-1;
+}
+1;
diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in
new file mode 100644
index 000000000..12aad85b3
--- /dev/null
+++ b/rt/bin/webmux.pl.in
@@ -0,0 +1,125 @@
+#!@PERL@
+# BEGIN LICENSE BLOCK
+#
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+#
+# (Except where explictly superceded by other copyright notices)
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
+#
+#
+# END LICENSE BLOCK
+
+use strict;
+
+BEGIN {
+ $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need
+ $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'};
+ $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'};
+ $ENV{'ENV'} = '' if defined $ENV{'ENV'};
+ $ENV{'IFS'} = '' if defined $ENV{'IFS'};
+}
+
+use lib ("@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 ($CGI::MOD_PERL) {
+ require HTML::Mason::ApacheHandler;
+ }
+ else {
+ require HTML::Mason::CGIHandler;
+ }
+}
+
+use HTML::Mason; # brings in subpackages: Parser, Interp, etc.
+
+use vars qw($Nobody $SystemUser $r);
+
+#This drags in RT's config.pm
+RT::LoadConfig();
+
+use Carp;
+
+{
+ package HTML::Mason::Commands;
+ use vars qw(%session);
+
+ use RT::Tickets;
+ use RT::Transactions;
+ use RT::Users;
+ use RT::CurrentUser;
+ use RT::Templates;
+ use RT::Queues;
+ use RT::ScripActions;
+ use RT::ScripConditions;
+ use RT::Scrips;
+ use RT::Groups;
+ use RT::GroupMembers;
+ use RT::CustomFields;
+ use RT::CustomFieldValues;
+ use RT::TicketCustomFieldValues;
+
+ use RT::Interface::Web;
+ use MIME::Entity;
+ use Text::Wrapper;
+ use CGI::Cookie;
+ use Time::ParseDate;
+ use HTML::Entities;
+}
+
+
+# Activate the following if running httpd as root (the normal case).
+# Resets ownership of all files created by Mason at startup.
+# Note that mysql uses DB for sessions, so there's no need to do this.
+unless ($RT::DatabaseType =~ /(mysql|Pg)/) {
+ # Clean up our umask to protect session files
+ umask(0077);
+
+if ( $CGI::MOD_PERL) {
+ chown( Apache->server->uid, Apache->server->gid, [$RT::MasonSessionDir] )
+ if Apache->server->can('uid');
+ }
+ # Die if WebSessionDir doesn't exist or we can't write to it
+ stat($RT::MasonSessionDir);
+ die "Can't read and write $RT::MasonSessionDir"
+ unless ( ( -d _ ) and ( -r _ ) and ( -w _ ) );
+}
+
+my $ah = &RT::Interface::Web::NewApacheHandler() if $CGI::MOD_PERL;
+
+sub handler {
+ ($r) = @_;
+
+ RT::Init();
+
+ # We don't need to handle non-text items
+ return -1 if defined( $r->content_type ) && $r->content_type !~ m|^text/|io;
+
+ my %session;
+ my $status = $ah->handle_request($r);
+ undef (%session);
+
+ $RT::Logger->crit("Transaction not committed. Usually indicates a software fault. Data loss may have occurred") if $RT::Handle->TransactionDepth;
+ return $status;
+}
+
+1;
generated by cgit v1.2.1 (git 2.18.0) at 2025-08-22 21:44:33 +0000