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, 6942 insertions, 0 deletions
diff --git a/rt/bin/fastcgi_server b/rt/bin/fastcgi_server new file mode 100755 index 000000000..7c0935dfe --- /dev/null +++ b/rt/bin/fastcgi_server @@ -0,0 +1,252 @@ +#!/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 new file mode 100644 index 000000000..a63714488 --- /dev/null +++ b/rt/bin/fastcgi_server.in @@ -0,0 +1,252 @@ +#!@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 new file mode 100755 index 000000000..881d6388a --- /dev/null +++ b/rt/bin/mason_handler.fcgi @@ -0,0 +1,88 @@ +#!/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 new file mode 100644 index 000000000..baf407d94 --- /dev/null +++ b/rt/bin/mason_handler.fcgi.in @@ -0,0 +1,88 @@ +#!@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 new file mode 100755 index 000000000..1a497de77 --- /dev/null +++ b/rt/bin/mason_handler.scgi @@ -0,0 +1,68 @@ +#!/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 new file mode 100644 index 000000000..cd24bc8f8 --- /dev/null +++ b/rt/bin/mason_handler.scgi.in @@ -0,0 +1,68 @@ +#!@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 new file mode 100644 index 000000000..4276b6ea1 --- /dev/null +++ b/rt/bin/mason_handler.svc @@ -0,0 +1,265 @@ +#!/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 new file mode 100644 index 000000000..d7e68b3a2 --- /dev/null +++ b/rt/bin/mason_handler.svc.in @@ -0,0 +1,265 @@ +#!@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 new file mode 100644 index 000000000..bf23a6c0b --- /dev/null +++ b/rt/bin/rt-commit-handler @@ -0,0 +1,846 @@ +#!/usr/bin/perl -w +# BEGIN LICENSE BLOCK +# +# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com> +# +# (Except where explictly superceded by other copyright notices) +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# Unless otherwise specified, all modifications, corrections or +# extensions to this work which alter its source code become the +# property of Best Practical Solutions, LLC when submitted for +# inclusion in the work. +# +# +# END LICENSE BLOCK + +# {{{ Docs +# -*-Perl-*- +# +#ident "@(#)ccvs/contrib:$Name: $:$Id: rt-commit-handler,v 1.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 new file mode 100644 index 000000000..13c11bfd7 --- /dev/null +++ b/rt/bin/rt-crontool @@ -0,0 +1,399 @@ +#!/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 new file mode 100644 index 000000000..8401acab3 --- /dev/null +++ b/rt/bin/rt-crontool.in @@ -0,0 +1,399 @@ +#!@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 new file mode 100755 index 000000000..d9e85a7b9 --- /dev/null +++ b/rt/bin/rt-mailgate @@ -0,0 +1,409 @@ +#!/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 new file mode 100644 index 000000000..b2343a0f5 --- /dev/null +++ b/rt/bin/rt-mailgate.in @@ -0,0 +1,409 @@ +#!@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 new file mode 100644 index 000000000..6ca302e19 --- /dev/null +++ b/rt/bin/rt.in @@ -0,0 +1,2586 @@ +#!@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 new file mode 100755 index 000000000..7b447050b --- /dev/null +++ b/rt/bin/standalone_httpd @@ -0,0 +1,186 @@ +#!/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 new file mode 100755 index 000000000..aa9204b68 --- /dev/null +++ b/rt/bin/standalone_httpd.in @@ -0,0 +1,186 @@ +#!@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 new file mode 100644 index 000000000..50b959a73 --- /dev/null +++ b/rt/bin/webmux.pl.in @@ -0,0 +1,176 @@ +#!@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; |