diff options
Diffstat (limited to 'rt/bin')
| -rwxr-xr-x | rt/bin/fastcgi_server | 252 | ||||
| -rw-r--r-- | rt/bin/fastcgi_server.in | 252 | ||||
| -rwxr-xr-x | rt/bin/mason_handler.fcgi | 88 | ||||
| -rw-r--r-- | rt/bin/mason_handler.fcgi.in | 88 | ||||
| -rwxr-xr-x | rt/bin/mason_handler.scgi | 68 | ||||
| -rw-r--r-- | rt/bin/mason_handler.scgi.in | 68 | ||||
| -rw-r--r-- | rt/bin/mason_handler.svc | 265 | ||||
| -rw-r--r-- | rt/bin/mason_handler.svc.in | 265 | ||||
| -rw-r--r-- | rt/bin/rt-commit-handler | 846 | ||||
| -rw-r--r-- | rt/bin/rt-crontool | 399 | ||||
| -rw-r--r-- | rt/bin/rt-crontool.in | 399 | ||||
| -rwxr-xr-x | rt/bin/rt-mailgate | 409 | ||||
| -rw-r--r-- | rt/bin/rt-mailgate.in | 409 | ||||
| -rw-r--r-- | rt/bin/rt.in | 2586 | ||||
| -rwxr-xr-x | rt/bin/standalone_httpd | 186 | ||||
| -rwxr-xr-x | rt/bin/standalone_httpd.in | 186 | ||||
| -rw-r--r-- | rt/bin/webmux.pl.in | 176 |
17 files changed, 0 insertions, 6942 deletions
diff --git a/rt/bin/fastcgi_server b/rt/bin/fastcgi_server deleted file mode 100755 index 7c0935d..0000000 --- a/rt/bin/fastcgi_server +++ /dev/null @@ -1,252 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} - -=head1 NAME - -fastcgi_server - external FastCGI server for RT - -=head1 USAGE - - # get help - fastcgi_server -h - - # start a server using defaults - fastcgi_server - - # start server with custom option - fastcgi_server --socket /path/to/socket -n 5 - fastcgi_server --port 12345 -n 5 - -=head1 DESCRIPTION - -This is a forking external FastCGI server for RT, it can be used -with apache and other servers supporting FastCGI technology. - -An advantage is lower memory usage because of sharing memory -between process. It's easier to setup this with nginx and other -servers that can not maintain pool of fastcgi servers, apache -can do this. - -Disadvantage is that you have to start this server yourself and -monitor it, web servers wouldn't be able to restart it on crash. - -=head1 OPTIONS - -=over 4 - -=item -h, --help - get help - -=item -n, --nprocesses - number of processes to start, by default 10 - -=item -s, --socket - socket path, by default F<RT/var/path/fastcgi.sock> -usually F</opt/rt3/var/fastcgi.sock>. - -=item -p, --port - port to use instead of socket, by default socket is -used. - -=item --pidfile - pid file path, by default F<RT/var/path/fastcgi.pid>. - -=back - -=head1 SERVER CONFIGURATION - -=head2 nginx - -Below you can find example of minimal config for nginx to run RT -with this FastCGI server. It's not ideal, but a good enough start. - - worker_processes 1; - events { worker_connections 1024; } - - pid /opt/rt3/var/nginx/server.pid; - error_log /opt/rt3/var/nginx/error.log debug; - - http { - access_log /opt/rt3/var/nginx/access.log; - - server { - listen 8080; - server_name localhost; - - location / { - root /opt/rt3/share/html; - fastcgi_pass unix:/opt/rt3/var/fastcgi.sock; - - fastcgi_param QUERY_STRING $query_string; - fastcgi_param REQUEST_METHOD $request_method; - fastcgi_param CONTENT_TYPE $content_type; - fastcgi_param CONTENT_LENGTH $content_length; - fastcgi_param PATH_INFO $fastcgi_script_name; - } - - location /NoAuth/images/ { - alias /opt/rt3/share/html/NoAuth/images/; - } - } - } - -=head1 lighttpd - -Server config: - - server.name = "localhost" - server.port = 80 - - server.username = "rt_web_user" - server.groupname = "rt_web_group" - - server.pid-file = "/opt/rt3/var/lighthttpd/server.pid" - server.errorlog = "/opt/rt3/var/lighthttpd/error.log" - - server.document-root = "/opt/rt3/share/html" - - server.modules = ( "mod_fastcgi" ) - fastcgi.server = ( - "/" => (( - "socket" => "/opt/rt3/var/fastcgi.sock", - "check-local" => "disable", - "fix-root-scriptname" => "enable", - )) - ) - -=cut - - -use strict; -use warnings; -no warnings qw(once); - -package RT::Interface::Web::FCGI::Server; -use base qw(FCGI::ProcManager); - -package main; - -use Getopt::Long; - -my %opt = ( - help => 0, - socket => '', - port => 0, - nprocesses => 10, - pidfile => '', -); - -GetOptions( - 'h|help!' => \$opt{'help'}, - 's|socket=s' => \$opt{'socket'}, - 'p|port=s' => \$opt{'port'}, - 'n|nprocesses=s' => \$opt{'nprocesses'}, - 'pidfile=s' => \$opt{'pidfile'}, -); - -if ( $opt{'help'} ) { - require Pod::Usage; - Pod::Usage::pod2usage( - -message => "", - -exitval => $opt{'help'}? 0 : 1, - -verbose => 99, - -sections => $opt{'help'}? 'NAME|USAGE|DESCRIPTION|OPTIONS' : 'NAME|USAGE', - ); -} - -$ENV{'RT_WEBMUX_HEAVY_LOAD'} = 1; -use File::Basename; -require (dirname(__FILE__) .'/webmux.pl'); - -unless ( $opt{'socket'} && $opt{'port'} ) { - require File::Spec; - $opt{'socket'} = File::Spec->catfile($RT::VarPath, 'fastcgi.sock'); -} -elsif ( $opt{'port'} ) { - $opt{'socket'} = ':'. $opt{'port'}; -} -$ENV{'FCGI_SOCKET_PATH'} = $opt{'socket'}; - -$opt{'pidfile'} ||= File::Spec->catfile($RT::VarPath, 'fastcgi.pid'); - -require CGI::Fast; - -my $proc_manager = RT::Interface::Web::FCGI::Server->new({ - n_processes => $opt{'nprocesses'} || 10, - pid_fname => $opt{'pidfile'}, -}); - -$proc_manager->pm_manage(); - -while ( my $cgi = CGI::Fast->new ) { - $proc_manager->pm_pre_dispatch; - - $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'}; - - Module::Refresh->refresh if RT->Config->Get('DevelMode'); - RT::ConnectToDatabase(); - - my $interp = $RT::Mason::Handler->interp; - if ( - !$interp->comp_exists( $cgi->path_info ) - && $interp->comp_exists( $cgi->path_info . "/index.html" ) - ) { - $cgi->path_info( $cgi->path_info . "/index.html" ); - } - - local $@; - eval { $RT::Mason::Handler->handle_cgi_object($cgi); }; - if ($@) { - $RT::Logger->crit($@); - } - RT::Interface::Web::Handler->CleanupRequest; - - $proc_manager->pm_post_dispatch; -} - -1; diff --git a/rt/bin/fastcgi_server.in b/rt/bin/fastcgi_server.in deleted file mode 100644 index a637144..0000000 --- a/rt/bin/fastcgi_server.in +++ /dev/null @@ -1,252 +0,0 @@ -#!@PERL@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} - -=head1 NAME - -fastcgi_server - external FastCGI server for RT - -=head1 USAGE - - # get help - fastcgi_server -h - - # start a server using defaults - fastcgi_server - - # start server with custom option - fastcgi_server --socket /path/to/socket -n 5 - fastcgi_server --port 12345 -n 5 - -=head1 DESCRIPTION - -This is a forking external FastCGI server for RT, it can be used -with apache and other servers supporting FastCGI technology. - -An advantage is lower memory usage because of sharing memory -between process. It's easier to setup this with nginx and other -servers that can not maintain pool of fastcgi servers, apache -can do this. - -Disadvantage is that you have to start this server yourself and -monitor it, web servers wouldn't be able to restart it on crash. - -=head1 OPTIONS - -=over 4 - -=item -h, --help - get help - -=item -n, --nprocesses - number of processes to start, by default 10 - -=item -s, --socket - socket path, by default F<RT/var/path/fastcgi.sock> -usually F</opt/rt3/var/fastcgi.sock>. - -=item -p, --port - port to use instead of socket, by default socket is -used. - -=item --pidfile - pid file path, by default F<RT/var/path/fastcgi.pid>. - -=back - -=head1 SERVER CONFIGURATION - -=head2 nginx - -Below you can find example of minimal config for nginx to run RT -with this FastCGI server. It's not ideal, but a good enough start. - - worker_processes 1; - events { worker_connections 1024; } - - pid /opt/rt3/var/nginx/server.pid; - error_log /opt/rt3/var/nginx/error.log debug; - - http { - access_log /opt/rt3/var/nginx/access.log; - - server { - listen 8080; - server_name localhost; - - location / { - root /opt/rt3/share/html; - fastcgi_pass unix:/opt/rt3/var/fastcgi.sock; - - fastcgi_param QUERY_STRING $query_string; - fastcgi_param REQUEST_METHOD $request_method; - fastcgi_param CONTENT_TYPE $content_type; - fastcgi_param CONTENT_LENGTH $content_length; - fastcgi_param PATH_INFO $fastcgi_script_name; - } - - location /NoAuth/images/ { - alias /opt/rt3/share/html/NoAuth/images/; - } - } - } - -=head1 lighttpd - -Server config: - - server.name = "localhost" - server.port = 80 - - server.username = "rt_web_user" - server.groupname = "rt_web_group" - - server.pid-file = "/opt/rt3/var/lighthttpd/server.pid" - server.errorlog = "/opt/rt3/var/lighthttpd/error.log" - - server.document-root = "/opt/rt3/share/html" - - server.modules = ( "mod_fastcgi" ) - fastcgi.server = ( - "/" => (( - "socket" => "/opt/rt3/var/fastcgi.sock", - "check-local" => "disable", - "fix-root-scriptname" => "enable", - )) - ) - -=cut - - -use strict; -use warnings; -no warnings qw(once); - -package RT::Interface::Web::FCGI::Server; -use base qw(FCGI::ProcManager); - -package main; - -use Getopt::Long; - -my %opt = ( - help => 0, - socket => '', - port => 0, - nprocesses => 10, - pidfile => '', -); - -GetOptions( - 'h|help!' => \$opt{'help'}, - 's|socket=s' => \$opt{'socket'}, - 'p|port=s' => \$opt{'port'}, - 'n|nprocesses=s' => \$opt{'nprocesses'}, - 'pidfile=s' => \$opt{'pidfile'}, -); - -if ( $opt{'help'} ) { - require Pod::Usage; - Pod::Usage::pod2usage( - -message => "", - -exitval => $opt{'help'}? 0 : 1, - -verbose => 99, - -sections => $opt{'help'}? 'NAME|USAGE|DESCRIPTION|OPTIONS' : 'NAME|USAGE', - ); -} - -$ENV{'RT_WEBMUX_HEAVY_LOAD'} = 1; -use File::Basename; -require (dirname(__FILE__) .'/webmux.pl'); - -unless ( $opt{'socket'} && $opt{'port'} ) { - require File::Spec; - $opt{'socket'} = File::Spec->catfile($RT::VarPath, 'fastcgi.sock'); -} -elsif ( $opt{'port'} ) { - $opt{'socket'} = ':'. $opt{'port'}; -} -$ENV{'FCGI_SOCKET_PATH'} = $opt{'socket'}; - -$opt{'pidfile'} ||= File::Spec->catfile($RT::VarPath, 'fastcgi.pid'); - -require CGI::Fast; - -my $proc_manager = RT::Interface::Web::FCGI::Server->new({ - n_processes => $opt{'nprocesses'} || 10, - pid_fname => $opt{'pidfile'}, -}); - -$proc_manager->pm_manage(); - -while ( my $cgi = CGI::Fast->new ) { - $proc_manager->pm_pre_dispatch; - - $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'}; - - Module::Refresh->refresh if RT->Config->Get('DevelMode'); - RT::ConnectToDatabase(); - - my $interp = $RT::Mason::Handler->interp; - if ( - !$interp->comp_exists( $cgi->path_info ) - && $interp->comp_exists( $cgi->path_info . "/index.html" ) - ) { - $cgi->path_info( $cgi->path_info . "/index.html" ); - } - - local $@; - eval { $RT::Mason::Handler->handle_cgi_object($cgi); }; - if ($@) { - $RT::Logger->crit($@); - } - RT::Interface::Web::Handler->CleanupRequest; - - $proc_manager->pm_post_dispatch; -} - -1; diff --git a/rt/bin/mason_handler.fcgi b/rt/bin/mason_handler.fcgi deleted file mode 100755 index 881d638..0000000 --- a/rt/bin/mason_handler.fcgi +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/copyleft/gpl.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -use warnings; -no warnings qw(once); - -use File::Basename; -require (dirname(__FILE__) .'/webmux.pl'); - -# Enter CGI::Fast mode, which should also work as a vanilla CGI script. -require CGI::Fast; - -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'}; - - Module::Refresh->refresh if RT->Config->Get('DevelMode'); - RT::ConnectToDatabase(); - - my $interp = $RT::Mason::Handler->interp; - if ( - !$interp->comp_exists( $cgi->path_info ) - && $interp->comp_exists( $cgi->path_info . "/index.html" ) - ) { - $cgi->path_info( $cgi->path_info . "/index.html" ); - } - - local $@; - eval { $RT::Mason::Handler->handle_cgi_object($cgi); }; - if ($@) { - $RT::Logger->crit($@); - } - RT::Interface::Web::Handler->CleanupRequest(); - -} - -1; diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in deleted file mode 100644 index baf407d..0000000 --- a/rt/bin/mason_handler.fcgi.in +++ /dev/null @@ -1,88 +0,0 @@ -#!@PERL@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -use warnings; -no warnings qw(once); - -use File::Basename; -require (dirname(__FILE__) .'/webmux.pl'); - -# Enter CGI::Fast mode, which should also work as a vanilla CGI script. -require CGI::Fast; - -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'}; - - Module::Refresh->refresh if RT->Config->Get('DevelMode'); - RT::ConnectToDatabase(); - - my $interp = $RT::Mason::Handler->interp; - if ( - !$interp->comp_exists( $cgi->path_info ) - && $interp->comp_exists( $cgi->path_info . "/index.html" ) - ) { - $cgi->path_info( $cgi->path_info . "/index.html" ); - } - - local $@; - eval { $RT::Mason::Handler->handle_cgi_object($cgi); }; - if ($@) { - $RT::Logger->crit($@); - } - RT::Interface::Web::Handler->CleanupRequest(); - -} - -1; diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi deleted file mode 100755 index 1a497de..0000000 --- a/rt/bin/mason_handler.scgi +++ /dev/null @@ -1,68 +0,0 @@ -#!/usr/local/bin/speedy -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/copyleft/gpl.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -package RT::Mason; - -use strict; -use vars '$Handler'; -use File::Basename; - -require (dirname(__FILE__) . '/webmux.pl'); - -require CGI; - -my $cgi = CGI->new; -if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) ) - && ( $Handler->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) { - $cgi->path_info( $cgi->path_info . "/index.html" ); -} - -RT::ConnectToDatabase(); -$Handler->handle_cgi_object($cgi); -RT::Interface::Web::Handler->CleanupRequest(); -1; diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in deleted file mode 100644 index cd24bc8..0000000 --- a/rt/bin/mason_handler.scgi.in +++ /dev/null @@ -1,68 +0,0 @@ -#!@SPEEDY_BIN@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -package RT::Mason; - -use strict; -use vars '$Handler'; -use File::Basename; - -require (dirname(__FILE__) . '/webmux.pl'); - -require CGI; - -my $cgi = CGI->new; -if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) ) - && ( $Handler->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) { - $cgi->path_info( $cgi->path_info . "/index.html" ); -} - -RT::ConnectToDatabase(); -$Handler->handle_cgi_object($cgi); -RT::Interface::Web::Handler->CleanupRequest(); -1; diff --git a/rt/bin/mason_handler.svc b/rt/bin/mason_handler.svc deleted file mode 100644 index 4276b6e..0000000 --- a/rt/bin/mason_handler.svc +++ /dev/null @@ -1,265 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/copyleft/gpl.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -=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 - -package RT::Mason; - -use strict; -use File::Basename; -use vars '$Handler'; -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->Config->Get('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; - -RT::Init(); -$Handler ||= RT::Interface::Web::Handler->new( - RT->Config->Get('MasonParameters') -); - - -# Response loop -while( my $cgi = CGI::Fast->new ) { - my $comp = $ENV{'PATH_INFO'}; - - $comp = $1 if ($comp =~ /^(.*)$/); - my $web_path = RT->Config->Get('WebPath'); - $comp =~ s|^\Q$web_path\E\b||i; - $comp .= "index.html" if ($comp =~ /\/$/); - $comp =~ s/.pl$/.html/g; - - warn "Serving $comp\n"; - - $Handler->handle_cgi($comp); - RT::Interface::Web::Handler->CleanupRequest(); - # _should_ always be tied -} - -1; - -=head1 AUTHORS - -Autrijus Tang E<lt>autrijus@autrijus.orgE<gt> - -=head1 COPYRIGHT - -Copyright 2002 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -See L<http://www.perl.com/perl/misc/Artistic.html> - -=cut diff --git a/rt/bin/mason_handler.svc.in b/rt/bin/mason_handler.svc.in deleted file mode 100644 index d7e68b3..0000000 --- a/rt/bin/mason_handler.svc.in +++ /dev/null @@ -1,265 +0,0 @@ -#!@PERL@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -=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 - -package RT::Mason; - -use strict; -use File::Basename; -use vars '$Handler'; -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->Config->Get('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; - -RT::Init(); -$Handler ||= RT::Interface::Web::Handler->new( - RT->Config->Get('MasonParameters') -); - - -# Response loop -while( my $cgi = CGI::Fast->new ) { - my $comp = $ENV{'PATH_INFO'}; - - $comp = $1 if ($comp =~ /^(.*)$/); - my $web_path = RT->Config->Get('WebPath'); - $comp =~ s|^\Q$web_path\E\b||i; - $comp .= "index.html" if ($comp =~ /\/$/); - $comp =~ s/.pl$/.html/g; - - warn "Serving $comp\n"; - - $Handler->handle_cgi($comp); - RT::Interface::Web::Handler->CleanupRequest(); - # _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-commit-handler b/rt/bin/rt-commit-handler deleted file mode 100644 index bf23a6c..0000000 --- a/rt/bin/rt-commit-handler +++ /dev/null @@ -1,846 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN LICENSE BLOCK -# -# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> -# -# (Except where explictly superceded by other copyright notices) -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# Unless otherwise specified, all modifications, corrections or -# extensions to this work which alter its source code become the -# property of Best Practical Solutions, LLC when submitted for -# inclusion in the work. -# -# -# END LICENSE BLOCK - -# {{{ Docs -# -*-Perl-*- -# -#ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler,v 1.2 2007-08-01 22:20:32 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-crontool b/rt/bin/rt-crontool deleted file mode 100644 index 13c11bf..0000000 --- a/rt/bin/rt-crontool +++ /dev/null @@ -1,399 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/copyleft/gpl.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -use Carp; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use 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(); - -my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg, - $template, $template_id, $transaction, $transaction_type, $help, $log, $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=s" => \$template, - "template-id=s" => \$template_id, - "transaction=s" => \$transaction, - "transaction-type=s" => \$transaction_type, - "log=s" => \$log, - "verbose|v" => \$verbose, - "help" => \$help, -); - -# Load the config file -RT::LoadConfig(); - -# adjust logging to the screen according to options -RT->Config->Set( LogToScreen => $log ) if $log; - -#Connect to the database and get RT::SystemUser and RT::Nobody loaded -RT::Init(); - -#Get the current user all loaded -my $CurrentUser = GetCurrentUser(); - -# show help even if there is no current user -help() if $help; - -unless ( $CurrentUser->Id ) { - print loc("No RT user found. Please consult your RT administrator.\n"); - exit(1); -} - -help() unless $search && $action; - -$transaction = lc( $transaction||'' ); -if ( $transaction && $transaction !~ /^(first|all|last)$/i ) { - print STDERR loc("--transaction argument could be only 'first', 'last' or 'all'"); - exit 1; -} - -if ( $template && $template_id ) { - print STDERR loc("--template-id is deprecated argument and can not be used with --template"); - exit 1; -} -elsif ( $template_id ) { -# don't warn - $template = $template_id; -} - -# We _must_ have a search object -load_module($search); -load_module($action) if ($action); -load_module($condition) if ($condition); - -my $void_scrip = RT::Scrip->new( $CurrentUser ); -my $void_scrip_action = RT::ScripAction->new( $CurrentUser ); - -#At the appointed time: - -#find a bunch of tickets -my $tickets = RT::Tickets->new($CurrentUser); -my $search = $search->new( - TicketsObj => $tickets, - Argument => $search_arg, - CurrentUser => $CurrentUser -); - -$search->Prepare(); - -# TicketsFound is an RT::Tickets object -my $tickets = $search->TicketsObj; - -#for each ticket we've found -while ( my $ticket = $tickets->Next() ) { - print $ticket->Id() . ": " if ($verbose); - - my $template_obj = get_template( $ticket ); - - if ( $transaction ) { - my $txns = get_transactions($ticket); - my $found = 0; - while ( my $txn = $txns->Next ) { - print loc("Using transaction #[_1]...", $txn->id) - if $verbose; - process($ticket, $txn, $template_obj); - $found = 1; - } - print loc("Couldn't find suitable transaction, skipping") - if $verbose && !$found; - } else { - print loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument") - if $verbose; - - process($ticket, undef, $template_obj); - } -} - -sub process { - my $ticket = shift; - my $transaction = shift; - my $template_obj = shift; - - # perform some more advanced check - if ($condition) { - my $condition_obj = $condition->new( - TransactionObj => $transaction, - TicketObj => $ticket, - ScripObj => $void_scrip, - TemplateObj => $template_obj, - Argument => $condition_arg, - CurrentUser => $CurrentUser, - ); - - # if the condition doesn't apply, get out of here - - return unless $condition_obj->IsApplicable; - print loc("Condition matches...") if $verbose; - } - - #prepare our action - my $action_obj = $action->new( - TicketObj => $ticket, - TransactionObj => $transaction, - TemplateObj => $template_obj, - Argument => $action_arg, - ScripObj => $void_scrip, - ScripActionObj => $void_scrip_action, - CurrentUser => $CurrentUser, - ); - - #if our preparation, move onto the next ticket - return unless $action_obj->Prepare; - print loc("Action prepared...") if $verbose; - - #commit our action. - return unless $action_obj->Commit; - print loc("Action committed.\n") if $verbose; -} - -=head2 get_transactions - -Takes ticket and returns L<RT::Transactions> object with transactions -of the ticket according to command line arguments C<--transaction> -and <--transaction-type>. - -=cut - -sub get_transactions { - my $ticket = shift; - my $txns = $ticket->Transactions; - my $order = $transaction eq 'last'? 'DESC': 'ASC'; - $txns->OrderByCols( - { FIELD => 'Created', ORDER => $order }, - { FIELD => 'id', ORDER => $order }, - ); - if ( $transaction_type ) { - $transaction_type =~ s/^\s+//; - $transaction_type =~ s/\s+$//; - foreach my $type ( split /\s*,\s*/, $transaction_type ) { - $txns->Limit( FIELD => 'Type', VALUE => $type, ENTRYAGGREGATOR => 'OR' ); - } - } - $txns->RowsPerPage(1) unless $transaction eq 'all'; - return $txns; -} - -=head2 get_template - -Takes a ticket and returns a template according to command line options. - -=cut - -{ my $cache = undef; -sub get_template { - my $ticket = shift; - return undef unless $template; - - unless ( $template =~ /\D/ ) { - # by id - return $cache if $cache; - - my $cache = RT::Template->new( $RT::SystemUser ); - $cache->Load( $template ); - die "Failed to load template '$template'" - unless $cache->id; - return $cache; - } - - my $queue = $ticket->Queue; - return $cache->{ $queue } if $cache->{ $queue }; - - my $res = RT::Template->new( $RT::SystemUser ); - $res->LoadQueueTemplate( Queue => $queue, Name => $template ); - unless ( $res->id ) { - $res->LoadGlobalTemplate( $template ); - die "Failed to load template '$template', either for queue #$queue or global" - unless $res->id; - } - return $cache->{ $queue } = $res; -} } - -# {{{ 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-arg", "--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-arg", "--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-arg", "--action" ) - . "\n"; - print " " - . loc( "[_1] - Specify name or id of template(s) you want to use", "--template" ) - . "\n"; - print " " - . loc( "[_1] - Specify if you want to use either 'first', 'last' or 'all' transactions", "--transaction" ) - . "\n"; - print " " - . loc( "[_1] - Specify the comma separated list of transactions' types you want to use", "--transaction-type" ) - . "\n"; - print " " - . loc( "[_1] - Adjust LogToScreen config option", "--log" ) . "\n"; - print " " - . loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n"; - print "\n"; - print "\n"; - print loc("Security:")."\n"; - print loc("This tool allows the user to run arbitrary perl modules from within RT.")." ". - loc("If this tool were setgid, a hostile local user could use this tool to gain administrative access to RT.")." ". - loc("It is incredibly important that nonprivileged users not be allowed to run this tool."). " " . - loc("It is suggested that you create a non-privileged unix user with the correct group membership and RT access to run this tool.")."\n"; - print "\n"; - print loc("Example:"); - print "\n"; - print " " - . loc( "The following command will find all active tickets in the queue 'general' and set their priority to 99 if they haven't been touched in 4 hours:" - ) - . "\n\n"; - - print " bin/rt-crontool \\\n"; - print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; - print " --condition RT::Condition::UntouchedInHours --condition-arg 4 \\\n"; - print " --action RT::Action::SetPriority --action-arg 99 \\\n"; - print " --verbose\n"; - - print "\n"; - print loc("Escalate tickets"). "\n"; - print " bin/rt-crontool \\\n"; - print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; - print " --action RT::Action::EscalatePriority\n"; - - - - - - - exit(0); -} diff --git a/rt/bin/rt-crontool.in b/rt/bin/rt-crontool.in deleted file mode 100644 index 8401aca..0000000 --- a/rt/bin/rt-crontool.in +++ /dev/null @@ -1,399 +0,0 @@ -#!@PERL@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -use Carp; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use 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(); - -my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg, - $template, $template_id, $transaction, $transaction_type, $help, $log, $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=s" => \$template, - "template-id=s" => \$template_id, - "transaction=s" => \$transaction, - "transaction-type=s" => \$transaction_type, - "log=s" => \$log, - "verbose|v" => \$verbose, - "help" => \$help, -); - -# Load the config file -RT::LoadConfig(); - -# adjust logging to the screen according to options -RT->Config->Set( LogToScreen => $log ) if $log; - -#Connect to the database and get RT::SystemUser and RT::Nobody loaded -RT::Init(); - -#Get the current user all loaded -my $CurrentUser = GetCurrentUser(); - -# show help even if there is no current user -help() if $help; - -unless ( $CurrentUser->Id ) { - print loc("No RT user found. Please consult your RT administrator.\n"); - exit(1); -} - -help() unless $search && $action; - -$transaction = lc( $transaction||'' ); -if ( $transaction && $transaction !~ /^(first|all|last)$/i ) { - print STDERR loc("--transaction argument could be only 'first', 'last' or 'all'"); - exit 1; -} - -if ( $template && $template_id ) { - print STDERR loc("--template-id is deprecated argument and can not be used with --template"); - exit 1; -} -elsif ( $template_id ) { -# don't warn - $template = $template_id; -} - -# We _must_ have a search object -load_module($search); -load_module($action) if ($action); -load_module($condition) if ($condition); - -my $void_scrip = RT::Scrip->new( $CurrentUser ); -my $void_scrip_action = RT::ScripAction->new( $CurrentUser ); - -#At the appointed time: - -#find a bunch of tickets -my $tickets = RT::Tickets->new($CurrentUser); -my $search = $search->new( - TicketsObj => $tickets, - Argument => $search_arg, - CurrentUser => $CurrentUser -); - -$search->Prepare(); - -# TicketsFound is an RT::Tickets object -my $tickets = $search->TicketsObj; - -#for each ticket we've found -while ( my $ticket = $tickets->Next() ) { - print $ticket->Id() . ": " if ($verbose); - - my $template_obj = get_template( $ticket ); - - if ( $transaction ) { - my $txns = get_transactions($ticket); - my $found = 0; - while ( my $txn = $txns->Next ) { - print loc("Using transaction #[_1]...", $txn->id) - if $verbose; - process($ticket, $txn, $template_obj); - $found = 1; - } - print loc("Couldn't find suitable transaction, skipping") - if $verbose && !$found; - } else { - print loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument") - if $verbose; - - process($ticket, undef, $template_obj); - } -} - -sub process { - my $ticket = shift; - my $transaction = shift; - my $template_obj = shift; - - # perform some more advanced check - if ($condition) { - my $condition_obj = $condition->new( - TransactionObj => $transaction, - TicketObj => $ticket, - ScripObj => $void_scrip, - TemplateObj => $template_obj, - Argument => $condition_arg, - CurrentUser => $CurrentUser, - ); - - # if the condition doesn't apply, get out of here - - return unless $condition_obj->IsApplicable; - print loc("Condition matches...") if $verbose; - } - - #prepare our action - my $action_obj = $action->new( - TicketObj => $ticket, - TransactionObj => $transaction, - TemplateObj => $template_obj, - Argument => $action_arg, - ScripObj => $void_scrip, - ScripActionObj => $void_scrip_action, - CurrentUser => $CurrentUser, - ); - - #if our preparation, move onto the next ticket - return unless $action_obj->Prepare; - print loc("Action prepared...") if $verbose; - - #commit our action. - return unless $action_obj->Commit; - print loc("Action committed.\n") if $verbose; -} - -=head2 get_transactions - -Takes ticket and returns L<RT::Transactions> object with transactions -of the ticket according to command line arguments C<--transaction> -and <--transaction-type>. - -=cut - -sub get_transactions { - my $ticket = shift; - my $txns = $ticket->Transactions; - my $order = $transaction eq 'last'? 'DESC': 'ASC'; - $txns->OrderByCols( - { FIELD => 'Created', ORDER => $order }, - { FIELD => 'id', ORDER => $order }, - ); - if ( $transaction_type ) { - $transaction_type =~ s/^\s+//; - $transaction_type =~ s/\s+$//; - foreach my $type ( split /\s*,\s*/, $transaction_type ) { - $txns->Limit( FIELD => 'Type', VALUE => $type, ENTRYAGGREGATOR => 'OR' ); - } - } - $txns->RowsPerPage(1) unless $transaction eq 'all'; - return $txns; -} - -=head2 get_template - -Takes a ticket and returns a template according to command line options. - -=cut - -{ my $cache = undef; -sub get_template { - my $ticket = shift; - return undef unless $template; - - unless ( $template =~ /\D/ ) { - # by id - return $cache if $cache; - - my $cache = RT::Template->new( $RT::SystemUser ); - $cache->Load( $template ); - die "Failed to load template '$template'" - unless $cache->id; - return $cache; - } - - my $queue = $ticket->Queue; - return $cache->{ $queue } if $cache->{ $queue }; - - my $res = RT::Template->new( $RT::SystemUser ); - $res->LoadQueueTemplate( Queue => $queue, Name => $template ); - unless ( $res->id ) { - $res->LoadGlobalTemplate( $template ); - die "Failed to load template '$template', either for queue #$queue or global" - unless $res->id; - } - return $cache->{ $queue } = $res; -} } - -# {{{ 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-arg", "--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-arg", "--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-arg", "--action" ) - . "\n"; - print " " - . loc( "[_1] - Specify name or id of template(s) you want to use", "--template" ) - . "\n"; - print " " - . loc( "[_1] - Specify if you want to use either 'first', 'last' or 'all' transactions", "--transaction" ) - . "\n"; - print " " - . loc( "[_1] - Specify the comma separated list of transactions' types you want to use", "--transaction-type" ) - . "\n"; - print " " - . loc( "[_1] - Adjust LogToScreen config option", "--log" ) . "\n"; - print " " - . loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n"; - print "\n"; - print "\n"; - print loc("Security:")."\n"; - print loc("This tool allows the user to run arbitrary perl modules from within RT.")." ". - loc("If this tool were setgid, a hostile local user could use this tool to gain administrative access to RT.")." ". - loc("It is incredibly important that nonprivileged users not be allowed to run this tool."). " " . - loc("It is suggested that you create a non-privileged unix user with the correct group membership and RT access to run this tool.")."\n"; - print "\n"; - print loc("Example:"); - print "\n"; - print " " - . loc( "The following command will find all active tickets in the queue 'general' and set their priority to 99 if they haven't been touched in 4 hours:" - ) - . "\n\n"; - - print " bin/rt-crontool \\\n"; - print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; - print " --condition RT::Condition::UntouchedInHours --condition-arg 4 \\\n"; - print " --action RT::Action::SetPriority --action-arg 99 \\\n"; - print " --verbose\n"; - - print "\n"; - print loc("Escalate tickets"). "\n"; - print " bin/rt-crontool \\\n"; - print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n"; - print " --action RT::Action::EscalatePriority\n"; - - - - - - - exit(0); -} diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate deleted file mode 100755 index d9e85a7..0000000 --- a/rt/bin/rt-mailgate +++ /dev/null @@ -1,409 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/copyleft/gpl.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -=head1 NAME - -rt-mailgate - Mail interface to RT3. - -=cut - -use strict; -use warnings; - -use Getopt::Long; -use LWP::UserAgent; -use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD); -$DYNAMIC_FILE_UPLOAD = 1; - -use constant EX_TEMPFAIL => 75; -use constant BUFFER_SIZE => 8192; - -my %opts; -GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" ); - -if ( $opts{'help'} ) { - require Pod::Usage; - import Pod::Usage; - pod2usage("RT Mail Gateway\n"); - exit 1; # Don't want to succeed if this is really an email! -} - -unless ( $opts{'url'} ) { - print STDERR "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n"; - exit 1; -} - -my $ua = new LWP::UserAgent; -$ua->cookie_jar( { file => $opts{'jar'} } ) if $opts{'jar'}; - -my %args = ( - SessionType => 'REST', # Surpress login box -); -foreach ( qw(queue action) ) { - $args{$_} = $opts{$_} if defined $opts{$_}; -}; - -if ( ($opts{'extension'} || '') =~ /^(?:action|queue|ticket)$/i ) { - $args{ lc $opts{'extension'} } = $ENV{'EXTENSION'} || $opts{$opts{'extension'}}; -} elsif ( $opts{'extension'} && $ENV{'EXTENSION'} ) { - print STDERR "Value of the --extension argument is not action, queue or ticket" - .", but environment variable EXTENSION is also defined. The former is ignored.\n"; -} - -# add ENV{'EXTENSION'} as X-RT-MailExtension to the message header -if ( my $value = ( $ENV{'EXTENSION'} || $opts{'extension'} ) ) { - # prepare value to avoid MIME format breakage - # strip trailing newline symbols - $value =~ s/(\r*\n)+$//; - # make a correct multiline header field, - # with tabs in the beginning of each line - $value =~ s/(\r*\n)/$1\t/g; - $opts{'headers'} .= "X-RT-Mail-Extension: $value\n"; -} - -# Read the message in from STDIN -my %message = write_down_message(); -unless( $message{'filename'} ) { - $args{'message'} = [ - undef, '', - 'Content-Type' => 'application/octet-stream', - Content => ${ $message{'content'} }, - ]; -} else { - $args{'message'} = [ - $message{'filename'}, '', - 'Content-Type' => 'application/octet-stream', - ]; -} - -my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway"; -print STDERR "$0: connecting to $full_url\n" if $opts{'debug'}; - -$ua->timeout( exists( $opts{'timeout'} )? $opts{'timeout'}: 180 ); -my $r = $ua->post( $full_url, \%args, Content_Type => 'form-data' ); -check_failure($r); - -my $content = $r->content; -print STDERR $content ."\n" 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. - print STDERR <<EOF; -RT server error. - -The RT server which handled your email did not behave as expected. It -said: - -$content -EOF - - exit EX_TEMPFAIL; -} - -exit; - -END { - unlink $message{'filename'} if $message{'filename'}; -} - - -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, - ); - print STDERR $formatter->format( $tree ); - print STDERR "\n$0: undefined server error\n" if $opts{'debug'}; - exit EX_TEMPFAIL; -} - -sub write_down_message { - use File::Temp qw(tempfile); - - local $@; - my ($fh, $filename) = eval { tempfile() }; - if ( !$fh || $@ ) { - print STDERR "$0: Couldn't create temp file, using memory\n"; - print STDERR "error: $@\n" if $@; - - my $message = \do { local (@ARGV, $/); <> }; - unless ( $$message =~ /\S/ ) { - print STDERR "$0: no message passed on STDIN\n"; - exit 0; - } - $$message = $opts{'headers'} . $$message if $opts{'headers'}; - return ( content => $message ); - } - - binmode $fh; - binmode \*STDIN; - - print $fh $opts{'headers'} if $opts{'headers'}; - - my $buf; my $empty = 1; - while(1) { - my $status = read \*STDIN, $buf, BUFFER_SIZE; - unless ( defined $status ) { - print STDERR "$0: couldn't read message: $!\n"; - exit EX_TEMPFAIL; - } elsif ( !$status ) { - last; - } - $empty = 0 if $buf =~ /\S/; - print $fh $buf; - }; - close $fh; - - if ( $empty ) { - print STDERR "$0: no message passed on STDIN\n"; - exit 0; - } - print STDERR "$0: temp file is '$filename'\n" if $opts{'debug'}; - return (filename => $filename); -} - - -=head1 SYNOPSIS - - rt-mailgate --help : this text - -Usual invocation (from MTA): - - rt-mailgate --action (correspond|comment|...) --queue queuename - --url http://your.rt.server/ - [ --debug ] - [ --extension (queue|action|ticket) ] - [ --timeout seconds ] - - - -=head1 OPTIONS - -=over 3 - -=item C<--action> - -Specifies what happens to email sent to this alias. The avaliable -basic actions are: C<correspond>, C<comment>. - - -If you've set the RT configuration variable B<< C<UnsafeEmailCommands> >>, -C<take> and C<resolve> are also available. You can execute two or more -actions on a single message using a C<-> separated list. RT will execute -the actions in the listed order. For example you can use C<take-comment>, -C<correspond-resolve> or C<take-comment-resolve> as actions. - -Note that C<take> and C<resolve> actions ignore message text if used -alone. Include a C<comment> or C<correspond> action if you want RT -to record the incoming message. - -The default action is C<correspond>. - -=item C<--queue> - -This flag determines which queue this alias should create a ticket in if no ticket identifier -is found. - -=item C<--url> - -This flag tells the mail gateway where it can find your RT server. You should -probably use the same URL that users use to log into RT. - - -=item C<--extension> OPTIONAL - -Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host -and present "foo" in the environment variable $EXTENSION. By specifying -the value "queue" for this parameter, the queue this message should be -submitted to will be set to the value of $EXTENSION. By specifying -"ticket", $EXTENSION will be interpreted as the id of the ticket this message -is related to. "action" will allow the user to specify either "comment" or -"correspond" in the address extension. - -=item C<--debug> OPTIONAL - -Print debugging output to standard error - - -=item C<--timeout> OPTIONAL - -Configure the timeout for posting the message to the web server. The -default timeout is 3 minutes (180 seconds). - - -=head1 DESCRIPTION - -The RT mail gateway is the primary mechanism for communicating with RT -via email. This program simply directs the email to the RT web server, -which handles filing correspondence and sending out any required mail. -It is designed to be run as part of the mail delivery process, either -called directly by the MTA or C<procmail>, or in a F<.forward> or -equivalent. - -=head1 SETUP - -Much of the set up of the mail gateway depends on your MTA and mail -routing configuration. However, you will need first of all to create an -RT user for the mail gateway and assign it a password; this helps to -ensure that mail coming into the web server did originate from the -gateway. - -Next, you need to route mail to C<rt-mailgate> for the queues you're -monitoring. For instance, if you're using F</etc/aliases> and you have a -"bugs" queue, you will want something like this: - - bugs: "|/opt/rt3/bin/rt-mailgate --queue bugs --action correspond - --url http://rt.mycorp.com/" - - bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment - --url http://rt.mycorp.com/" - -Note that you don't have to run your RT server on your mail server, as -the mail gateway will happily relay to a different machine. - -=head1 CUSTOMIZATION - -By default, the mail gateway will accept mail from anyone. However, -there are situations in which you will want to authenticate users -before allowing them to communicate with the system. You can do this -via a plug-in mechanism in the RT configuration. - -You can set the array C<@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: - - Set( @MailPlugins => - "Filter::SpamAssassin", - "Auth::LDAP", - # ... - ); - -See the documentation for any additional plugins you have. - -You may also put Perl subroutines into the C<@MailPlugins> array, if -they behave as described below. - -=head1 WRITING PLUGINS - -What's actually going on in the above is that C<@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. - -=head1 ENVIRONMENT - -=over 4 - -=item EXTENSION - -Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host -and present "foo" in the environment variable C<EXTENSION>. Mailgate adds value -of this variable to message in the C<X-RT-Mail-Extension> field of the message -header. - -See also C<--extension> option. Note that value of the environment variable is -always added to the message header when it's not empty even if C<--extension> -option is not provided. - -=back 4 - -=cut - diff --git a/rt/bin/rt-mailgate.in b/rt/bin/rt-mailgate.in deleted file mode 100644 index b2343a0..0000000 --- a/rt/bin/rt-mailgate.in +++ /dev/null @@ -1,409 +0,0 @@ -#!@PERL@ -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -=head1 NAME - -rt-mailgate - Mail interface to RT3. - -=cut - -use strict; -use warnings; - -use Getopt::Long; -use LWP::UserAgent; -use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD); -$DYNAMIC_FILE_UPLOAD = 1; - -use constant EX_TEMPFAIL => 75; -use constant BUFFER_SIZE => 8192; - -my %opts; -GetOptions( \%opts, "queue=s", "action=s", "url=s", "jar=s", "help", "debug", "extension=s", "timeout=i" ); - -if ( $opts{'help'} ) { - require Pod::Usage; - import Pod::Usage; - pod2usage("RT Mail Gateway\n"); - exit 1; # Don't want to succeed if this is really an email! -} - -unless ( $opts{'url'} ) { - print STDERR "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n"; - exit 1; -} - -my $ua = new LWP::UserAgent; -$ua->cookie_jar( { file => $opts{'jar'} } ) if $opts{'jar'}; - -my %args = ( - SessionType => 'REST', # Surpress login box -); -foreach ( qw(queue action) ) { - $args{$_} = $opts{$_} if defined $opts{$_}; -}; - -if ( ($opts{'extension'} || '') =~ /^(?:action|queue|ticket)$/i ) { - $args{ lc $opts{'extension'} } = $ENV{'EXTENSION'} || $opts{$opts{'extension'}}; -} elsif ( $opts{'extension'} && $ENV{'EXTENSION'} ) { - print STDERR "Value of the --extension argument is not action, queue or ticket" - .", but environment variable EXTENSION is also defined. The former is ignored.\n"; -} - -# add ENV{'EXTENSION'} as X-RT-MailExtension to the message header -if ( my $value = ( $ENV{'EXTENSION'} || $opts{'extension'} ) ) { - # prepare value to avoid MIME format breakage - # strip trailing newline symbols - $value =~ s/(\r*\n)+$//; - # make a correct multiline header field, - # with tabs in the beginning of each line - $value =~ s/(\r*\n)/$1\t/g; - $opts{'headers'} .= "X-RT-Mail-Extension: $value\n"; -} - -# Read the message in from STDIN -my %message = write_down_message(); -unless( $message{'filename'} ) { - $args{'message'} = [ - undef, '', - 'Content-Type' => 'application/octet-stream', - Content => ${ $message{'content'} }, - ]; -} else { - $args{'message'} = [ - $message{'filename'}, '', - 'Content-Type' => 'application/octet-stream', - ]; -} - -my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway"; -print STDERR "$0: connecting to $full_url\n" if $opts{'debug'}; - -$ua->timeout( exists( $opts{'timeout'} )? $opts{'timeout'}: 180 ); -my $r = $ua->post( $full_url, \%args, Content_Type => 'form-data' ); -check_failure($r); - -my $content = $r->content; -print STDERR $content ."\n" 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. - print STDERR <<EOF; -RT server error. - -The RT server which handled your email did not behave as expected. It -said: - -$content -EOF - - exit EX_TEMPFAIL; -} - -exit; - -END { - unlink $message{'filename'} if $message{'filename'}; -} - - -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, - ); - print STDERR $formatter->format( $tree ); - print STDERR "\n$0: undefined server error\n" if $opts{'debug'}; - exit EX_TEMPFAIL; -} - -sub write_down_message { - use File::Temp qw(tempfile); - - local $@; - my ($fh, $filename) = eval { tempfile() }; - if ( !$fh || $@ ) { - print STDERR "$0: Couldn't create temp file, using memory\n"; - print STDERR "error: $@\n" if $@; - - my $message = \do { local (@ARGV, $/); <> }; - unless ( $$message =~ /\S/ ) { - print STDERR "$0: no message passed on STDIN\n"; - exit 0; - } - $$message = $opts{'headers'} . $$message if $opts{'headers'}; - return ( content => $message ); - } - - binmode $fh; - binmode \*STDIN; - - print $fh $opts{'headers'} if $opts{'headers'}; - - my $buf; my $empty = 1; - while(1) { - my $status = read \*STDIN, $buf, BUFFER_SIZE; - unless ( defined $status ) { - print STDERR "$0: couldn't read message: $!\n"; - exit EX_TEMPFAIL; - } elsif ( !$status ) { - last; - } - $empty = 0 if $buf =~ /\S/; - print $fh $buf; - }; - close $fh; - - if ( $empty ) { - print STDERR "$0: no message passed on STDIN\n"; - exit 0; - } - print STDERR "$0: temp file is '$filename'\n" if $opts{'debug'}; - return (filename => $filename); -} - - -=head1 SYNOPSIS - - rt-mailgate --help : this text - -Usual invocation (from MTA): - - rt-mailgate --action (correspond|comment|...) --queue queuename - --url http://your.rt.server/ - [ --debug ] - [ --extension (queue|action|ticket) ] - [ --timeout seconds ] - - - -=head1 OPTIONS - -=over 3 - -=item C<--action> - -Specifies what happens to email sent to this alias. The avaliable -basic actions are: C<correspond>, C<comment>. - - -If you've set the RT configuration variable B<< C<UnsafeEmailCommands> >>, -C<take> and C<resolve> are also available. You can execute two or more -actions on a single message using a C<-> separated list. RT will execute -the actions in the listed order. For example you can use C<take-comment>, -C<correspond-resolve> or C<take-comment-resolve> as actions. - -Note that C<take> and C<resolve> actions ignore message text if used -alone. Include a C<comment> or C<correspond> action if you want RT -to record the incoming message. - -The default action is C<correspond>. - -=item C<--queue> - -This flag determines which queue this alias should create a ticket in if no ticket identifier -is found. - -=item C<--url> - -This flag tells the mail gateway where it can find your RT server. You should -probably use the same URL that users use to log into RT. - - -=item C<--extension> OPTIONAL - -Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host -and present "foo" in the environment variable $EXTENSION. By specifying -the value "queue" for this parameter, the queue this message should be -submitted to will be set to the value of $EXTENSION. By specifying -"ticket", $EXTENSION will be interpreted as the id of the ticket this message -is related to. "action" will allow the user to specify either "comment" or -"correspond" in the address extension. - -=item C<--debug> OPTIONAL - -Print debugging output to standard error - - -=item C<--timeout> OPTIONAL - -Configure the timeout for posting the message to the web server. The -default timeout is 3 minutes (180 seconds). - - -=head1 DESCRIPTION - -The RT mail gateway is the primary mechanism for communicating with RT -via email. This program simply directs the email to the RT web server, -which handles filing correspondence and sending out any required mail. -It is designed to be run as part of the mail delivery process, either -called directly by the MTA or C<procmail>, or in a F<.forward> or -equivalent. - -=head1 SETUP - -Much of the set up of the mail gateway depends on your MTA and mail -routing configuration. However, you will need first of all to create an -RT user for the mail gateway and assign it a password; this helps to -ensure that mail coming into the web server did originate from the -gateway. - -Next, you need to route mail to C<rt-mailgate> for the queues you're -monitoring. For instance, if you're using F</etc/aliases> and you have a -"bugs" queue, you will want something like this: - - bugs: "|/opt/rt3/bin/rt-mailgate --queue bugs --action correspond - --url http://rt.mycorp.com/" - - bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment - --url http://rt.mycorp.com/" - -Note that you don't have to run your RT server on your mail server, as -the mail gateway will happily relay to a different machine. - -=head1 CUSTOMIZATION - -By default, the mail gateway will accept mail from anyone. However, -there are situations in which you will want to authenticate users -before allowing them to communicate with the system. You can do this -via a plug-in mechanism in the RT configuration. - -You can set the array C<@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: - - Set( @MailPlugins => - "Filter::SpamAssassin", - "Auth::LDAP", - # ... - ); - -See the documentation for any additional plugins you have. - -You may also put Perl subroutines into the C<@MailPlugins> array, if -they behave as described below. - -=head1 WRITING PLUGINS - -What's actually going on in the above is that C<@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. - -=head1 ENVIRONMENT - -=over 4 - -=item EXTENSION - -Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host -and present "foo" in the environment variable C<EXTENSION>. Mailgate adds value -of this variable to message in the C<X-RT-Mail-Extension> field of the message -header. - -See also C<--extension> option. Note that value of the environment variable is -always added to the message header when it's not empty even if C<--extension> -option is not provided. - -=back 4 - -=cut - diff --git a/rt/bin/rt.in b/rt/bin/rt.in deleted file mode 100644 index 6ca302e..0000000 --- a/rt/bin/rt.in +++ /dev/null @@ -1,2586 +0,0 @@ -#!@PERL@ -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -# Designed and implemented for Best Practical Solutions, LLC by -# Abhijit Menon-Sen <ams@wiw.org> - -use strict; - -# This program is intentionally written to have as few non-core module -# dependencies as possible. It should stay that way. - -use Cwd; -use LWP; -use Text::ParseWords; -use HTTP::Request::Common; -use HTTP::Headers; -use Term::ReadLine; -use Time::Local; # used in prettyshow - -# strong (GSSAPI based) authentication is supported if the server does provide -# it and the perl modules GSSAPI and LWP::Authen::Negotiate are installed -# it can be suppressed by setting externalauth=0 (default is undef) -eval { require GSSAPI }; -my $no_strong_auth = 'missing perl module GSSAPI'; -if ( ! $@ ) { - eval {require LWP::Authen::Negotiate}; - $no_strong_auth = $@ ? 'missing perl module LWP::Authen::Negotiate' : 0; -} - -# We derive configuration information from hardwired defaults, dotfiles, -# and the RT* environment variables (in increasing order of precedence). -# Session information is stored in ~/.rt_sessions. - -my $VERSION = 0.02; -my $HOME = eval{(getpwuid($<))[7]} - || $ENV{HOME} || $ENV{LOGDIR} || $ENV{HOMEPATH} - || "."; -my %config = ( - ( - debug => 0, - user => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME}, - passwd => undef, - server => 'http://localhost/', - query => "Status!='resolved' and Status!='rejected'", - orderby => 'id', - queue => undef, -# to protect against unlimited searches a better choice would be -# queue => 'Unknown_Queue', -# setting externalauth => undef will try GSSAPI auth if the corresponding perl -# modules are installed, externalauth => 0 is the backward compatible choice - externalauth => 0, - ), - config_from_file($ENV{RTCONFIG} || ".rtrc"), - config_from_env() -); -my $session = new Session("$HOME/.rt_sessions"); -my $REST = "$config{server}/REST/1.0"; -$no_strong_auth = 'switched off by externalauth=0' - if defined $config{externalauth}; - - -my $prompt = 'rt> '; - -sub whine; -sub DEBUG { warn @_ if $config{debug} >= shift } - -# These regexes are used by command handlers to parse arguments. -# (XXX: Ask Autrijus how i18n changes these definitions.) - -my $name = '[\w.-]+'; -my $CF_name = '[\sa-z0-9_ :()/-]+'; -my $field = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})'; -my $label = '[a-zA-Z0-9@_.+-]+'; -my $labels = "(?:$label,)*$label"; -my $idlist = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+'; - -# Our command line looks like this: -# -# rt <action> [options] [arguments] -# -# We'll parse just enough of it to decide upon an action to perform, and -# leave the rest to per-action handlers to interpret appropriately. - -my %handlers = ( -# handler => [ ...aliases... ], - version => ["version", "ver"], - shell => ["shell"], - logout => ["logout"], - help => ["help", "man"], - show => ["show", "cat"], - edit => ["create", "edit", "new", "ed"], - list => ["search", "list", "ls"], - comment => ["comment", "correspond"], - link => ["link", "ln"], - merge => ["merge"], - grant => ["grant", "revoke"], - take => ["take", "steal", "untake"], - quit => ["quit", "exit"], - setcommand => ["del", "delete", "give", "res", "resolve", - "subject"], -); - -my %actions; -foreach my $fn (keys %handlers) { - foreach my $alias (@{ $handlers{$fn} }) { - $actions{$alias} = \&{"$fn"}; - } -} - -# Once we find and call an appropriate handler, we're done. - -sub handler { - my $action; - - push @ARGV, 'shell' if (!@ARGV); # default to shell mode - shift @ARGV if ($ARGV[0] eq 'rt'); # ignore a leading 'rt' - if (@ARGV && exists $actions{$ARGV[0]}) { - $action = shift @ARGV; - return $actions{$action}->($action); - } - else { - print STDERR "rt: Unknown command '@ARGV'.\n"; - print STDERR "rt: For help, run 'rt help'.\n"; - return 1; - } -} - -exit handler(); - -# Handler functions. -# ------------------ -# -# The following subs are handlers for each entry in %actions. - -sub shell { - $|=1; - my $term = new Term::ReadLine 'RT CLI'; - while ( defined ($_ = $term->readline($prompt)) ) { - next if /^#/ || /^\s*$/; - - @ARGV = shellwords($_); - handler(); - } -} - -sub version { - print "rt $VERSION\n"; - return 0; -} - -sub logout { - submit("$REST/logout") if defined $session->cookie; - return 0; -} - -sub quit { - logout(); - exit; -} - -my %help; -sub help { - my ($action, $type, $rv) = @_; - $rv = defined $rv ? $rv : 0; - my $key; - - # What help topics do we know about? - if (!%help) { - local $/ = undef; - foreach my $item (@{ Form::parse(<DATA>) }) { - my $title = $item->[2]{Title}; - my @titles = ref $title eq 'ARRAY' ? @$title : $title; - - foreach $title (grep $_, @titles) { - $help{$title} = $item->[2]{Text}; - } - } - } - - # What does the user want help with? - undef $action if ($action && $actions{$action} eq \&help); - unless ($action || $type) { - # If we don't know, we'll look for clues in @ARGV. - foreach (@ARGV) { - if (exists $help{$_}) { $key = $_; last; } - } - unless ($key) { - # Tolerate possibly plural words. - foreach (@ARGV) { - if ($_ =~ s/s$// && exists $help{$_}) { $key = $_; last; } - } - } - } - - if ($type && $action) { - $key = "$type.$action"; - } - $key ||= $type || $action || "introduction"; - - # Find a suitable topic to display. - while (!exists $help{$key}) { - if ($type && $action) { - if ($key eq "$type.$action") { $key = $action; } - elsif ($key eq $action) { $key = $type; } - else { $key = "introduction"; } - } - else { - $key = "introduction"; - } - } - - print STDERR $help{$key}, "\n\n"; - return $rv; -} - -# Displays a list of objects that match some specified condition. - -sub list { - my ($q, $type, %data); - my $orderby = $config{orderby}; - - if ($config{orderby}) { - $data{orderby} = $config{orderby}; - } - my $bad = 0; - my $rawprint = 0; - my $reverse_sort = 0; - my $queue = $config{queue}; - - while (@ARGV) { - $_ = shift @ARGV; - - if (/^-t$/) { - $bad = 1, last unless defined($type = get_type_argument()); - } - elsif (/^-S$/) { - $bad = 1, last unless get_var_argument(\%data); - } - elsif (/^-o$/) { - $data{'orderby'} = shift @ARGV; - } - elsif (/^-([isl])$/) { - $data{format} = $1; - $rawprint = 1; - } - elsif (/^-q$/) { - $queue = shift @ARGV; - } - elsif (/^-r$/) { - $reverse_sort = 1; - } - elsif (/^-f$/) { - if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) { - whine "No valid field list in '-f $ARGV[0]'."; - $bad = 1; last; - } - $data{fields} = shift @ARGV; - $data{format} = 's' if ! $data{format}; - $rawprint = 1; - } - elsif (!defined $q && !/^-/) { - $q = $_; - } - else { - my $datum = /^-/ ? "option" : "argument"; - whine "Unrecognised $datum '$_'."; - $bad = 1; last; - } - } - if ( ! $rawprint and ! exists $data{format} ) { - $data{format} = 'l'; - } - if ( $reverse_sort and $data{orderby} =~ /^-/ ) { - $data{orderby} =~ s/^-/+/; - } elsif ($reverse_sort) { - $data{orderby} =~ s/^\+?(.*)/-$1/; - } - - if (!defined $q) { - $q = $config{query}; - } - - $q =~ s/^#//; # get rid of leading hash - if ($q =~ /^\d+$/) { - # only digits, must be an id, formulate a correct query - $q = "id=$q" if $q =~ /^\d+$/; - } else { - # a string only, take it as an owner or requestor (quoting done later) - $q = "(Owner=$q or Requestor like $q) and $config{query}" - if $q =~ /^[\w\-]+$/; - # always add a query for a specific queue or (comma separated) queues - $queue =~ s/,/ or Queue=/g if $queue; - $q .= " and (Queue=$queue)" if $queue and $q and $q !~ /Queue\s*=/i - and $q !~ /id\s*=/i; - } - # correctly quote strings in a query - $q =~ s/(=|like\s)\s*([^'\d\s]\S*)\b/$1\'$2\'/g; - - $type ||= "ticket"; - unless ($type && defined $q) { - my $item = $type ? "query string" : "object type"; - whine "No $item specified."; - $bad = 1; - } - #return help("list", $type) if $bad; - return suggest_help("list", $type, $bad) if $bad; - - print "Query:$q\n" if ! $rawprint; - my $r = submit("$REST/search/$type", { query => $q, %data }); - if ( $rawprint ) { - print $r->content; - } else { - my $forms = Form::parse($r->content); - prettylist ($forms); - } - return 0; -} - -# Displays selected information about a single object. - -sub show { - my ($type, @objects, %data); - my $slurped = 0; - my $bad = 0; - my $rawprint = 0; - my $histspec; - - while (@ARGV) { - $_ = shift @ARGV; - s/^#// if /^#\d+/; # get rid of leading hash - if (/^-t$/) { - $bad = 1, last unless defined($type = get_type_argument()); - } - elsif (/^-S$/) { - $bad = 1, last unless get_var_argument(\%data); - } - elsif (/^-([isl])$/) { - $data{format} = $1; - $rawprint = 1; - } - elsif (/^-$/ && !$slurped) { - chomp(my @lines = <STDIN>); - foreach (@lines) { - unless (is_object_spec($_, $type)) { - whine "Invalid object on STDIN: '$_'."; - $bad = 1; last; - } - push @objects, $_; - } - $slurped = 1; - } - elsif (/^-f$/) { - if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) { - whine "No valid field list in '-f $ARGV[0]'."; - $bad = 1; last; - } - $data{fields} = shift @ARGV; - # option f requires short raw listing format - $data{format} = 's'; - $rawprint = 1; - } - elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) { - push @objects, $spc2; - $histspec = is_object_spec("ticket/$_/history", $type); - } - elsif (/^\d+\// and my $spc3 = is_object_spec("ticket/$_", $type)) { - push @objects, $spc3; - $rawprint = 1 if $_ =~ /\/content$/; - } - elsif (my $spec = is_object_spec($_, $type)) { - push @objects, $spec; - $rawprint = 1 if $_ =~ /\/content$/ or $_ !~ /^ticket/; - } - else { - my $datum = /^-/ ? "option" : "argument"; - whine "Unrecognised $datum '$_'."; - $bad = 1; last; - } - } - if ( ! $rawprint ) { - push @objects, $histspec if $histspec; - $data{format} = 'l' if ! exists $data{format}; - } - - unless (@objects) { - whine "No objects specified."; - $bad = 1; - } - #return help("show", $type) if $bad; - return suggest_help("show", $type, $bad) if $bad; - - my $r = submit("$REST/show", { id => \@objects, %data }); - my $c = $r->content; - # if this isn't a text reply, remove the trailing newline so we - # don't corrupt things like tarballs when people do - # show ticket/id/attachments/id/content > foo.tar.gz - if ($r->content_type !~ /^text\//) { - chomp($c); - $rawprint = 1; - } - if ( $rawprint ) { - print $c; - } else { - # I do not know how to get more than one form correctly returned - $c =~ s!^RT/[\d\.]+ 200 Ok$!--!mg; - my $forms = Form::parse($c); - prettyshow ($forms); - } - return 0; -} - -# To create a new object, we ask the server for a form with the defaults -# filled in, allow the user to edit it, and send the form back. -# -# To edit an object, we must ask the server for a form representing that -# object, make changes requested by the user (either on the command line -# or interactively via $EDITOR), and send the form back. - -sub edit { - my ($action) = @_; - my (%data, $type, @objects); - my ($cl, $text, $edit, $input, $output); - - use vars qw(%set %add %del); - %set = %add = %del = (); - my $slurped = 0; - my $bad = 0; - - while (@ARGV) { - $_ = shift @ARGV; - s/^#// if /^#\d+/; # get rid of leading hash - - if (/^-e$/) { $edit = 1 } - elsif (/^-i$/) { $input = 1 } - elsif (/^-o$/) { $output = 1 } - elsif (/^-t$/) { - $bad = 1, last unless defined($type = get_type_argument()); - } - elsif (/^-S$/) { - $bad = 1, last unless get_var_argument(\%data); - } - elsif (/^-$/ && !($slurped || $input)) { - chomp(my @lines = <STDIN>); - foreach (@lines) { - unless (is_object_spec($_, $type)) { - whine "Invalid object on STDIN: '$_'."; - $bad = 1; last; - } - push @objects, $_; - } - $slurped = 1; - } - elsif (/^set$/i) { - my $vars = 0; - - while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/s) { - my ($key, $op, $val) = ($1, $2, $3); - my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del; - - vpush($hash, lc $key, $val); - shift @ARGV; - $vars++; - } - unless ($vars) { - whine "No variables to set."; - $bad = 1; last; - } - $cl = $vars; - } - elsif (/^(?:add|del)$/i) { - my $vars = 0; - my $hash = ($_ eq "add") ? \%add : \%del; - - while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/s) { - my ($key, $val) = ($1, $2); - - vpush($hash, lc $key, $val); - shift @ARGV; - $vars++; - } - unless ($vars) { - whine "No variables to set."; - $bad = 1; last; - } - $cl = $vars; - } - elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) { - push @objects, $spc2; - } - elsif (my $spec = is_object_spec($_, $type)) { - push @objects, $spec; - } - else { - my $datum = /^-/ ? "option" : "argument"; - whine "Unrecognised $datum '$_'."; - $bad = 1; last; - } - } - - if ($action =~ /^ed(?:it)?$/) { - unless (@objects) { - whine "No objects specified."; - $bad = 1; - } - } - else { - if (@objects) { - whine "You shouldn't specify objects as arguments to $action."; - $bad = 1; - } - unless ($type) { - whine "What type of object do you want to create?"; - $bad = 1; - } - @objects = ("$type/new") if defined($type); - } - #return help($action, $type) if $bad; - return suggest_help($action, $type, $bad) if $bad; - - # We need a form to make changes to. We usually ask the server for - # one, but we can avoid that if we are fed one on STDIN, or if the - # user doesn't want to edit the form by hand, and the command line - # specifies only simple variable assignments. We *should* get a - # form if we're creating a new ticket, so that the default values - # get filled in properly. - - my @new_objects = grep /\/new$/, @objects; - - if ($input) { - local $/ = undef; - $text = <STDIN>; - } - elsif ($edit || %add || %del || !$cl || @new_objects) { - my $r = submit("$REST/show", { id => \@objects, format => 'l' }); - $text = $r->content; - } - - # If any changes were specified on the command line, apply them. - if ($cl) { - if ($text) { - # We're updating forms from the server. - my $forms = Form::parse($text); - - foreach my $form (@$forms) { - my ($c, $o, $k, $e) = @$form; - my ($key, $val); - - next if ($e || !@$o); - - local %add = %add; - local %del = %del; - local %set = %set; - - # Make changes to existing fields. - foreach $key (@$o) { - if (exists $add{lc $key}) { - $val = delete $add{lc $key}; - vpush($k, $key, $val); - $k->{$key} = vsplit($k->{$key}) if $val =~ /[,\n]/; - } - if (exists $del{lc $key}) { - $val = delete $del{lc $key}; - my %val = map {$_=>1} @{ vsplit($val) }; - $k->{$key} = vsplit($k->{$key}); - @{$k->{$key}} = grep {!exists $val{$_}} @{$k->{$key}}; - } - if (exists $set{lc $key}) { - $k->{$key} = delete $set{lc $key}; - } - } - - # Then update the others. - foreach $key (keys %set) { vpush($k, $key, $set{$key}) } - foreach $key (keys %add) { - vpush($k, $key, $add{$key}); - $k->{$key} = vsplit($k->{$key}); - } - push @$o, (keys %add, keys %set); - } - - $text = Form::compose($forms); - } - else { - # We're rolling our own set of forms. - my @forms; - foreach (@objects) { - my ($type, $ids, $args) = - m{^($name)/($idlist|$labels)(?:(/.*))?$}o; - - $args ||= ""; - foreach my $obj (expand_list($ids)) { - my %set = (%set, id => "$type/$obj$args"); - push @forms, ["", [keys %set], \%set]; - } - } - $text = Form::compose(\@forms); - } - } - - if ($output) { - print $text; - return 0; - } - - my $synerr = 0; - -EDIT: - # We'll let the user edit the form before sending it to the server, - # unless we have enough information to submit it non-interactively. - if ($edit || (!$input && !$cl)) { - my $newtext = vi($text); - # We won't resubmit a bad form unless it was changed. - $text = ($synerr && $newtext eq $text) ? undef : $newtext; - } - - if ($text) { - my $r = submit("$REST/edit", {content => $text, %data}); - if ($r->code == 409) { - # If we submitted a bad form, we'll give the user a chance - # to correct it and resubmit. - if ($edit || (!$input && !$cl)) { - $text = $r->content; - $synerr = 1; - goto EDIT; - } - else { - print $r->content; - return 0; - } - } - print $r->content; - } - return 0; -} - -# handler for special edit commands. A valid edit command is constructed and -# further work is delegated to the edit handler - -sub setcommand { - my ($action) = @_; - my ($id, $bad, $what); - if ( @ARGV ) { - $_ = shift @ARGV; - $id = $1 if (m|^(?:ticket/)?($idlist)$|); - } - if ( ! $id ) { - $bad = 1; - whine "No ticket number specified."; - } - if ( @ARGV ) { - if ($action eq 'subject') { - my $subject = '"'.join (" ", @ARGV).'"'; - @ARGV = (); - $what = "subject=$subject"; - } elsif ($action eq 'give') { - my $owner = shift @ARGV; - $what = "owner=$owner"; - } - } else { - if ( $action eq 'delete' or $action eq 'del' ) { - $what = "status=deleted"; - } elsif ($action eq 'resolve' or $action eq 'res' ) { - $what = "status=resolved"; - } elsif ($action eq 'take' ) { - $what = "owner=$config{user}"; - } elsif ($action eq 'untake') { - $what = "owner=Nobody"; - } - } - if (@ARGV) { - $bad = 1; - whine "Extraneous arguments for action $action: @ARGV."; - } - if ( ! $what ) { - $bad = 1; - whine "unrecognized action $action."; - } - return help("edit", undef, $bad) if $bad; - @ARGV = ( $id, "set", $what ); - print "Executing: rt edit @ARGV\n"; - return edit("edit"); -} - -# We roll "comment" and "correspond" into the same handler. - -sub comment { - my ($action) = @_; - my (%data, $id, @files, @bcc, @cc, $msg, $wtime, $edit); - my $bad = 0; - - while (@ARGV) { - $_ = shift @ARGV; - - if (/^-e$/) { - $edit = 1; - } - elsif (/^-[abcmw]$/) { - unless (@ARGV) { - whine "No argument specified with $_."; - $bad = 1; last; - } - - if (/-a/) { - unless (-f $ARGV[0] && -r $ARGV[0]) { - whine "Cannot read attachment: '$ARGV[0]'."; - return 0; - } - push @files, shift @ARGV; - } - elsif (/-([bc])/) { - my $a = $_ eq "-b" ? \@bcc : \@cc; - @$a = split /\s*,\s*/, shift @ARGV; - } - elsif (/-m/) { - $msg = shift @ARGV; - if ( $msg =~ /^-$/ ) { - undef $msg; - while (<STDIN>) { $msg .= $_ } - } - } - - elsif (/-w/) { $wtime = shift @ARGV } - } - elsif (!$id && m|^(?:ticket/)?($idlist)$|) { - $id = $1; - } - else { - my $datum = /^-/ ? "option" : "argument"; - whine "Unrecognised $datum '$_'."; - $bad = 1; last; - } - } - - unless ($id) { - whine "No object specified."; - $bad = 1; - } - #return help($action, "ticket") if $bad; - return suggest_help($action, "ticket") if $bad; - - my $form = [ - "", - [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Text" ], - { - Ticket => $id, - Action => $action, - Cc => [ @cc ], - Bcc => [ @bcc ], - Attachment => [ @files ], - TimeWorked => $wtime || '', - Text => $msg || '', - Status => '' - } - ]; - - my $text = Form::compose([ $form ]); - - if ($edit || !$msg) { - my $error = 0; - my ($c, $o, $k, $e); - - do { - my $ntext = vi($text); - return if ($error && $ntext eq $text); - $text = $ntext; - $form = Form::parse($text); - $error = 0; - - ($c, $o, $k, $e) = @{ $form->[0] }; - if ($e) { - $error = 1; - $c = "# Syntax error."; - goto NEXT; - } - elsif (!@$o) { - return 0; - } - @files = @{ vsplit($k->{Attachment}) }; - - NEXT: - $text = Form::compose([[$c, $o, $k, $e]]); - } while ($error); - } - - my $i = 1; - foreach my $file (@files) { - $data{"attachment_$i"} = bless([ $file ], "Attachment"); - $i++; - } - $data{content} = $text; - - my $r = submit("$REST/ticket/$id/comment", \%data); - print $r->content; - return 0; -} - -# Merge one ticket into another. - -sub merge { - my @id; - my $bad = 0; - - while (@ARGV) { - $_ = shift @ARGV; - s/^#// if /^#\d+/; # get rid of leading hash - - if (/^\d+$/) { - push @id, $_; - } - else { - whine "Unrecognised argument: '$_'."; - $bad = 1; last; - } - } - - unless (@id == 2) { - my $evil = @id > 2 ? "many" : "few"; - whine "Too $evil arguments specified."; - $bad = 1; - } - #return help("merge", "ticket") if $bad; - return suggest_help("merge", "ticket", $bad) if $bad; - - my $r = submit("$REST/ticket/$id[0]/merge/$id[1]"); - print $r->content; - return 0; -} - -# Link one ticket to another. - -sub link { - my ($bad, $del, %data) = (0, 0, ()); - my $type; - - my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo - ReferredToBy HasMember MemberOf); - - while (@ARGV && $ARGV[0] =~ /^-/) { - $_ = shift @ARGV; - - if (/^-d$/) { - $del = 1; - } - elsif (/^-t$/) { - $bad = 1, last unless defined($type = get_type_argument()); - } - else { - whine "Unrecognised option: '$_'."; - $bad = 1; last; - } - } - - $type = "ticket" unless $type; # default type to tickets - - if (@ARGV == 3) { - my ($from, $rel, $to) = @ARGV; - if ($from !~ /^\d+$/ || $to !~ /^\d+$/) { - my $bad = $from =~ /^\d+$/ ? $to : $from; - whine "Invalid $type ID '$bad' specified."; - $bad = 1; - } - if (($type eq "ticket") && ( ! exists $ltypes{lc $rel})) { - whine "Invalid link '$rel' for type $type specified."; - $bad = 1; - } - %data = (id => $from, rel => $rel, to => $to, del => $del); - } - else { - my $bad = @ARGV < 3 ? "few" : "many"; - whine "Too $bad arguments specified."; - $bad = 1; - } - return suggest_help("link", $type, $bad) if $bad; - - my $r = submit("$REST/$type/link", \%data); - print $r->content; - return 0; -} - -# Take/steal a ticket -sub take { - my ($cmd) = @_; - my ($bad, %data) = (0, ()); - - my $id; - - # get the ticket id - if (@ARGV == 1) { - ($id) = @ARGV; - unless ($id =~ /^\d+$/) { - whine "Invalid ticket ID $id specified."; - $bad = 1; - } - my $form = [ - "", - [ "Ticket", "Action" ], - { - Ticket => $id, - Action => $cmd, - Status => '', - } - ]; - - my $text = Form::compose([ $form ]); - $data{content} = $text; - } - else { - $bad = @ARGV < 1 ? "few" : "many"; - whine "Too $bad arguments specified."; - $bad = 1; - } - return suggest_help("take", "ticket", $bad) if $bad; - - my $r = submit("$REST/ticket/$id/take", \%data); - print $r->content; - return 0; -} - -# Grant/revoke a user's rights. - -sub grant { - my ($cmd) = @_; - - my $revoke = 0; - while (@ARGV) { - } - - $revoke = 1 if $cmd->{action} eq 'revoke'; - return 0; -} - -# Client <-> Server communication. -# -------------------------------- -# -# This function composes and sends an HTTP request to the RT server, and -# interprets the response. It takes a request URI, and optional request -# data (a string, or a reference to a set of key-value pairs). - -sub submit { - my ($uri, $content) = @_; - my ($req, $data); - my $ua = new LWP::UserAgent(agent => "RT/3.0b", env_proxy => 1); - my $h = HTTP::Headers->new; - - # Did the caller specify any data to send with the request? - $data = []; - if (defined $content) { - unless (ref $content) { - # If it's just a string, make sure LWP handles it properly. - # (By pretending that it's a file!) - $content = [ content => [undef, "", Content => $content] ]; - } - elsif (ref $content eq 'HASH') { - my @data; - foreach my $k (keys %$content) { - if (ref $content->{$k} eq 'ARRAY') { - foreach my $v (@{ $content->{$k} }) { - push @data, $k, $v; - } - } - else { push @data, $k, $content->{$k} } - } - $content = \@data; - } - $data = $content; - } - - # Should we send authentication information to start a new session? - my $how = $config{server} =~ /^https/ ? 'over SSL' : 'unencrypted'; - (my $server = $config{server}) =~ s/^.*\/\/([^\/]+)\/?/$1/; - if ($config{externalauth}) { - $h->authorization_basic($config{user}, $config{passwd} || read_passwd() ); - print " Password will be sent to $server $how\n", - " Press CTRL-C now if you do not want to continue\n" - if ! $config{passwd}; - } elsif ( $no_strong_auth ) { - if (!defined $session->cookie) { - print " Strong encryption not available, $no_strong_auth\n", - " Password will be sent to $server $how\n", - " Press CTRL-C now if you do not want to continue\n" - if ! $config{passwd}; - push @$data, ( user => $config{user} ); - push @$data, ( pass => $config{passwd} || read_passwd() ); - } - } - - # Now, we construct the request. - if (@$data) { - $req = POST($uri, $data, Content_Type => 'form-data'); - } - else { - $req = GET($uri); - } - $session->add_cookie_header($req); - if ($config{externalauth}) { - $req->header(%$h); - } - - # Then we send the request and parse the response. - DEBUG(3, $req->as_string); - my $res = $ua->request($req); - DEBUG(3, $res->as_string); - - if ($res->is_success) { - # The content of the response we get from the RT server consists - # of an HTTP-like status line followed by optional header lines, - # a blank line, and arbitrary text. - - my ($head, $text) = split /\n\n/, $res->content, 2; - my ($status, @headers) = split /\n/, $head; - $text =~ s/\n*$/\n/ if ($text); - - # "RT/3.0.1 401 Credentials required" - if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) { - warn "rt: Malformed RT response from $config{server}.\n"; - warn "(Rerun with RTDEBUG=3 for details.)\n" if $config{debug} < 3; - exit -1; - } - - # Our caller can pretend that the server returned a custom HTTP - # response code and message. (Doing that directly is apparently - # not sufficiently portable and uncomplicated.) - $res->code($1); - $res->message($2); - $res->content($text); - $session->update($res) if ($res->is_success || $res->code != 401); - - if (!$res->is_success) { - # We can deal with authentication failures ourselves. Either - # we sent invalid credentials, or our session has expired. - if ($res->code == 401) { - my %d = @$data; - if (exists $d{user}) { - warn "rt: Incorrect username or password.\n"; - exit -1; - } - elsif ($req->header("Cookie")) { - # We'll retry the request with credentials, unless - # we only wanted to logout in the first place. - $session->delete; - return submit(@_) unless $uri eq "$REST/logout"; - } - } - # Conflicts should be dealt with by the handler and user. - # For anything else, we just die. - elsif ($res->code != 409) { - warn "rt: ", $res->content; - #exit; - } - } - } - else { - warn "rt: Server error: ", $res->message, " (", $res->code, ")\n"; - exit -1; - } - - return $res; -} - -# Session management. -# ------------------- -# -# Maintains a list of active sessions in the ~/.rt_sessions file. -{ - package Session; - my ($s, $u); - - # Initialises the session cache. - sub new { - my ($class, $file) = @_; - my $self = { - file => $file || "$HOME/.rt_sessions", - sids => { } - }; - - # The current session is identified by the currently configured - # server and user. - ($s, $u) = @config{"server", "user"}; - - bless $self, $class; - $self->load(); - - return $self; - } - - # Returns the current session cookie. - sub cookie { - my ($self) = @_; - my $cookie = $self->{sids}{$s}{$u}; - return defined $cookie ? "RT_SID_$cookie" : undef; - } - - # Deletes the current session cookie. - sub delete { - my ($self) = @_; - delete $self->{sids}{$s}{$u}; - } - - # Adds a Cookie header to an outgoing HTTP request. - sub add_cookie_header { - my ($self, $request) = @_; - my $cookie = $self->cookie(); - - $request->header(Cookie => $cookie) if defined $cookie; - } - - # Extracts the Set-Cookie header from an HTTP response, and updates - # session information accordingly. - sub update { - my ($self, $response) = @_; - my $cookie = $response->header("Set-Cookie"); - - if (defined $cookie && $cookie =~ /^RT_SID_(.[^;,\s]+=[0-9A-Fa-f]+);/) { - $self->{sids}{$s}{$u} = $1; - } - } - - # Loads the session cache from the specified file. - sub load { - my ($self, $file) = @_; - $file ||= $self->{file}; - local *F; - - open(F, $file) && do { - $self->{file} = $file; - my $sids = $self->{sids} = {}; - while (<F>) { - chomp; - next if /^$/ || /^#/; - next unless m#^https?://[^ ]+ \w+ [^;,\s]+=[0-9A-Fa-f]+$#; - my ($server, $user, $cookie) = split / /, $_; - $sids->{$server}{$user} = $cookie; - } - return 1; - }; - return 0; - } - - # Writes the current session cache to the specified file. - sub save { - my ($self, $file) = shift; - $file ||= $self->{file}; - local *F; - - open(F, ">$file") && do { - my $sids = $self->{sids}; - foreach my $server (keys %$sids) { - foreach my $user (keys %{ $sids->{$server} }) { - my $sid = $sids->{$server}{$user}; - if (defined $sid) { - print F "$server $user $sid\n"; - } - } - } - close(F); - chmod 0600, $file; - return 1; - }; - return 0; - } - - sub DESTROY { - my $self = shift; - $self->save; - } -} - -# Form handling. -# -------------- -# -# Forms are RFC822-style sets of (field, value) specifications with some -# initial comments and interspersed blank lines allowed for convenience. -# Sets of forms are separated by --\n (in a cheap parody of MIME). -# -# Each form is parsed into an array with four elements: commented text -# at the start of the form, an array with the order of keys, a hash with -# key/value pairs, and optional error text if the form syntax was wrong. - -# Returns a reference to an array of parsed forms. -sub Form::parse { - my $state = 0; - my @forms = (); - my @lines = split /\n/, $_[0] if $_[0]; - my ($c, $o, $k, $e) = ("", [], {}, ""); - - LINE: - while (@lines) { - my $line = shift @lines; - - next LINE if $line eq ''; - - if ($line eq '--') { - # We reached the end of one form. We'll ignore it if it was - # empty, and store it otherwise, errors and all. - if ($e || $c || @$o) { - push @forms, [ $c, $o, $k, $e ]; - $c = ""; $o = []; $k = {}; $e = ""; - } - $state = 0; - } - elsif ($state != -1) { - if ($state == 0 && $line =~ /^#/) { - # Read an optional block of comments (only) at the start - # of the form. - $state = 1; - $c = $line; - while (@lines && $lines[0] =~ /^#/) { - $c .= "\n".shift @lines; - } - $c .= "\n"; - } - elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/) { - # Read a field: value specification. - my $f = $1; - my @v = ($2 || ()); - - # Read continuation lines, if any. - while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) { - push @v, shift @lines; - } - pop @v while (@v && $v[-1] eq ''); - - # Strip longest common leading indent from text. - my $ws = ""; - foreach my $ls (map {/^(\s+)/} @v[1..$#v]) { - $ws = $ls if (!$ws || length($ls) < length($ws)); - } - s/^$ws// foreach @v; - - push(@$o, $f) unless exists $k->{$f}; - vpush($k, $f, join("\n", @v)); - - $state = 1; - } - elsif ($line !~ /^#/) { - # We've found a syntax error, so we'll reconstruct the - # form parsed thus far, and add an error marker. (>>) - $state = -1; - $e = Form::compose([[ "", $o, $k, "" ]]); - $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n"; - } - } - else { - # We saw a syntax error earlier, so we'll accumulate the - # contents of this form until the end. - $e .= "$line\n"; - } - } - push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o); - - foreach my $l (keys %$k) { - $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY'); - } - - return \@forms; -} - -# Returns text representing a set of forms. -sub Form::compose { - my ($forms) = @_; - my @text; - - foreach my $form (@$forms) { - my ($c, $o, $k, $e) = @$form; - my $text = ""; - - if ($c) { - $c =~ s/\n*$/\n/; - $text = "$c\n"; - } - if ($e) { - $text .= $e; - } - elsif ($o) { - my @lines; - - foreach my $key (@$o) { - my ($line, $sp); - my $v = $k->{$key}; - my @values = ref $v eq 'ARRAY' ? @$v : $v; - - $sp = " "x(length("$key: ")); - $sp = " "x4 if length($sp) > 16; - - foreach $v (@values) { - if ($v =~ /\n/) { - $v =~ s/^/$sp/gm; - $v =~ s/^$sp//; - - if ($line) { - push @lines, "$line\n\n"; - $line = ""; - } - elsif (@lines && $lines[-1] !~ /\n\n$/) { - $lines[-1] .= "\n"; - } - push @lines, "$key: $v\n\n"; - } - elsif ($line && - length($line)+length($v)-rindex($line, "\n") >= 70) - { - $line .= ",\n$sp$v"; - } - else { - $line = $line ? "$line, $v" : "$key: $v"; - } - } - - $line = "$key:" unless @values; - if ($line) { - if ($line =~ /\n/) { - if (@lines && $lines[-1] !~ /\n\n$/) { - $lines[-1] .= "\n"; - } - $line .= "\n"; - } - push @lines, "$line\n"; - } - } - - $text .= join "", @lines; - } - else { - chomp $text; - } - push @text, $text; - } - - return join "\n--\n\n", @text; -} - -# Configuration. -# -------------- - -# Returns configuration information from the environment. -sub config_from_env { - my %env; - - foreach my $k (qw(EXTERNALAUTH DEBUG USER PASSWD SERVER QUERY ORDERBY)) { - - if (exists $ENV{"RT$k"}) { - $env{lc $k} = $ENV{"RT$k"}; - } - } - - return %env; -} - -# Finds a suitable configuration file and returns information from it. -sub config_from_file { - my ($rc) = @_; - - if ($rc =~ m#^/#) { - # We'll use an absolute path if we were given one. - return parse_config_file($rc); - } - else { - # Otherwise we'll use the first file we can find in the current - # directory, or in one of its (increasingly distant) ancestors. - - my @dirs = split /\//, cwd; - while (@dirs) { - my $file = join('/', @dirs, $rc); - if (-r $file) { - return parse_config_file($file); - } - - # Remove the last directory component each time. - pop @dirs; - } - - # Still nothing? We'll fall back to some likely defaults. - for ("$HOME/$rc", "/etc/rt.conf") { - return parse_config_file($_) if (-r $_); - } - } - - return (); -} - -# Makes a hash of the specified configuration file. -sub parse_config_file { - my %cfg; - my ($file) = @_; - local $_; # $_ may be aliased to a constant, from line 1163 - - open(CFG, $file) && do { - while (<CFG>) { - chomp; - next if (/^#/ || /^\s*$/); - - if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) { - $cfg{$1} = $2; - } - else { - die "rt: $file:$.: unknown configuration directive.\n"; - } - } - }; - - return %cfg; -} - -# Helper functions. -# ----------------- - -sub whine { - my $sub = (caller(1))[3]; - $sub =~ s/^main:://; - warn "rt: $sub: @_\n"; - return 0; -} - -sub read_passwd { - eval 'require Term::ReadKey'; - if ($@) { - die "No password specified (and Term::ReadKey not installed).\n"; - } - - print "Password: "; - Term::ReadKey::ReadMode('noecho'); - chomp(my $passwd = Term::ReadKey::ReadLine(0)); - Term::ReadKey::ReadMode('restore'); - print "\n"; - - return $passwd; -} - -sub vi { - my ($text) = @_; - my $file = "/tmp/rt.form.$$"; - my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi"; - - local *F; - local $/ = undef; - - open(F, ">$file") || die "$file: $!\n"; print F $text; close(F); - system($editor, $file) && die "Couldn't run $editor.\n"; - open(F, $file) || die "$file: $!\n"; $text = <F>; close(F); - unlink($file); - - return $text; -} - -# Add a value to a (possibly multi-valued) hash key. -sub vpush { - my ($hash, $key, $val) = @_; - my @val = ref $val eq 'ARRAY' ? @$val : $val; - - if (exists $hash->{$key}) { - unless (ref $hash->{$key} eq 'ARRAY') { - my @v = $hash->{$key} ne '' ? $hash->{$key} : (); - $hash->{$key} = \@v; - } - push @{ $hash->{$key} }, @val; - } - else { - $hash->{$key} = $val; - } -} - -# "Normalise" a hash key that's known to be multi-valued. -sub vsplit { - my ($val) = @_; - my ($word, @words); - my @values = ref $val eq 'ARRAY' ? @$val : $val; - - foreach my $line (map {split /\n/} @values) { - # XXX: This should become a real parser, Ã la Text::ParseWords. - $line =~ s/^\s+//; - $line =~ s/\s+$//; - my ( $a, $b ) = split /,/, $line, 2; - - while ($a) { - no warnings 'uninitialized'; - if ( $a =~ /^'/ ) { - my $s = $a; - while ( $a !~ /'$/ || ( $a !~ /(\\\\)+'$/ - && $a =~ /(\\)+'$/ )) { - ( $a, $b ) = split /,/, $b, 2; - $s .= ',' . $a; - } - push @words, $s; - } - elsif ( $a =~ /^q{/ ) { - my $s = $a; - while ( $a !~ /}$/ ) { - ( $a, $b ) = - split /,/, $b, 2; - $s .= ',' . $a; - } - $s =~ s/^q{/'/; - $s =~ s/}/'/; - push @words, $s; - } - else { - push @words, $a; - } - ( $a, $b ) = split /,/, $b, 2; - } - - - } - - return \@words; -} - -# WARN: this code is duplicated in lib/RT/Interface/REST.pm -# change both functions at once -sub expand_list { - my ($list) = @_; - - my @elts; - foreach (split /,/, $list) { - push @elts, /^(\d+)-(\d+)$/? ($1..$2): $_; - } - - return map $_->[0], # schwartzian transform - sort { - defined $a->[1] && defined $b->[1]? - # both numbers - $a->[1] <=> $b->[1] - :!defined $a->[1] && !defined $b->[1]? - # both letters - $a->[2] cmp $b->[2] - # mix, number must be first - :defined $a->[1]? -1: 1 - } - map [ $_, (defined( /^(\d+)$/ )? $1: undef), lc($_) ], - @elts; -} - -sub get_type_argument { - my $type; - - if (@ARGV) { - $type = shift @ARGV; - unless ($type =~ /^[A-Za-z0-9_.-]+$/) { - # We want whine to mention our caller, not us. - @_ = ("Invalid type '$type' specified."); - goto &whine; - } - } - else { - @_ = ("No type argument specified with -t."); - goto &whine; - } - - $type =~ s/s$//; # "Plural". Ugh. - return $type; -} - -sub get_var_argument { - my ($data) = @_; - - if (@ARGV) { - my $kv = shift @ARGV; - if (my ($k, $v) = $kv =~ /^($field)=(.*)$/) { - push @{ $data->{$k} }, $v; - } - else { - @_ = ("Invalid variable specification: '$kv'."); - goto &whine; - } - } - else { - @_ = ("No variable argument specified with -S."); - goto &whine; - } -} - -sub is_object_spec { - my ($spec, $type) = @_; - - $spec =~ s|^(?:$type/)?|$type/| if defined $type; - return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o); - return 0; -} - -sub suggest_help { - my ($action, $type, $rv) = @_; - - print STDERR "rt: For help, run 'rt help $action'.\n" if defined $action; - print STDERR "rt: For help, run 'rt help $type'.\n" if defined $type; - return $rv; -} - -sub str2time { - # simplified procedure for parsing date, avoid loading Date::Parse - my %month = (Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5, - Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11); - $_ = shift; - my ($mon, $day, $hr, $min, $sec, $yr, $monstr); - if ( /(\w{3})\s+(\d\d?)\s+(\d\d):(\d\d):(\d\d)\s+(\d{4})/ ) { - ($monstr, $day, $hr, $min, $sec, $yr) = ($1, $2, $3, $4, $5, $6); - $mon = $month{$monstr} if exists $month{$monstr}; - } elsif ( /(\d{4})-(\d\d)-(\d\d)\s+(\d\d):(\d\d):(\d\d)/ ) { - ($yr, $mon, $day, $hr, $min, $sec) = ($1, $2-1, $3, $4, $5, $6); - } - if ( $yr and defined $mon and $day and defined $hr and defined $sec ) { - return timelocal($sec,$min,$hr,$day,$mon,$yr); - } else { - print "Unknown date format in parsedate: $_\n"; - return undef; - } -} - -sub date_diff { - my ($old, $new) = @_; - $new = time() if ! $new; - $old = str2time($old) if $old !~ /^\d+$/; - $new = str2time($new) if $new !~ /^\d+$/; - return "???" if ! $old or ! $new; - - my %seconds = (min => 60, - hr => 60*60, - day => 60*60*24, - wk => 60*60*24*7, - mth => 60*60*24*30, - yr => 60*60*24*365); - - my $diff = $new - $old; - my $what = 'sec'; - my $howmuch = $diff; - for ( sort {$seconds{$a} <=> $seconds{$b}} keys %seconds) { - last if $diff < $seconds{$_}; - $what = $_; - $howmuch = int($diff/$seconds{$_}); - } - return "$howmuch $what"; -} - -sub prettyshow { - my $forms = shift; - my ($form) = grep { exists $_->[2]->{Queue} } @$forms; - my $k = $form->[2]; - # dates are in local time zone - if ( $k ) { - print "Date: $k->{Created}\n"; - print "From: $k->{Requestors}\n"; - print "Cc: $k->{Cc}\n" if $k->{Cc}; - print "X-AdminCc: $k->{AdminCc}\n" if $k->{AdminCc}; - print "X-Queue: $k->{Queue}\n"; - print "Subject: [rt #$k->{id}] $k->{Subject}\n\n"; - } - # dates in these attributes are in GMT and will be converted - foreach my $form (@$forms) { - my ($c, $o, $k, $e) = @$form; - next if ! $k->{id} or exists $k->{Queue}; - if ( exists $k->{Created} ) { - my ($y,$m,$d,$hh,$mm,$ss) = ($k->{Created} =~ /(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)/); - $m--; - my $created = localtime(timegm($ss,$mm,$hh,$d,$m,$y)); - if ( exists $k->{Description} ) { - print "===> $k->{Description} on $created\n"; - } - } - print "$k->{Content}\n" if exists $k->{Content} and - $k->{Content} !~ /to have no content$/ and - $k->{Type} ne 'EmailRecord'; - print "$k->{Attachments}\n" if exists $k->{Attachments} and - $k->{Attachments}; - } -} - -sub prettylist { - my $forms = shift; - my $heading = "Ticket Owner Queue Age Told Status Requestor Subject\n"; - $heading .= '-' x 80 . "\n"; - my (@open, @me); - foreach my $form (@$forms) { - my ($c, $o, $k, $e) = @$form; - next if ! $k->{id}; - print $heading if $heading; - $heading = ''; - my $id = $k->{id}; - $id =~ s!^ticket/!!; - my $owner = $k->{Owner} eq 'Nobody' ? '' : $k->{Owner}; - $owner = substr($owner, 0, 5); - my $queue = substr($k->{Queue}, 0, 5); - my $subject = substr($k->{Subject}, 0, 30); - my $age = date_diff($k->{Created}); - my $told = $k->{Told} eq 'Not set' ? '' : date_diff($k->{Told}); - my $status = substr($k->{Status}, 0, 6); - my $requestor = substr($k->{Requestors}, 0, 9); - my $line = sprintf "%6s %5s %5s %6s %6s %-6s %-9s %-30s\n", - $id, $owner, $queue, $age, $told, $status, $requestor, $subject; - if ( $k->{Owner} eq 'Nobody' ) { - push @open, $line; - } elsif ($k->{Owner} eq $config{user} ) { - push @me, $line; - } else { - print $line; - } - } - print "No matches found\n" if $heading; - printf "========== my %2d open tickets ==========\n", scalar @me if @me; - print @me if @me; - printf "========== %2d unowned tickets ==========\n", scalar @open if @open; - print @open if @open; -} - -__DATA__ - -Title: intro -Title: introduction -Text: - - This is a command-line interface to RT 3.0 or newer. - - It allows you to interact with an RT server over HTTP, and offers an - interface to RT's functionality that is better-suited to automation - and integration with other tools. - - In general, each invocation of this program should specify an action - to perform on one or more objects, and any other arguments required - to complete the desired action. - - For more information: - - - rt help usage (syntax information) - - rt help objects (how to specify objects) - - rt help actions (a list of possible actions) - - rt help types (a list of object types) - - - rt help config (configuration details) - - rt help examples (a few useful examples) - - rt help topics (a list of help topics) - --- - -Title: usage -Title: syntax -Text: - - Syntax: - - rt <action> [options] [arguments] - or - rt shell - - Each invocation of this program must specify an action (e.g. "edit", - "create"), options to modify behaviour, and other arguments required - by the specified action. (For example, most actions expect a list of - numeric object IDs to act upon.) - - The details of the syntax and arguments for each action are given by - "rt help <action>". Some actions may be referred to by more than one - name ("create" is the same as "new", for example). - - You may also call "rt shell", which will give you an 'rt>' prompt at - which you can issue commands of the form "<action> [options] - [arguments]". See "rt help shell" for details. - - Objects are identified by a type and an ID (which can be a name or a - number, depending on the type). For some actions, the object type is - implied (you can only comment on tickets); for others, the user must - specify it explicitly. See "rt help objects" for details. - - In syntax descriptions, mandatory arguments that must be replaced by - appropriate value are enclosed in <>, and optional arguments are - indicated by [] (for example, <action> and [options] above). - - For more information: - - - rt help objects (how to specify objects) - - rt help actions (a list of actions) - - rt help types (a list of object types) - - rt help shell (how to use the shell) - --- - -Title: conf -Title: config -Title: configuration -Text: - - This program has two major sources of configuration information: its - configuration files, and the environment. - - The program looks for configuration directives in a file named .rtrc - (or $RTCONFIG; see below) in the current directory, and then in more - distant ancestors, until it reaches /. If no suitable configuration - files are found, it will also check for ~/.rtrc and /etc/rt.conf. - - Configuration directives: - - The following directives may occur, one per line: - - - server <URL> URL to RT server. - - user <username> RT username. - - passwd <passwd> RT user's password. - - query <RT Query> Default RT Query for list action - - orderby <order> Default RT order for list action - - queue <queuename> Default RT Queue for list action - - externalauth <0|1> Use HTTP Basic authentication - explicitely setting externalauth to 0 inhibits also GSSAPI based - authentication, if LWP::Authen::Negotiate (and GSSAPI) is installed - - Blank and #-commented lines are ignored. - - Sample configuration file contents: - - server https://rt.somewhere.com/ - # more than one queue can be given (by adding a query expression) - queue helpdesk or queue=support - query Status != resolved and Owner=myaccount - - - Environment variables: - - The following environment variables override any corresponding - values defined in configuration files: - - - RTUSER - - RTPASSWD - - RTEXTERNALAUTH - - RTSERVER - - RTDEBUG Numeric debug level. (Set to 3 for full logs.) - - RTCONFIG Specifies a name other than ".rtrc" for the - configuration file. - - RTQUERY Default RT Query for rt list - - RTORDERBY Default order for rt list - --- - -Title: objects -Text: - - Syntax: - - <type>/<id>[/<attributes>] - - Every object in RT has a type (e.g. "ticket", "queue") and a numeric - ID. Some types of objects can also be identified by name (like users - and queues). Furthermore, objects may have named attributes (such as - "ticket/1/history"). - - An object specification is like a path in a virtual filesystem, with - object types as top-level directories, object IDs as subdirectories, - and named attributes as further subdirectories. - - A comma-separated list of names, numeric IDs, or numeric ranges can - be used to specify more than one object of the same type. Note that - the list must be a single argument (i.e., no spaces). For example, - "user/root,1-3,5,7-10,ams" is a list of ten users; the same list - can also be written as "user/ams,root,1,2,3,5,7,8-10". - - If just a number is given as object specification it will be - interpreted as ticket/<number> - - Examples: - - 1 # the same as ticket/1 - ticket/1 - ticket/1/attachments - ticket/1/attachments/3 - ticket/1/attachments/3/content - ticket/1-3/links - ticket/1-3,5-7/history - - user/ams - user/ams/rights - user/ams,rai,1/rights - - For more information: - - - rt help <action> (action-specific details) - - rt help <type> (type-specific details) - --- - -Title: actions -Title: commands -Text: - - You can currently perform the following actions on all objects: - - - list (list objects matching some condition) - - show (display object details) - - edit (edit object details) - - create (create a new object) - - Each type may define actions specific to itself; these are listed in - the help item about that type. - - For more information: - - - rt help <action> (action-specific details) - - rt help types (a list of possible types) - - The following actions on tickets are also possible: - - - comment Add comments to a ticket - - correspond Add comments to a ticket - - merge Merge one ticket into another - - link Link one ticket to another - - take Take a ticket (steal and untake are possible as well) - - For several edit set subcommands that are frequently used abbreviations - have been introduced. These abbreviations are: - - - delete or del delete a ticket (edit set status=deleted) - - resolve or res resolve a ticket (edit set status=resolved) - - subject change subject of ticket (edit set subject=string) - - give give a ticket to somebody (edit set owner=user) - --- - -Title: types -Text: - - You can currently operate on the following types of objects: - - - tickets - - users - - groups - - queues - - For more information: - - - rt help <type> (type-specific details) - - rt help objects (how to specify objects) - - rt help actions (a list of possible actions) - --- - -Title: ticket -Text: - - Tickets are identified by a numeric ID. - - The following generic operations may be performed upon tickets: - - - list - - show - - edit - - create - - In addition, the following ticket-specific actions exist: - - - link - - merge - - comment - - correspond - - take - - steal - - untake - - give - - resolve - - delete - - subject - - Attributes: - - The following attributes can be used with "rt show" or "rt edit" - to retrieve or edit other information associated with tickets: - - links A ticket's relationships with others. - history All of a ticket's transactions. - history/type/<type> Only a particular type of transaction. - history/id/<id> Only the transaction of the specified id. - attachments A list of attachments. - attachments/<id> The metadata for an individual attachment. - attachments/<id>/content The content of an individual attachment. - --- - -Title: user -Title: group -Text: - - Users and groups are identified by name or numeric ID. - - The following generic operations may be performed upon them: - - - list - - show - - edit - - create - - In addition, the following type-specific actions exist: - - - grant - - revoke - - Attributes: - - The following attributes can be used with "rt show" or "rt edit" - to retrieve or edit other information associated with users and - groups: - - rights Global rights granted to this user. - rights/<queue> Queue rights for this user. - --- - -Title: queue -Text: - - Queues are identified by name or numeric ID. - - Currently, they can be subjected to the following actions: - - - show - - edit - - create - --- - -Title: subject -Text: - - Syntax: - - rt subject <id> <new subject text> - - Change the subject of a ticket whose ticket id is given. - --- - -Title: give -Text: - - Syntax: - - rt give <id> <accountname> - - Give a ticket whose ticket id is given to another user. - --- - -Title: steal -Text: - - rt steal <id> - - Steal a ticket whose ticket id is given, i.e. set the owner to myself. - --- - -Title: take -Text: - - Syntax: - - rt take <id> - - Take a ticket whose ticket id is given, i.e. set the owner to myself. - --- - -Title: untake -Text: - - Syntax: - - rt untake <id> - - Untake a ticket whose ticket id is given, i.e. set the owner to Nobody. - --- - -Title: resolve -Title: res -Text: - - Syntax: - - rt resolve <id> - - Resolves a ticket whose ticket id is given. - --- - -Title: delete -Title: del -Text: - - Syntax: - - rt delete <id> - - Deletes a ticket whose ticket id is given. - --- - -Title: logout -Text: - - Syntax: - - rt logout - - Terminates the currently established login session. You will need to - provide authentication credentials before you can continue using the - server. (See "rt help config" for details about authentication.) - --- - -Title: ls -Title: list -Title: search -Text: - - Syntax: - - rt <ls|list|search> [options] "query string" - - Displays a list of objects matching the specified conditions. - ("ls", "list", and "search" are synonyms.) - - Conditions are expressed in the SQL-like syntax used internally by - RT3. (For more information, see "rt help query".) The query string - must be supplied as one argument. - - (Right now, the server doesn't support listing anything but tickets. - Other types will be supported in future; this client will be able to - take advantage of that support without any changes.) - - Options: - - The following options control how much information is displayed - about each matching object: - - -i Numeric IDs only. (Useful for |rt edit -; see examples.) - -s Short description. - -l Longer description. - -f <field[s] Display only the fields listed and the ticket id - - In addition, - - -o +/-<field> Orders the returned list by the specified field. - -r reversed order (useful if a default was given) - -q queue[s] restricts the query to the queue[s] given - multiple queues are separated by comma - -S var=val Submits the specified variable with the request. - -t type Specifies the type of object to look for. (The - default is "ticket".) - - Examples: - - rt ls "Priority > 5 and Status=new" - rt ls -o +Subject "Priority > 5 and Status=new" - rt ls -o -Created "Priority > 5 and Status=new" - rt ls -i "Priority > 5"|rt edit - set status=resolved - rt ls -t ticket "Subject like '[PATCH]%'" - rt ls -q systems - rt ls -f owner,subject - --- - -Title: show -Text: - - Syntax: - - rt show [options] <object-ids> - - Displays details of the specified objects. - - For some types, object information is further classified into named - attributes (for example, "1-3/links" is a valid ticket specification - that refers to the links for tickets 1-3). Consult "rt help <type>" - and "rt help objects" for further details. - - If only a number is given it will be interpreted as the objects - ticket/number and ticket/number/history - - This command writes a set of forms representing the requested object - data to STDOUT. - - Options: - - The following options control how much information is displayed - about each matching object: - - Without any formatting options prettyprinted output is generated. - Giving any of the two options below reverts to raw output. - -s Short description (history and attachments only). - -l Longer description (history and attachments only). - - In addition, - - Read IDs from STDIN instead of the command-line. - -t type Specifies object type. - -f a,b,c Restrict the display to the specified fields. - -S var=val Submits the specified variable with the request. - - Examples: - - rt show -t ticket -f id,subject,status 1-3 - rt show ticket/3/attachments/29 - rt show ticket/3/attachments/29/content - rt show ticket/1-3/links - rt show ticket/3/history - rt show -l ticket/3/history - rt show -t user 2 - rt show 2 - --- - -Title: new -Title: edit -Title: create -Text: - - Syntax: - - rt edit [options] <object-ids> set field=value [field=value] ... - add field=value [field=value] ... - del field=value [field=value] ... - - Edits information corresponding to the specified objects. - - A purely numeric object id nnn is translated into ticket/nnn - - If, instead of "edit", an action of "new" or "create" is specified, - then a new object is created. In this case, no numeric object IDs - may be specified, but the syntax and behaviour remain otherwise - unchanged. - - This command typically starts an editor to allow you to edit object - data in a form for submission. If you specified enough information - on the command-line, however, it will make the submission directly. - - The command line may specify field-values in three different ways. - "set" sets the named field to the given value, "add" adds a value - to a multi-valued field, and "del" deletes the corresponding value. - Each "field=value" specification must be given as a single argument. - - For some types, object information is further classified into named - attributes (for example, "1-3/links" is a valid ticket specification - that refers to the links for tickets 1-3). These attributes may also - be edited. Consult "rt help <type>" and "rt help object" for further - details. - - Options: - - - Read numeric IDs from STDIN instead of the command-line. - (Useful with rt ls ... | rt edit -; see examples below.) - -i Read a completed form from STDIN before submitting. - -o Dump the completed form to STDOUT instead of submitting. - -e Allows you to edit the form even if the command-line has - enough information to make a submission directly. - -S var=val - Submits the specified variable with the request. - -t type Specifies object type. - - Examples: - - # Interactive (starts $EDITOR with a form). - rt edit ticket/3 - rt create -t ticket - - # Non-interactive. - rt edit ticket/1-3 add cc=foo@example.com set priority=3 due=tomorrow - rt ls -t tickets -i 'Priority > 5' | rt edit - set status=resolved - rt edit ticket/4 set priority=3 owner=bar@example.com \ - add cc=foo@example.com bcc=quux@example.net - rt create -t ticket set subject='new ticket' priority=10 \ - add cc=foo@example.com - --- - -Title: comment -Title: correspond -Text: - - Syntax: - - rt <comment|correspond> [options] <ticket-id> - - Adds a comment (or correspondence) to the specified ticket (the only - difference being that comments aren't sent to the requestors.) - - This command will typically start an editor and allow you to type a - comment into a form. If, however, you specified all the necessary - information on the command line, it submits the comment directly. - - (See "rt help forms" for more information about forms.) - - Options: - - -m <text> Specify comment text. - -a <file> Attach a file to the comment. (May be used more - than once to attach multiple files.) - -c <addrs> A comma-separated list of Cc addresses. - -b <addrs> A comma-separated list of Bcc addresses. - -w <time> Specify the time spent working on this ticket. - -e Starts an editor before the submission, even if - arguments from the command line were sufficient. - - Examples: - - rt comment -m 'Not worth fixing.' -a stddisclaimer.h 23 - --- - -Title: merge -Text: - - Syntax: - - rt merge <from-id> <to-id> - - Merges the first ticket specified into the second ticket specified. - --- - -Title: link -Text: - - Syntax: - - rt link [-d] <id-A> <link> <id-B> - - Creates (or, with -d, deletes) a link between the specified tickets. - The link can (irrespective of case) be any of: - - DependsOn/DependedOnBy: A depends upon B (or vice versa). - RefersTo/ReferredToBy: A refers to B (or vice versa). - MemberOf/HasMember: A is a member of B (or vice versa). - - To view a ticket's links, use "rt show ticket/3/links". (See - "rt help ticket" and "rt help show".) - - Options: - - -d Deletes the specified link. - - Examples: - - rt link 2 dependson 3 - rt link -d 4 referredtoby 6 # 6 no longer refers to 4 - --- - -Title: grant -Title: revoke -Text: - --- - -Title: query -Text: - - RT3 uses an SQL-like syntax to specify object selection constraints. - See the <RT:...> documentation for details. - - (XXX: I'm going to have to write it, aren't I?) - - Until it exists here a short description of important constructs: - - The two simple forms of query expressions are the constructs - Attribute like Value and - Attribute = Value or Attribute != Value - - Whether attributes can be matched using like or using = is built into RT. - The attributes id, Queue, Owner Priority and Status require the = or != - tests. - - If Value is a string it must be quoted and may contain the wildcard - character %. If the string does not contain white space, the quoting - may however be omitted, it will be added automatically when parsing - the input. - - Simple query expressions can be combined using and, or and parentheses - can be used to group expressions. - - As a special case a standalone string (which would not form a correct - query) is transformed into (Owner='string' or Requestor like 'string%') - and added to the default query, i.e. the query is narrowed down. - - If no Queue=name clause is contained in the query, a default clause - Queue=$config{queue} is added. - - Examples: - Status!='resolved' and Status!='rejected' - (Owner='myaccount' or Requestor like 'myaccount%') and Status!='resolved' - --- - -Title: form -Title: forms -Text: - - This program uses RFC822 header-style forms to represent object data - in a form that's suitable for processing both by humans and scripts. - - A form is a set of (field, value) specifications, with some initial - commented text and interspersed blank lines allowed for convenience. - Field names may appear more than once in a form; a comma-separated - list of multiple field values may also be specified directly. - - Field values can be wrapped as in RFC822, with leading whitespace. - The longest sequence of leading whitespace common to all the lines - is removed (preserving further indentation). There is no limit on - the length of a value. - - Multiple forms are separated by a line containing only "--\n". - - (XXX: A more detailed specification will be provided soon. For now, - the server-side syntax checking will suffice.) - --- - -Title: topics -Text: - - Syntax: - - rt help <topic> - - Get help on any of the following subjects: - - - tickets, users, groups, queues. - - show, edit, ls/list/search, new/create. - - - query (search query syntax) - - forms (form specification) - - - objects (how to specify objects) - - types (a list of object types) - - actions/commands (a list of actions) - - usage/syntax (syntax details) - - conf/config/configuration (configuration details) - - examples (a few useful examples) - --- - -Title: example -Title: examples -Text: - - some useful examples - - All the following list requests will be restricted to the default queue. - That can be changed by adding the option -q queuename - - List all tickets that are not rejected/resolved - rt ls - List all tickets that are new and do not have an owner - rt ls "status=new and owner=nobody" - List all tickets which I have sent or of which I am the owner - rt ls myaccount - List all attributes for the ticket 6977 (ls -l instead of ls) - rt ls -l 6977 - Show the content of ticket 6977 - rt show 6977 - Show all attributes in the ticket and in the history of the ticket - rt show -l 6977 - Comment a ticket (mail is sent to all queue watchers, i.e. AdminCc's) - rt comment 6977 - This will open an editor and lets you add text (attribute Text:) - Other attributes may be changed as well, but usually don't do that. - Correspond a ticket (like comment, but mail is also sent to requestors) - rt correspond 6977 - Edit a ticket (generic change, interactive using the editor) - rt edit 6977 - Change the owner of a ticket non interactively - rt edit 6977 set owner=myaccount - or - rt give 6977 account - or - rt take 6977 - Change the status of a ticket - rt edit 6977 set status=resolved - or - rt resolve 6977 - Change the status of all tickets I own to resolved !!! - rt ls -i owner=myaccount | rt edit - set status=resolved - --- - -Title: shell -Text: - - Syntax: - - rt shell - - Opens an interactive shell, at which you can issue commands of - the form "<action> [options] [arguments]". - - To exit the shell, type "quit" or "exit". - - Commands can be given at the shell in the same form as they would - be given at the command line without the leading 'rt' invocation. - - Example: - $ rt shell - rt> create -t ticket set subject='new' add cc=foo@example.com - # Ticket 8 created. - rt> quit - $ - --- - -Title: take -Title: untake -Title: steal -Text: - - Syntax: - - rt <take|untake|steal> <ticket-id> - - Sets the owner of the specified ticket to the current user, - assuming said user has the bits to do so, or releases the - ticket. - - 'Take' is used on tickets which are not currently owned - (Owner: Nobody), 'steal' is used on tickets which *are* - currently owned, and 'untake' is used to "release" a ticket - (reset its Owner to Nobody). 'Take' cannot be used on - tickets which are currently owned. - - Example: - alice$ rt create -t ticket set subject="New ticket" - # Ticket 7 created. - alice$ rt take 7 - # Owner changed from Nobody to alice - alice$ su bob - bob$ rt steal 7 - # Owner changed from alice to bob - bob$ rt untake 7 - # Owner changed from bob to Nobody - --- - -Title: quit -Title: exit -Text: - - Use "quit" or "exit" to leave the shell. Only valid within shell - mode. - - Example: - $ rt shell - rt> quit - $ diff --git a/rt/bin/standalone_httpd b/rt/bin/standalone_httpd deleted file mode 100755 index 7b44705..0000000 --- a/rt/bin/standalone_httpd +++ /dev/null @@ -1,186 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use warnings; -use strict; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use RT; -RT::LoadConfig(); -RT->InitLogging(); -if (RT->Config->Get('DevelMode')) { require Module::Refresh; } - -RT::CheckPerlRequirements(); -RT->InitPluginPaths(); - -my $explicit_port = shift @ARGV; -my $port = $explicit_port || RT->Config->Get('WebPort') || '8080'; - - -require RT::Handle; -my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; - -unless ( $integrity ) { - print STDERR <<EOF; - -RT couldn't connect to the database where tickets are stored. -If this is a new installation of RT, you should visit the URL below -to configure RT and initialize your database. - -If this is an existing RT installation, this may indicate a database -connectivity problem. - -The error RT got back when trying to connect to your database was: - -$msg - -EOF - - require RT::Installer; - # don't enter install mode if the file exists but is unwritable - if (-e RT::Installer->ConfigFile && !-w _) { - die 'Since your configuration exists (' - . RT::Installer->ConfigFile - . ") but is not writable, I'm refusing to do anything.\n"; - } - - RT->Config->Set( 'LexiconLanguages' => '*' ); - RT::I18N->Init; - - RT->InstallMode(1); -} else { - RT->ConnectToDatabase(); - RT->InitSystemObjects(); - RT->InitClasses( Heavy => 1 ); - RT->InitPlugins(); - RT->Config->PostLoadCheck(); - - my ($status, $msg) = RT::Handle->CheckCompatibility( - $RT::Handle->dbh, 'post' - ); - unless ( $status ) { - print STDERR $msg, "\n\n"; - exit -1; - } -} - -require RT::Interface::Web::Standalone; -my $server = RT::Interface::Web::Standalone->new; -run_server($port); -exit 0; - -sub run_server { - my $port = shift; - $server->port($port); - eval { $server->run() }; - - if ( my $err = $@ ) { - handle_startup_error($err); - } -} - -sub handle_startup_error { - my $err = shift; - if ( $err =~ /bind: Permission denied/ ) { - handle_bind_error(); - } else { - die - "Something went wrong while trying to run RT's standalone web server:\n\t" - . $err; - } -} - - -sub handle_bind_error { - - print STDERR <<EOF; -WARNING: RT couldn't start up a web server on port @{[$port]}. -This is often the case if you're running @{[$0]} as -someone other than your system's "root" user. -EOF - - if ($explicit_port) { - print STDERR - "Please check your system configuration or choose another port\n\n"; - } else { - print STDERR "\nFor now, RT has chosen an alternate port to run on.\n\n"; - if ( !$integrity ) { - print STDERR <<EOF; -You can use this server to configure and explore RT. While configuring -RT, you'll have a chance to set a permanent port and URL for your -server. - -EOF - } - run_server( 8000 + int( rand(1024) ) ); - } -} diff --git a/rt/bin/standalone_httpd.in b/rt/bin/standalone_httpd.in deleted file mode 100755 index aa9204b..0000000 --- a/rt/bin/standalone_httpd.in +++ /dev/null @@ -1,186 +0,0 @@ -#!@PERL@ -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use warnings; -use strict; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use RT; -RT::LoadConfig(); -RT->InitLogging(); -if (RT->Config->Get('DevelMode')) { require Module::Refresh; } - -RT::CheckPerlRequirements(); -RT->InitPluginPaths(); - -my $explicit_port = shift @ARGV; -my $port = $explicit_port || RT->Config->Get('WebPort') || '8080'; - - -require RT::Handle; -my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; - -unless ( $integrity ) { - print STDERR <<EOF; - -RT couldn't connect to the database where tickets are stored. -If this is a new installation of RT, you should visit the URL below -to configure RT and initialize your database. - -If this is an existing RT installation, this may indicate a database -connectivity problem. - -The error RT got back when trying to connect to your database was: - -$msg - -EOF - - require RT::Installer; - # don't enter install mode if the file exists but is unwritable - if (-e RT::Installer->ConfigFile && !-w _) { - die 'Since your configuration exists (' - . RT::Installer->ConfigFile - . ") but is not writable, I'm refusing to do anything.\n"; - } - - RT->Config->Set( 'LexiconLanguages' => '*' ); - RT::I18N->Init; - - RT->InstallMode(1); -} else { - RT->ConnectToDatabase(); - RT->InitSystemObjects(); - RT->InitClasses( Heavy => 1 ); - RT->InitPlugins(); - RT->Config->PostLoadCheck(); - - my ($status, $msg) = RT::Handle->CheckCompatibility( - $RT::Handle->dbh, 'post' - ); - unless ( $status ) { - print STDERR $msg, "\n\n"; - exit -1; - } -} - -require RT::Interface::Web::Standalone; -my $server = RT::Interface::Web::Standalone->new; -run_server($port); -exit 0; - -sub run_server { - my $port = shift; - $server->port($port); - eval { $server->run() }; - - if ( my $err = $@ ) { - handle_startup_error($err); - } -} - -sub handle_startup_error { - my $err = shift; - if ( $err =~ /bind: Permission denied/ ) { - handle_bind_error(); - } else { - die - "Something went wrong while trying to run RT's standalone web server:\n\t" - . $err; - } -} - - -sub handle_bind_error { - - print STDERR <<EOF; -WARNING: RT couldn't start up a web server on port @{[$port]}. -This is often the case if you're running @{[$0]} as -someone other than your system's "root" user. -EOF - - if ($explicit_port) { - print STDERR - "Please check your system configuration or choose another port\n\n"; - } else { - print STDERR "\nFor now, RT has chosen an alternate port to run on.\n\n"; - if ( !$integrity ) { - print STDERR <<EOF; -You can use this server to configure and explore RT. While configuring -RT, you'll have a chance to set a permanent port and URL for your -server. - -EOF - } - run_server( 8000 + int( rand(1024) ) ); - } -} diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in deleted file mode 100644 index 50b959a..0000000 --- a/rt/bin/webmux.pl.in +++ /dev/null @@ -1,176 +0,0 @@ -#!@PERL@ -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; - -package HTML::Mason::Commands; -our %session; - -package RT::Mason; - -our ($Nobody, $SystemUser, $Handler, $r); - -sub handler { - ($r) = @_; - - local $SIG{__WARN__}; - local $SIG{__DIE__}; - RT::InitSignalHandlers(); - - if ($r->content_type =~ m/^httpd\b.*\bdirectory/i) { - use File::Spec::Unix; - # Our DirectoryIndex is always index.html, regardless of httpd settings - $r->filename( File::Spec::Unix->catfile( $r->filename, 'index.html' ) ); - } - - Module::Refresh->refresh if RT->Config->Get('DevelMode'); - - RT::ConnectToDatabase(); - - my (%session, $status); - { - local $@; - $status = eval { $Handler->handle_request($r) }; - $RT::Logger->crit( $@ ) if $@; - } - undef %session; - - RT::Interface::Web::Handler->CleanupRequest(); - - return $status; -} - -package main; - -# check mod_perl version if it's mod_perl -BEGIN { - die "RT does not support mod_perl 1.99. Please upgrade to mod_perl 2.0" - if $ENV{'MOD_PERL'} - and $ENV{'MOD_PERL'} =~ m{mod_perl/(?:1\.9)}; -} - -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'}; - - # bring this in before mason, to make sure we - # use private tempfiles - use CGI qw(-private_tempfiles); -} - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -require RT; -RT::LoadConfig(); -if ( RT->Config->Get('DevelMode') ) { - require Module::Refresh; -} -RT::Init(); - -# check compatibility of the DB -{ - my $dbh = $RT::Handle->dbh; - if ( $dbh ) { - my ($status, $msg) = $RT::Handle->CheckCompatibility( $dbh, 'post' ); - die $msg unless $status; - } -} - -require RT::Interface::Web::Handler; -$RT::Mason::Handler = RT::Interface::Web::Handler->new( - RT->Config->Get('MasonParameters') -); - -# load more for mod_perl before forking -RT::InitClasses( Heavy => 1 ) if $ENV{'MOD_PERL'} || $ENV{RT_WEBMUX_HEAVY_LOAD}; - -# we must disconnect DB before fork -$RT::Handle->dbh(undef); -undef $RT::Handle; - -if ( $ENV{'MOD_PERL'} && !RT->Config->Get('DevelMode')) { - # Under static_source, we need to purge the component cache - # each time we restart, so newer components may be reloaded. - # - # We can't do this in FastCGI or we'll blow away the component - # root _every_ time a new server starts which happens every few - # hits. - - require File::Path; - require File::Glob; - my @files = File::Glob::bsd_glob("$RT::MasonDataDir/obj/*"); - File::Path::rmtree([ @files ], 0, 1) if @files; -} - -1; |