summaryrefslogtreecommitdiff
path: root/rt/bin
diff options
context:
space:
mode:
Diffstat (limited to 'rt/bin')
-rwxr-xr-xrt/bin/fastcgi_server263
-rw-r--r--rt/bin/fastcgi_server.in263
-rwxr-xr-xrt/bin/mason_handler.fcgi99
-rw-r--r--rt/bin/mason_handler.fcgi.in99
-rwxr-xr-xrt/bin/mason_handler.scgi80
-rw-r--r--rt/bin/mason_handler.scgi.in80
-rw-r--r--rt/bin/mason_handler.svc276
-rw-r--r--rt/bin/mason_handler.svc.in276
-rwxr-xr-xrt/bin/rt2611
-rw-r--r--rt/bin/rt-crontool400
-rw-r--r--rt/bin/rt-crontool.in159
-rwxr-xr-xrt/bin/rt-mailgate409
-rw-r--r--rt/bin/rt-mailgate.in331
-rw-r--r--rt/bin/rt.in136
-rwxr-xr-xrt/bin/standalone_httpd186
-rwxr-xr-xrt/bin/standalone_httpd.in186
-rw-r--r--rt/bin/webmux.pl.in205
17 files changed, 3036 insertions, 3023 deletions
diff --git a/rt/bin/fastcgi_server b/rt/bin/fastcgi_server
deleted file mode 100755
index 4ccf014da..000000000
--- a/rt/bin/fastcgi_server
+++ /dev/null
@@ -1,263 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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();
-
- # Each environment has its own way of handling .. and so on in paths,
- # so RT consistently forbids such paths.
- if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
-
- RT::Interface::Web::Handler->CleanupRequest();
- $proc_manager->pm_post_dispatch;
-
- next;
- }
-
- my $interp = $RT::Mason::Handler->interp;
- if (
- !$interp->comp_exists( $cgi->path_info )
- && $interp->comp_exists( $cgi->path_info . "/index.html" )
- ) {
- $cgi->path_info( $cgi->path_info . "/index.html" );
- }
-
- local $@;
- eval { $RT::Mason::Handler->handle_cgi_object($cgi); };
- if ($@) {
- $RT::Logger->crit($@);
- }
- RT::Interface::Web::Handler->CleanupRequest;
-
- $proc_manager->pm_post_dispatch;
-}
-
-1;
diff --git a/rt/bin/fastcgi_server.in b/rt/bin/fastcgi_server.in
deleted file mode 100644
index d6df63c7d..000000000
--- a/rt/bin/fastcgi_server.in
+++ /dev/null
@@ -1,263 +0,0 @@
-#!@PERL@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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();
-
- # Each environment has its own way of handling .. and so on in paths,
- # so RT consistently forbids such paths.
- if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
-
- RT::Interface::Web::Handler->CleanupRequest();
- $proc_manager->pm_post_dispatch;
-
- next;
- }
-
- my $interp = $RT::Mason::Handler->interp;
- if (
- !$interp->comp_exists( $cgi->path_info )
- && $interp->comp_exists( $cgi->path_info . "/index.html" )
- ) {
- $cgi->path_info( $cgi->path_info . "/index.html" );
- }
-
- local $@;
- eval { $RT::Mason::Handler->handle_cgi_object($cgi); };
- if ($@) {
- $RT::Logger->crit($@);
- }
- RT::Interface::Web::Handler->CleanupRequest;
-
- $proc_manager->pm_post_dispatch;
-}
-
-1;
diff --git a/rt/bin/mason_handler.fcgi b/rt/bin/mason_handler.fcgi
deleted file mode 100755
index 996e96076..000000000
--- a/rt/bin/mason_handler.fcgi
+++ /dev/null
@@ -1,99 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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();
-
- # Each environment has its own way of handling .. and so on in paths,
- # so RT consistently forbids such paths.
- if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
-
- RT::Interface::Web::Handler->CleanupRequest();
-
- next;
- }
-
- my $interp = $RT::Mason::Handler->interp;
- if (
- !$interp->comp_exists( $cgi->path_info )
- && $interp->comp_exists( $cgi->path_info . "/index.html" )
- ) {
- $cgi->path_info( $cgi->path_info . "/index.html" );
- }
-
- local $@;
- eval { $RT::Mason::Handler->handle_cgi_object($cgi); };
- if ($@) {
- $RT::Logger->crit($@);
- }
- RT::Interface::Web::Handler->CleanupRequest();
-
-}
-
-1;
diff --git a/rt/bin/mason_handler.fcgi.in b/rt/bin/mason_handler.fcgi.in
deleted file mode 100644
index 4682abf16..000000000
--- a/rt/bin/mason_handler.fcgi.in
+++ /dev/null
@@ -1,99 +0,0 @@
-#!@PERL@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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();
-
- # Each environment has its own way of handling .. and so on in paths,
- # so RT consistently forbids such paths.
- if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
-
- RT::Interface::Web::Handler->CleanupRequest();
-
- next;
- }
-
- my $interp = $RT::Mason::Handler->interp;
- if (
- !$interp->comp_exists( $cgi->path_info )
- && $interp->comp_exists( $cgi->path_info . "/index.html" )
- ) {
- $cgi->path_info( $cgi->path_info . "/index.html" );
- }
-
- local $@;
- eval { $RT::Mason::Handler->handle_cgi_object($cgi); };
- if ($@) {
- $RT::Logger->crit($@);
- }
- RT::Interface::Web::Handler->CleanupRequest();
-
-}
-
-1;
diff --git a/rt/bin/mason_handler.scgi b/rt/bin/mason_handler.scgi
deleted file mode 100755
index 83649edaf..000000000
--- a/rt/bin/mason_handler.scgi
+++ /dev/null
@@ -1,80 +0,0 @@
-#!/usr/local/bin/speedy
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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;
-
-# Each environment has its own way of handling .. and so on in paths,
-# so RT consistently forbids such paths.
-if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
-
- RT::Interface::Web::Handler->CleanupRequest();
-
- return 0;
-}
-
-if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
- && ( $Handler->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) {
- $cgi->path_info( $cgi->path_info . "/index.html" );
-}
-
-RT::ConnectToDatabase();
-$Handler->handle_cgi_object($cgi);
-RT::Interface::Web::Handler->CleanupRequest();
-1;
diff --git a/rt/bin/mason_handler.scgi.in b/rt/bin/mason_handler.scgi.in
deleted file mode 100644
index fa771b783..000000000
--- a/rt/bin/mason_handler.scgi.in
+++ /dev/null
@@ -1,80 +0,0 @@
-#!@SPEEDY_BIN@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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;
-
-# Each environment has its own way of handling .. and so on in paths,
-# so RT consistently forbids such paths.
-if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
-
- RT::Interface::Web::Handler->CleanupRequest();
-
- return 0;
-}
-
-if ( ( !$Handler->interp->comp_exists( $cgi->path_info ) )
- && ( $Handler->interp->comp_exists( $cgi->path_info . "/index.html" ) ) ) {
- $cgi->path_info( $cgi->path_info . "/index.html" );
-}
-
-RT::ConnectToDatabase();
-$Handler->handle_cgi_object($cgi);
-RT::Interface::Web::Handler->CleanupRequest();
-1;
diff --git a/rt/bin/mason_handler.svc b/rt/bin/mason_handler.svc
deleted file mode 100644
index 6275a9e59..000000000
--- a/rt/bin/mason_handler.svc
+++ /dev/null
@@ -1,276 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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'};
-
- # Each environment has its own way of handling .. and so on in paths,
- # so RT consistently forbids such paths.
- if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
-
- RT::Interface::Web::Handler->CleanupRequest();
-
- next;
- }
-
- $comp = $1 if ($comp =~ /^(.*)$/);
- my $web_path = RT->Config->Get('WebPath');
- $comp =~ s|^\Q$web_path\E\b||i;
- $comp .= "index.html" if ($comp =~ /\/$/);
- $comp =~ s/.pl$/.html/g;
-
- warn "Serving $comp\n";
-
- $Handler->handle_cgi($comp);
- RT::Interface::Web::Handler->CleanupRequest();
- # _should_ always be tied
-}
-
-1;
-
-=head1 AUTHORS
-
-Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
-
-=head1 COPYRIGHT
-
-Copyright 2002 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>
-
-=cut
diff --git a/rt/bin/mason_handler.svc.in b/rt/bin/mason_handler.svc.in
deleted file mode 100644
index 119b110db..000000000
--- a/rt/bin/mason_handler.svc.in
+++ /dev/null
@@ -1,276 +0,0 @@
-#!@PERL@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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'};
-
- # Each environment has its own way of handling .. and so on in paths,
- # so RT consistently forbids such paths.
- if ( $cgi->path_info =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$cgi->path_info." aborting");
- print STDOUT "HTTP/1.0 400\r\n\r\n";
-
- RT::Interface::Web::Handler->CleanupRequest();
-
- next;
- }
-
- $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 b/rt/bin/rt
new file mode 100755
index 000000000..32f459a7e
--- /dev/null
+++ b/rt/bin/rt
@@ -0,0 +1,2611 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# <sales@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;
+
+if ( $ARGV[0] && $ARGV[0] =~ /^(?:--help|-h)$/ ) {
+ require Pod::Usage;
+ print Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+# 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 = Session->new("$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 = Term::ReadLine->new('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 (($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 = LWP::UserAgent->new(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};
+
+ open( my $handle, '<', $file ) or return 0;
+
+ $self->{file} = $file;
+ my $sids = $self->{sids} = {};
+ while (<$handle>) {
+ chomp;
+ next if /^$/ || /^#/;
+ next unless m#^https?://[^ ]+ \w+ [^;,\s]+=[0-9A-Fa-f]+$#;
+ my ($server, $user, $cookie) = split / /, $_;
+ $sids->{$server}{$user} = $cookie;
+ }
+ return 1;
+ }
+
+ # Writes the current session cache to the specified file.
+ sub save {
+ my ($self, $file) = shift;
+ $file ||= $self->{file};
+
+ open( my $handle, '>', "$file" ) or return 0;
+
+ my $sids = $self->{sids};
+ foreach my $server (keys %$sids) {
+ foreach my $user (keys %{ $sids->{$server} }) {
+ my $sid = $sids->{$server}{$user};
+ if (defined $sid) {
+ print $handle "$server $user $sid\n";
+ }
+ }
+ }
+ close($handle);
+ chmod 0600, $file;
+ return 1;
+ }
+
+ 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", "/opt/rt3/local/etc/rt.conf", "/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( my $handle, '<', $file ) or return;
+
+ while (<$handle>) {
+ 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 $/ = undef;
+
+ open( my $handle, '>', $file ) or die "$file: $!\n";
+ print $handle $text;
+ close($handle);
+
+ system($editor, $file) && die "Couldn't run $editor.\n";
+
+ open( $handle, '<', $file ) or die "$file: $!\n";
+ $text = <$handle>;
+ close($handle);
+
+ 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 /\s*,\s*/, $line, 2;
+
+ while ($a) {
+ no warnings 'uninitialized';
+ if ( $a =~ /^'/ ) {
+ my $s = $a;
+ while ( $a !~ /'$/ || ( $a !~ /(\\\\)+'$/
+ && $a =~ /(\\)+'$/ )) {
+ ( $a, $b ) = split /\s*,\s*/, $b, 2;
+ $s .= ',' . $a;
+ }
+ push @words, $s;
+ }
+ elsif ( $a =~ /^q{/ ) {
+ my $s = $a;
+ while ( $a !~ /}$/ ) {
+ ( $a, $b ) =
+ split /\s*,\s*/, $b, 2;
+ $s .= ',' . $a;
+ }
+ $s =~ s/^q{/'/;
+ $s =~ s/}/'/;
+ push @words, $s;
+ }
+ else {
+ push @words, $a;
+ }
+ ( $a, $b ) = split /\s*,\s*/, $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 /\s*,\s*/, $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, /opt/rt3/local/etc/rt.conf
+ 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
+ RT. (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:
+
+ RT 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
+ $
+
+__END__
+
+=head1 NAME
+
+rt - command-line interface to RT 3.0 or newer
+
+=head1 SYNOPSIS
+
+ rt help
+
+=head1 DESCRIPTION
+
+This script 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.
+
diff --git a/rt/bin/rt-crontool b/rt/bin/rt-crontool
deleted file mode 100644
index 61932804c..000000000
--- a/rt/bin/rt-crontool
+++ /dev/null
@@ -1,400 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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 = ("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);
-
-#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();
-
-require RT::Tickets;
-require RT::Template;
-
-#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 are overdue:"
- )
- . "\n\n";
-
- print " bin/rt-crontool \\\n";
- print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n";
- print " --condition RT::Condition::Overdue \\\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
index 459ebf386..86251a39f 100644
--- a/rt/bin/rt-crontool.in
+++ b/rt/bin/rt-crontool.in
@@ -3,7 +3,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -120,7 +120,7 @@ my $CurrentUser = GetCurrentUser();
help() if $help;
unless ( $CurrentUser->Id ) {
- print loc("No RT user found. Please consult your RT administrator.\n");
+ print loc("No RT user found. Please consult your RT administrator.");
exit(1);
}
@@ -166,7 +166,7 @@ my $tickets = $search->TicketsObj;
#for each ticket we've found
while ( my $ticket = $tickets->Next() ) {
- print $ticket->Id() . ": " if ($verbose);
+ print $ticket->Id() . ":\n" if ($verbose);
my $template_obj = get_template( $ticket );
@@ -174,15 +174,15 @@ while ( my $ticket = $tickets->Next() ) {
my $txns = get_transactions($ticket);
my $found = 0;
while ( my $txn = $txns->Next ) {
- print loc("Using transaction #[_1]...", $txn->id)
+ print "\t".loc("Using transaction #[_1]...", $txn->id)."\n"
if $verbose;
process($ticket, $txn, $template_obj);
$found = 1;
}
- print loc("Couldn't find suitable transaction, skipping")
+ print "\t".loc("Couldn't find suitable transaction, skipping")."\n"
if $verbose && !$found;
} else {
- print loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument")
+ print "\t".loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument")."\n"
if $verbose;
process($ticket, undef, $template_obj);
@@ -208,7 +208,7 @@ sub process {
# if the condition doesn't apply, get out of here
return unless $condition_obj->IsApplicable;
- print loc("Condition matches...") if $verbose;
+ print "\t".loc("Condition matches...")."\n" if $verbose;
}
#prepare our action
@@ -224,20 +224,20 @@ sub process {
#if our preparation, move onto the next ticket
return unless $action_obj->Prepare;
- print loc("Action prepared...") if $verbose;
+ print "\t".loc("Action prepared...")."\n" if $verbose;
#commit our action.
return unless $action_obj->Commit;
- print loc("Action committed.\n") if $verbose;
+ print "\t".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
+# =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;
@@ -258,11 +258,11 @@ sub get_transactions {
return $txns;
}
-=head2 get_template
-
-Takes a ticket and returns a template according to command line options.
-
-=cut
+# =head2 get_template
+#
+# Takes a ticket and returns a template according to command line options.
+#
+# =cut
{ my $cache = undef;
sub get_template {
@@ -273,7 +273,7 @@ sub get_template {
# by id
return $cache if $cache;
- my $cache = RT::Template->new( $RT::SystemUser );
+ my $cache = RT::Template->new( RT->SystemUser );
$cache->Load( $template );
die "Failed to load template '$template'"
unless $cache->id;
@@ -283,7 +283,7 @@ sub get_template {
my $queue = $ticket->Queue;
return $cache->{ $queue } if $cache->{ $queue };
- my $res = RT::Template->new( $RT::SystemUser );
+ my $res = RT::Template->new( RT->SystemUser );
$res->LoadQueueTemplate( Queue => $queue, Name => $template );
unless ( $res->id ) {
$res->LoadGlobalTemplate( $template );
@@ -293,13 +293,12 @@ sub get_template {
return $cache->{ $queue } = $res;
} }
-# {{{ load_module
-
-=head2 load_module
-
-Loads a perl module, dying nicely if it can't find it.
-=cut
+# =head2 load_module
+#
+# Loads a perl module, dying nicely if it can't find it.
+#
+# =cut
sub load_module {
my $modname = shift;
@@ -310,21 +309,18 @@ sub load_module {
}
-# }}}
-# {{{ loc
-=head2 loc LIST
-
-Localize this string, with the current user's currentuser object
-
-=cut
+# =head2 loc LIST
+#
+# Localize this string, with the current user's currentuser object
+#
+# =cut
sub loc {
$CurrentUser->loc(@_);
}
-# }}}
sub help {
@@ -389,7 +385,7 @@ sub help {
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";
+ print" --action RT::Action::EscalatePriority\n";
@@ -398,3 +394,90 @@ sub help {
exit(0);
}
+
+__END__
+
+=head1 NAME
+
+rt-crontool - a tool to act on tickets from an external scheduling tool
+
+=head1 SYNOPSIS
+
+ # find all active tickets in the queue 'general' and set their priority to 99 if they are overdue:
+ rt-crontool \
+ --search RT::Search::ActiveTicketsInQueue --search-arg general \
+ --condition RT::Condition::Overdue \
+ --action RT::Action::SetPriority --action-arg 99 \
+ --verbose
+
+ # Escalate tickets
+ rt-crontool \
+ --search RT::Search::ActiveTicketsInQueue --search-arg general \
+ --action RT::Action::EscalatePriority
+
+=head1 DESCRIPTION
+
+This script is a tool to act on tickets from an external scheduling tool, such
+as cron.
+
+Security:
+
+This tool allows the user to run arbitrary perl modules from within RT. If
+this tool were setgid, a hostile local user could use this tool to gain
+administrative access to RT. It is incredibly important that nonprivileged
+users not be allowed to run this tool. It is suggested that you create a
+non-privileged unix user with the correct group membership and RT access to
+run this tool.
+
+
+=head1 OPTIONS
+
+=over
+
+=item search
+
+Specify the search module you want to use
+
+=item search-arg
+
+An argument to pass to --search
+
+=item condition
+
+Specify the condition module you want to use
+
+=item condition-arg
+
+An argument to pass to --condition
+
+=item action
+
+Specify the action module you want to use
+
+=item action-arg
+
+An argument to pass to --action
+
+=item template
+
+Specify name or id of template(s) you want to use
+
+=item transaction
+
+Specify if you want to use either 'first', 'last' or 'all' transactions
+
+
+=item transaction-type
+
+Specify the comma separated list of transactions' types you want to use
+
+=item log
+
+Adjust LogToScreen config option
+
+=item verbose
+
+Output status updates to STDOUT
+
+=back
+
diff --git a/rt/bin/rt-mailgate b/rt/bin/rt-mailgate
deleted file mode 100755
index de0529d84..000000000
--- a/rt/bin/rt-mailgate
+++ /dev/null
@@ -1,409 +0,0 @@
-#!/usr/bin/perl -w
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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, $/); <STDIN> };
- 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
index a74b2da15..72cada613 100644
--- a/rt/bin/rt-mailgate.in
+++ b/rt/bin/rt-mailgate.in
@@ -3,7 +3,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -48,7 +48,7 @@
# END BPS TAGGED BLOCK }}}
=head1 NAME
-rt-mailgate - Mail interface to RT3.
+rt-mailgate - Mail interface to RT.
=cut
@@ -56,85 +56,185 @@ use strict;
use warnings;
use Getopt::Long;
+
+my $opts = { };
+GetOptions( $opts, "queue=s", "action=s", "url=s",
+ "jar=s", "help", "debug", "extension=s",
+ "timeout=i", "verify-ssl!", "ca-file=s",
+ );
+
+my $gateway = RT::Client::MailGateway->new();
+
+$gateway->run($opts);
+
+package RT::Client::MailGateway;
+
use LWP::UserAgent;
use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
+use File::Temp qw(tempfile tempdir);
$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" );
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+ return $self;
+}
+
+sub run {
+ my $self = shift;
+ my $opts = shift;
-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!
+ if ( $opts->{running_in_test_harness} ) {
+ $self->{running_in_test_harness} = 1;
+ }
+
+ $self->validate_cli_flags($opts);
+
+ my $ua = $self->get_useragent($opts);
+ my $post_params = $self->setup_session($opts);
+ $self->upload_message( $ua => $post_params );
+ $self->exit_with_success();
}
-unless ( $opts{'url'} ) {
- print STDERR "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n";
- exit 1;
+sub exit_with_success {
+ my $self = shift;
+ if ( $self->{running_in_test_harness} ) {
+ return 1;
+ } else {
+ exit 0;
+ }
}
-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";
+sub tempfail {
+ my $self = shift;
+ if ( $self->{running_in_test_harness} ) {
+ die "tempfail";
+ } else {
+
+ exit EX_TEMPFAIL;
+ }
}
-# 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";
+sub permfail {
+ my $self = shift;
+ if ( $self->{running_in_test_harness} ) {
+ die "permfail";
+ } else {
+
+ exit 1;
+ }
+}
+
+sub validate_cli_flags {
+ my $self = shift;
+ my $opts = shift;
+ if ( $opts->{'help'} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage( { verbose => 2 } );
+ return $self->permfail()
+ ; # 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";
+ return $self->permfail();
+ }
+
+ if (($opts->{'ca-file'} or $opts->{"verify-ssl"})
+ and not LWP::UserAgent->can("ssl_opts")) {
+ print STDERR "Verifying SSL certificates requires LWP::UserAgent 6.0 or higher.\n";
+ return $self->tempfail();
+ }
+
+ $opts->{"verify-ssl"} = 1 unless defined $opts->{"verify-ssl"};
}
-# 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',
- ];
+sub get_useragent {
+ my $self = shift;
+ my $opts = shift;
+ my $ua = LWP::UserAgent->new();
+ $ua->cookie_jar( { file => $opts->{'jar'} } ) if $opts->{'jar'};
+
+ if ( $ua->can("ssl_opts") ) {
+ $ua->ssl_opts( verify_hostname => $opts->{'verify-ssl'} );
+ $ua->ssl_opts( SSL_ca_file => $opts->{'ca-file'} )
+ if $opts->{'ca-file'};
+ }
+
+ return $ua;
}
-my $full_url = $opts{'url'}. "/REST/1.0/NoAuth/mail-gateway";
-print STDERR "$0: connecting to $full_url\n" if $opts{'debug'};
+sub setup_session {
+ my $self = shift;
+ my $opts = shift;
+ my %post_params;
+ foreach (qw(queue action)) {
+ $post_params{$_} = $opts->{$_} if defined $opts->{$_};
+ }
-$ua->timeout( exists( $opts{'timeout'} )? $opts{'timeout'}: 180 );
-my $r = $ua->post( $full_url, \%args, Content_Type => 'form-data' );
-check_failure($r);
+ if ( ( $opts->{'extension'} || '' ) =~ /^(?:action|queue|ticket)$/i ) {
+ $post_params{ 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";
+ }
-my $content = $r->content;
-print STDERR $content ."\n" if $opts{'debug'};
+ # add ENV{'EXTENSION'} as X-RT-MailExtension to the message header
+ if ( my $value = ( $ENV{'EXTENSION'} || $opts->{'extension'} ) ) {
-if ( $content !~ /^(ok|not ok)/ ) {
+ # prepare value to avoid MIME format breakage
+ # strip trailing newline symbols
+ $value =~ s/(\r*\n)+$//;
- # It's not the server's fault if the mail is bogus. We just want to know that
- # *something* came out of the server.
+ # 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
+ # _raw_message is used for testing
+ my $message = $opts->{'_raw_message'} || $self->slurp_message();
+ unless ( $message->{'filename'} ) {
+ $post_params{'message'} = [
+ undef, '',
+ 'Content-Type' => 'application/octet-stream',
+ Content => ${ $message->{'content'} },
+ ];
+ } else {
+ $post_params{'message'} = [
+ $message->{'filename'}, '',
+ 'Content-Type' => 'application/octet-stream',
+ ];
+ }
+
+ return \%post_params;
+}
+
+sub upload_message {
+ my $self = shift;
+ my $ua = shift;
+ my $post_params = shift;
+ 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, $post_params, Content_Type => 'form-data' );
+ $self->check_failure($r);
+
+ my $content = $r->content;
+ print STDERR $content . "\n" if $opts->{'debug'};
+
+ return 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.
@@ -144,85 +244,74 @@ said:
$content
EOF
- exit EX_TEMPFAIL;
+ return $self->tempfail();
}
-exit;
-
-END {
- unlink $message{'filename'} if $message{'filename'};
-}
-
-
sub check_failure {
- my $r = shift;
+ my $self = shift;
+ 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;
+ # XXX TODO 4.2: Remove the multi-line error strings in favor of something more concise
+ print STDERR <<" ERROR";
+An Error Occurred
+=================
- 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;
+@{[ $r->status_line ]}
+ ERROR
+ print STDERR "\n$0: undefined server error\n" if $opts->{'debug'};
+ return $self->tempfail();
}
-sub write_down_message {
- use File::Temp qw(tempfile);
+sub slurp_message {
+ my $self = shift;
local $@;
- my ($fh, $filename) = eval { tempfile() };
+
+ my %message;
+ my ( $fh, $filename )
+ = eval { tempfile( DIR => tempdir( CLEANUP => 1 ) ) };
if ( !$fh || $@ ) {
print STDERR "$0: Couldn't create temp file, using memory\n";
print STDERR "error: $@\n" if $@;
- my $message = \do { local (@ARGV, $/); <STDIN> };
+ my $message = \do { local ( @ARGV, $/ ); <STDIN> };
unless ( $$message =~ /\S/ ) {
print STDERR "$0: no message passed on STDIN\n";
- exit 0;
+ $self->exit_with_success;
}
- $$message = $opts{'headers'} . $$message if $opts{'headers'};
- return ( content => $message );
+ $$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) {
+ 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;
+ return $self->tempfail();
} elsif ( !$status ) {
last;
}
$empty = 0 if $buf =~ /\S/;
print $fh $buf;
- };
+ }
close $fh;
- if ( $empty ) {
+ if ($empty) {
print STDERR "$0: no message passed on STDIN\n";
- exit 0;
+ $self->exit_with_success;
}
- print STDERR "$0: temp file is '$filename'\n" if $opts{'debug'};
- return (filename => $filename);
+ print STDERR "$0: temp file is '$filename'\n" if $opts->{'debug'};
+ return ( { filename => $filename } );
}
-
=head1 SYNOPSIS
rt-mailgate --help : this text
@@ -267,8 +356,34 @@ 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.
+probably use the same URL that users use to log into RT.
+If your RT server uses SSL, you will need to install additional Perl
+libraries. RT will detect and install these dependencies if you pass the
+C<--enable-ssl-mailgate> flag to configure as documented in RT's README.
+
+If you have a self-signed SSL certificate, you may also need to pass
+C<--ca-file> or C<--no-verify-ssl>, below.
+
+=item C<--ca-file> I<path>
+
+Specifies the path to the public SSL certificate for the certificate
+authority that should be used to verify the website's SSL certificate.
+If your webserver uses a self-signed certificate, you should
+preferentially use this option over C<--no-verify-ssl>, as it will
+ensure that the self-signed certificate that the mailgate is seeing the
+I<right> self-signed certificate.
+
+=item C<--no-verify-ssl>
+
+This flag tells the mail gateway to trust all SSL certificates,
+regardless of if their hostname matches the certificate, and regardless
+of CA. This is required if you have a self-signed certificate, or some
+other certificate which is not traceable back to an certificate your
+system ultimitely trusts.
+
+Verifying SSL certificates requires L<LWP::UserAgent> version 6.0 or
+higher; explicitly passing C<--verify-ssl> on prior versions will error.
=item C<--extension> OPTIONAL
@@ -290,6 +405,8 @@ Print debugging output to standard error
Configure the timeout for posting the message to the web server. The
default timeout is 3 minutes (180 seconds).
+=back
+
=head1 DESCRIPTION
@@ -312,10 +429,10 @@ 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
+ bugs: "|/opt/rt4/bin/rt-mailgate --queue bugs --action correspond
--url http://rt.mycorp.com/"
- bugs-comment: "|/opt/rt3/bin/rt-mailgate --queue bugs --action comment
+ bugs-comment: "|/opt/rt4/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
@@ -379,7 +496,7 @@ If we don't already have a ticket id, we need to know which queue we're talking
The action being performed. At the moment, it's one of "comment" or "correspond"
-=back 4
+=back
It returns two values, the new C<RT::CurrentUser> object, and the new
authentication level. The authentication level can be zero, not allowed
@@ -403,7 +520,7 @@ 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
+=back
=cut
diff --git a/rt/bin/rt.in b/rt/bin/rt.in
index aefe7af72..e54a07add 100644
--- a/rt/bin/rt.in
+++ b/rt/bin/rt.in
@@ -3,7 +3,7 @@
#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
@@ -51,6 +51,12 @@
use strict;
+if ( $ARGV[0] && $ARGV[0] =~ /^(?:--help|-h)$/ ) {
+ require Pod::Usage;
+ print Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
# This program is intentionally written to have as few non-core module
# dependencies as possible. It should stay that way.
@@ -98,7 +104,7 @@ my %config = (
config_from_file($ENV{RTCONFIG} || ".rtrc"),
config_from_env()
);
-my $session = new Session("$HOME/.rt_sessions");
+my $session = Session->new("$HOME/.rt_sessions");
my $REST = "$config{server}/REST/1.0";
$no_strong_auth = 'switched off by externalauth=0'
if defined $config{externalauth};
@@ -179,7 +185,7 @@ exit handler();
sub shell {
$|=1;
- my $term = new Term::ReadLine 'RT CLI';
+ my $term = Term::ReadLine->new('RT CLI');
while ( defined ($_ = $term->readline($prompt)) ) {
next if /^#/ || /^\s*$/;
@@ -899,11 +905,6 @@ sub link {
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;
@@ -984,7 +985,7 @@ sub grant {
sub submit {
my ($uri, $content) = @_;
my ($req, $data);
- my $ua = new LWP::UserAgent(agent => "RT/3.0b", env_proxy => 1);
+ my $ua = LWP::UserAgent->new(agent => "RT/3.0b", env_proxy => 1);
my $h = HTTP::Headers->new;
# Did the caller specify any data to send with the request?
@@ -1164,44 +1165,40 @@ sub submit {
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;
+
+ open( my $handle, '<', $file ) or return 0;
+
+ $self->{file} = $file;
+ my $sids = $self->{sids} = {};
+ while (<$handle>) {
+ chomp;
+ next if /^$/ || /^#/;
+ next unless m#^https?://[^ ]+ \w+ [^;,\s]+=[0-9A-Fa-f]+$#;
+ my ($server, $user, $cookie) = split / /, $_;
+ $sids->{$server}{$user} = $cookie;
+ }
+ return 1;
}
# 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";
- }
+
+ open( my $handle, '>', "$file" ) or return 0;
+
+ my $sids = $self->{sids};
+ foreach my $server (keys %$sids) {
+ foreach my $user (keys %{ $sids->{$server} }) {
+ my $sid = $sids->{$server}{$user};
+ if (defined $sid) {
+ print $handle "$server $user $sid\n";
}
}
- close(F);
- chmod 0600, $file;
- return 1;
- };
- return 0;
+ }
+ close($handle);
+ chmod 0600, $file;
+ return 1;
}
sub DESTROY {
@@ -1429,19 +1426,19 @@ sub parse_config_file {
my ($file) = @_;
local $_; # $_ may be aliased to a constant, from line 1163
- open(CFG, '<', $file) && do {
- while (<CFG>) {
- chomp;
- next if (/^#/ || /^\s*$/);
+ open( my $handle, '<', $file ) or return;
- if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) {
- $cfg{$1} = $2;
- }
- else {
- die "rt: $file:$.: unknown configuration directive.\n";
- }
+ while (<$handle>) {
+ 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;
}
@@ -1476,12 +1473,18 @@ sub vi {
my $file = "/tmp/rt.form.$$";
my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi";
- local *F;
local $/ = undef;
- open(F, '>', $file) or die "$file: $!\n"; print F $text; close(F);
+ open( my $handle, '>', $file ) or die "$file: $!\n";
+ print $handle $text;
+ close($handle);
+
system($editor, $file) && die "Couldn't run $editor.\n";
- open(F, '<', $file) or die "$file: $!\n"; $text = <F>; close(F);
+
+ open( $handle, '<', $file ) or die "$file: $!\n";
+ $text = <$handle>;
+ close($handle);
+
unlink($file);
return $text;
@@ -1702,7 +1705,7 @@ sub prettyshow {
}
print "$k->{Content}\n" if exists $k->{Content} and
$k->{Content} !~ /to have no content$/ and
- $k->{Type} ne 'EmailRecord';
+ ($k->{Type}||'') ne 'EmailRecord';
print "$k->{Attachments}\n" if exists $k->{Attachments} and
$k->{Attachments};
}
@@ -2157,7 +2160,7 @@ Text:
("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
+ RT. (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.
@@ -2390,7 +2393,7 @@ Text:
Title: query
Text:
- RT3 uses an SQL-like syntax to specify object selection constraints.
+ RT 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?)
@@ -2585,3 +2588,24 @@ Text:
$ rt shell
rt> quit
$
+
+__END__
+
+=head1 NAME
+
+rt - command-line interface to RT 3.0 or newer
+
+=head1 SYNOPSIS
+
+ rt help
+
+=head1 DESCRIPTION
+
+This script 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.
+
diff --git a/rt/bin/standalone_httpd b/rt/bin/standalone_httpd
deleted file mode 100755
index a307910c1..000000000
--- a/rt/bin/standalone_httpd
+++ /dev/null
@@ -1,186 +0,0 @@
-#!/usr/bin/perl -w
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use warnings;
-use strict;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("lib", "local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use RT;
-RT::LoadConfig();
-RT->InitLogging();
-if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
-
-RT::CheckPerlRequirements();
-RT->InitPluginPaths();
-
-my $explicit_port = shift @ARGV;
-my $port = $explicit_port || RT->Config->Get('WebPort') || '8080';
-
-
-require RT::Handle;
-my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
-
-unless ( $integrity ) {
- print STDERR <<EOF;
-
-RT couldn't connect to the database where tickets are stored.
-If this is a new installation of RT, you should visit the URL below
-to configure RT and initialize your database.
-
-If this is an existing RT installation, this may indicate a database
-connectivity problem.
-
-The error RT got back when trying to connect to your database was:
-
-$msg
-
-EOF
-
- require RT::Installer;
- # don't enter install mode if the file exists but is unwritable
- if (-e RT::Installer->ConfigFile && !-w _) {
- die 'Since your configuration exists ('
- . RT::Installer->ConfigFile
- . ") but is not writable, I'm refusing to do anything.\n";
- }
-
- RT->Config->Set( 'LexiconLanguages' => '*' );
- RT::I18N->Init;
-
- RT->InstallMode(1);
-} else {
- RT->ConnectToDatabase();
- RT->InitSystemObjects();
- RT->InitClasses( Heavy => 1 );
- RT->InitPlugins();
- RT->Config->PostLoadCheck();
-
- my ($status, $msg) = RT::Handle->CheckCompatibility(
- $RT::Handle->dbh, 'post'
- );
- unless ( $status ) {
- print STDERR $msg, "\n\n";
- exit -1;
- }
-}
-
-require RT::Interface::Web::Standalone;
-my $server = RT::Interface::Web::Standalone->new;
-run_server($port);
-exit 0;
-
-sub run_server {
- my $port = shift;
- $server->port($port);
- eval { $server->run() };
-
- if ( my $err = $@ ) {
- handle_startup_error($err);
- }
-}
-
-sub handle_startup_error {
- my $err = shift;
- if ( $err =~ /bind: Permission denied/ ) {
- handle_bind_error();
- } else {
- die
- "Something went wrong while trying to run RT's standalone web server:\n\t"
- . $err;
- }
-}
-
-
-sub handle_bind_error {
-
- print STDERR <<EOF;
-WARNING: RT couldn't start up a web server on port @{[$port]}.
-This is often the case if you're running @{[$0]} as
-someone other than your system's "root" user.
-EOF
-
- if ($explicit_port) {
- print STDERR
- "Please check your system configuration or choose another port\n\n";
- } else {
- print STDERR "\nFor now, RT has chosen an alternate port to run on.\n\n";
- if ( !$integrity ) {
- print STDERR <<EOF;
-You can use this server to configure and explore RT. While configuring
-RT, you'll have a chance to set a permanent port and URL for your
-server.
-
-EOF
- }
- run_server( 8000 + int( rand(1024) ) );
- }
-}
diff --git a/rt/bin/standalone_httpd.in b/rt/bin/standalone_httpd.in
deleted file mode 100755
index 8c8c1ae56..000000000
--- a/rt/bin/standalone_httpd.in
+++ /dev/null
@@ -1,186 +0,0 @@
-#!@PERL@ -w
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use warnings;
-use strict;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use RT;
-RT::LoadConfig();
-RT->InitLogging();
-if (RT->Config->Get('DevelMode')) { require Module::Refresh; }
-
-RT::CheckPerlRequirements();
-RT->InitPluginPaths();
-
-my $explicit_port = shift @ARGV;
-my $port = $explicit_port || RT->Config->Get('WebPort') || '8080';
-
-
-require RT::Handle;
-my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
-
-unless ( $integrity ) {
- print STDERR <<EOF;
-
-RT couldn't connect to the database where tickets are stored.
-If this is a new installation of RT, you should visit the URL below
-to configure RT and initialize your database.
-
-If this is an existing RT installation, this may indicate a database
-connectivity problem.
-
-The error RT got back when trying to connect to your database was:
-
-$msg
-
-EOF
-
- require RT::Installer;
- # don't enter install mode if the file exists but is unwritable
- if (-e RT::Installer->ConfigFile && !-w _) {
- die 'Since your configuration exists ('
- . RT::Installer->ConfigFile
- . ") but is not writable, I'm refusing to do anything.\n";
- }
-
- RT->Config->Set( 'LexiconLanguages' => '*' );
- RT::I18N->Init;
-
- RT->InstallMode(1);
-} else {
- RT->ConnectToDatabase();
- RT->InitSystemObjects();
- RT->InitClasses( Heavy => 1 );
- RT->InitPlugins();
- RT->Config->PostLoadCheck();
-
- my ($status, $msg) = RT::Handle->CheckCompatibility(
- $RT::Handle->dbh, 'post'
- );
- unless ( $status ) {
- print STDERR $msg, "\n\n";
- exit -1;
- }
-}
-
-require RT::Interface::Web::Standalone;
-my $server = RT::Interface::Web::Standalone->new;
-run_server($port);
-exit 0;
-
-sub run_server {
- my $port = shift;
- $server->port($port);
- eval { $server->run() };
-
- if ( my $err = $@ ) {
- handle_startup_error($err);
- }
-}
-
-sub handle_startup_error {
- my $err = shift;
- if ( $err =~ /bind: Permission denied/ ) {
- handle_bind_error();
- } else {
- die
- "Something went wrong while trying to run RT's standalone web server:\n\t"
- . $err;
- }
-}
-
-
-sub handle_bind_error {
-
- print STDERR <<EOF;
-WARNING: RT couldn't start up a web server on port @{[$port]}.
-This is often the case if you're running @{[$0]} as
-someone other than your system's "root" user.
-EOF
-
- if ($explicit_port) {
- print STDERR
- "Please check your system configuration or choose another port\n\n";
- } else {
- print STDERR "\nFor now, RT has chosen an alternate port to run on.\n\n";
- if ( !$integrity ) {
- print STDERR <<EOF;
-You can use this server to configure and explore RT. While configuring
-RT, you'll have a chance to set a permanent port and URL for your
-server.
-
-EOF
- }
- run_server( 8000 + int( rand(1024) ) );
- }
-}
diff --git a/rt/bin/webmux.pl.in b/rt/bin/webmux.pl.in
deleted file mode 100644
index 7aae041b3..000000000
--- a/rt/bin/webmux.pl.in
+++ /dev/null
@@ -1,205 +0,0 @@
-#!@PERL@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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;
-local $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need
-local $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'};
-local $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'};
-local $ENV{'ENV'} = '' if defined $ENV{'ENV'};
-local $ENV{'IFS'} = '' if defined $ENV{'IFS'};
-
-package HTML::Mason::Commands;
-our %session;
-
-package RT::Mason;
-
-our ($Nobody, $SystemUser, $Handler, $r);
-
-my $protect_fd;
-
-sub handler {
- ($r) = @_;
-
- if ( !$protect_fd && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'}
- && $ENV{'MOD_PERL_API_VERSION'} >= 2 && fileno(STDOUT) != 1
- ) {
- # under mod_perl2, STDOUT gets closed and re-opened, however new STDOUT
- # is not on FD #1. In this case next IO operation will occupy this FD
- # and make all system() and open "|-" dangerouse, for example DBI
- # can get this FD for DB connection and system() call will close
- # by putting grabage into the socket
- open( $protect_fd, '>', '/dev/null' )
- or die "Couldn't open /dev/null: $!";
- unless ( fileno($protect_fd) == 1 ) {
- warn "We opened /dev/null to protect FD #1, but descriptor #1 is already occupied";
- }
- }
-
- 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();
-
- # none of the methods in $r gives us the information we want (most
- # canonicalize /foo/../bar to /bar which is exactly what we want to avoid)
- my (undef, $requested) = split ' ', $r->the_request, 3;
- my $uri = URI->new("http://".$r->hostname.$requested);
- my $path = URI::Escape::uri_unescape($uri->path);
-
- ## Each environment has its own way of handling .. and so on in paths,
- ## so RT consistently forbids such paths.
- if ( $path =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$path." aborting");
- RT::Interface::Web::Handler->CleanupRequest();
- return 400;
- }
-
- 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)};
-}
-
-require CGI;
-CGI->import(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;
-die "Wrong version of RT $RT::Version found; need @RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.*"
- unless $RT::VERSION =~ /^@RT_VERSION_MAJOR@\.@RT_VERSION_MINOR@\./;
-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;
generated by cgit v1.2.1 (git 2.18.0) at 2025-10-17 05:40:41 +0000