summaryrefslogtreecommitdiff
path: root/rt/sbin
diff options
context:
space:
mode:
authorIvan Kohler <ivan@freeside.biz>2014-09-15 20:44:48 -0700
committerIvan Kohler <ivan@freeside.biz>2014-09-15 20:44:48 -0700
commited1f84b4e8f626245995ecda5afcf83092c153b2 (patch)
tree3f58bbef5fbf2502e65d29b37b5dbe537519e89d /rt/sbin
parentfe9ea9183e8a16616d6d04a7b5c7498d28e78248 (diff)
RT 4.0.22
Diffstat (limited to 'rt/sbin')
-rwxr-xr-xrt/sbin/rt-attributes-viewer122
-rwxr-xr-xrt/sbin/rt-clean-sessions190
-rwxr-xr-xrt/sbin/rt-dump-metadata357
-rwxr-xr-xrt/sbin/rt-email-dashboards173
-rwxr-xr-xrt/sbin/rt-email-digest380
-rw-r--r--rt/sbin/rt-email-digest.in6
-rwxr-xr-xrt/sbin/rt-email-group-admin527
-rwxr-xr-xrt/sbin/rt-fulltext-indexer479
-rwxr-xr-xrt/sbin/rt-preferences-viewer149
-rwxr-xr-xrt/sbin/rt-server285
-rwxr-xr-xrt/sbin/rt-server.fcgi285
-rwxr-xr-xrt/sbin/rt-session-viewer121
-rwxr-xr-xrt/sbin/rt-setup-database609
-rwxr-xr-xrt/sbin/rt-setup-fulltext-index720
-rwxr-xr-xrt/sbin/rt-shredder325
-rwxr-xr-xrt/sbin/rt-shredder.in4
-rwxr-xr-xrt/sbin/rt-test-dependencies694
-rw-r--r--rt/sbin/rt-test-dependencies.in2
-rwxr-xr-xrt/sbin/rt-validate-aliases343
-rwxr-xr-xrt/sbin/rt-validator1182
-rwxr-xr-xrt/sbin/standalone_httpd285
21 files changed, 7233 insertions, 5 deletions
diff --git a/rt/sbin/rt-attributes-viewer b/rt/sbin/rt-attributes-viewer
new file mode 100755
index 000000000..35449e0ec
--- /dev/null
+++ b/rt/sbin/rt-attributes-viewer
@@ -0,0 +1,122 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+my %opt;
+GetOptions( \%opt, 'help|h', );
+
+my $id = shift;
+
+if ( $opt{help} || !$id ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage({ verbose => 2 });
+ exit;
+}
+
+require RT;
+RT::LoadConfig();
+RT::Init();
+
+require RT::Attribute;
+my $attr = RT::Attribute->new( RT->SystemUser );
+$attr->Load( $id );
+unless ( $attr->id ) {
+ print STDERR "Couldn't load attribute #$id\n";
+ exit 1;
+}
+
+my %res = ();
+$res{$_} = $attr->$_() foreach qw(ObjectType ObjectId Name Description Content ContentType);
+
+use Data::Dumper;
+print "Content of attribute #$id: ". Dumper( \%res );
+
+__END__
+
+=head1 NAME
+
+rt-attributes-viewer - show the content of an attribute
+
+=head1 SYNOPSIS
+
+ # show the content of attribute 2
+ rt-attributes-viewer 2
+
+=head1 DESCRIPTION
+
+This script deserializes and print content of an attribute defined
+by <attribute id>. May be useful for developers and for troubleshooting
+problems.
+
diff --git a/rt/sbin/rt-clean-sessions b/rt/sbin/rt-clean-sessions
new file mode 100755
index 000000000..02e1901d0
--- /dev/null
+++ b/rt/sbin/rt-clean-sessions
@@ -0,0 +1,190 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+my %opt;
+GetOptions( \%opt, "older=s", "debug", "help|h", "skip-user" );
+
+
+if ( $opt{help} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage({ verbose => 2 });
+ exit;
+}
+
+
+if( $opt{'older'} ) {
+ unless( $opt{'older'} =~ /^\s*([0-9]+)\s*(H|D|M|Y)?$/i ) {
+ print STDERR "wrong format of the 'older' argumnet\n";
+ exit(1);
+ }
+ my ($num,$unit) = ($1, uc($2 ||'D'));
+ my %factor = ( H => 60*60 );
+ $factor{'D'} = $factor{'H'}*24;
+ $factor{'M'} = $factor{'D'}*31;
+ $factor{'Y'} = $factor{'D'}*365;
+ $opt{'older'} = $num * $factor{ $unit };
+}
+
+require RT;
+RT::LoadConfig();
+
+if( $opt{'debug'} ) {
+ RT->Config->Set( LogToScreen => 'debug' );
+} else {
+ RT->Config->Set( LogToScreen => undef );
+}
+
+RT::ConnectToDatabase();
+RT::InitLogging();
+
+require RT::Interface::Web::Session;
+
+my $alogoff = int RT->Config->Get('AutoLogoff');
+if ( $opt{'older'} or $alogoff ) {
+ my $min;
+ foreach ($alogoff*60, $opt{'older'}) {
+ next unless $_;
+ $min = $_ unless $min;
+ $min = $_ if $_ < $min;
+ }
+
+ RT::Interface::Web::Session->ClearOld( $min );
+}
+
+RT::Interface::Web::Session->ClearByUser
+ unless $opt{'skip-user'};
+
+exit(0);
+
+__END__
+
+=head1 NAME
+
+rt-clean-sessions - clean old and duplicate RT sessions
+
+=head1 SYNOPSIS
+
+ rt-clean-sessions [--debug] [--older <NUM>[H|D|M|Y]]
+
+ rt-clean-sessions
+ rt-clean-sessions --debug
+ rt-clean-sessions --older 10D
+ rt-clean-sessions --debug --older 1M
+ rt-clean-sessions --older 10D --skip-user
+
+=head1 DESCRIPTION
+
+Script cleans RT sessions from DB or dir with sessions data.
+Leaves in DB only one session per RT user and sessions that aren't older
+than specified(see options).
+
+Script is safe because data in the sessions is temporary and can be deleted.
+
+=head1 OPTIONS
+
+=over 4
+
+=item older
+
+Date interval in the C<< <NUM>[<unit>] >> format. Default unit is D(ays),
+H(our), M(onth) and Y(ear) are also supported.
+
+For example: C<rt-clean-sessions --older 1M> would delete all sessions that are
+older than 1 month.
+
+=item skip-user
+
+By default only one session per user left in the DB, so users that have
+sessions on multiple computers or in different browsers will be logged out.
+Use this option to avoid this.
+
+=item debug
+
+Turn on debug output.
+
+=back
+
+=head1 NOTES
+
+Functionality similar to this is implemented in
+html/Elements/SetupSessionCookie ; however, that does not guarantee
+that a session will be removed from disk and database soon after the
+timeout expires. This script, if run from a cron job, will ensure
+that the timed out sessions are actually removed from disk; the Mason
+component just ensures that the old sessions are not reusable before
+the cron job gets to them.
+
+=cut
diff --git a/rt/sbin/rt-dump-metadata b/rt/sbin/rt-dump-metadata
new file mode 100755
index 000000000..a2ebe3622
--- /dev/null
+++ b/rt/sbin/rt-dump-metadata
@@ -0,0 +1,357 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+
+# As we specify that XML is UTF-8 and we output it to STDOUT, we must be sure
+# it is UTF-8 so further XMLin will not break
+binmode( STDOUT, ":utf8" );
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ( "/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+my %opt;
+GetOptions( \%opt, "help|h",
+ "limit-to-privileged|l",
+ "skip-disabled|s",
+ "all|a",
+);
+
+if ( $opt{help} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+require RT;
+require XML::Simple;
+
+RT::LoadConfig();
+RT::Init();
+
+my %RV;
+my %Ignore = (
+ All => [
+ qw(
+ id Created Creator LastUpdated LastUpdatedBy
+ )
+ ],
+ Templates => [
+ qw(
+ TranslationOf
+ )
+ ],
+);
+
+my $SystemUserId = RT->SystemUser->Id;
+my @classes = qw(
+ Users Groups Queues ScripActions ScripConditions
+ Templates Scrips ACL CustomFields
+ );
+foreach my $class (@classes) {
+ require "RT/$class.pm";
+ my $objects = "RT::$class"->new( RT->SystemUser );
+ $objects->{find_disabled_rows} = 1 unless $opt{'skip-disabled'};
+ $objects->UnLimit;
+ $objects->LimitToPrivileged if $class eq 'Users'
+ && $opt{'limit-to-privileged'};
+ $objects->Limit(
+ FIELD => 'Domain',
+ OPERATOR => '=',
+ VALUE => 'UserDefined'
+ ) if $class eq 'Groups';
+
+ if ( $class eq 'CustomFields' ) {
+ $objects->OrderByCols(
+ { FIELD => 'LookupType' },
+ { FIELD => 'SortOrder' },
+ { FIELD => 'Id' },
+ );
+ } else {
+ $objects->OrderBy( FIELD => 'Id' );
+ }
+
+ unless ($opt{all}) {
+ next if $class eq 'ACL'; # XXX - would go into infinite loop - XXX
+ $objects->Limit(
+ FIELD => 'LastUpdatedBy',
+ OPERATOR => '!=',
+ VALUE => $SystemUserId
+ ) unless $class eq 'Groups';
+ $objects->Limit(
+ FIELD => 'Id',
+ OPERATOR => '!=',
+ VALUE => $SystemUserId
+ ) if $class eq 'Users';
+ }
+
+ my %fields;
+OBJECT:
+ while ( my $obj = $objects->Next ) {
+ next
+ if $obj->can('LastUpdatedBy')
+ and $obj->LastUpdatedBy == $SystemUserId;
+
+ if ( !%fields ) {
+ %fields = map { $_ => 1 } keys %{ $obj->_ClassAccessible };
+ delete @fields{ @{ $Ignore{$class} ||= [] },
+ @{ $Ignore{All} ||= [] }, };
+ }
+
+ my $rv;
+
+ if ( $class ne 'ACL' ) {
+ # next if $obj-> # skip default names
+ foreach my $field ( sort keys %fields ) {
+ my $value = $obj->__Value($field);
+ $rv->{$field} = $value if ( defined($value) && length($value) );
+ }
+ delete $rv->{Disabled} unless $rv->{Disabled};
+
+ foreach my $record ( map { /ACL/ ? 'ACE' : substr( $_, 0, -1 ) }
+ @classes )
+ {
+ foreach my $key ( map "$record$_", ( '', 'Id' ) ) {
+ next unless exists $rv->{$key};
+ my $id = $rv->{$key} or next;
+ my $obj = "RT::$record"->new( RT->SystemUser );
+ $obj->LoadByCols( Id => $id ) or next;
+ $rv->{$key} = $obj->__Value('Name') || 0;
+ }
+ }
+
+ if ( $class eq 'Users' and defined $obj->Privileged ) {
+ $rv->{Privileged} = int( $obj->Privileged );
+ } elsif ( $class eq 'CustomFields' ) {
+ my $values = $obj->Values;
+ while ( my $value = $values->Next ) {
+ push @{ $rv->{Values} }, {
+ map { ( $_ => $value->__Value($_) ) }
+ qw(
+ Name Description SortOrder
+ ),
+ };
+ }
+ if ( $obj->LookupType eq 'RT::Queue-RT::Ticket' ) {
+ # XXX-TODO: unused CF's turn into global CF when importing
+ # as the sub InsertData in RT::Handle creates a global CF
+ # when no queue is specified.
+ $rv->{Queue} = [];
+ my $applies = $obj->AppliedTo;
+ while ( my $queue = $applies->Next ) {
+ push @{ $rv->{Queue} }, $queue->Name;
+ }
+ }
+ }
+ }
+ else {
+ # 1) pick the right
+ $rv->{Right} = $obj->RightName;
+
+ # 2) Pick a level: Granted on Queue, CF, CF+Queue, or Globally?
+ for ( $obj->ObjectType ) {
+ if ( /^RT::Queue$/ ) {
+ next OBJECT if $opt{'skip-disabled'} && $obj->Object->Disabled;
+ $rv->{Queue} = $obj->Object->Name;
+ }
+ elsif ( /^RT::CustomField$/ ) {
+ next OBJECT if $opt{'skip-disabled'} && $obj->Object->Disabled;
+ $rv->{CF} = $obj->Object->Name;
+ }
+ elsif ( /^RT::Group$/ ) {
+ # No support for RT::Group ACLs in RT::Handle yet.
+ next OBJECT;
+ }
+ elsif ( /^RT::System$/ ) {
+ # skip setting anything on $rv;
+ # "Specifying none of the above will get you a global right."
+ }
+ }
+
+ # 3) Pick a Principal; User or Group or Role
+ if ( $obj->PrincipalType eq 'Group' ) {
+ next OBJECT if $opt{'skip-disabled'} && $obj->PrincipalObj->Disabled;
+ my $group = $obj->PrincipalObj->Object;
+ for ( $group->Domain ) {
+ # An internal user group
+ if ( /^SystemInternal$/ ) {
+ $rv->{GroupDomain} = $group->Domain;
+ $rv->{GroupType} = $group->Type;
+ }
+ # An individual user
+ elsif ( /^ACLEquivalence$/ ) {
+ my $member = $group->MembersObj->Next->MemberObj;
+ next OBJECT if $opt{'skip-disabled'} && $member->Disabled;
+ $rv->{UserId} = $member->Object->Name;
+ }
+ # A group you created
+ elsif ( /^UserDefined$/ ) {
+ $rv->{GroupDomain} = 'UserDefined';
+ $rv->{GroupId} = $group->Name;
+ }
+ }
+ } else {
+ $rv->{GroupType} = $obj->PrincipalType;
+ # A system-level role
+ if ( $obj->ObjectType eq 'RT::System' ) {
+ $rv->{GroupDomain} = 'RT::System-Role';
+ }
+ # A queue-level role
+ elsif ( $obj->ObjectType eq 'RT::Queue' ) {
+ $rv->{GroupDomain} = 'RT::Queue-Role';
+ }
+ }
+ if ( $obj->LookupType eq 'RT::Queue-RT::Ticket' ) {
+ # XXX-TODO: unused CF's turn into global CF when importing
+ # as the sub InsertData in RT::Handle creates a global CF
+ # when no queue is specified.
+ $rv->{Queue} = [];
+ my $applies = $obj->AppliedTo;
+ while ( my $queue = $applies->Next ) {
+ push @{ $rv->{Queue} }, $queue->Name;
+ }
+ }
+ }
+
+ if ( eval { require RT::Attributes; 1 } ) {
+ my $attributes = $obj->Attributes;
+ while ( my $attribute = $attributes->Next ) {
+ my $content = $attribute->Content;
+ if ( $class eq 'Users' and $attribute->Name eq 'Bookmarks' ) {
+ next;
+ }
+ $rv->{Attributes}{ $attribute->Name } = $content
+ if length($content);
+ }
+ }
+
+ push @{ $RV{$class} }, $rv;
+ }
+}
+
+print(<< ".");
+no strict; use XML::Simple; *_ = XMLin(do { local \$/; readline(DATA) }, ForceArray => [qw(
+ @classes Values
+)], NoAttr => 1, SuppressEmpty => ''); *\$_ = (\$_{\$_} || []) for keys \%_; 1; # vim: ft=xml
+__DATA__
+.
+
+print XML::Simple::XMLout(
+ { map { ( $_ => ( $RV{$_} || [] ) ) } @classes },
+ RootName => 'InitialData',
+ NoAttr => 1,
+ SuppressEmpty => '',
+ XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>',
+);
+
+__END__
+
+=head1 NAME
+
+rt-dump-metadata - dump configuration metadata from an RT database
+
+=head1 SYNOPSIS
+
+ rt-dump-metdata [--all]
+
+=head1 DESCRIPTION
+
+C<rt-dump-metadata> is a tool that dumps configuration metadata from the
+Request Tracker database into XML format, suitable for feeding into
+C<rt-setup-database>. To dump and load a full RT database, you should generally
+use the native database tools instead, as well as performing any necessary
+steps from UPGRADING.
+
+This is NOT a tool for backing up an RT database. See also
+L<docs/initialdata> for more straightforward means of importing data.
+
+=head1 OPTIONS
+
+=over
+
+=item C<--all> or C<-a>
+
+When run with C<--all>, the dump will include all configuration
+metadata; otherwise, the metadata dump will only include 'local'
+configuration changes, i.e. those done manually in the web interface.
+
+=item C<--limit-to-privileged> or C<-l>
+
+Causes the dumper to only dump privileged users.
+
+=item C<--skip-disabled> or C<-s>
+
+Ignores disabled rows in the database.
+
+=back
+
+=cut
+
diff --git a/rt/sbin/rt-email-dashboards b/rt/sbin/rt-email-dashboards
new file mode 100755
index 000000000..7c797ab25
--- /dev/null
+++ b/rt/sbin/rt-email-dashboards
@@ -0,0 +1,173 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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;
+ }
+
+}
+
+# Read in the options
+my %opts;
+use Getopt::Long;
+GetOptions( \%opts,
+ "help|h", "dryrun", "time=i", "epoch=i", "all"
+);
+
+if ($opts{'help'}) {
+ require Pod::Usage;
+ print Pod::Usage::pod2usage(-verbose => 2);
+ exit;
+}
+
+require RT;
+require RT::Interface::CLI;
+RT::Interface::CLI->import(qw{ CleanEnv loc });
+
+# Clean out all the nasties from the environment
+CleanEnv();
+
+# Load the config file
+RT::LoadConfig();
+
+# Connect to the database and get RT::SystemUser and RT::Nobody loaded
+RT::Init();
+
+require RT::Dashboard::Mailer;
+RT::Dashboard::Mailer->MailDashboards(
+ All => $opts{all},
+ DryRun => $opts{dryrun},
+ Time => ($opts{time} || $opts{epoch} || time), # epoch is the old-style
+ Opts => \%opts,
+);
+
+=head1 NAME
+
+rt-email-dashboards - Send email dashboards
+
+=head1 SYNOPSIS
+
+ rt-email-dashboards [options]
+
+=head1 DESCRIPTION
+
+This tool will send users email based on how they have subscribed to
+dashboards. A dashboard is a set of saved searches, the subscription controls
+how often that dashboard is sent and how it's displayed.
+
+Each subscription has an hour, and possibly day of week or day of month. These
+are taken to be in the user's timezone if available, UTC otherwise.
+
+=head1 SETUP
+
+You'll need to have cron run this script every hour. Here's an example crontab
+entry to do this.
+
+ 0 * * * * /usr/bin/perl /opt/rt4/local/sbin/rt-email-dashboards
+
+This will run the script every hour on the hour. This may need some further
+tweaking to be run as the correct user.
+
+=head1 OPTIONS
+
+This tool supports a few options. Most are for debugging.
+
+=over 8
+
+=item -h
+
+=item --help
+
+Display this documentation
+
+=item --dryrun
+
+Figure out which dashboards would be sent, but don't actually generate or email
+any of them
+
+=item --time SECONDS
+
+Instead of using the current time to figure out which dashboards should be
+sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would
+be Oct 12 19:06:58 GMT 2007).
+
+=item --epoch SECONDS
+
+Back-compat for --time SECONDS.
+
+=item --all
+
+Ignore subscription frequency when considering each dashboard (should only be
+used with --dryrun for testing and debugging)
+
+=back
+
+=cut
+
diff --git a/rt/sbin/rt-email-digest b/rt/sbin/rt-email-digest
new file mode 100755
index 000000000..6efab1190
--- /dev/null
+++ b/rt/sbin/rt-email-digest
@@ -0,0 +1,380 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Date::Format qw( strftime );
+use Getopt::Long;
+use RT;
+use RT::Interface::CLI qw( CleanEnv loc );
+use RT::Interface::Email;
+
+CleanEnv();
+RT::LoadConfig();
+RT::Init();
+
+sub usage {
+ my ($error) = @_;
+ print loc("Usage:") . " $0 -m (daily|weekly) [--print] [--help]\n";
+ print loc(
+ "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.",
+ $0
+ ) . "\n";
+ print "\n\t-m, --mode\t"
+ . loc("Specify whether this is a daily or weekly run.") . "\n";
+ print "\t-p, --print\t"
+ . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent")
+ . "\n";
+ print "\t-v, --verbose\t" . loc("Give output even on messages successfully sent") . "\n";
+ print "\t-h, --help\t" . loc("Print this message") . "\n";
+
+ if ( $error eq 'help' ) {
+ exit 0;
+ } else {
+ print loc("Error") . ": " . loc($error) . "\n";
+ exit 1;
+ }
+}
+
+my ( $frequency, $print, $verbose, $help ) = ( '', '', '', '' );
+GetOptions(
+ 'mode=s' => \$frequency,
+ 'print' => \$print,
+ 'verbose' => \$verbose,
+ 'help' => \$help,
+);
+
+usage('help') if $help;
+usage("Mode argument must be 'daily' or 'weekly'")
+ unless $frequency =~ /^(daily|weekly)$/;
+
+run( $frequency, $print );
+
+sub run {
+ my $frequency = shift;
+ my $print = shift;
+
+## Find all the tickets that have been modified within the time frame
+## described by $frequency.
+
+ my ( $all_digest, $sent_transactions ) = find_transactions($frequency);
+
+## Iterate through our huge hash constructing the digest message
+## for each user and sending it.
+
+ foreach my $user ( keys %$all_digest ) {
+ my ( $contents_list, $contents_body ) = build_digest_for_user( $user, $all_digest->{$user} );
+ # Now we have a content head and a content body. We can send a message.
+ if ( send_digest( $user, $contents_list, $contents_body ) ) {
+ print "Sent message to $user\n" if $verbose;
+ mark_transactions_sent( $frequency, $user, values %{$sent_transactions->{$user}} ) unless ($print);
+ } else {
+ print "Failed to send message to $user\n";
+ }
+ }
+}
+exit 0;
+
+# Subroutines.
+
+sub send_digest {
+ my ( $to, $index, $messages ) = @_;
+
+ # Combine the index and the messages.
+
+ my $body = "============== Tickets with activity in the last "
+ . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
+
+ $body .= $index;
+ $body .= "\n\n============== Messages recorded in the last "
+ . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
+ $body .= $messages;
+
+ # Load our template. If we cannot load the template, abort
+ # immediately rather than failing through many loops.
+ my $digest_template = RT::Template->new( RT->SystemUser );
+ my ( $ret, $msg ) = $digest_template->Load('Email Digest');
+ unless ($ret) {
+ print loc("Failed to load template")
+ . " 'Email Digest': "
+ . $msg
+ . ". Cannot continue.\n";
+ exit 1;
+ }
+ ( $ret, $msg ) = $digest_template->Parse( Argument => $body );
+ unless ($ret) {
+ print loc("Failed to parse template")
+ . " 'Email Digest'. Cannot continue.\n";
+ exit 1;
+ }
+
+ # Set our sender and recipient.
+ $digest_template->MIMEObj->head->replace(
+ 'From', Encode::encode( "UTF-8", RT::Config->Get('CorrespondAddress') ) );
+ $digest_template->MIMEObj->head->replace(
+ 'To', Encode::encode( "UTF-8", $to ) );
+
+ if ($print) {
+ $digest_template->MIMEObj->print;
+ return 1;
+ } else {
+ return RT::Interface::Email::SendEmail( Entity => $digest_template->MIMEObj)
+ }
+}
+
+# =item mark_transactions_sent( $frequency, $user, @txn_list );
+#
+# Takes a frequency string (either 'daily' or 'weekly'), a user and one or more
+# transaction objects as its arguments. Marks the given deferred
+# notifications as sent.
+#
+# =cut
+
+sub mark_transactions_sent {
+ my ( $freq, $user, @txns ) = @_;
+ return unless $freq =~ /(daily|weekly)/;
+ return unless @txns;
+ foreach my $txn (@txns) {
+
+ # Grab the attribute, mark the "sent" as true, and store the new
+ # value.
+ if ( my $attr = $txn->FirstAttribute('DeferredRecipients') ) {
+ my $deferred = $attr->Content;
+ $deferred->{$freq}->{$user}->{'_sent'} = 1;
+ $txn->SetAttribute(
+ Name => 'DeferredRecipients',
+ Description => 'Deferred recipients for this message',
+ Content => $deferred,
+ );
+ }
+ }
+}
+
+sub since_date {
+ my $frequency = shift;
+
+ # Specify a short time for digest overlap, in case we aren't starting
+ # this process exactly on time.
+ my $OVERLAP_HEDGE = -30;
+
+ my $since_date = RT::Date->new( RT->SystemUser );
+ $since_date->Set( Format => 'unix', Value => time() );
+ if ( $frequency eq 'daily' ) {
+ $since_date->AddDays(-1);
+ } else {
+ $since_date->AddDays(-7);
+ }
+
+ $since_date->AddSeconds($OVERLAP_HEDGE);
+
+ return $since_date;
+}
+
+sub find_transactions {
+ my $frequency = shift;
+ my $since_date = since_date($frequency);
+
+ my $txns = RT::Transactions->new( RT->SystemUser );
+
+ # First limit to recent transactions.
+ $txns->Limit(
+ FIELD => 'Created',
+ OPERATOR => '>',
+ VALUE => $since_date->ISO
+ );
+
+ # Next limit to ticket transactions.
+ $txns->Limit(
+ FIELD => 'ObjectType',
+ OPERATOR => '=',
+ VALUE => 'RT::Ticket',
+ ENTRYAGGREGATOR => 'AND'
+ );
+ my $all_digest = {};
+ my $sent_transactions = {};
+
+ while ( my $txn = $txns->Next ) {
+ my $ticket = $txn->Ticket;
+ my $queue = $txn->TicketObj->QueueObj->Name;
+ # Xxx todo - may clobber if two queues have the same name
+ foreach my $user ( $txn->DeferredRecipients($frequency) ) {
+ $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn->ContentObj;
+ $sent_transactions->{$user}->{ $txn->id } = $txn;
+ }
+ }
+
+ return ( $all_digest, $sent_transactions );
+}
+
+sub build_digest_for_user {
+ my $user = shift;
+ my $user_digest = shift;
+
+ my $contents_list = ''; # Holds the digest index.
+ my $contents_body = ''; # Holds the digest body.
+
+ # Has the user been disabled since a message was deferred on his/her
+ # behalf?
+ my $user_obj = RT::User->new( RT->SystemUser );
+ $user_obj->LoadByEmail($user);
+ if ( $user_obj->PrincipalObj->Disabled ) {
+ print STDERR loc("Skipping disabled user") . " $user\n";
+ next;
+ }
+
+ print loc("Message for user") . " $user:\n\n" if $print;
+ foreach my $queue ( keys %$user_digest ) {
+ $contents_list .= "Queue $queue:\n";
+ $contents_body .= "Queue $queue:\n";
+ foreach my $ticket ( sort keys %{ $user_digest->{$queue} } ) {
+ my $tkt_txns = $user_digest->{$queue}->{$ticket};
+ my $ticket_obj = RT::Ticket->new( RT->SystemUser );
+ $ticket_obj->Load($ticket);
+
+ # Spit out the index entry for this ticket.
+ my $ticket_title = sprintf(
+ "#%d %s [%s]\t%s\n",
+ $ticket, $ticket_obj->Status, $ticket_obj->OwnerObj->Name,
+ $ticket_obj->Subject
+ );
+ $contents_list .= $ticket_title;
+
+ # Spit out the messages for the transactions on this ticket.
+ $contents_body .= "\n== $ticket_title\n";
+ foreach my $txn ( sort keys %$tkt_txns ) {
+ my $msg = $tkt_txns->{$txn};
+
+ # $msg contains an RT::Attachment with our outgoing
+ # message. Print a few headers for clarity's sake.
+ $contents_body .= "From: " . $msg->GetHeader('From') . "\n";
+ my $date = $msg->GetHeader('Date ');
+ unless ($date) {
+ my $txn_obj = RT::Transaction->new( RT->SystemUser );
+ $txn_obj->Load($txn);
+ my $date_obj = RT::Date->new( RT->SystemUser );
+ $date_obj->Set(
+ Format => 'sql',
+ Value => $txn_obj->Created
+ );
+ $date = strftime( '%a, %d %b %Y %H:%M:%S %z',
+ @{ [ localtime( $date_obj->Unix ) ] } );
+ }
+ $contents_body .= "Date: $date\n\n";
+ $contents_body .= $msg->Content . "\n";
+ $contents_body .= "-------\n";
+ } # foreach transaction
+ } # foreach ticket
+ } # foreach queue
+
+ return ( $contents_list, $contents_body );
+
+}
+
+__END__
+
+=head1 NAME
+
+rt-email-digest - dispatch deferred notifications as a per-user digest
+
+=head1 SYNOPSIS
+
+ rt-email-digest -m (daily|weekly) [--print] [--help]
+
+=head1 DESCRIPTION
+
+This script is a tool to dispatch all deferred RT notifications as a per-user
+object.
+
+=head1 OPTIONS
+
+=over
+
+=item mode
+
+Specify whether this is a daily or weekly run.
+
+--mode is equal to -m
+
+=item print
+
+Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent
+
+--print is equal to -p
+
+=item help
+
+Print this message
+
+--help is equal to -h
+
+=back
diff --git a/rt/sbin/rt-email-digest.in b/rt/sbin/rt-email-digest.in
index a535e3649..47cd8eb45 100644
--- a/rt/sbin/rt-email-digest.in
+++ b/rt/sbin/rt-email-digest.in
@@ -179,8 +179,10 @@ sub send_digest {
}
# Set our sender and recipient.
- $digest_template->MIMEObj->head->replace( 'From', RT::Config->Get('CorrespondAddress') );
- $digest_template->MIMEObj->head->replace( 'To', $to );
+ $digest_template->MIMEObj->head->replace(
+ 'From', Encode::encode( "UTF-8", RT::Config->Get('CorrespondAddress') ) );
+ $digest_template->MIMEObj->head->replace(
+ 'To', Encode::encode( "UTF-8", $to ) );
if ($print) {
$digest_template->MIMEObj->print;
diff --git a/rt/sbin/rt-email-group-admin b/rt/sbin/rt-email-group-admin
new file mode 100755
index 000000000..bfbdccd27
--- /dev/null
+++ b/rt/sbin/rt-email-group-admin
@@ -0,0 +1,527 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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-email-group-admin - Command line tool for administrating NotifyGroup actions
+
+=head1 SYNOPSIS
+
+ rt-email-group-admin --list
+ rt-email-group-admin --create 'Notify foo team' --group Foo
+ rt-email-group-admin --create 'Notify foo team as comment' --comment --group Foo
+ rt-email-group-admin --create 'Notify group Foo and Bar' --group Foo --group Bar
+ rt-email-group-admin --create 'Notify user foo@bar.com' --user foo@bar.com
+ rt-email-group-admin --create 'Notify VIPs' --user vip1@bar.com
+ rt-email-group-admin --add 'Notify VIPs' --user vip2@bar.com --group vip1 --user vip3@foo.com
+ rt-email-group-admin --rename 'Notify VIPs' --newname 'Inform VIPs'
+ rt-email-group-admin --switch 'Notify VIPs'
+ rt-email-group-admin --delete 'Notify user foo@bar.com'
+
+=head1 DESCRIPTION
+
+This script list, create, modify or delete scrip actions in the RT DB. Once
+you've created an action you can use it in a scrip.
+
+For example you can create the following action using this script:
+
+ rt-email-group-admin --create 'Notify developers' --group 'Development Team'
+
+Then you can add the followoing scrip to your Bugs queue:
+
+ Condition: On Create
+ Action: Notify developers
+ Template: Transaction
+ Stage: TransactionCreate
+
+Your development team will be notified on every new ticket in the queue.
+
+=cut
+
+use warnings;
+use strict;
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long qw(GetOptions);
+Getopt::Long::Configure( "pass_through" );
+
+our $cmd = 'usage';
+our $opts = {};
+
+sub parse_args {
+ my $tmp;
+ if ( GetOptions( 'list' => \$tmp ) && $tmp ) {
+ $cmd = 'list';
+ }
+ elsif ( GetOptions( 'create=s' => \$tmp ) && $tmp ) {
+ $cmd = 'create';
+ $opts->{'name'} = $tmp;
+ $opts->{'groups'} = [];
+ $opts->{'users'} = [];
+ GetOptions( 'comment' => \$opts->{'comment'} );
+ GetOptions( 'group:s@' => $opts->{'groups'} );
+ GetOptions( 'user:s@' => $opts->{'users'} );
+ unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) {
+ usage();
+ exit(-1);
+ }
+ }
+ elsif ( GetOptions( 'add=s' => \$tmp ) && $tmp ) {
+ $cmd = 'add';
+ $opts->{'name'} = $tmp;
+ $opts->{'groups'} = [];
+ $opts->{'users'} = [];
+ GetOptions( 'group:s@' => $opts->{'groups'} );
+ GetOptions( 'user:s@' => $opts->{'users'} );
+ unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) {
+ usage();
+ exit(-1);
+ }
+ }
+ elsif ( GetOptions( 'switch=s' => \$tmp ) && $tmp ) {
+ $cmd = 'switch';
+ $opts->{'name'} = $tmp;
+ }
+ elsif ( GetOptions( 'rename=s' => \$tmp ) && $tmp ) {
+ $cmd = 'rename';
+ $opts->{'name'} = $tmp;
+ GetOptions( 'newname=s' => \$opts->{'newname'} );
+ unless ( $opts->{'newname'} ) {
+ usage();
+ exit(-1);
+ }
+ }
+ elsif ( GetOptions( 'delete=s' => \$tmp ) && $tmp) {
+ $cmd = 'delete';
+ $opts->{'name'} = $tmp;
+ } else {
+ $cmd = 'usage';
+ }
+
+ return;
+}
+
+sub usage {
+ require Pod::Usage;
+ Pod::Usage::pod2usage({ verbose => 2 });
+}
+
+my $help;
+if ( GetOptions( 'help|h' => \$help ) && $help ) {
+ usage();
+ exit;
+}
+
+parse_args();
+
+require RT;
+RT->LoadConfig;
+RT->Init;
+
+require RT::Principal;
+require RT::User;
+require RT::Group;
+require RT::ScripActions;
+
+
+{
+ eval "main::$cmd()";
+ if ( $@ ) {
+ print STDERR $@ ."\n";
+ }
+}
+
+exit(0);
+
+=head1 USAGE
+
+rt-email-group-admin --COMMAND ARGS
+
+=head1 COMMANDS
+
+=head2 list
+
+Lists actions and its descriptions.
+
+=cut
+
+sub list {
+ my $actions = _get_our_actions();
+ while( my $a = $actions->Next ) {
+ _list( $a );
+ }
+ return;
+}
+
+sub _list {
+ my $action = shift;
+
+ print "Name: ". $action->Name() ."\n";
+ print "Module: ". $action->ExecModule() ."\n";
+
+ my @princ = argument_to_list( $action );
+
+ print "Members: \n";
+ foreach( @princ ) {
+ my $obj = RT::Principal->new( RT->SystemUser );
+ $obj->Load( $_ );
+ next unless $obj->id;
+
+ print "\t". $obj->PrincipalType;
+ print "\t=> ". $obj->Object->Name;
+ print "(Disabled!!!)" if $obj->Disabled;
+ print "\n";
+ }
+ print "\n";
+ return;
+}
+
+=head2 create NAME [--comment] [--group GNAME] [--user NAME-OR-EMAIL]
+
+Creates new action with NAME and adds users and/or groups to its
+recipient list. Would be notify as comment if --comment specified. The
+user, if specified, will be autocreated if necessary.
+
+=cut
+
+sub create {
+ my $actions = RT::ScripActions->new( RT->SystemUser );
+ $actions->Limit(
+ FIELD => 'Name',
+ VALUE => $opts->{'name'},
+ );
+ if ( $actions->Count ) {
+ print STDERR "ScripAction '". $opts->{'name'} ."' allready exists\n";
+ exit(-1);
+ }
+
+ my @groups = _check_groups( @{ $opts->{'groups'} } );
+ my @users = _check_users( @{ $opts->{'users'} } );
+ unless ( @users + @groups ) {
+ print STDERR "List of groups and users is empty\n";
+ exit(-1);
+ }
+
+ my $action = __create_empty( $opts->{'name'}, $opts->{'comment'} );
+
+ __add( $action, $_ ) foreach( @users );
+ __add( $action, $_ ) foreach( @groups );
+
+ return;
+}
+
+sub __create_empty {
+ my $name = shift;
+ my $as_comment = shift || 0;
+ require RT::ScripAction;
+ my $action = RT::ScripAction->new( RT->SystemUser );
+ $action->Create(
+ Name => $name,
+ Description => "Created with rt-email-group-admin script",
+ ExecModule => $as_comment? 'NotifyGroupAsComment': 'NotifyGroup',
+ Argument => '',
+ );
+
+ return $action;
+}
+
+sub _check_groups
+{
+ return map {$_->[1]}
+ grep { $_->[1] ? 1: do { print STDERR "Group '$_->[0]' skipped, doesn't exist\n"; 0; } }
+ map { [$_, __check_group($_)] } @_;
+}
+
+sub __check_group
+{
+ my $instance = shift;
+ require RT::Group;
+ my $obj = RT::Group->new( RT->SystemUser );
+ $obj->LoadUserDefinedGroup( $instance );
+ return $obj->id ? $obj : undef;
+}
+
+sub _check_users
+{
+ return map {$_->[1]}
+ grep { $_->[1] ? 1: do { print STDERR "User '$_->[0]' skipped, doesn't exist and couldn't autocreate\n"; 0; } }
+ map { [$_, __check_user($_)] } @_;
+}
+
+sub __check_user
+{
+ my $instance = shift;
+ require RT::User;
+ my $obj = RT::User->new( RT->SystemUser );
+ $obj->Load( $instance );
+ $obj->LoadByEmail( $instance )
+ if not $obj->id and $instance =~ /@/;
+
+ unless ($obj->id) {
+ my ($ok, $msg) = $obj->Create(
+ Name => $instance,
+ EmailAddress => $instance,
+ Privileged => 0,
+ Comments => 'Autocreated when added to notify action via rt-email-group-admin',
+ );
+ print STDERR "Autocreate of user '$instance' failed: $msg\n"
+ unless $ok;
+ }
+
+ return $obj->id ? $obj : undef;
+}
+
+=head2 add NAME [--group GNAME] [--user NAME-OR-EMAIL]
+
+Adds groups and/or users to recipients of the action NAME. The user, if
+specified, will be autocreated if necessary.
+
+=cut
+
+sub add {
+ my $action = _get_action_by_name( $opts->{'name'} );
+ unless ( $action ) {
+ print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+ exit(-1);
+ }
+
+ my @groups = _check_groups( @{ $opts->{'groups'} } );
+ my @users = _check_users( @{ $opts->{'users'} } );
+
+ unless ( @users + @groups ) {
+ print STDERR "List of groups and users is empty\n";
+ exit(-1);
+ }
+
+ __add( $action, $_ ) foreach @users;
+ __add( $action, $_ ) foreach @groups;
+
+ return;
+}
+
+sub __add
+{
+ my $action = shift;
+ my $obj = shift;
+
+ my @cur = argument_to_list( $action );
+
+ my $id = $obj->id;
+ return if grep $_ == $id, @cur;
+
+ push @cur, $id;
+
+ return $action->__Set( Field => 'Argument', Value => join(',', @cur) );
+}
+
+=head2 delete NAME
+
+Deletes action NAME if scrips doesn't use it.
+
+=cut
+
+sub delete {
+ my $action = _get_action_by_name( $opts->{'name'} );
+ unless ( $action ) {
+ print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+ exit(-1);
+ }
+
+ require RT::Scrips;
+ my $scrips = RT::Scrips->new( RT->SystemUser );
+ $scrips->Limit( FIELD => 'ScripAction', VALUE => $action->id );
+ if ( $scrips->Count ) {
+ my @sid;
+ while( my $s = $scrips->Next ) {
+ push @sid, $s->id;
+ }
+ print STDERR "ScripAction '". $opts->{'name'} ."'"
+ . " is in use by Scrip(s) ". join( ", ", map "#$_", @sid )
+ . "\n";
+ exit(-1);
+ }
+
+ return __delete( $action );
+}
+
+sub __delete {
+ require DBIx::SearchBuilder::Record;
+ return DBIx::SearchBuilder::Record::Delete( shift );
+}
+
+sub _get_action_by_name {
+ my $name = shift;
+ my $actions = _get_our_actions();
+ $actions->Limit(
+ FIELD => 'Name',
+ VALUE => $name
+ );
+
+ if ( $actions->Count > 1 ) {
+ print STDERR "More then one ScripAction with name '$name'\n";
+ }
+
+ return $actions->First;
+}
+
+=head2 switch NAME
+
+Switch action NAME from notify as correspondence to comment and back.
+
+=cut
+
+sub switch {
+ my $action = _get_action_by_name( $opts->{'name'} );
+ unless ( $action ) {
+ print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+ exit(-1);
+ }
+
+ my %h = (
+ NotifyGroup => 'NotifyGroupAsComment',
+ NotifyGroupAsComment => 'NotifyGroup'
+ );
+
+ return $action->__Set(
+ Field => 'ExecModule',
+ Value => $h{ $action->ExecModule }
+ );
+}
+
+=head2 rename NAME --newname NEWNAME
+
+Renames action NAME to NEWNAME.
+
+=cut
+
+sub rename {
+ my $action = _get_action_by_name( $opts->{'name'} );
+ unless ( $action ) {
+ print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
+ exit(-1);
+ }
+
+ my $actions = RT::ScripActions->new( RT->SystemUser );
+ $actions->Limit( FIELD => 'Name', VALUE => $opts->{'newname'} );
+ if ( $actions->Count ) {
+ print STDERR "ScripAction '". $opts->{'newname'} ."' allready exists\n";
+ exit(-1);
+ }
+
+ return $action->__Set(
+ Field => 'Name',
+ Value => $opts->{'newname'},
+ );
+}
+
+=head2 NOTES
+
+If command has option --group or --user then you can use it more then once,
+if other is not specified.
+
+=cut
+
+###############
+#### Utils ####
+###############
+
+sub argument_to_list {
+ my $action = shift;
+ require RT::Action::NotifyGroup;
+ return RT::Action::NotifyGroup->__SplitArg( $action->Argument );
+}
+
+sub _get_our_actions {
+ my $actions = RT::ScripActions->new( RT->SystemUser );
+ $actions->Limit(
+ FIELD => 'ExecModule',
+ VALUE => 'NotifyGroup',
+ ENTRYAGGREGATOR => 'OR',
+ );
+ $actions->Limit(
+ FIELD => 'ExecModule',
+ VALUE => 'NotifyGroupAsComment',
+ ENTRYAGGREGATOR => 'OR',
+ );
+
+ return $actions;
+}
+
+=head1 AUTHOR
+
+Ruslan U. Zakirov E<lt>ruz@bestpractical.comE<gt>
+
+=head1 SEE ALSO
+
+L<RT::Action::NotifyGroup>, L<RT::Action::NotifyGroupAsComment>
+
+=cut
diff --git a/rt/sbin/rt-fulltext-indexer b/rt/sbin/rt-fulltext-indexer
new file mode 100755
index 000000000..cdcc78e15
--- /dev/null
+++ b/rt/sbin/rt-fulltext-indexer
@@ -0,0 +1,479 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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 'once';
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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;
+ }
+}
+
+BEGIN {
+ use RT;
+ RT::LoadConfig();
+ RT::Init();
+};
+use RT::Interface::CLI ();
+
+my %OPT = (
+ help => 0,
+ debug => 0,
+ quiet => 0,
+);
+my @OPT_LIST = qw(help|h! debug! quiet);
+
+my $db_type = RT->Config->Get('DatabaseType');
+if ( $db_type eq 'Pg' ) {
+ %OPT = (
+ %OPT,
+ limit => 0,
+ all => 0,
+ );
+ push @OPT_LIST, 'limit=i', 'all!';
+}
+elsif ( $db_type eq 'mysql' ) {
+ %OPT = (
+ %OPT,
+ limit => 0,
+ all => 0,
+ xmlpipe2 => 0,
+ );
+ push @OPT_LIST, 'limit=i', 'all!', 'xmlpipe2!';
+}
+elsif ( $db_type eq 'Oracle' ) {
+ %OPT = (
+ %OPT,
+ memory => '2M',
+ );
+ push @OPT_LIST, qw(memory=s);
+}
+
+use Getopt::Long qw(GetOptions);
+GetOptions( \%OPT, @OPT_LIST );
+
+if ( $OPT{'help'} ) {
+ RT::Interface::CLI->ShowHelp(
+ Sections => 'NAME|DESCRIPTION|'. uc($db_type),
+ );
+}
+
+use Fcntl ':flock';
+if ( !flock main::DATA, LOCK_EX | LOCK_NB ) {
+ if ( $OPT{quiet} ) {
+ RT::Logger->info("$0 is already running; aborting silently, as requested");
+ exit;
+ }
+ else {
+ print STDERR "$0 is already running\n";
+ exit 1;
+ }
+}
+
+my $fts_config = RT->Config->Get('FullTextSearch') || {};
+unless ( $fts_config->{'Enable'} ) {
+ print STDERR <<EOT;
+
+Full text search is disabled in your RT configuration. Run
+/opt/rt3/sbin/rt-setup-fulltext-index to configure and enable it.
+
+EOT
+ exit 1;
+}
+unless ( $fts_config->{'Indexed'} ) {
+ print STDERR <<EOT;
+
+Full text search is enabled in your RT configuration, but not with any
+full-text database indexing -- hence this tool is not required. Read
+the documentation for %FullTextSearch in your RT_Config for more details.
+
+EOT
+ exit 1;
+}
+
+if ( $db_type eq 'Oracle' ) {
+ my $index = $fts_config->{'IndexName'} || 'rt_fts_index';
+ $RT::Handle->dbh->do(
+ "begin ctx_ddl.sync_index(?, ?); end;", undef,
+ $index, $OPT{'memory'}
+ );
+ exit;
+} elsif ( $db_type eq 'mysql' ) {
+ unless ($OPT{'xmlpipe2'}) {
+ print STDERR <<EOT;
+
+Updates to the external Sphinx index are done via running the sphinx
+`indexer` tool:
+
+ indexer rt
+
+EOT
+ exit 1;
+ }
+}
+
+my @types = qw(text html);
+foreach my $type ( @types ) {
+ REDO:
+ my $attachments = attachments($type);
+ $attachments->Limit(
+ FIELD => 'id',
+ OPERATOR => '>',
+ VALUE => last_indexed($type)
+ );
+ $attachments->OrderBy( FIELD => 'id', ORDER => 'asc' );
+ $attachments->RowsPerPage( $OPT{'limit'} || 100 );
+
+ my $found = 0;
+ while ( my $a = $attachments->Next ) {
+ next if filter( $type, $a );
+ debug("Found attachment #". $a->id );
+ my $txt = extract($type, $a) or next;
+ $found++;
+ process( $type, $a, $txt );
+ debug("Processed attachment #". $a->id );
+ }
+ finalize( $type, $attachments ) if $found;
+ clean( $type );
+ goto REDO if $OPT{'all'} and $attachments->Count == ($OPT{'limit'} || 100)
+}
+
+sub attachments {
+ my $type = shift;
+ my $res = RT::Attachments->new( RT->SystemUser );
+ my $txn_alias = $res->Join(
+ ALIAS1 => 'main',
+ FIELD1 => 'TransactionId',
+ TABLE2 => 'Transactions',
+ FIELD2 => 'id',
+ );
+ $res->Limit(
+ ALIAS => $txn_alias,
+ FIELD => 'ObjectType',
+ VALUE => 'RT::Ticket',
+ );
+ my $ticket_alias = $res->Join(
+ ALIAS1 => $txn_alias,
+ FIELD1 => 'ObjectId',
+ TABLE2 => 'Tickets',
+ FIELD2 => 'id',
+ );
+ $res->Limit(
+ ALIAS => $ticket_alias,
+ FIELD => 'Status',
+ OPERATOR => '!=',
+ VALUE => 'deleted'
+ );
+
+ # On newer DBIx::SearchBuilder's, indicate that making the query DISTINCT
+ # is unnecessary because the joins won't produce duplicates. This
+ # drastically improves performance when fetching attachments.
+ $res->{joins_are_distinct} = 1;
+
+ return goto_specific(
+ suffix => $type,
+ error => "Don't know how to find $type attachments",
+ arguments => [$res],
+ );
+}
+
+sub last_indexed {
+ my ($type) = (@_);
+ return goto_specific(
+ suffix => $db_type,
+ error => "Don't know how to find last indexed $type attachment for $db_type DB",
+ arguments => \@_,
+ );
+}
+
+sub filter {
+ my $type = shift;
+ return goto_specific(
+ suffix => $type,
+ arguments => \@_,
+ );
+}
+
+sub extract {
+ my $type = shift;
+ return goto_specific(
+ suffix => $type,
+ error => "No way to convert $type attachment into text",
+ arguments => \@_,
+ );
+}
+
+sub process {
+ return goto_specific(
+ suffix => $db_type,
+ error => "No processer for $db_type DB",
+ arguments => \@_,
+ );
+}
+
+sub finalize {
+ return goto_specific(
+ suffix => $db_type,
+ arguments => \@_,
+ );
+}
+
+sub clean {
+ return goto_specific(
+ suffix => $db_type,
+ arguments => \@_,
+ );
+}
+
+{
+sub last_indexed_mysql {
+ my $type = shift;
+ my $attr = $RT::System->FirstAttribute('LastIndexedAttachments');
+ return 0 unless $attr;
+ return 0 unless exists $attr->{ $type };
+ return $attr->{ $type } || 0;
+}
+
+sub process_mysql {
+ my ($type, $attachment, $text) = (@_);
+
+ my $doc = sphinx_template();
+
+ my $element = $doc->createElement('sphinx:document');
+ $element->setAttribute( id => $attachment->id );
+ $element->appendTextChild( content => $$text );
+
+ $doc->documentElement->appendChild( $element );
+}
+
+my $doc = undef;
+sub sphinx_template {
+ return $doc if $doc;
+
+ require XML::LibXML;
+ $doc = XML::LibXML::Document->new('1.0', 'UTF-8');
+ my $root = $doc->createElement('sphinx:docset');
+ $doc->setDocumentElement( $root );
+
+ my $schema = $doc->createElement('sphinx:schema');
+ $root->appendChild( $schema );
+ foreach ( qw(content) ) {
+ my $field = $doc->createElement('sphinx:field');
+ $field->setAttribute( name => $_ );
+ $schema->appendChild( $field );
+ }
+
+ return $doc;
+}
+
+sub finalize_mysql {
+ my ($type, $attachments) = @_;
+ sphinx_template()->toFH(*STDOUT, 1);
+}
+
+sub clean_mysql {
+ $doc = undef;
+}
+
+}
+
+sub last_indexed_pg {
+ my $type = shift;
+ my $attachments = attachments( $type );
+ my $alias = 'main';
+ if ( $fts_config->{'Table'} && $fts_config->{'Table'} ne 'Attachments' ) {
+ $alias = $attachments->Join(
+ TYPE => 'left',
+ FIELD1 => 'id',
+ TABLE2 => $fts_config->{'Table'},
+ FIELD2 => 'id',
+ );
+ }
+ $attachments->Limit(
+ ALIAS => $alias,
+ FIELD => $fts_config->{'Column'},
+ OPERATOR => 'IS NOT',
+ VALUE => 'NULL',
+ );
+ $attachments->OrderBy( FIELD => 'id', ORDER => 'desc' );
+ $attachments->RowsPerPage( 1 );
+ my $res = $attachments->First;
+ return 0 unless $res;
+ return $res->id;
+}
+
+sub process_pg {
+ my ($type, $attachment, $text) = (@_);
+
+ my $dbh = $RT::Handle->dbh;
+ my $table = $fts_config->{'Table'};
+ my $column = $fts_config->{'Column'};
+
+ my $query;
+ if ( $table ) {
+ if ( my ($id) = $dbh->selectrow_array("SELECT id FROM $table WHERE id = ?", undef, $attachment->id) ) {
+ $query = "UPDATE $table SET $column = to_tsvector(?) WHERE id = ?";
+ } else {
+ $query = "INSERT INTO $table($column, id) VALUES(to_tsvector(?), ?)";
+ }
+ } else {
+ $query = "UPDATE Attachments SET $column = to_tsvector(?) WHERE id = ?";
+ }
+
+ my $status = eval { $dbh->do( $query, undef, $$text, $attachment->id ) };
+ unless ( $status ) {
+ if ( $dbh->err == 7 && $dbh->state eq '54000' ) {
+ warn "Attachment @{[$attachment->id]} cannot be indexed. Most probably it contains too many unique words. Error: ". $dbh->errstr;
+ } elsif ( $dbh->err == 7 && $dbh->state eq '22021' ) {
+ warn "Attachment @{[$attachment->id]} cannot be indexed. Most probably it contains invalid UTF8 bytes. Error: ". $dbh->errstr;
+ } else {
+ die "error: ". $dbh->errstr;
+ }
+
+ # Insert an empty tsvector, so we count this row as "indexed"
+ # for purposes of knowing where to pick up
+ eval { $dbh->do( $query, undef, "", $attachment->id ) }
+ or die "Failed to insert empty tsvector: " . $dbh->errstr;
+ }
+}
+
+sub attachments_text {
+ my $res = shift;
+ $res->Limit( FIELD => 'ContentType', VALUE => 'text/plain' );
+ return $res;
+}
+
+sub extract_text {
+ my $attachment = shift;
+ my $text = $attachment->Content;
+ return undef unless defined $text && length($text);
+ return \$text;
+}
+
+sub attachments_html {
+ my $res = shift;
+ $res->Limit( FIELD => 'ContentType', VALUE => 'text/html' );
+ return $res;
+}
+
+sub filter_html {
+ my $attachment = shift;
+ if ( my $parent = $attachment->ParentObj ) {
+# skip html parts that are alternatives
+ return 1 if $parent->id
+ && $parent->ContentType eq 'mulitpart/alternative';
+ }
+ return 0;
+}
+
+sub extract_html {
+ my $attachment = shift;
+ my $text = $attachment->Content;
+ return undef unless defined $text && length($text);
+# TODO: html -> text
+ return \$text;
+}
+
+sub goto_specific {
+ my %args = (@_);
+
+ my $func = (caller(1))[3];
+ $func =~ s/.*:://;
+ my $call = $func ."_". lc $args{'suffix'};
+ unless ( defined &$call ) {
+ return undef unless $args{'error'};
+ require Carp; Carp::croak( $args{'error'} );
+ }
+ @_ = @{ $args{'arguments'} };
+ goto &$call;
+}
+
+
+# helper functions
+sub debug { print @_, "\n" if $OPT{debug}; 1 }
+sub error { $RT::Logger->error(_(@_)); 1 }
+sub warning { $RT::Logger->warn(_(@_)); 1 }
+
+=head1 NAME
+
+rt-fulltext-indexer - Indexer for full text search
+
+=head1 DESCRIPTION
+
+This is a helper script to keep full text indexes in sync with data.
+Read F<docs/full_text_indexing.pod> for complete details on how and when
+to run it.
+
+=head1 AUTHOR
+
+Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>,
+Alex Vandiver E<lt>alexmv@bestpractical.comE<gt>
+
+=cut
+
+__DATA__
diff --git a/rt/sbin/rt-preferences-viewer b/rt/sbin/rt-preferences-viewer
new file mode 100755
index 000000000..e9d6ce337
--- /dev/null
+++ b/rt/sbin/rt-preferences-viewer
@@ -0,0 +1,149 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+my %opt;
+GetOptions( \%opt, 'help|h', 'user|u=s', 'option|o=s' );
+
+if ( $opt{help} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage({ verbose => 2 });
+ exit;
+}
+
+require RT;
+RT::LoadConfig();
+RT::Init();
+
+require RT::Attributes;
+my $attrs = RT::Attributes->new( RT->SystemUser );
+$attrs->Limit( FIELD => 'Name', VALUE => 'Pref-RT::System-1' );
+$attrs->Limit( FIELD => 'ObjectType', VALUE => 'RT::User' );
+
+if ($opt{user}) {
+ my $user = RT::User->new( RT->SystemUser );
+ my ($val, $msg) = $user->Load($opt{user});
+ unless ($val) {
+ RT->Logger->error("Unable to load $opt{user}: $msg");
+ exit(1);
+ }
+ $attrs->Limit( FIELD => 'ObjectId', VALUE => $user->Id );
+}
+
+use Data::Dumper;
+$Data::Dumper::Terse = 1;
+
+while (my $attr = $attrs->Next ) {
+ my $user = RT::User->new( RT->SystemUser );
+ my ($val, $msg) = $user->Load($attr->ObjectId);
+ unless ($val) {
+ RT->Logger->warn("Unable to load User ".$attr->ObjectId." $msg");
+ next;
+ }
+ next if $user->Disabled;
+
+ my $content = $attr->Content;
+ if ( my $config_name = $opt{option} ) {
+ if ( exists $content->{$config_name} ) {
+ my $setting = $content->{$config_name};
+ print $user->Name, "\t$config_name: $setting\n";
+ }
+ } else {
+ print $user->Name, " => ", Dumper($content);
+ }
+
+}
+
+__END__
+
+=head1 NAME
+
+rt-preferences-viewer - show user defined preferences
+
+=head1 SYNOPSIS
+
+ rt-preferences-viewer
+
+ rt-preferences-viewer --user=falcone
+ show only the falcone user's preferences
+
+ rt-preferences-viewer --option=EmailFrequency
+ show users who have set the EmailFrequence config option
+
+=head1 DESCRIPTION
+
+This script shows user settings of preferences. If a user is using the system
+default, it will not be listed. You can limit to a user name or id or to users
+with a particular option set.
diff --git a/rt/sbin/rt-server b/rt/sbin/rt-server
new file mode 100755
index 000000000..c451a7370
--- /dev/null
+++ b/rt/sbin/rt-server
@@ -0,0 +1,285 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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 {
+ die <<EOT if ${^TAINT};
+RT does not run under Perl's "taint mode". Remove -T from the command
+line, or remove the PerlTaintCheck parameter from your mod_perl
+configuration.
+EOT
+
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+no warnings 'once';
+
+if (grep { m/help/ } @ARGV) {
+ require Pod::Usage;
+ print Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+require RT;
+RT->LoadConfig();
+RT->InitPluginPaths();
+RT->InitLogging();
+require Module::Refresh if RT->Config->Get('DevelMode');
+
+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->Init( Heavy => 1 );
+
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post');
+ unless ( $status ) {
+ print STDERR $msg, "\n\n";
+ exit -1;
+ }
+}
+
+# we must disconnect DB before fork
+if ($RT::Handle) {
+ $RT::Handle->dbh->disconnect if $RT::Handle->dbh;
+ $RT::Handle->dbh(undef);
+ undef $RT::Handle;
+}
+
+require RT::Interface::Web::Handler;
+my $app = RT::Interface::Web::Handler->PSGIApp;
+
+if ($ENV{RT_TESTING}) {
+ my $screen_logger = $RT::Logger->remove('screen');
+ require Log::Dispatch::Perl;
+ $RT::Logger->add(
+ Log::Dispatch::Perl->new(
+ name => 'rttest',
+ min_level => $screen_logger->min_level,
+ action => {
+ error => 'warn',
+ critical => 'warn'
+ }
+ )
+ );
+ require Plack::Middleware::Test::StashWarnings;
+ $app = Plack::Middleware::Test::StashWarnings->wrap($app);
+}
+
+# when used as a psgi file
+if (caller) {
+ return $app;
+}
+
+
+# load appropriate server
+
+require Plack::Runner;
+
+my $is_fastcgi = $0 =~ m/fcgi$/;
+my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
+ $is_fastcgi ? ( server => 'FCGI' )
+ : (),
+ env => 'deployment' );
+
+# figure out the port
+my $port;
+
+# handle "rt-server 8888" for back-compat, but complain about it
+if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) {
+ warn "Deprecated: please run $0 --port $ARGV[0] instead\n";
+ unshift @ARGV, '--port';
+}
+
+my @args = @ARGV;
+
+use List::MoreUtils 'last_index';
+my $last_index = last_index { $_ eq '--port' } @args;
+
+my $explicit_port;
+
+if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) {
+ $explicit_port = $args[$last_index+1];
+ $port = $explicit_port;
+
+ # inform the rest of the system what port we manually chose
+ my $old_app = $app;
+ $app = sub {
+ my $env = shift;
+
+ $env->{'rt.explicit_port'} = $port;
+
+ $old_app->($env, @_);
+ };
+}
+else {
+ # default to the configured WebPort and inform Plack::Runner
+ $port = RT->Config->Get('WebPort') || '8080';
+ push @args, '--port', $port;
+}
+
+push @args, '--server', 'Standalone' if RT->InstallMode;
+push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args;
+
+$r->parse_options(@args);
+
+delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything
+
+unless ($r->{env} eq 'development') {
+ push @{$r->{options}}, server_ready => sub {
+ my($args) = @_;
+ my $name = $args->{server_software} || ref($args); # $args is $server
+ my $host = $args->{host} || 0;
+ my $proto = $args->{proto} || 'http';
+ print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n";
+ };
+}
+eval { $r->run($app) };
+if (my $err = $@) {
+ handle_startup_error($err);
+}
+
+exit 0;
+
+sub handle_startup_error {
+ my $err = shift;
+ if ( $err =~ /listen/ ) {
+ 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 the port is already in use or you're running @{[$0]}
+as someone other than your system's "root" user. You may also specify a
+temporary port with: $0 --port <port>
+EOF
+
+ if ($explicit_port) {
+ print STDERR
+ "Please check your system configuration or choose another port\n\n";
+ }
+}
+
+__END__
+
+=head1 NAME
+
+rt-server - RT standalone server
+
+=head1 SYNOPSIS
+
+ # runs prefork server listening on port 8080, requires Starlet
+ rt-server --port 8080
+
+ # runs server listening on port 8080
+ rt-server --server Standalone --port 8080
+ # or
+ standalone_httpd --port 8080
+
+ # runs other PSGI server on port 8080
+ rt-server --server Starman --port 8080
diff --git a/rt/sbin/rt-server.fcgi b/rt/sbin/rt-server.fcgi
new file mode 100755
index 000000000..c451a7370
--- /dev/null
+++ b/rt/sbin/rt-server.fcgi
@@ -0,0 +1,285 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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 {
+ die <<EOT if ${^TAINT};
+RT does not run under Perl's "taint mode". Remove -T from the command
+line, or remove the PerlTaintCheck parameter from your mod_perl
+configuration.
+EOT
+
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+no warnings 'once';
+
+if (grep { m/help/ } @ARGV) {
+ require Pod::Usage;
+ print Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+require RT;
+RT->LoadConfig();
+RT->InitPluginPaths();
+RT->InitLogging();
+require Module::Refresh if RT->Config->Get('DevelMode');
+
+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->Init( Heavy => 1 );
+
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post');
+ unless ( $status ) {
+ print STDERR $msg, "\n\n";
+ exit -1;
+ }
+}
+
+# we must disconnect DB before fork
+if ($RT::Handle) {
+ $RT::Handle->dbh->disconnect if $RT::Handle->dbh;
+ $RT::Handle->dbh(undef);
+ undef $RT::Handle;
+}
+
+require RT::Interface::Web::Handler;
+my $app = RT::Interface::Web::Handler->PSGIApp;
+
+if ($ENV{RT_TESTING}) {
+ my $screen_logger = $RT::Logger->remove('screen');
+ require Log::Dispatch::Perl;
+ $RT::Logger->add(
+ Log::Dispatch::Perl->new(
+ name => 'rttest',
+ min_level => $screen_logger->min_level,
+ action => {
+ error => 'warn',
+ critical => 'warn'
+ }
+ )
+ );
+ require Plack::Middleware::Test::StashWarnings;
+ $app = Plack::Middleware::Test::StashWarnings->wrap($app);
+}
+
+# when used as a psgi file
+if (caller) {
+ return $app;
+}
+
+
+# load appropriate server
+
+require Plack::Runner;
+
+my $is_fastcgi = $0 =~ m/fcgi$/;
+my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
+ $is_fastcgi ? ( server => 'FCGI' )
+ : (),
+ env => 'deployment' );
+
+# figure out the port
+my $port;
+
+# handle "rt-server 8888" for back-compat, but complain about it
+if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) {
+ warn "Deprecated: please run $0 --port $ARGV[0] instead\n";
+ unshift @ARGV, '--port';
+}
+
+my @args = @ARGV;
+
+use List::MoreUtils 'last_index';
+my $last_index = last_index { $_ eq '--port' } @args;
+
+my $explicit_port;
+
+if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) {
+ $explicit_port = $args[$last_index+1];
+ $port = $explicit_port;
+
+ # inform the rest of the system what port we manually chose
+ my $old_app = $app;
+ $app = sub {
+ my $env = shift;
+
+ $env->{'rt.explicit_port'} = $port;
+
+ $old_app->($env, @_);
+ };
+}
+else {
+ # default to the configured WebPort and inform Plack::Runner
+ $port = RT->Config->Get('WebPort') || '8080';
+ push @args, '--port', $port;
+}
+
+push @args, '--server', 'Standalone' if RT->InstallMode;
+push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args;
+
+$r->parse_options(@args);
+
+delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything
+
+unless ($r->{env} eq 'development') {
+ push @{$r->{options}}, server_ready => sub {
+ my($args) = @_;
+ my $name = $args->{server_software} || ref($args); # $args is $server
+ my $host = $args->{host} || 0;
+ my $proto = $args->{proto} || 'http';
+ print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n";
+ };
+}
+eval { $r->run($app) };
+if (my $err = $@) {
+ handle_startup_error($err);
+}
+
+exit 0;
+
+sub handle_startup_error {
+ my $err = shift;
+ if ( $err =~ /listen/ ) {
+ 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 the port is already in use or you're running @{[$0]}
+as someone other than your system's "root" user. You may also specify a
+temporary port with: $0 --port <port>
+EOF
+
+ if ($explicit_port) {
+ print STDERR
+ "Please check your system configuration or choose another port\n\n";
+ }
+}
+
+__END__
+
+=head1 NAME
+
+rt-server - RT standalone server
+
+=head1 SYNOPSIS
+
+ # runs prefork server listening on port 8080, requires Starlet
+ rt-server --port 8080
+
+ # runs server listening on port 8080
+ rt-server --server Standalone --port 8080
+ # or
+ standalone_httpd --port 8080
+
+ # runs other PSGI server on port 8080
+ rt-server --server Starman --port 8080
diff --git a/rt/sbin/rt-session-viewer b/rt/sbin/rt-session-viewer
new file mode 100755
index 000000000..0f6c4e420
--- /dev/null
+++ b/rt/sbin/rt-session-viewer
@@ -0,0 +1,121 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+# <jesse@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+my %opt;
+GetOptions( \%opt, 'help|h', );
+
+my $session_id = shift;
+
+if ( $opt{help} || !$session_id ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage({ verbose => 2 });
+ exit;
+}
+
+require RT;
+RT::LoadConfig();
+RT::Init();
+
+require RT::Interface::Web::Session;
+my %session;
+
+tie %session, 'RT::Interface::Web::Session', $session_id;
+unless ( $session{'_session_id'} eq $session_id ) {
+ print STDERR "Couldn't load session $session_id\n";
+ exit 1;
+}
+
+use Data::Dumper;
+print "Content of session $session_id: ". Dumper( \%session);
+
+__END__
+
+=head1 NAME
+
+rt-session-viewer - show the content of a user's session
+
+=head1 SYNOPSIS
+
+ # show the content of a session
+ rt-session-viewer 2c21c8a2909c14eff12975dd2cc7b9a3
+
+=head1 DESCRIPTION
+
+This script deserializes and print content of a session identified
+by <session id>. May be useful for developers and for troubleshooting
+problems.
+
+=cut
diff --git a/rt/sbin/rt-setup-database b/rt/sbin/rt-setup-database
new file mode 100755
index 000000000..5d7f21cef
--- /dev/null
+++ b/rt/sbin/rt-setup-database
@@ -0,0 +1,609 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+
+use vars qw($Nobody $SystemUser $item);
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Term::ReadKey;
+use Getopt::Long;
+
+$| = 1; # unbuffer all output.
+
+my %args = (
+ dba => 'freeside',
+ package => 'RT',
+);
+GetOptions(
+ \%args,
+ 'action=s',
+ 'force', 'debug',
+ 'dba=s', 'dba-password=s', 'prompt-for-dba-password', 'package=s',
+ 'datafile=s', 'datadir=s', 'skip-create', 'root-password-file=s',
+ 'upgrade-from=s', 'upgrade-to=s',
+ 'help|h',
+);
+
+no warnings 'once';
+if ( $args{help} || ! $args{'action'} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage({ verbose => 2 });
+ exit;
+}
+
+require RT;
+RT->LoadConfig();
+RT->InitClasses();
+
+# Force warnings to be output to STDERR if we're not already logging
+# them at a higher level
+RT->Config->Set( LogToScreen => 'warning')
+ unless ( RT->Config->Get( 'LogToScreen' )
+ && RT->Config->Get( 'LogToScreen' ) =~ /^(debug|info|notice)$/ );
+
+# get customized root password
+my $root_password;
+if ( $args{'root-password-file'} ) {
+ open( my $fh, '<', $args{'root-password-file'} )
+ or die "Couldn't open 'args{'root-password-file'}' for reading: $!";
+ $root_password = <$fh>;
+ chomp $root_password;
+ my $min_length = RT->Config->Get('MinimumPasswordLength');
+ if ($min_length) {
+ die
+"password needs to be at least $min_length long, please check file '$args{'root-password-file'}'"
+ if length $root_password < $min_length;
+ }
+ close $fh;
+}
+
+
+# check and setup @actions
+my @actions = grep $_, split /,/, $args{'action'};
+if ( @actions > 1 && $args{'datafile'} ) {
+ print STDERR "You can not use --datafile option with multiple actions.\n";
+ exit(-1);
+}
+foreach ( @actions ) {
+ unless ( /^(?:init|create|drop|schema|acl|coredata|insert|upgrade)$/ ) {
+ print STDERR "$0 called with an invalid --action parameter.\n";
+ exit(-1);
+ }
+ if ( /^(?:init|drop|upgrade)$/ && @actions > 1 ) {
+ print STDERR "You can not mix init, drop or upgrade action with any action.\n";
+ exit(-1);
+ }
+}
+
+# convert init to multiple actions
+my $init = 0;
+if ( $actions[0] eq 'init' ) {
+ if ($args{'skip-create'}) {
+ @actions = qw(schema coredata insert);
+ } else {
+ @actions = qw(create schema acl coredata insert);
+ }
+ $init = 1;
+}
+
+# set options from environment
+foreach my $key(qw(Type Host Name User Password)) {
+ next unless exists $ENV{ 'RT_DB_'. uc $key };
+ print "Using Database$key from RT_DB_". uc($key) ." environment variable.\n";
+ RT->Config->Set( "Database$key", $ENV{ 'RT_DB_'. uc $key });
+}
+
+my $db_type = RT->Config->Get('DatabaseType') || '';
+my $db_host = RT->Config->Get('DatabaseHost') || '';
+my $db_port = RT->Config->Get('DatabasePort') || '';
+my $db_name = RT->Config->Get('DatabaseName') || '';
+my $db_user = RT->Config->Get('DatabaseUser') || '';
+my $db_pass = RT->Config->Get('DatabasePassword') || '';
+
+# load it here to get error immidiatly if DB type is not supported
+require RT::Handle;
+
+if ( $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name) ) {
+ $db_name = File::Spec->catfile($RT::VarPath, $db_name);
+ RT->Config->Set( DatabaseName => $db_name );
+}
+
+my $dba_user = $args{'dba'} || $ENV{'RT_DBA_USER'} || $db_user || '';
+my $dba_pass = exists($args{'dba-password'})
+ ? $args{'dba-password'}
+ : $ENV{'RT_DBA_PASSWORD'};
+
+if ($args{'skip-create'}) {
+ $dba_user = $db_user;
+ $dba_pass = $db_pass;
+} else {
+ if ( !$args{force} && ( !defined $dba_pass || $args{'prompt-for-dba-password'} ) ) {
+ $dba_pass = get_dba_password();
+ chomp $dba_pass if defined($dba_pass);
+ }
+}
+
+my $version_word_regex = join '|', RT::Handle->version_words;
+my $version_dir = qr/^\d+\.\d+\.\d+(?:$version_word_regex)?\d*$/;
+
+print "Working with:\n"
+ ."Type:\t$db_type\nHost:\t$db_host\nPort:\t$db_port\nName:\t$db_name\n"
+ ."User:\t$db_user\nDBA:\t$dba_user" . ($args{'skip-create'} ? ' (No DBA)' : '') . "\n";
+
+foreach my $action ( @actions ) {
+ no strict 'refs';
+ my ($status, $msg) = *{ 'action_'. $action }{'CODE'}->( %args );
+ error($action, $msg) unless $status;
+ print $msg .".\n" if $msg;
+ print "Done.\n";
+}
+
+sub action_create {
+ my %args = @_;
+ my $dbh = get_system_dbh();
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'create' );
+ return ($status, $msg) unless $status;
+
+ print "Now creating a $db_type database $db_name for RT.\n";
+ return RT::Handle->CreateDatabase( $dbh );
+}
+
+sub action_drop {
+ my %args = @_;
+
+ print "Dropping $db_type database $db_name.\n";
+ unless ( $args{'force'} ) {
+ print <<END;
+
+About to drop $db_type database $db_name on $db_host (port '$db_port').
+WARNING: This will erase all data in $db_name.
+
+END
+ exit(-2) unless _yesno();
+ }
+
+ my $dbh = get_system_dbh();
+ return RT::Handle->DropDatabase( $dbh );
+}
+
+sub action_schema {
+ my %args = @_;
+ my $dbh = get_admin_dbh();
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'schema' );
+ return ($status, $msg) unless $status;
+
+ print "Now populating database schema.\n";
+ return RT::Handle->InsertSchema( $dbh, $args{'datafile'} || $args{'datadir'} );
+}
+
+sub action_acl {
+ my %args = @_;
+ my $dbh = get_admin_dbh();
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'acl' );
+ return ($status, $msg) unless $status;
+
+ print "Now inserting database ACLs.\n";
+ return RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} );
+}
+
+sub action_coredata {
+ my %args = @_;
+ $RT::Handle = RT::Handle->new;
+ $RT::Handle->dbh( undef );
+ RT::ConnectToDatabase();
+ RT::InitLogging();
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'coredata' );
+ return ($status, $msg) unless $status;
+
+ print "Now inserting RT core system objects.\n";
+ return $RT::Handle->InsertInitialData;
+}
+
+sub action_insert {
+ my %args = @_;
+ $RT::Handle = RT::Handle->new;
+ RT::Init();
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'insert' );
+ return ($status, $msg) unless $status;
+
+ print "Now inserting data.\n";
+ my $file = $args{'datafile'};
+ $file = $RT::EtcPath . "/initialdata" if $init && !$file;
+ $file ||= $args{'datadir'}."/content";
+
+ # Slurp in backcompat
+ my %removed;
+ my @back = @{$args{backcompat} || []};
+ if (@back) {
+ my @lines = do {local @ARGV = @back; <>};
+ for (@lines) {
+ s/\#.*//;
+ next unless /\S/;
+ my ($class, @fields) = split;
+ $class->_BuildTableAttributes;
+ $RT::Logger->debug("Temporarily removing @fields from $class");
+ $removed{$class}{$_} = delete $RT::Record::_TABLE_ATTR->{$class}{$_}
+ for @fields;
+ }
+ }
+
+ my @ret = $RT::Handle->InsertData( $file, $root_password );
+
+ # Put back the fields we chopped off
+ for my $class (keys %removed) {
+ $RT::Record::_TABLE_ATTR->{$class}{$_} = $removed{$class}{$_}
+ for keys %{$removed{$class}};
+ }
+ return @ret;
+}
+
+sub action_upgrade {
+ my %args = @_;
+ my $base_dir = $args{'datadir'} || "./etc/upgrade";
+ return (0, "Couldn't read dir '$base_dir' with upgrade data")
+ unless -d $base_dir || -r _;
+
+ my $upgrading_from = undef;
+ do {
+ if ( defined $upgrading_from ) {
+ print "Doesn't match #.#.#: ";
+ } else {
+ print "Enter $args{package} version you're upgrading from: ";
+ }
+ $upgrading_from = $args{'upgrade-from'} || scalar <STDIN>;
+ chomp $upgrading_from;
+ $upgrading_from =~ s/\s+//g;
+ } while $upgrading_from !~ /$version_dir/;
+
+ my $upgrading_to = $RT::VERSION;
+ return (0, "The current version $upgrading_to is lower than $upgrading_from")
+ if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) > 0;
+
+ return (1, "The version $upgrading_to you're upgrading to is up to date")
+ if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) == 0;
+
+ my @versions = get_versions_from_to($base_dir, $upgrading_from, undef);
+ return (1, "No DB changes since $upgrading_from")
+ unless @versions;
+
+ if (RT::Handle::cmp_version($versions[-1], $upgrading_to) > 0) {
+ print "\n***** There are upgrades for $versions[-1], which is later than $upgrading_to,\n";
+ print "***** which you are nominally upgrading to. Upgrading to $versions[-1] instead.\n";
+ $upgrading_to = $versions[-1];
+ }
+
+ print "\nGoing to apply following upgrades:\n";
+ print map "* $_\n", @versions;
+
+ {
+ my $custom_upgrading_to = undef;
+ do {
+ if ( defined $custom_upgrading_to ) {
+ print "Doesn't match #.#.#: ";
+ } else {
+ print "\nEnter $args{package} version if you want to stop upgrade at some point,\n";
+ print " or leave it blank if you want apply above upgrades: ";
+ }
+ $custom_upgrading_to = $args{'upgrade-to'} || scalar <STDIN>;
+ chomp $custom_upgrading_to;
+ $custom_upgrading_to =~ s/\s+//g;
+ last unless $custom_upgrading_to;
+ } while $custom_upgrading_to !~ /$version_dir/;
+
+ if ( $custom_upgrading_to ) {
+ return (
+ 0, "The version you entered ($custom_upgrading_to) is lower than\n"
+ ."version you're upgrading from ($upgrading_from)"
+ ) if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) > 0;
+
+ return (1, "The version you're upgrading to is up to date")
+ if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) == 0;
+
+ if ( RT::Handle::cmp_version( $RT::VERSION, $custom_upgrading_to ) < 0 ) {
+ print "Version you entered is greater than installed ($RT::VERSION).\n";
+ _yesno() or exit(-2);
+ }
+ # ok, checked everything no let's refresh list
+ $upgrading_to = $custom_upgrading_to;
+ @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to);
+
+ return (1, "No DB changes between $upgrading_from and $upgrading_to")
+ unless @versions;
+
+ print "\nGoing to apply following upgrades:\n";
+ print map "* $_\n", @versions;
+ }
+ }
+
+ print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n";
+ _yesno() or exit(-2) unless $args{'force'};
+
+ my ( $ret, $msg );
+ foreach my $n ( 0..$#versions ) {
+ my $v = $versions[$n];
+ my @back = grep {-e $_} map {"$base_dir/$versions[$_]/backcompat"} $n+1..$#versions;
+ print "Processing $v\n";
+ my %tmp = (%args, datadir => "$base_dir/$v", datafile => undef, backcompat => \@back);
+ if ( -e "$base_dir/$v/schema.$db_type" ) {
+ ( $ret, $msg ) = action_schema( %tmp );
+ return ( $ret, $msg ) unless $ret;
+ }
+ if ( -e "$base_dir/$v/acl.$db_type" ) {
+ ( $ret, $msg ) = action_acl( %tmp );
+ return ( $ret, $msg ) unless $ret;
+ }
+ if ( -e "$base_dir/$v/content" ) {
+ ( $ret, $msg ) = action_insert( %tmp );
+ return ( $ret, $msg ) unless $ret;
+ }
+ }
+ return 1;
+}
+
+sub get_versions_from_to {
+ my ($base_dir, $from, $to) = @_;
+
+ opendir( my $dh, $base_dir ) or die "couldn't open dir: $!";
+ my @versions = grep -d "$base_dir/$_" && /$version_dir/, readdir $dh;
+ closedir $dh;
+
+ die "\nERROR: No upgrade data found in '$base_dir'! Perhaps you specified the wrong --datadir?\n"
+ unless @versions;
+
+ return
+ grep defined $to ? RT::Handle::cmp_version($_, $to) <= 0 : 1,
+ grep RT::Handle::cmp_version($_, $from) > 0,
+ sort RT::Handle::cmp_version @versions;
+}
+
+sub error {
+ my ($action, $msg) = @_;
+ print STDERR "Couldn't finish '$action' step.\n\n";
+ print STDERR "ERROR: $msg\n\n";
+ exit(-1);
+}
+
+sub get_dba_password {
+ print "In order to create or update your RT database,"
+ . " this script needs to connect to your "
+ . " $db_type instance on $db_host (port '$db_port') as $dba_user\n";
+ print "Please specify that user's database password below. If the user has no database\n";
+ print "password, just press return.\n\n";
+ print "Password: ";
+ ReadMode('noecho');
+ my $password = ReadLine(0);
+ ReadMode('normal');
+ print "\n";
+ return ($password);
+}
+
+# get_system_dbh
+# Returns L<DBI> database handle connected to B<system> with DBA credentials.
+# See also L<RT::Handle/SystemDSN>.
+
+
+sub get_system_dbh {
+ return _get_dbh( RT::Handle->SystemDSN, $dba_user, $dba_pass );
+}
+
+sub get_admin_dbh {
+ return _get_dbh( RT::Handle->DSN, $dba_user, $dba_pass );
+}
+
+# get_rt_dbh [USER, PASSWORD]
+
+# Returns L<DBI> database handle connected to RT database,
+# you may specify credentials(USER and PASSWORD) to connect
+# with. By default connects with credentials from RT config.
+
+sub get_rt_dbh {
+ return _get_dbh( RT::Handle->DSN, $db_user, $db_pass );
+}
+
+sub _get_dbh {
+ my ($dsn, $user, $pass) = @_;
+ my $dbh = DBI->connect(
+ $dsn, $user, $pass,
+ { RaiseError => 0, PrintError => 0 },
+ );
+ unless ( $dbh ) {
+ my $msg = "Failed to connect to $dsn as user '$user': ". $DBI::errstr;
+ if ( $args{'debug'} ) {
+ require Carp; Carp::confess( $msg );
+ } else {
+ print STDERR $msg; exit -1;
+ }
+ }
+ return $dbh;
+}
+
+sub _yesno {
+ print "Proceed [y/N]:";
+ my $x = scalar(<STDIN>);
+ $x =~ /^y/i;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+rt-setup-database - Set up RT's database
+
+=head1 SYNOPSIS
+
+ rt-setup-database --action ...
+
+=head1 OPTIONS
+
+=over
+
+=item action
+
+Several actions can be combined using comma separated list.
+
+=over
+
+=item init
+
+Initialize the database. This is combination of multiple actions listed below.
+Create DB, schema, setup acl, insert core data and initial data.
+
+=item upgrade
+
+Apply all needed schema/acl/content updates (will ask for version to upgrade
+from)
+
+=item create
+
+Create the database.
+
+=item drop
+
+Drop the database. This will B<ERASE ALL YOUR DATA>.
+
+=item schema
+
+Initialize only the database schema
+
+To use a local or supplementary datafile, specify it using the '--datadir'
+option below.
+
+=item acl
+
+Initialize only the database ACLs
+
+To use a local or supplementary datafile, specify it using the '--datadir'
+option below.
+
+=item coredata
+
+Insert data into RT's database. This data is required for normal functioning of
+any RT instance.
+
+=item insert
+
+Insert data into RT's database. By default, will use RT's installation data.
+To use a local or supplementary datafile, specify it using the '--datafile'
+option below.
+
+=back
+
+=item datafile
+
+file path of the data you want to action on
+
+e.g. C<--datafile /path/to/datafile>
+
+=item datadir
+
+Used to specify a path to find the local database schema and acls to be
+installed.
+
+e.g. C<--datadir /path/to/>
+
+=item dba
+
+dba's username
+
+=item dba-password
+
+dba's password
+
+=item prompt-for-dba-password
+
+Ask for the database administrator's password interactively
+
+=item skip-create
+
+for 'init': skip creating the database and the user account, so we don't need
+administrator privileges
+
+=item root-password-file
+
+for 'init' and 'insert': rather than using the default administrative password
+for RT's "root" user, use the password in this file.
+
+=item upgrade-from
+
+for 'upgrade': specifies the version to upgrade from, and do not prompt
+for it if it appears to be a valid version.
+
+=item upgrade-to
+
+for 'upgrade': specifies the version to upgrade to, and do not prompt
+for it if it appears to be a valid version.
+
+=back
diff --git a/rt/sbin/rt-setup-fulltext-index b/rt/sbin/rt-setup-fulltext-index
new file mode 100755
index 000000000..e27a27010
--- /dev/null
+++ b/rt/sbin/rt-setup-fulltext-index
@@ -0,0 +1,720 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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 'once';
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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;
+ }
+}
+
+BEGIN {
+ use RT;
+ RT::LoadConfig();
+ RT::Init();
+};
+use RT::Interface::CLI ();
+
+my %DB = (
+ type => scalar RT->Config->Get('DatabaseType'),
+ user => scalar RT->Config->Get('DatabaseUser'),
+ admin => 'freeside',
+ admin_password => undef,
+);
+
+my %OPT = (
+ help => 0,
+ ask => 1,
+ dryrun => 0,
+ attachments => 1,
+);
+
+my %DEFAULT;
+if ( $DB{'type'} eq 'Pg' ) {
+ %DEFAULT = (
+ table => 'Attachments',
+ column => 'ContentIndex',
+ );
+}
+elsif ( $DB{'type'} eq 'mysql' ) {
+ %DEFAULT = (
+ table => 'AttachmentsIndex',
+ );
+}
+elsif ( $DB{'type'} eq 'Oracle' ) {
+ %DEFAULT = (
+ prefix => 'rt_fts_',
+ );
+}
+
+use Getopt::Long qw(GetOptions);
+GetOptions(
+ 'h|help!' => \$OPT{'help'},
+ 'ask!' => \$OPT{'ask'},
+ 'dry-run!' => \$OPT{'dryrun'},
+ 'attachments!' => \$OPT{'attachments'},
+
+ 'table=s' => \$OPT{'table'},
+ 'column=s' => \$OPT{'column'},
+ 'url=s' => \$OPT{'url'},
+ 'maxmatches=i' => \$OPT{'maxmatches'},
+ 'index-type=s' => \$OPT{'index-type'},
+
+ 'dba=s' => \$DB{'admin'},
+ 'dba-password=s' => \$DB{'admin_password'},
+) or show_help();
+
+if ( $OPT{'help'} || (!$DB{'admin'} && $DB{'type'} eq 'Oracle' ) ) {
+ show_help( !$OPT{'help'} );
+}
+
+my $dbh = $RT::Handle->dbh;
+$dbh->{'RaiseError'} = 1;
+$dbh->{'PrintError'} = 1;
+
+if ( $DB{'type'} eq 'mysql' ) {
+ check_sphinx();
+ my $table = $OPT{'table'} || prompt(
+ message => "Enter name of a new MySQL table that will be used to connect to the\n"
+ . "Sphinx server:",
+ default => $DEFAULT{'table'},
+ silent => !$OPT{'ask'},
+ );
+
+ my $url = 'sphinx://localhost:3312/rt';
+ my $version = ($dbh->selectrow_array("show variables like 'version'"))[1];
+ $url = 'sphinx://127.0.0.1:3312/rt'
+ if $version and $version =~ /^(\d+\.\d+)/ and $1 >= 5.5;
+
+ $url = $OPT{'url'} || prompt(
+ message => "Enter URL of the sphinx search server; this should be of the form\n"
+ . "sphinx://<server>:<port>/<index name>",
+ default => $url,
+ silent => !$OPT{'ask'},
+ );
+ my $maxmatches = $OPT{'maxmatches'} || prompt(
+ message => "Maximum number of matches to return; this is the maximum number of\n"
+ . "attachment records returned by the search, not the maximum number\n"
+ . "of tickets. Both your RT_SiteConfig.pm and your sphinx.conf must\n"
+ . "agree on this value. Larger values cause your Sphinx server to\n"
+ . "consume more memory and CPU time per query.",
+ default => 10000,
+ silent => !$OPT{'ask'},
+ );
+
+ my $schema = <<END;
+CREATE TABLE $table (
+ id INTEGER UNSIGNED NOT NULL,
+ weight INTEGER NOT NULL,
+ query VARCHAR(3072) NOT NULL,
+ INDEX(query)
+) ENGINE=SPHINX CONNECTION="$url" CHARACTER SET utf8
+END
+
+ do_error_is_ok( dba_handle() => "DROP TABLE $table" )
+ unless $OPT{'dryrun'};
+ insert_schema( $schema );
+
+ print_rt_config( Table => $table, MaxMatches => $maxmatches );
+
+ require URI;
+ my $urlo = URI->new( $url );
+ my ($host, $port) = split /:/, $urlo->authority;
+ my $index = $urlo->path;
+ $index =~ s{^/+}{};
+
+ my $var_path = $RT::VarPath;
+
+ my %sphinx_conf = ();
+ $sphinx_conf{'host'} = RT->Config->Get('DatabaseHost');
+ $sphinx_conf{'db'} = RT->Config->Get('DatabaseName');
+ $sphinx_conf{'user'} = RT->Config->Get('DatabaseUser');
+ $sphinx_conf{'pass'} = RT->Config->Get('DatabasePassword');
+
+ print <<END
+
+Below is a simple Sphinx configuration which can be used to index all
+text/plain attachments in your database. This configuration is not
+ideal; you should read the Sphinx documentation to understand how to
+configure it to better suit your needs.
+
+source rt {
+ type = mysql
+
+ sql_host = $sphinx_conf{'host'}
+ sql_db = $sphinx_conf{'db'}
+ sql_user = $sphinx_conf{'user'}
+ sql_pass = $sphinx_conf{'pass'}
+
+ sql_query_pre = SET NAMES utf8
+ sql_query = \\
+ SELECT a.id, a.content FROM Attachments a \\
+ JOIN Transactions txn ON a.TransactionId = txn.id AND txn.ObjectType = 'RT::Ticket' \\
+ JOIN Tickets t ON txn.ObjectId = t.id \\
+ WHERE a.ContentType = 'text/plain' AND t.Status != 'deleted'
+
+ sql_query_info = SELECT * FROM Attachments WHERE id=\$id
+}
+
+index $index {
+ source = rt
+ path = $var_path/sphinx/index
+ docinfo = extern
+ charset_type = utf-8
+}
+
+indexer {
+ mem_limit = 32M
+}
+
+searchd {
+ port = $port
+ log = $var_path/sphinx/searchd.log
+ query_log = $var_path/sphinx/query.log
+ read_timeout = 5
+ max_children = 30
+ pid_file = $var_path/sphinx/searchd.pid
+ max_matches = $maxmatches
+ seamless_rotate = 1
+ preopen_indexes = 0
+ unlink_old = 1
+}
+
+END
+
+}
+elsif ( $DB{'type'} eq 'Pg' ) {
+ check_tsvalue();
+ my $table = $OPT{'table'} || prompt(
+ message => "Enter the name of a DB table that will be used to store the Pg tsvector.\n"
+ . "You may either use the existing Attachments table, or create a new\n"
+ . "table.",
+ default => $DEFAULT{'table'},
+ silent => !$OPT{'ask'},
+ );
+ my $column = $OPT{'column'} || prompt(
+ message => 'Enter the name of a column that will be used to store the Pg tsvector:',
+ default => $DEFAULT{'column'},
+ silent => !$OPT{'ask'},
+ );
+
+ my $schema;
+ my $drop;
+ if ( lc($table) eq 'attachments' ) {
+ $drop = "ALTER TABLE $table DROP COLUMN $column";
+ $schema = "ALTER TABLE $table ADD COLUMN $column tsvector";
+ } else {
+ $drop = "DROP TABLE $table";
+ $schema = "CREATE TABLE $table ( "
+ ."id INTEGER NOT NULL,"
+ ."$column tsvector )";
+ }
+
+ my $index_type = lc($OPT{'index-type'} || '');
+ while ( $index_type ne 'gist' and $index_type ne 'gin' ) {
+ $index_type = lc prompt(
+ message => "You may choose between GiST or GIN indexes; the former is several times\n"
+ . "slower to search, but takes less space on disk and is faster to update.",
+ default => 'GiST',
+ silent => !$OPT{'ask'},
+ );
+ }
+
+ do_error_is_ok( dba_handle() => $drop )
+ unless $OPT{'dryrun'};
+ insert_schema( $schema );
+ insert_schema("CREATE INDEX ${column}_idx ON $table USING $index_type($column)");
+
+ print_rt_config( Table => $table, Column => $column );
+}
+elsif ( $DB{'type'} eq 'Oracle' ) {
+ {
+ my $dbah = dba_handle();
+ do_print_error( $dbah => 'GRANT CTXAPP TO '. $DB{'user'} );
+ do_print_error( $dbah => 'GRANT EXECUTE ON CTXSYS.CTX_DDL TO '. $DB{'user'} );
+ }
+
+ my %PREFERENCES = (
+ datastore => {
+ type => 'DIRECT_DATASTORE',
+ },
+ filter => {
+ type => 'AUTO_FILTER',
+# attributes => {
+# timeout => 120, # seconds
+# timeout_type => 'HEURISTIC', # or 'FIXED'
+# },
+ },
+ lexer => {
+ type => 'WORLD_LEXER',
+ },
+ word_list => {
+ type => 'BASIC_WORDLIST',
+ attributes => {
+ stemmer => 'AUTO',
+ fuzzy_match => 'AUTO',
+# fuzzy_score => undef,
+# fuzzy_numresults => undef,
+# substring_index => undef,
+# prefix_index => undef,
+# prefix_length_min => undef,
+# prefix_length_max => undef,
+# wlidcard_maxterms => undef,
+ },
+ },
+ 'section_group' => {
+ type => 'NULL_SECTION_GROUP',
+ },
+
+ storage => {
+ type => 'BASIC_STORAGE',
+ attributes => {
+ R_TABLE_CLAUSE => 'lob (data) store as (cache)',
+ I_INDEX_CLAUSE => 'compress 2',
+ },
+ },
+ );
+
+ my @params = ();
+ push @params, ora_create_datastore( %{ $PREFERENCES{'datastore'} } );
+ push @params, ora_create_filter( %{ $PREFERENCES{'filter'} } );
+ push @params, ora_create_lexer( %{ $PREFERENCES{'lexer'} } );
+ push @params, ora_create_word_list( %{ $PREFERENCES{'word_list'} } );
+ push @params, ora_create_stop_list();
+ push @params, ora_create_section_group( %{ $PREFERENCES{'section_group'} } );
+ push @params, ora_create_storage( %{ $PREFERENCES{'storage'} } );
+
+ my $index_params = join "\n", @params;
+ my $index_name = $DEFAULT{prefix} .'index';
+ do_error_is_ok( $dbh => "DROP INDEX $index_name" )
+ unless $OPT{'dryrun'};
+ $dbh->do(
+ "CREATE INDEX $index_name ON Attachments(Content)
+ indextype is ctxsys.context parameters('
+ $index_params
+ ')",
+ ) unless $OPT{'dryrun'};
+
+ print_rt_config( IndexName => $index_name );
+}
+else {
+ die "Full-text indexes on $DB{type} are not yet supported";
+}
+
+sub check_tsvalue {
+ my $dbh = $RT::Handle->dbh;
+ my $fts = ($dbh->selectrow_array(<<EOQ))[0];
+SELECT 1 FROM information_schema.routines WHERE routine_name = 'plainto_tsquery'
+EOQ
+ unless ($fts) {
+ print STDERR <<EOT;
+
+Your PostgreSQL server does not include full-text support. You will
+need to upgrade to PostgreSQL version 8.3 or higher to use full-text
+indexing.
+
+EOT
+ exit 1;
+ }
+}
+
+sub check_sphinx {
+ return if $RT::Handle->CheckSphinxSE;
+
+ print STDERR <<EOT;
+
+Your MySQL server has not been compiled with the Sphinx storage engine
+(sphinxse). You will need to recompile MySQL according to the
+instructions in Sphinx's documentation at
+http://sphinxsearch.com/docs/current.html#sphinxse-installing
+
+EOT
+ exit 1;
+}
+
+sub ora_create_datastore {
+ return sprintf 'datastore %s', ora_create_preference(
+ @_,
+ name => 'datastore',
+ );
+}
+
+sub ora_create_filter {
+ my $res = '';
+ $res .= sprintf "format column %s\n", ora_create_format_column();
+ $res .= sprintf 'filter %s', ora_create_preference(
+ @_,
+ name => 'filter',
+ );
+ return $res;
+}
+
+sub ora_create_lexer {
+ return sprintf 'lexer %s', ora_create_preference(
+ @_,
+ name => 'lexer',
+ );
+}
+
+sub ora_create_word_list {
+ return sprintf 'wordlist %s', ora_create_preference(
+ @_,
+ name => 'word_list',
+ );
+}
+
+sub ora_create_stop_list {
+ my $file = shift || 'etc/stopwords/en.txt';
+ return '' unless -e $file;
+
+ my $name = $DEFAULT{'prefix'} .'stop_list';
+ unless ($OPT{'dryrun'}) {
+ do_error_is_ok( $dbh => 'begin ctx_ddl.drop_stoplist(?); end;', $name );
+
+ $dbh->do(
+ 'begin ctx_ddl.create_stoplist(?, ?); end;',
+ undef, $name, 'BASIC_STOPLIST'
+ );
+
+ open( my $fh, '<:utf8', $file )
+ or die "couldn't open file '$file': $!";
+ while ( my $word = <$fh> ) {
+ chomp $word;
+ $dbh->do(
+ 'begin ctx_ddl.add_stopword(?, ?); end;',
+ undef, $name, $word
+ );
+ }
+ close $fh;
+ }
+ return sprintf 'stoplist %s', $name;
+}
+
+sub ora_create_section_group {
+ my %args = @_;
+ my $name = $DEFAULT{'prefix'} .'section_group';
+ unless ($OPT{'dryrun'}) {
+ do_error_is_ok( $dbh => 'begin ctx_ddl.drop_section_group(?); end;', $name );
+ $dbh->do(
+ 'begin ctx_ddl.create_section_group(?, ?); end;',
+ undef, $name, $args{'type'}
+ );
+ }
+ return sprintf 'section group %s', $name;
+}
+
+sub ora_create_storage {
+ return sprintf 'storage %s', ora_create_preference(
+ @_,
+ name => 'storage',
+ );
+}
+
+sub ora_create_format_column {
+ my $column_name = 'ContentOracleFormat';
+ return $column_name if $OPT{'dryrun'};
+ unless (
+ $dbh->column_info(
+ undef, undef, uc('Attachments'), uc( $column_name )
+ )->fetchrow_array
+ ) {
+ $dbh->do(qq{
+ ALTER TABLE Attachments ADD $column_name VARCHAR2(10)
+ });
+ }
+
+ my $detect_format = qq{
+ CREATE OR REPLACE FUNCTION $DEFAULT{prefix}detect_format_simple(
+ parent IN NUMBER,
+ type IN VARCHAR2,
+ encoding IN VARCHAR2,
+ fname IN VARCHAR2
+ )
+ RETURN VARCHAR2
+ AS
+ format VARCHAR2(10);
+ BEGIN
+ format := CASE
+ };
+ unless ( $OPT{'attachments'} ) {
+ $detect_format .= qq{
+ WHEN fname IS NOT NULL THEN 'ignore'
+ };
+ }
+ $detect_format .= qq{
+ WHEN type = 'text' THEN 'text'
+ WHEN type = 'text/rtf' THEN 'ignore'
+ WHEN type LIKE 'text/%' THEN 'text'
+ WHEN type LIKE 'message/%' THEN 'text'
+ ELSE 'ignore'
+ END;
+ RETURN format;
+ END;
+ };
+ ora_create_procedure( $detect_format );
+
+ $dbh->do(qq{
+ UPDATE Attachments
+ SET $column_name = $DEFAULT{prefix}detect_format_simple(
+ Parent,
+ ContentType, ContentEncoding,
+ Filename
+ )
+ WHERE $column_name IS NULL
+ });
+ $dbh->do(qq{
+ CREATE OR REPLACE TRIGGER $DEFAULT{prefix}set_format
+ BEFORE INSERT
+ ON Attachments
+ FOR EACH ROW
+ BEGIN
+ :new.$column_name := $DEFAULT{prefix}detect_format_simple(
+ :new.Parent,
+ :new.ContentType, :new.ContentEncoding,
+ :new.Filename
+ );
+ END;
+ });
+ return $column_name;
+}
+
+sub ora_create_preference {
+ my %info = @_;
+ my $name = $DEFAULT{'prefix'} . $info{'name'};
+ return $name if $OPT{'dryrun'};
+ do_error_is_ok( $dbh => 'begin ctx_ddl.drop_preference(?); end;', $name );
+ $dbh->do(
+ 'begin ctx_ddl.create_preference(?, ?); end;',
+ undef, $name, $info{'type'}
+ );
+ return $name unless $info{'attributes'};
+
+ while ( my ($attr, $value) = each %{ $info{'attributes'} } ) {
+ $dbh->do(
+ 'begin ctx_ddl.set_attribute(?, ?, ?); end;',
+ undef, $name, $attr, $value
+ );
+ }
+
+ return $name;
+}
+
+sub ora_create_procedure {
+ my $text = shift;
+
+ return if $OPT{'dryrun'};
+ my $status = $dbh->do($text, { RaiseError => 0 });
+
+ # Statement succeeded
+ return if $status;
+
+ if ( 6550 != $dbh->err ) {
+ # Utter failure
+ die $dbh->errstr;
+ }
+ else {
+ my $msg = $dbh->func( 'plsql_errstr' );
+ die $dbh->errstr if !defined $msg;
+ die $msg if $msg;
+ }
+}
+
+sub dba_handle {
+ if ( $DB{'type'} eq 'Oracle' ) {
+ $ENV{'NLS_LANG'} = "AMERICAN_AMERICA.AL32UTF8";
+ $ENV{'NLS_NCHAR'} = "AL32UTF8";
+ }
+ my $dsn = do { my $h = new RT::Handle; $h->BuildDSN; $h->DSN };
+ my $dbh = DBI->connect(
+ $dsn, $DB{admin}, $DB{admin_password},
+ { RaiseError => 1, PrintError => 1 },
+ );
+ unless ( $dbh ) {
+ die "Failed to connect to $dsn as user '$DB{admin}': ". $DBI::errstr;
+ }
+ return $dbh;
+}
+
+sub do_error_is_ok {
+ my $dbh = shift;
+ local $dbh->{'RaiseError'} = 0;
+ local $dbh->{'PrintError'} = 0;
+ return $dbh->do(shift, undef, @_);
+}
+
+sub do_print_error {
+ my $dbh = shift;
+ local $dbh->{'RaiseError'} = 0;
+ local $dbh->{'PrintError'} = 1;
+ return $dbh->do(shift, undef, @_);
+}
+
+sub prompt {
+ my %args = ( @_ );
+ return $args{'default'} if $args{'silent'};
+
+ local $| = 1;
+ print $args{'message'};
+ if ( $args{'default'} ) {
+ print "\n[". $args{'default'} .']: ';
+ } else {
+ print ":\n";
+ }
+
+ my $res = <STDIN>;
+ chomp $res;
+ print "\n";
+ return $args{'default'} if !$res && $args{'default'};
+ return $res;
+}
+
+sub verbose { print @_, "\n" if $OPT{verbose} || $OPT{verbose}; 1 }
+sub debug { print @_, "\n" if $OPT{debug}; 1 }
+sub error { $RT::Logger->error( @_ ); verbose(@_); 1 }
+sub warning { $RT::Logger->warning( @_ ); verbose(@_); 1 }
+
+sub show_help {
+ my $error = shift;
+ RT::Interface::CLI->ShowHelp(
+ ExitValue => $error,
+ Sections => 'NAME|DESCRIPTION',
+ );
+}
+
+sub print_rt_config {
+ my %args = @_;
+ my $config = <<END;
+
+You can now configure RT to use the newly-created full-text index by
+adding the following to your RT_SiteConfig.pm:
+
+Set( %FullTextSearch,
+ Enable => 1,
+ Indexed => 1,
+END
+
+ $config .= sprintf(" %-10s => '$args{$_}',\n",$_)
+ foreach grep defined $args{$_}, keys %args;
+ $config .= ");\n";
+
+ print $config;
+}
+
+sub insert_schema {
+ my $dbh = dba_handle();
+ my $message = "Going to run the following in the DB:";
+ my $schema = shift;
+ print "$message\n";
+ my $disp = $schema;
+ $disp =~ s/^/ /mg;
+ print "$disp\n\n";
+ return if $OPT{'dryrun'};
+
+ my $res = $dbh->do( $schema );
+ unless ( $res ) {
+ die "Couldn't run DDL query: ". $dbh->errstr;
+ }
+}
+
+=head1 NAME
+
+rt-setup-fulltext-index - Create indexes for full text search
+
+=head1 DESCRIPTION
+
+This script creates the appropriate tables, columns, functions, and / or
+views necessary for full-text searching for your database type. It will
+drop any existing indexes in the process.
+
+Please read F<docs/full_text_indexing.pod> for complete documentation on
+full-text indexing for your database type.
+
+If you have a non-standard database administrator user or password, you
+may use the C<--dba> and C<--dba-password> parameters to set them
+explicitly:
+
+ rt-setup-fulltext-index --dba sysdba --dba-password 'secret'
+
+To test what will happen without running any DDL, pass the C<--dryrun>
+flag.
+
+The Oracle index determines which content-types it will index at
+creation time. By default, textual message bodies and textual uploaded
+attachments (attachments with filenames) are indexed; to ignore textual
+attachments, pass the C<--no-attachments> flag when the index is
+created.
+
+
+=head1 AUTHOR
+
+Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>,
+Alex Vandiver E<lt>alexmv@bestpractical.comE<gt>
+
+=cut
+
diff --git a/rt/sbin/rt-shredder b/rt/sbin/rt-shredder
new file mode 100755
index 000000000..27d57a24f
--- /dev/null
+++ b/rt/sbin/rt-shredder
@@ -0,0 +1,325 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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-shredder - Script which wipe out tickets from RT DB
+
+=head1 SYNOPSIS
+
+ rt-shredder --plugin list
+ rt-shredder --plugin help-Tickets
+ rt-shredder --plugin 'Tickets=query,Queue="general" and Status="deleted"'
+
+ rt-shredder --sqldump unshred.sql --plugin ...
+ rt-shredder --force --plugin ...
+
+=head1 DESCRIPTION
+
+rt-shredder - is script that allow you to wipe out objects
+from RT DB. This script uses API that L<RT::Shredder> module adds to RT.
+Script can be used as example of usage of the shredder API.
+
+=head1 USAGE
+
+You can use several options to control which objects script
+should wipeout.
+
+=head1 OPTIONS
+
+=head2 --sqldump <filename>
+
+Outputs INSERT queries into file. This dump can be used to restore data
+after wiping out.
+
+By default creates files named F<< <ISO_date>-XXXX.sql >> in the current
+directory.
+
+=head2 --object (DEPRECATED)
+
+Option has been deprecated, use plugin C<Objects> instead.
+
+=head2 --plugin '<plugin name>[=<arg>,<val>[;<arg>,<val>]...]'
+
+You can use plugins to select RT objects with various conditions.
+See also --plugin list and --plugin help options.
+
+=head2 --plugin list
+
+Output list of the available plugins.
+
+=head2 --plugin help-<plugin name>
+
+Outputs help for specified plugin.
+
+=head2 --force
+
+Script doesn't ask any questions.
+
+=head1 SEE ALSO
+
+L<RT::Shredder>
+
+=cut
+
+use strict;
+use warnings FATAL => 'all';
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 -init;
+
+require RT::Shredder;
+
+use Getopt::Long qw(GetOptions);
+use File::Spec ();
+
+use RT::Shredder::Plugin ();
+# prefetch list of plugins
+our %plugins = RT::Shredder::Plugin->List;
+
+our %opt;
+parse_args();
+
+my $shredder = RT::Shredder->new;
+
+{
+ my $plugin = eval { $shredder->AddDumpPlugin( Arguments => {
+ file_name => $opt{'sqldump'},
+ from_storage => 0,
+ } ) };
+ if( $@ ) {
+ print STDERR "ERROR: Couldn't open SQL dump file: $@\n";
+ exit 1 if $opt{'sqldump'};
+
+ print STDERR "WARNING: It's strongly recommended to use '--sqldump <filename>' option\n";
+ unless( $opt{'force'} ) {
+ exit 0 unless prompt_yN( "Do you want to proceed?" );
+ }
+ } else {
+ print "SQL dump file is '". $plugin->FileName ."'\n";
+ }
+}
+
+my @objs = process_plugins( $shredder );
+prompt_delete_objs( \@objs ) unless $opt{'force'};
+
+$shredder->PutObjects( Objects => $_ ) foreach @objs;
+eval { $shredder->WipeoutAll };
+if( $@ ) {
+ require RT::Shredder::Exceptions;
+ if( my $e = RT::Shredder::Exception::Info->caught ) {
+ print "\nERROR: $e\n\n";
+ exit 1;
+ }
+ die $@;
+}
+
+sub prompt_delete_objs
+{
+ my( $objs ) = @_;
+ unless( @$objs ) {
+ print "Objects list is empty, try refine search options\n";
+ exit 0;
+ }
+ my $list = "Next ". scalar( @$objs ) ." objects would be deleted:\n";
+ foreach my $o( @$objs ) {
+ $list .= "\t". $o->_AsString ." object\n";
+ }
+ print $list;
+ exit(0) unless prompt_yN( "Do you want to proceed?" );
+}
+
+sub prompt_yN
+{
+ my $text = shift;
+ print "$text [y/N] ";
+ unless( <STDIN> =~ /^(?:y|yes)$/i ) {
+ return 0;
+ }
+ return 1;
+}
+
+sub usage
+{
+ require RT::Shredder::POD;
+ RT::Shredder::POD::shredder_cli( $0, \*STDOUT );
+ exit 1;
+}
+
+sub parse_args
+{
+ my $tmp;
+ Getopt::Long::Configure( "pass_through" );
+ my @objs = ();
+ if( GetOptions( 'object=s' => \@objs ) && @objs ) {
+ print STDERR "Option --object had been deprecated, use plugin 'Objects' instead\n";
+ exit(1);
+ }
+
+ my @plugins = ();
+ if( GetOptions( 'plugin=s' => \@plugins ) && @plugins ) {
+ $opt{'plugin'} = \@plugins;
+ foreach my $str( @plugins ) {
+ if( $str =~ /^\s*list\s*$/ ) {
+ show_plugin_list();
+ } elsif( $str =~ /^\s*help-(\w+)\s*$/ ) {
+ show_plugin_help( $1 );
+ } elsif( $str =~ /^(\w+)(=.*)?$/ && !$plugins{$1} ) {
+ print "Couldn't find plugin '$1'\n";
+ show_plugin_list();
+ }
+ }
+ }
+
+ # other options make no sense without previouse
+ usage() unless keys %opt;
+
+ if( GetOptions( 'force' => \$tmp ) && $tmp ) {
+ $opt{'force'}++;
+ }
+ $tmp = undef;
+ if( GetOptions( 'sqldump=s' => \$tmp ) && $tmp ) {
+ $opt{'sqldump'} = $tmp;
+ }
+ return;
+}
+
+sub process_plugins
+{
+ my $shredder = shift;
+
+ my @res;
+ foreach my $str( @{ $opt{'plugin'} } ) {
+ my $plugin = RT::Shredder::Plugin->new;
+ my( $status, $msg ) = $plugin->LoadByString( $str );
+ unless( $status ) {
+ print STDERR "Couldn't load plugin\n";
+ print STDERR "Error: $msg\n";
+ exit(1);
+ }
+ if ( lc $plugin->Type eq 'search' ) {
+ push @res, _process_search_plugin( $shredder, $plugin );
+ }
+ elsif ( lc $plugin->Type eq 'dump' ) {
+ _process_dump_plugin( $shredder, $plugin );
+ }
+ }
+ return RT::Shredder->CastObjectsToRecords( Objects => \@res );
+}
+
+sub _process_search_plugin {
+ my ($shredder, $plugin) = @_;
+ my ($status, @objs) = $plugin->Run;
+ unless( $status ) {
+ print STDERR "Couldn't run plugin\n";
+ print STDERR "Error: $objs[1]\n";
+ exit(1);
+ }
+
+ my $msg;
+ ($status, $msg) = $plugin->SetResolvers( Shredder => $shredder );
+ unless( $status ) {
+ print STDERR "Couldn't set conflicts resolver\n";
+ print STDERR "Error: $msg\n";
+ exit(1);
+ }
+ return @objs;
+}
+
+sub _process_dump_plugin {
+ my ($shredder, $plugin) = @_;
+ $shredder->AddDumpPlugin(
+ Object => $plugin,
+ );
+}
+
+sub show_plugin_list
+{
+ print "Plugins list:\n";
+ print "\t$_\n" foreach( grep !/^Base$/, keys %plugins );
+ exit(1);
+}
+
+sub show_plugin_help
+{
+ my( $name ) = @_;
+ require RT::Shredder::POD;
+ unless( $plugins{ $name } ) {
+ print "Couldn't find plugin '$name'\n";
+ show_plugin_list();
+ }
+ RT::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 );
+ RT::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT );
+ exit(1);
+}
+
+exit(0);
diff --git a/rt/sbin/rt-shredder.in b/rt/sbin/rt-shredder.in
index a903728ce..f1e79f8bf 100755
--- a/rt/sbin/rt-shredder.in
+++ b/rt/sbin/rt-shredder.in
@@ -77,8 +77,8 @@ should wipeout.
Outputs INSERT queries into file. This dump can be used to restore data
after wiping out.
-By default creates files
-F<< <RT_home>/var/data/RT-Shredder/<ISO_date>-XXXX.sql >>
+By default creates files named F<< <ISO_date>-XXXX.sql >> in the current
+directory.
=head2 --object (DEPRECATED)
diff --git a/rt/sbin/rt-test-dependencies b/rt/sbin/rt-test-dependencies
new file mode 100755
index 000000000..99520aaa7
--- /dev/null
+++ b/rt/sbin/rt-test-dependencies
@@ -0,0 +1,694 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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 }}}
+#
+# This is just a basic script that checks to make sure that all
+# the modules needed by RT before you can install it.
+#
+
+use strict;
+use warnings;
+no warnings qw(numeric redefine);
+use Getopt::Long;
+use Cwd qw(abs_path);
+my %args;
+my %deps;
+my @orig_argv = @ARGV;
+# Save our path because installers or tests can change cwd
+my $script_path = abs_path($0);
+
+GetOptions(
+ \%args, 'v|verbose',
+ 'install!', 'with-MYSQL',
+ 'with-POSTGRESQL|with-pg|with-pgsql', 'with-SQLITE',
+ 'with-ORACLE', 'with-FASTCGI',
+ 'with-MODPERL1', 'with-MODPERL2',
+ 'with-STANDALONE',
+
+ 'with-DEV',
+
+ 'with-GPG',
+ 'with-ICAL',
+ 'with-SMTP',
+ 'with-GRAPHVIZ',
+ 'with-GD',
+ 'with-DASHBOARDS',
+ 'with-USERLOGO',
+ 'with-SSL-MAILGATE',
+ 'with-HTML-DOC',
+
+ 'download=s',
+ 'repository=s',
+ 'list-deps',
+ 'help|h',
+);
+
+if ( $args{help} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+# Set up defaults
+my %default = (
+ 'with-MASON' => 1,
+ 'with-PSGI' => 0,
+ 'with-CORE' => 1,
+ 'with-CLI' => 1,
+ 'with-MAILGATE' => 1,
+ 'with-DEV' => 0,
+ 'with-GPG' => 1,
+ 'with-ICAL' => 1,
+ 'with-SMTP' => 1,
+ 'with-GRAPHVIZ' => 1,
+ 'with-GD' => 0,
+ 'with-DASHBOARDS' => 1,
+ 'with-USERLOGO' => 1,
+ 'with-SSL-MAILGATE' => 0,
+ 'with-HTML-DOC' => 0,
+);
+$args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default;
+
+{
+ my $section;
+ my %always_show_sections = (
+ perl => 1,
+ users => 1,
+ );
+
+ sub section {
+ my $s = shift;
+ $section = $s;
+ print "$s:\n" unless $args{'list-deps'};
+ }
+
+ sub print_found {
+ my $msg = shift;
+ my $test = shift;
+ my $extra = shift;
+
+ unless ( $args{'list-deps'} ) {
+ if ( $args{'v'} or not $test or $always_show_sections{$section} ) {
+ print "\t$msg ...";
+ print $test ? "found" : "MISSING";
+ print "\n";
+ }
+
+ print "\t\t$extra\n" if defined $extra;
+ }
+ }
+}
+
+sub conclude {
+ my %missing_by_type = @_;
+
+ unless ( $args{'list-deps'} ) {
+ unless ( keys %missing_by_type ) {
+ print "\nAll dependencies have been found.\n";
+ return;
+ }
+
+ print "\nSOME DEPENDENCIES WERE MISSING.\n";
+
+ for my $type ( keys %missing_by_type ) {
+ my $missing = $missing_by_type{$type};
+
+ print "$type missing dependencies:\n";
+ for my $name ( keys %$missing ) {
+ my $module = $missing->{$name};
+ my $version = $module->{version};
+ my $error = $module->{error};
+ print_found( $name . ( $version && !$error ? " >= $version" : "" ),
+ 0, $module->{error} );
+ }
+ }
+ exit 1;
+ }
+}
+
+sub text_to_hash {
+ my %hash;
+ for my $line ( split /\n/, $_[0] ) {
+ my($key, $value) = $line =~ /(\S+)\s*(\S*)/;
+ $value ||= '';
+ $hash{$key} = $value;
+ }
+
+ return %hash;
+}
+sub set_dep {
+ my ($name, $module, $version) = @_;
+ my %list = @{$deps{$name}};
+ $list{$module} = ($version || '');
+ $deps{$name} = [ %list ];
+}
+
+$deps{'CORE'} = [ text_to_hash( << '.') ];
+Class::Accessor 0.34
+DateTime 0.44
+DateTime::Locale 0.40
+Digest::base
+Digest::MD5 2.27
+Digest::SHA
+DBI 1.37
+Class::ReturnValue 0.40
+DBIx::SearchBuilder 1.59
+Text::Template 1.44
+File::ShareDir
+File::Spec 0.8
+HTML::Quoted
+HTML::Scrubber 0.08
+HTML::TreeBuilder
+HTML::FormatText
+Log::Dispatch 2.23
+Sys::Syslog 0.16
+Locale::Maketext 1.06
+Locale::Maketext::Lexicon 0.32
+Locale::Maketext::Fuzzy
+MIME::Entity 5.425
+Mail::Mailer 1.57
+Email::Address
+Text::Wrapper
+Time::ParseDate
+Time::HiRes
+File::Temp 0.19
+Text::Quoted 2.02
+Tree::Simple 1.04
+UNIVERSAL::require
+Regexp::Common
+Scalar::Util
+Module::Versions::Report 1.05
+Cache::Simple::TimedExpiry
+Encode 2.39
+CSS::Squish 0.06
+File::Glob
+Devel::StackTrace 1.19
+Text::Password::Pronounceable
+Devel::GlobalDestruction
+List::MoreUtils
+Net::CIDR
+Regexp::Common::net::CIDR
+Regexp::IPv6
+.
+
+$deps{'MASON'} = [ text_to_hash( << '.') ];
+HTML::Mason 1.43
+Errno
+Digest::MD5 2.27
+CGI::Cookie 1.20
+Storable 2.08
+Apache::Session 1.53
+XML::RSS 1.05
+Text::WikiFormat 0.76
+CSS::Squish 0.06
+Devel::StackTrace 1.19
+JSON
+IPC::Run3
+.
+
+$deps{'PSGI'} = [ text_to_hash( << '.') ];
+CGI 3.38
+CGI::PSGI 0.12
+HTML::Mason::PSGIHandler 0.52
+Plack 0.9971
+Plack::Handler::Starlet
+CGI::Emulate::PSGI
+.
+set_dep( PSGI => CGI => 4.00 ) if $] > 5.019003;
+
+
+$deps{'MAILGATE'} = [ text_to_hash( << '.') ];
+Getopt::Long
+LWP::UserAgent
+Pod::Usage
+.
+
+$deps{'SSL-MAILGATE'} = [ text_to_hash( << '.') ];
+Crypt::SSLeay
+Net::SSL
+LWP::UserAgent 6.0
+LWP::Protocol::https
+Mozilla::CA
+.
+
+$deps{'CLI'} = [ text_to_hash( << '.') ];
+Getopt::Long 2.24
+LWP
+HTTP::Request::Common
+Text::ParseWords
+Term::ReadLine
+Term::ReadKey
+.
+
+$deps{'DEV'} = [ text_to_hash( << '.') ];
+Email::Abstract
+Test::Email
+HTML::Form
+HTML::TokeParser
+WWW::Mechanize 1.52
+Test::WWW::Mechanize 1.30
+Module::Refresh 0.03
+Test::Expect 0.31
+XML::Simple
+File::Find
+Test::Deep 0 # needed for shredder tests
+String::ShellQuote 0 # needed for gnupg-incoming.t
+Log::Dispatch::Perl
+Test::Warn
+Test::Builder 0.90 # needed for is_passing
+Test::MockTime
+Log::Dispatch::Perl
+Test::WWW::Mechanize::PSGI
+Plack::Middleware::Test::StashWarnings 0.08
+Test::LongString
+Test::NoWarnings
+Locale::PO
+.
+
+$deps{'FASTCGI'} = [ text_to_hash( << '.') ];
+FCGI 0.74
+FCGI::ProcManager
+.
+
+$deps{'MODPERL1'} = [ text_to_hash( << '.') ];
+Apache::Request
+Apache::DBI 0.92
+.
+
+$deps{'MODPERL2'} = [ text_to_hash( << '.') ];
+Apache::DBI
+HTML::Mason 1.36
+.
+
+$deps{'MYSQL'} = [ text_to_hash( << '.') ];
+DBD::mysql 2.1018
+.
+
+$deps{'ORACLE'} = [ text_to_hash( << '.') ];
+DBD::Oracle
+.
+
+$deps{'POSTGRESQL'} = [ text_to_hash( << '.') ];
+DBIx::SearchBuilder 1.66
+DBD::Pg 1.43
+.
+
+$deps{'SQLITE'} = [ text_to_hash( << '.') ];
+DBD::SQLite 1.00
+.
+
+$deps{'GPG'} = [ text_to_hash( << '.') ];
+GnuPG::Interface
+PerlIO::eol
+.
+
+$deps{'ICAL'} = [ text_to_hash( << '.') ];
+Data::ICal
+.
+
+$deps{'SMTP'} = [ text_to_hash( << '.') ];
+Net::SMTP
+.
+
+$deps{'DASHBOARDS'} = [ text_to_hash( << '.') ];
+HTML::RewriteAttributes 0.05
+MIME::Types
+URI 1.59
+.
+
+$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ];
+GraphViz
+IPC::Run 0.90
+.
+
+$deps{'GD'} = [ text_to_hash( << '.') ];
+GD
+GD::Graph
+GD::Text
+.
+
+$deps{'USERLOGO'} = [ text_to_hash( << '.') ];
+Convert::Color
+.
+
+$deps{'HTML-DOC'} = [ text_to_hash( <<'.') ];
+Pod::Simple 3.24
+HTML::Entities
+.
+
+my %AVOID = (
+ 'DBD::Oracle' => [qw(1.23)],
+ 'Email::Address' => [qw(1.893 1.894)],
+ 'Devel::StackTrace' => [qw(1.28 1.29)],
+);
+
+if ($args{'download'}) {
+ download_mods();
+}
+
+
+check_perl_version();
+
+check_users();
+
+my %Missing_By_Type = ();
+foreach my $type (sort grep $args{$_}, keys %args) {
+ next unless ($type =~ /^with-(.*?)$/) and $deps{$1};
+
+ $type = $1;
+ section("$type dependencies");
+
+ my @missing;
+ my @deps = @{ $deps{$type} };
+
+ my %missing = test_deps(@deps);
+
+ if ( $args{'install'} ) {
+ for my $module (keys %missing) {
+ resolve_dep($module, $missing{$module}{version});
+ my $m = $module . '.pm';
+ $m =~ s!::!/!g;
+ if ( delete $INC{$m} ) {
+ my $symtab = $module . '::';
+ no strict 'refs';
+ for my $symbol ( keys %{$symtab} ) {
+ next if substr( $symbol, -2, 2 ) eq '::';
+ delete $symtab->{$symbol};
+ }
+ }
+ delete $missing{$module}
+ if test_dep($module, $missing{$module}{version}, $AVOID{$module});
+ }
+ }
+
+ $Missing_By_Type{$type} = \%missing if keys %missing;
+}
+
+if ( $args{'install'} && keys %Missing_By_Type ) {
+ exec($script_path, @orig_argv, '--no-install');
+}
+else {
+ conclude(%Missing_By_Type);
+}
+
+sub test_deps {
+ my @deps = @_;
+
+ my %missing;
+ while(@deps) {
+ my $module = shift @deps;
+ my $version = shift @deps;
+ my($test, $error) = test_dep($module, $version, $AVOID{$module});
+ my $msg = $module . ($version && !$error ? " >= $version" : '');
+ print_found($msg, $test, $error);
+
+ $missing{$module} = { version => $version, error => $error } unless $test;
+ }
+
+ return %missing;
+}
+
+sub test_dep {
+ my $module = shift;
+ my $version = shift;
+ my $avoid = shift;
+
+ if ( $args{'list-deps'} ) {
+ print $module, ': ', $version || 0, "\n";
+ }
+ else {
+ no warnings 'deprecated';
+ eval "use $module $version ()";
+ if ( my $error = $@ ) {
+ return 0 unless wantarray;
+
+ $error =~ s/\n(.*)$//s;
+ $error =~ s/at \(eval \d+\) line \d+\.$//;
+ undef $error if $error =~ /this is only/;
+
+ return ( 0, $error );
+ }
+
+ if ( $avoid ) {
+ my $version = $module->VERSION;
+ if ( grep $version eq $_, @$avoid ) {
+ return 0 unless wantarray;
+ return (0, "It's known that there are problems with RT and version '$version' of '$module' module. If it's the latest available version of the module then you have to downgrade manually.");
+ }
+ }
+
+ return 1;
+ }
+}
+
+sub resolve_dep {
+ my $module = shift;
+ my $version = shift;
+
+ print "\nInstall module $module\n";
+
+ my $ext = $ENV{'RT_FIX_DEPS_CMD'} || $ENV{'PERL_PREFER_CPAN_CLIENT'};
+ unless( $ext ) {
+ my $configured = 1;
+ {
+ local @INC = @INC;
+ if ( $ENV{'HOME'} ) {
+ unshift @INC, "$ENV{'HOME'}/.cpan";
+ }
+ $configured = eval { require CPAN::MyConfig } || eval { require CPAN::Config };
+ }
+ unless ( $configured ) {
+ print <<END;
+You haven't configured the CPAN shell yet.
+Please run `/usr/bin/perl -MCPAN -e shell` to configure it.
+END
+ exit(1);
+ }
+ my $rv = eval { require CPAN; CPAN::Shell->install($module) };
+ return $rv unless $@;
+
+ print <<END;
+Failed to load module CPAN.
+
+-------- Error ---------
+$@
+------------------------
+
+When we tried to start installing RT's perl dependencies,
+we were unable to load the CPAN client. This module is usually distributed
+with Perl. This usually indicates that your vendor has shipped an unconfigured
+or incorrectly configured CPAN client.
+The error above may (or may not) give you a hint about what went wrong
+
+You have several choices about how to install dependencies in
+this situatation:
+
+1) use a different tool to install dependencies by running setting the following
+ shell environment variable and rerunning this tool:
+ RT_FIX_DEPS_CMD='/usr/bin/perl -MCPAN -e"install %s"'
+2) Attempt to configure CPAN by running:
+ `/usr/bin/perl -MCPAN -e shell` program from shell.
+ If this fails, you may have to manually upgrade CPAN (see below)
+3) Try to update the CPAN client. Download it from:
+ http://search.cpan.org/dist/CPAN and try again
+4) Install each dependency manually by downloading them one by one from
+ http://search.cpan.org
+
+END
+ exit(1);
+ }
+
+ if( $ext =~ /\%s/) {
+ $ext =~ s/\%s/$module/g; # sprintf( $ext, $module );
+ } else {
+ $ext .= " $module";
+ }
+ print "\t\tcommand: '$ext'\n";
+ return scalar `$ext 1>&2`;
+}
+
+sub download_mods {
+ my %modules;
+ use CPAN;
+
+ foreach my $key (keys %deps) {
+ my @deps = (@{$deps{$key}});
+ while (@deps) {
+ my $mod = shift @deps;
+ my $ver = shift @deps;
+ next if ($mod =~ /^(DBD-|Apache-Request)/);
+ $modules{$mod} = $ver;
+ }
+ }
+ my @mods = keys %modules;
+ CPAN::get();
+ my $moddir = $args{'download'};
+ foreach my $mod (@mods) {
+ $CPAN::Config->{'build_dir'} = $moddir;
+ CPAN::get($mod);
+ }
+
+ opendir(DIR, $moddir);
+ while ( my $dir = readdir(DIR)) {
+ print "Dir is $dir\n";
+ next if ( $dir =~ /^\.\.?$/);
+
+ # Skip things we've previously tagged
+ my $out = `svn ls $args{'repository'}/tags/$dir`;
+ next if ($out);
+
+ if ($dir =~ /^(.*)-(.*?)$/) {
+ `svn_load_dirs -no_user_input -t tags/$dir -v $args{'repository'} dists/$1 $moddir/$dir`;
+ `rm -rf $moddir/$dir`;
+
+ }
+
+ }
+ closedir(DIR);
+ exit;
+}
+
+sub check_perl_version {
+ section("perl");
+ eval {require 5.008003};
+ if ($@) {
+ print_found("5.8.3", 0,"RT is known to be non-functional on versions of perl older than 5.8.3. Please upgrade to 5.8.3 or newer.");
+ exit(1);
+ } else {
+ print_found( sprintf(">=5.8.3(%vd)", $^V), 1 );
+ }
+}
+
+sub check_users {
+ section("users");
+ print_found("rt group (freeside)", defined getgrnam("freeside"));
+ print_found("bin owner (root)", defined getpwnam("root"));
+ print_found("libs owner (root)", defined getpwnam("root"));
+ print_found("libs group (bin)", defined getgrnam("bin"));
+ print_found("web owner (freeside)", defined getpwnam("freeside"));
+ print_found("web group (freeside)", defined getgrnam("freeside"));
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+rt-test-dependencies - test rt's dependencies
+
+=head1 SYNOPSIS
+
+ rt-test-dependencies
+ rt-test-dependencies --install
+ rt-test-dependencies --with-mysql --with-fastcgi
+
+=head1 DESCRIPTION
+
+by default, C<rt-test-dependencies> determines whether you have installed all
+the perl modules RT needs to run.
+
+the "RT_FIX_DEPS_CMD" environment variable, if set, will be used instead of
+the standard CPAN shell by --install to install any required modules. it will
+be called with the module name, or, if "RT_FIX_DEPS_CMD" contains a "%s", will
+replace the "%s" with the module name before calling the program.
+
+=head1 OPTIONS
+
+=over
+
+=item install
+
+ install missing modules
+
+=item verbose
+
+list the status of all dependencies, rather than just the missing ones.
+
+-v is equal to --verbose
+
+=item specify dependencies
+
+=over
+
+=item --with-mysql
+
+ database interface for mysql
+
+=item --with-postgresql
+
+ database interface for postgresql
+
+=item with-oracle
+
+ database interface for oracle
+
+=item with-sqlite
+
+ database interface and driver for sqlite (unsupported)
+
+=item with-fastcgi
+
+ libraries needed to support the fastcgi handler
+
+=item with-modperl1
+
+ libraries needed to support the modperl 1 handler
+
+=item with-modperl2
+
+ libraries needed to support the modperl 2 handler
+
+=item with-dev
+
+ tools needed for RT development
+
+=back
+
+=back
+
diff --git a/rt/sbin/rt-test-dependencies.in b/rt/sbin/rt-test-dependencies.in
index d41337a96..19ec297e5 100644
--- a/rt/sbin/rt-test-dependencies.in
+++ b/rt/sbin/rt-test-dependencies.in
@@ -334,6 +334,7 @@ DBD::Oracle
.
$deps{'POSTGRESQL'} = [ text_to_hash( << '.') ];
+DBIx::SearchBuilder 1.66
DBD::Pg 1.43
.
@@ -382,7 +383,6 @@ HTML::Entities
my %AVOID = (
'DBD::Oracle' => [qw(1.23)],
- 'DBD::Pg' => [qw(3.3.0)],
'Email::Address' => [qw(1.893 1.894)],
'Devel::StackTrace' => [qw(1.28 1.29)],
);
diff --git a/rt/sbin/rt-validate-aliases b/rt/sbin/rt-validate-aliases
new file mode 100755
index 000000000..0953f9300
--- /dev/null
+++ b/rt/sbin/rt-validate-aliases
@@ -0,0 +1,343 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+use Text::ParseWords qw//;
+use Getopt::Long;
+
+BEGIN { # BEGIN RT CMD BOILERPLATE
+ require File::Spec;
+ require Cwd;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+}
+
+require RT;
+RT::LoadConfig();
+RT::Init();
+
+my ($PREFIX, $URL, $HOST) = ("");
+GetOptions(
+ "prefix|p=s" => \$PREFIX,
+ "url|u=s" => \$URL,
+ "host|h=s" => \$HOST,
+);
+
+unless (@ARGV) {
+ @ARGV = grep {-f} ("/etc/aliases",
+ "/etc/mail/aliases",
+ "/etc/postfix/aliases");
+ die "Can't determine aliases file to parse!"
+ unless @ARGV;
+}
+
+my %aliases = parse_lines();
+unless (%aliases) {
+ warn "No mailgate aliases found in @ARGV";
+ exit;
+}
+
+my %seen;
+my $global_mailgate;
+for my $address (sort keys %aliases) {
+ my ($mailgate, $opts, $extra) = @{$aliases{$address}};
+ my %opts = %{$opts};
+
+ next if $opts{url} and $URL and $opts{url} !~ /\Q$URL\E/;
+
+ if ($mailgate !~ /^\|/) {
+ warn "Missing the leading | on alias $address\n";
+ $mailgate = "|$mailgate";
+ }
+ if (($global_mailgate ||= $mailgate) ne $mailgate) {
+ warn "Unexpected mailgate for alias $address -- expected $global_mailgate, got $mailgate\n";
+ }
+
+ if (not defined $opts{action}) {
+ warn "Missing --action parameter for alias $address\n";
+ } elsif ($opts{action} !~ /^(correspond|comment)$/) {
+ warn "Invalid --action parameter for alias $address: $opts{action}\n"
+ }
+
+ my $queue = RT::Queue->new( RT->SystemUser );
+ if (not defined $opts{queue}) {
+ warn "Missing --queue parameter for alias $address\n";
+ } else {
+ $queue->Load( $opts{queue} );
+ if (not $queue->id) {
+ warn "Invalid --queue parameter for alias $address: $opts{queue}\n";
+ } elsif ($queue->Disabled) {
+ warn "Disabled --queue given for alias $address: $opts{queue}\n";
+ }
+ }
+
+ if (not defined $opts{url}) {
+ warn "Missing --url parameter for alias $address\n";
+ } #XXX: Test connectivity and/or https certs?
+
+ if ($queue->id and $opts{action} =~ /^(correspond|comment)$/) {
+ push @{$seen{lc $queue->Name}{$opts{action}}}, $address;
+ }
+
+ warn "Unknown extra arguments for alias $address: @{$extra}\n"
+ if @{$extra};
+}
+
+# Check the global settings
+my %global;
+for my $action (qw/correspond comment/) {
+ my $setting = ucfirst($action) . "Address";
+ my $value = RT->Config->Get($setting);
+ if (not defined $value) {
+ warn "$setting is not set!\n";
+ next;
+ }
+ my ($local,$host) = lc($value) =~ /(.*?)\@(.*)/;
+ next if $HOST and $host !~ /\Q$HOST\E/;
+ $local = "$PREFIX$local" unless exists $aliases{$local};
+
+ $global{$setting} = $local;
+ if (not exists $aliases{$local}) {
+ warn "$setting $value does not exist in aliases!\n"
+ } elsif ($aliases{$local}[1]{action} ne $action) {
+ warn "$setting $value is a $aliases{$local}[1]{action} in aliases!"
+ }
+}
+warn "CorrespondAddress and CommentAddress are the same!\n"
+ if RT->Config->Get("CorrespondAddress") eq RT->Config->Get("CommentAddress");
+
+
+# Go through the queues, one at a time
+my $queues = RT::Queues->new( RT->SystemUser );
+$queues->UnLimit;
+while (my $q = $queues->Next) {
+ my $qname = $q->Name;
+ for my $action (qw/correspond comment/) {
+ my $setting = ucfirst($action) . "Address";
+ my $value = $q->$setting;
+
+ if (not $value) {
+ my @other = grep {$_ ne $global{$setting}} @{$seen{lc $q->Name}{$action} || []};
+ warn "CorrespondAddress not set on $qname, but in aliases as "
+ .join(" and ", @other) . "\n" if @other;
+ next;
+ }
+
+ if ($action eq "comment" and $q->CorrespondAddress
+ and $q->CorrespondAddress eq $q->CommentAddress) {
+ warn "CorrespondAddress and CommentAddress are set the same on $qname\n";
+ next;
+ }
+
+ my ($local, $host) = lc($value) =~ /(.*?)\@(.*)/;
+ next if $HOST and $host !~ /\Q$HOST\E/;
+ $local = "$PREFIX$local" unless exists $aliases{$local};
+
+ my @other = @{$seen{lc $q->Name}{$action} || []};
+ if (not exists $aliases{$local}) {
+ if (@other) {
+ warn "$setting $value on $qname does not exist in aliases -- typo'd as "
+ .join(" or ", @other) . "?\n";
+ } else {
+ warn "$setting $value on $qname does not exist in aliases!\n"
+ }
+ next;
+ }
+
+ my %opt = %{$aliases{$local}[1]};
+ if ($opt{action} ne $action) {
+ warn "$setting address $value on $qname is a $opt{action} in aliases!\n"
+ }
+ if (lc $opt{queue} ne lc $q->Name and $action ne "comment") {
+ warn "$setting address $value on $qname points to queue $opt{queue} in aliases!\n";
+ }
+
+ @other = grep {$_ ne $local} @other;
+ warn "Extra aliases for queue $qname: ".join(",",@other)."\n"
+ if @other;
+ }
+}
+
+
+sub parse_lines {
+ local @ARGV = @ARGV;
+
+ my %aliases;
+ my $line = "";
+ for (<>) {
+ next unless /\S/;
+ next if /^#/;
+ chomp;
+ if (/^\s+/) {
+ $line .= $_;
+ } else {
+ add_line($line, \%aliases);
+ $line = $_;
+ }
+ }
+ add_line($line, \%aliases);
+
+ expand(\%aliases);
+ filter_mailgate(\%aliases);
+
+ return %aliases;
+}
+
+sub expand {
+ my ($data) = @_;
+
+ for (1..100) {
+ my $expanded = 0;
+ for my $address (sort keys %{$data}) {
+ my @new;
+ for my $part (@{$data->{$address}}) {
+ if (m!^[|/]! or not $data->{$part}) {
+ push @new, $part;
+ } else {
+ $expanded++;
+ push @new, @{$data->{$part}};
+ }
+ }
+ $data->{$address} = \@new;
+ }
+ return unless $expanded;
+ }
+ warn "Recursion limit exceeded -- cycle in aliases?\n";
+}
+
+sub filter_mailgate {
+ my ($data) = @_;
+
+ for my $address (sort keys %{$data}) {
+ my @parts = @{delete $data->{$address}};
+
+ my @pipes = grep {m!^\|?.*?/rt-mailgate\b!} @parts;
+ next unless @pipes;
+
+ my $pipe = shift @pipes;
+ warn "More than one rt-mailgate pipe for alias: $address\n"
+ if @pipes;
+
+ my @args = Text::ParseWords::shellwords($pipe);
+
+ # We allow "|/random-other-command /opt/rt4/bin/rt-mailgate ...",
+ # we just need to strip off enough
+ my $index = 0;
+ $index++ while $args[$index] !~ m!/rt-mailgate!;
+ my $mailgate = join(' ', splice(@args,0,$index+1));
+
+ my %opts;
+ local @ARGV = @args;
+ Getopt::Long::Configure( "pass_through" ); # Allow unknown options
+ my $ret = eval {
+ GetOptions( \%opts, "queue=s", "action=s", "url=s",
+ "jar=s", "debug", "extension=s",
+ "timeout=i", "verify-ssl!", "ca-file=s",
+ );
+ 1;
+ };
+ warn "Failed to parse options for $address: $@" unless $ret;
+ next unless %opts;
+
+ $data->{lc $address} = [$mailgate, \%opts, [@ARGV]];
+ }
+}
+
+sub add_line {
+ my ($line, $data) = @_;
+ return unless $line =~ /\S/;
+
+ my ($name, $parts) = parse_line($line);
+ return unless defined $name;
+
+ if (defined $data->{$name}) {
+ warn "Duplicate definition for alias $name\n";
+ return;
+ }
+
+ $data->{lc $name} = $parts;
+}
+
+sub parse_line {
+ my $re_name = qr/\S+/;
+ # Intentionally accept pipe-like aliases with a missing | -- we deal with them later
+ my $re_quoted_pipe = qr/"\|?[^\\"]*(?:\\[\\"][^\\"]*)*"/;
+ my $re_nonquoted_pipe = qr/\|[^\s,]+/;
+ my $re_pipe = qr/(?:$re_quoted_pipe|$re_nonquoted_pipe)/;
+ my $re_path = qr!/[^,\s]+!;
+ my $re_address = qr![^|/,\s][^,\s]*!;
+ my $re_value = qr/(?:$re_pipe|$re_path|$re_address)/;
+ my $re_values = qr/(?:$re_value(?:\s*,\s*$re_value)*)/;
+
+ my ($line) = @_;
+ if ($line =~ /^($re_name):\s*($re_values)/) {
+ my ($name, $all_parts) = ($1, $2);
+ my @parts;
+ while ($all_parts =~ s/^(?:\s*,\s*)?($re_value)//) {
+ my $part = $1;
+ if ($part =~ /^"/) {
+ $part =~ s/^"//; $part =~ s/"$//;
+ $part =~ s/\\(.)/$1/g;
+ }
+ push @parts, $part;
+ }
+ return $name, [@parts];
+ } else {
+ warn "Parse failure, line $. of $ARGV: $line\n";
+ return ();
+ }
+}
diff --git a/rt/sbin/rt-validator b/rt/sbin/rt-validator
new file mode 100755
index 000000000..db6c1e914
--- /dev/null
+++ b/rt/sbin/rt-validator
@@ -0,0 +1,1182 @@
+#!/usr/bin/perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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;
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+my %opt = ();
+GetOptions(
+ \%opt,
+ 'check|c',
+ 'resolve',
+ 'force',
+ 'verbose|v',
+ 'help|h',
+);
+
+if ( $opt{help} || !$opt{check} ) {
+ require Pod::Usage;
+ print Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+usage_warning() if $opt{'resolve'} && !$opt{'force'};
+
+
+sub usage_warning {
+ print <<END;
+This utility can fix some issues with DB by creating or updating. In some
+cases there is no enough data to resurect a missing record, but records which
+refers to a missing can be deleted. It's up to you to decide what to do.
+
+In any case it's highly recommended to have a backup before resolving anything.
+
+Press enter to continue.
+END
+# Read a line of text, any line of text
+ <STDIN>;
+}
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+my $dbh = $RT::Handle->dbh;
+my $db_type = RT->Config->Get('DatabaseType');
+
+my %TYPE = (
+ 'Transactions.Field' => 'text',
+ 'Transactions.OldValue' => 'text',
+ 'Transactions.NewValue' => 'text',
+);
+
+my @models = qw(
+ ACE
+ Attachment
+ Attribute
+ CachedGroupMember
+ CustomField
+ CustomFieldValue
+ GroupMember
+ Group
+ Link
+ ObjectCustomField
+ ObjectCustomFieldValue
+ Principal
+ Queue
+ ScripAction
+ ScripCondition
+ Scrip
+ Template
+ Ticket
+ Transaction
+ User
+);
+
+my %redo_on;
+$redo_on{'Delete'} = {
+ ACL => [],
+
+ Attributes => [],
+
+ Links => [],
+
+ CustomFields => [],
+ CustomFieldValues => [],
+ ObjectCustomFields => [],
+ ObjectCustomFieldValues => [],
+
+ Queues => [],
+
+ Scrips => [],
+ ScripActions => [],
+ ScripConditions => [],
+ Templates => [],
+
+ Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
+ Transactions => [ 'Attachments -> other' ],
+
+ Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
+ Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
+ Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],
+
+ GroupMembers => [ 'CGM vs. GM' ],
+ CachedGroupMembers => [ 'CGM vs. GM' ],
+};
+$redo_on{'Create'} = {
+ Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
+ Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
+ GroupMembers => [ 'CGM vs. GM' ],
+ CachedGroupMembers => [ 'CGM vs. GM' ],
+};
+$redo_on{'Update'} = {
+ Groups => ['User Defined Group Name uniqueness'],
+};
+
+my %describe_cb;
+%describe_cb = (
+ Attachments => sub {
+ my $row = shift;
+ my $txn_id = $row->{transactionid};
+ my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
+ return $res .', '. describe( 'Transactions', $txn_id );
+ },
+ Transactions => sub {
+ my $row = shift;
+ return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
+ },
+);
+
+{ my %cache = ();
+sub m2t($) {
+ my $model = shift;
+ return $cache{$model} if $cache{$model};
+ my $class = "RT::$model";
+ my $object = $class->new( RT->SystemUser );
+ return $cache{$model} = $object->Table;
+} }
+
+my (@do_check, %redo_check);
+
+my @CHECKS;
+foreach my $table ( qw(Users Groups) ) {
+ push @CHECKS, "$table -> Principals" => sub {
+ my $msg = "A record in $table refers to a nonexistent record in Principals."
+ ." The script can either create the missing record in Principals"
+ ." or delete the record in $table.";
+ my ($type) = ($table =~ /^(.*)s$/);
+ check_integrity(
+ $table, 'id' => 'Principals', 'id',
+ join_condition => 't.PrincipalType = ?',
+ bind_values => [ $type ],
+ action => sub {
+ my $id = shift;
+ return unless my $a = prompt_action( ['Create', 'delete'], $msg );
+
+ if ( $a eq 'd' ) {
+ delete_record( $table, $id );
+ }
+ elsif ( $a eq 'c' ) {
+ my $principal_id = create_record( 'Principals',
+ id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
+ );
+ }
+ else {
+ die "Unknown action '$a'";
+ }
+ },
+ );
+ };
+
+ push @CHECKS, "Principals -> $table" => sub {
+ my $msg = "A record in Principals refers to a nonexistent record in $table."
+ ." In some cases it's possible to manually resurrect such records,"
+ ." but this utility can only delete records.";
+
+ check_integrity(
+ 'Principals', 'id' => $table, 'id',
+ condition => 's.PrincipalType = ?',
+ bind_values => [ $table =~ /^(.*)s$/ ],
+ action => sub {
+ my $id = shift;
+ return unless prompt( 'Delete', $msg );
+
+ delete_record( 'Principals', $id );
+ },
+ );
+ };
+}
+
+push @CHECKS, 'User <-> ACL equivalence group' => sub {
+ # from user to group
+ check_integrity(
+ 'Users', 'id' => 'Groups', 'Instance',
+ join_condition => 't.Domain = ? AND t.Type = ?',
+ bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Create', "Found an user that has no ACL equivalence group."
+ );
+
+ my $gid = create_record( 'Groups',
+ Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
+ );
+ },
+ );
+ # from group to user
+ check_integrity(
+ 'Groups', 'Instance' => 'Users', 'id',
+ condition => 's.Domain = ? AND s.Type = ?',
+ bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found an user ACL equivalence group, but there is no user."
+ );
+
+ delete_record( 'Groups', $id );
+ },
+ );
+ # one ACL equiv group for each user
+ check_uniqueness(
+ 'Groups',
+ columns => ['Instance'],
+ condition => '.Domain = ? AND .Type = ?',
+ bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
+ );
+};
+
+# check integrity of Queue role groups
+push @CHECKS, 'Queues <-> Role Groups' => sub {
+ # XXX: we check only that there is at least one group for a queue
+ # from queue to group
+ check_integrity(
+ 'Queues', 'id' => 'Groups', 'Instance',
+ join_condition => 't.Domain = ?',
+ bind_values => [ 'RT::Queue-Role' ],
+ );
+ # from group to queue
+ check_integrity(
+ 'Groups', 'Instance' => 'Queues', 'id',
+ condition => 's.Domain = ?',
+ bind_values => [ 'RT::Queue-Role' ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a role group of a nonexistent queue."
+ );
+
+ delete_record( 'Groups', $id );
+ },
+ );
+};
+
+# check integrity of Ticket role groups
+push @CHECKS, 'Tickets <-> Role Groups' => sub {
+ # XXX: we check only that there is at least one group for a queue
+ # from queue to group
+ check_integrity(
+ 'Tickets', 'id' => 'Groups', 'Instance',
+ join_condition => 't.Domain = ?',
+ bind_values => [ 'RT::Ticket-Role' ],
+ );
+ # from group to ticket
+ check_integrity(
+ 'Groups', 'Instance' => 'Tickets', 'id',
+ condition => 's.Domain = ?',
+ bind_values => [ 'RT::Ticket-Role' ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a role group of a nonexistent ticket."
+ );
+
+ delete_record( 'Groups', $id );
+ },
+ );
+};
+
+# additional CHECKS on groups
+push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
+ # Check that Domain, Instance and Type are unique
+ check_uniqueness(
+ 'Groups',
+ columns => ['Domain', 'Instance', 'Type'],
+ condition => '.Domain LIKE ?',
+ bind_values => [ '%-Role' ],
+ );
+};
+
+push @CHECKS, 'System internal group uniqueness' => sub {
+ check_uniqueness(
+ 'Groups',
+ columns => ['Instance', 'Type'],
+ condition => '.Domain = ?',
+ bind_values => [ 'SystemInternal' ],
+ );
+};
+
+# CHECK that user defined group names are unique
+push @CHECKS, 'User Defined Group Name uniqueness' => sub {
+ check_uniqueness(
+ 'Groups',
+ columns => ['Name'],
+ condition => '.Domain = ?',
+ bind_values => [ 'UserDefined' ],
+ extra_tables => ['Principals sp', 'Principals tp'],
+ extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)),
+ extra_values => ['Group', 'Group'],
+ action => sub {
+ return unless prompt(
+ 'Rename', "Found a user defined group with a non-unique Name."
+ );
+
+ my $id = shift;
+ my %cols = @_;
+ update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) });
+ },
+ );
+};
+
+push @CHECKS, 'GMs -> Groups, Members' => sub {
+ my $msg = "A record in GroupMembers references an object that doesn't exist."
+ ." Maybe you deleted a group or principal directly from the database?"
+ ." Usually it's OK to delete such records.";
+ check_integrity(
+ 'GroupMembers', 'GroupId' => 'Groups', 'id',
+ action => sub {
+ my $id = shift;
+ return unless prompt( 'Delete', $msg );
+
+ delete_record( 'GroupMembers', $id );
+ },
+ );
+ check_integrity(
+ 'GroupMembers', 'MemberId' => 'Principals', 'id',
+ action => sub {
+ my $id = shift;
+ return unless prompt( 'Delete', $msg );
+
+ delete_record( 'GroupMembers', $id );
+ },
+ );
+};
+
+# CGM and GM
+push @CHECKS, 'CGM vs. GM' => sub {
+ # all GM record should be duplicated in CGM
+ check_integrity(
+ GroupMembers => ['GroupId', 'MemberId'],
+ CachedGroupMembers => ['GroupId', 'MemberId'],
+ join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Create',
+ "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
+ );
+
+ my $gm = RT::GroupMember->new( RT->SystemUser );
+ $gm->Load( $id );
+ die "Couldn't load GM record #$id" unless $gm->id;
+ my $cgm = create_record( 'CachedGroupMembers',
+ GroupId => $gm->GroupId, MemberId => $gm->MemberId,
+ ImmediateParentId => $gm->GroupId, Via => undef,
+ Disabled => 0, # XXX: we should check integrity of Disabled field
+ );
+ update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
+ },
+ );
+ # all first level CGM records should have a GM record
+ check_integrity(
+ CachedGroupMembers => ['GroupId', 'MemberId'],
+ GroupMembers => ['GroupId', 'MemberId'],
+ condition => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete',
+ "Found a record in CachedGroupMembers for a (Group, Member) pair"
+ ." that doesn't exist in the GroupMembers table."
+ );
+
+ delete_record( 'CachedGroupMembers', $id );
+ },
+ );
+ # each group should have a CGM record where MemberId == GroupId
+ check_integrity(
+ Groups => ['id', 'id'],
+ CachedGroupMembers => ['GroupId', 'MemberId'],
+ join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Create',
+ "Found a record in Groups that has no direct"
+ ." duplicate in CachedGroupMembers table."
+ );
+
+ my $g = RT::Group->new( RT->SystemUser );
+ $g->Load( $id );
+ die "Couldn't load group #$id" unless $g->id;
+ die "Loaded group by $id has id ". $g->id unless $g->id == $id;
+ my $cgm = create_record( 'CachedGroupMembers',
+ GroupId => $id, MemberId => $id,
+ ImmediateParentId => $id, Via => undef,
+ Disabled => $g->Disabled,
+ );
+ update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
+ },
+ );
+
+ # and back, each record in CGM with MemberId == GroupId without exceptions
+ # should reference a group
+ check_integrity(
+ CachedGroupMembers => ['GroupId', 'MemberId'],
+ Groups => ['id', 'id'],
+ condition => "s.GroupId = s.MemberId",
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete',
+ "Found a record in CachedGroupMembers for a group that doesn't exist."
+ );
+
+ delete_record( 'CachedGroupMembers', $id );
+ },
+ );
+ # Via
+ check_integrity(
+ CachedGroupMembers => 'Via',
+ CachedGroupMembers => 'id',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete',
+ "Found a record in CachedGroupMembers with Via that references a nonexistent record."
+ );
+
+ delete_record( 'CachedGroupMembers', $id );
+ },
+ );
+
+ # for every CGM where ImmediateParentId != GroupId there should be
+ # matching parent record (first level)
+ check_integrity(
+ CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
+ CachedGroupMembers => ['GroupId', 'MemberId'],
+ join_condition => 't.Via = t.id',
+ condition => 's.ImmediateParentId != s.GroupId',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete',
+ "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
+ );
+
+ delete_record( 'CachedGroupMembers', $id );
+ },
+ );
+
+ # for every CGM where ImmediateParentId != GroupId there should be
+ # matching "grand" parent record
+ check_integrity(
+ CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
+ CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
+ condition => 's.ImmediateParentId != s.GroupId',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete',
+ "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
+ );
+
+ delete_record( 'CachedGroupMembers', $id );
+ },
+ );
+
+ # CHECK recursive records:
+ # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
+ # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
+ {
+ my $query = <<END;
+SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
+ cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
+FROM
+ CachedGroupMembers cgm1
+ CROSS JOIN GroupMembers gm2
+ LEFT JOIN CachedGroupMembers cgm3 ON (
+ cgm3.GroupId = cgm1.GroupId
+ AND cgm3.MemberId = gm2.MemberId
+ AND cgm3.Via = cgm1.id
+ AND cgm3.ImmediateParentId = cgm1.MemberId )
+WHERE cgm1.GroupId != cgm1.MemberId
+AND gm2.GroupId = cgm1.MemberId
+AND cgm3.id IS NULL
+END
+
+ my $action = sub {
+ my %props = @_;
+ return unless prompt(
+ 'Create',
+ "Found records in CachedGroupMembers table without recursive duplicates."
+ );
+ my $cgm = create_record( 'CachedGroupMembers', %props );
+ };
+
+ my $sth = execute_query( $query );
+ while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
+ print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
+ print STDERR " but there is no cached GM record that $m is member of #$g.\n";
+ $action->(
+ GroupId => $g, MemberId => $m, Via => $via,
+ ImmediateParentId => $ip, Disabled => $dis,
+ );
+ }
+ }
+};
+
+# Tickets
+push @CHECKS, 'Tickets -> other' => sub {
+ check_integrity(
+ 'Tickets', 'EffectiveId' => 'Tickets', 'id',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete',
+ "Found a ticket that's been merged into a ticket that no longer exists."
+ );
+
+ delete_record( 'Tickets', $id );
+ },
+ );
+ check_integrity(
+ 'Tickets', 'Queue' => 'Queues', 'id',
+ );
+ check_integrity(
+ 'Tickets', 'Owner' => 'Users', 'id',
+ );
+ # XXX: check that owner is only member of owner role group
+};
+
+
+push @CHECKS, 'Transactions -> other' => sub {
+ foreach my $model ( @models ) {
+ check_integrity(
+ 'Transactions', 'ObjectId' => m2t($model), 'id',
+ condition => 's.ObjectType = ?',
+ bind_values => [ "RT::$model" ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a transaction without object."
+ );
+
+ delete_record( 'Transactions', $id );
+ },
+ );
+ }
+ # type = CustomField
+ check_integrity(
+ 'Transactions', 'Field' => 'CustomFields', 'id',
+ condition => 's.Type = ?',
+ bind_values => [ 'CustomField' ],
+ );
+ # type = Take, Untake, Force, Steal or Give
+ check_integrity(
+ 'Transactions', 'OldValue' => 'Users', 'id',
+ condition => 's.Type IN (?, ?, ?, ?, ?)',
+ bind_values => [ qw(Take Untake Force Steal Give) ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a transaction regarding Owner changes,"
+ ." but the User with id stored in OldValue column doesn't exist anymore."
+ );
+
+ delete_record( 'Transactions', $id );
+ },
+ );
+ check_integrity(
+ 'Transactions', 'NewValue' => 'Users', 'id',
+ condition => 's.Type IN (?, ?, ?, ?, ?)',
+ bind_values => [ qw(Take Untake Force Steal Give) ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a transaction regarding Owner changes,"
+ ." but the User with id stored in NewValue column doesn't exist anymore."
+ );
+
+ delete_record( 'Transactions', $id );
+ },
+ );
+ # type = DelWatcher
+ check_integrity(
+ 'Transactions', 'OldValue' => 'Principals', 'id',
+ condition => 's.Type = ?',
+ bind_values => [ 'DelWatcher' ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a transaction describing watcher changes,"
+ ." but the User with id stored in OldValue column doesn't exist anymore."
+ );
+
+ delete_record( 'Transactions', $id );
+ },
+ );
+ # type = AddWatcher
+ check_integrity(
+ 'Transactions', 'NewValue' => 'Principals', 'id',
+ condition => 's.Type = ?',
+ bind_values => [ 'AddWatcher' ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a transaction describing watcher changes,"
+ ." but the User with id stored in NewValue column doesn't exist anymore."
+ );
+
+ delete_record( 'Transactions', $id );
+ },
+ );
+
+# XXX: Links need more love, uri is stored instead of id
+# # type = DeleteLink
+# check_integrity(
+# 'Transactions', 'OldValue' => 'Links', 'id',
+# condition => 's.Type = ?',
+# bind_values => [ 'DeleteLink' ],
+# );
+# # type = AddLink
+# check_integrity(
+# 'Transactions', 'NewValue' => 'Links', 'id',
+# condition => 's.Type = ?',
+# bind_values => [ 'AddLink' ],
+# );
+
+ # type = Set, Field = Queue
+ check_integrity(
+ 'Transactions', 'NewValue' => 'Queues', 'id',
+ condition => 's.Type = ? AND s.Field = ?',
+ bind_values => [ 'Set', 'Queue' ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a transaction describing a queue change,"
+ ." but the Queue with id stored in the NewValue column doesn't exist anymore."
+ );
+
+ delete_record( 'Transactions', $id );
+ },
+ );
+ check_integrity(
+ 'Transactions', 'OldValue' => 'Queues', 'id',
+ condition => 's.Type = ? AND s.Field = ?',
+ bind_values => [ 'Set', 'Queue' ],
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found a transaction describing a queue change,"
+ ." but the Queue with id stored in the OldValue column doesn't exist anymore."
+ );
+
+ delete_record( 'Transactions', $id );
+ },
+ );
+ # Reminders
+ check_integrity(
+ 'Transactions', 'NewValue' => 'Tickets', 'id',
+ join_condition => 't.Type = ?',
+ condition => 's.Type IN (?, ?, ?)',
+ bind_values => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
+ );
+};
+
+# Attachments
+push @CHECKS, 'Attachments -> other' => sub {
+ check_integrity(
+ Attachments => 'TransactionId', Transactions => 'id',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found an attachment without a transaction."
+ );
+ delete_record( 'Attachments', $id );
+ },
+ );
+ check_integrity(
+ Attachments => 'Parent', Attachments => 'id',
+ action => sub {
+ my $id = shift;
+ return unless prompt(
+ 'Delete', "Found an sub-attachment without its parent attachment."
+ );
+ delete_record( 'Attachments', $id );
+ },
+ );
+ check_integrity(
+ Attachments => 'Parent',
+ Attachments => 'id',
+ join_condition => 's.TransactionId = t.TransactionId',
+ );
+};
+
+push @CHECKS, 'CustomFields and friends' => sub {
+ #XXX: ObjectCustomFields needs more love
+ check_integrity(
+ 'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
+ );
+ check_integrity(
+ 'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
+ );
+ foreach my $model ( @models ) {
+ check_integrity(
+ 'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
+ condition => 's.ObjectType = ?',
+ bind_values => [ "RT::$model" ],
+ );
+ }
+};
+
+push @CHECKS, Templates => sub {
+ check_integrity(
+ 'Templates', 'Queue' => 'Queues', 'id',
+ );
+};
+
+push @CHECKS, Scrips => sub {
+ check_integrity(
+ 'Scrips', 'Queue' => 'Queues', 'id',
+ );
+ check_integrity(
+ 'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
+ );
+ check_integrity(
+ 'Scrips', 'ScripAction' => 'ScripActions', 'id',
+ );
+ check_integrity(
+ 'Scrips', 'Template' => 'Templates', 'id',
+ );
+};
+
+push @CHECKS, Attributes => sub {
+ foreach my $model ( @models ) {
+ check_integrity(
+ 'Attributes', 'ObjectId' => m2t($model), 'id',
+ condition => 's.ObjectType = ?',
+ bind_values => [ "RT::$model" ],
+ );
+ }
+};
+
+# Fix situations when Creator or LastUpdatedBy references ACL equivalence
+# group of a user instead of user
+push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
+ my %fix = ();
+ foreach my $model ( @models ) {
+ my $class = "RT::$model";
+ my $object = $class->new( RT->SystemUser );
+ foreach my $column ( qw(LastUpdatedBy Creator) ) {
+ next unless $object->_Accessible( $column, 'auto' );
+
+ my $table = m2t($model);
+ my $query = <<END;
+SELECT m.id, g.id, g.Instance
+FROM
+ Groups g JOIN $table m ON g.id = m.$column
+WHERE
+ g.Domain = ?
+ AND g.Type = ?
+END
+ my $action = sub {
+ my ($gid, $uid) = @_;
+ return unless prompt(
+ 'Update',
+ "Looks like there were a bug in old versions of RT back in 2006\n"
+ ."that has been fixed. If other checks are ok then it's ok to update\n"
+ ."these records to point them to users instead of groups"
+ );
+ $fix{ $table }{ $column }{ $gid } = $uid;
+ };
+
+ my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
+ while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
+ print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
+ print STDERR " when must reference user.\n";
+ $action->( $gid, $uid );
+ if ( keys( %fix ) > 1000 ) {
+ $sth->finish;
+ last;
+ }
+ }
+ }
+ }
+
+ if ( keys %fix ) {
+ foreach my $table ( keys %fix ) {
+ foreach my $column ( keys %{ $fix{ $table } } ) {
+ my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
+ while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
+ update_records( $table, { $column => $gid }, { $column => $uid } );
+ }
+ }
+ }
+ $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
+ }
+};
+
+push @CHECKS, 'LastUpdatedBy and Creator' => sub {
+ foreach my $model ( @models ) {
+ my $class = "RT::$model";
+ my $object = $class->new( RT->SystemUser );
+ my $table = $object->Table;
+ foreach my $column ( qw(LastUpdatedBy Creator) ) {
+ next unless $object->_Accessible( $column, 'auto' );
+ check_integrity(
+ $table, $column => 'Users', 'id',
+ action => sub {
+ my ($id, %prop) = @_;
+ return unless my $replace_with = prompt_integer(
+ 'Replace',
+ "Column $column should point to a user, but there is record #$id in table $table\n"
+ ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
+ ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
+ ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
+ ."or something like that.",
+ "$table.$column -> user #$prop{$column}"
+ );
+ update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
+ },
+ );
+ }
+ }
+};
+my %CHECKS = @CHECKS;
+
+@do_check = do { my $i = 1; grep $i++%2, @CHECKS };
+
+while ( my $check = shift @do_check ) {
+ $CHECKS{ $check }->();
+
+ foreach my $redo ( keys %redo_check ) {
+ die "check $redo doesn't exist" unless $CHECKS{ $redo };
+ delete $redo_check{ $redo };
+ next if grep $_ eq $redo, @do_check; # don't do twice
+ push @do_check, $redo;
+ }
+}
+
+sub check_integrity {
+ my ($stable, @scols) = (shift, shift);
+ my ($ttable, @tcols) = (shift, shift);
+ my %args = @_;
+
+ @scols = @{ $scols[0] } if ref $scols[0];
+ @tcols = @{ $tcols[0] } if ref $tcols[0];
+
+ print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
+ if $opt{'verbose'};
+
+ my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
+ ." FROM $stable s LEFT JOIN $ttable t"
+ ." ON (". join(
+ ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
+ ) .")"
+ . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
+ ." WHERE t.id IS NULL"
+ ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);
+
+ $query .= " AND ( $args{'condition'} )" if $args{'condition'};
+
+ my @binds = @{ $args{'bind_values'} || [] };
+ if ( $tcols[0] eq 'id' && @tcols == 1 ) {
+ my $type = $TYPE{"$stable.$scols[0]"} || 'number';
+ if ( $type eq 'number' ) {
+ $query .= " AND s.$scols[0] != ?"
+ }
+ elsif ( $type eq 'text' ) {
+ $query .= " AND s.$scols[0] NOT LIKE ?"
+ }
+ push @binds, 0;
+ }
+
+ my $sth = execute_query( $query, @binds );
+ while ( my ($sid, @set) = $sth->fetchrow_array ) {
+ print STDERR "Record #$sid in $stable references a nonexistent record in $ttable\n";
+ for ( my $i = 0; $i < @scols; $i++ ) {
+ print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
+ }
+ print STDERR "\t". describe( $stable, $sid ) ."\n";
+ $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'};
+ }
+}
+
+sub describe {
+ my ($table, $id) = @_;
+ return '' unless my $cb = $describe_cb{ $table };
+
+ my $row = load_record( $table, $id );
+ unless ( $row->{id} ) {
+ $table =~ s/s$//;
+ return "$table doesn't exist";
+ }
+ return $cb->( $row );
+}
+
+sub columns_eq_cond {
+ my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
+ my $ltype = $TYPE{"$lt.$lc"} || 'number';
+ my $rtype = $TYPE{"$rt.$rc"} || 'number';
+ return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;
+
+ if ( $rtype eq 'text' ) {
+ return "$ra.$rc LIKE CAST($la.$lc AS text)";
+ }
+ elsif ( $ltype eq 'text' ) {
+ return "$la.$lc LIKE CAST($ra.$rc AS text)";
+ }
+ else { die "don't know how to cast" }
+}
+
+sub check_uniqueness {
+ my $on = shift;
+ my %args = @_;
+
+ my @columns = @{ $args{'columns'} };
+
+ print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
+ if $opt{'verbose'};
+
+ my ($scond, $tcond);
+ if ( $scond = $tcond = $args{'condition'} ) {
+ $scond =~ s/(\s|^)\./$1s./g;
+ $tcond =~ s/(\s|^)\./$1t./g;
+ }
+
+ my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
+ ." FROM $on s LEFT JOIN $on t "
+ ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
+ . ($tcond? " AND ( $tcond )": "")
+ . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "")
+ ." WHERE t.id IS NOT NULL "
+ ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
+ $query .= " AND ( $scond )" if $scond;
+ $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'};
+
+ my $sth = execute_query(
+ $query,
+ $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (),
+ $args{'extra_values'}? (@{ $args{'extra_values'} }): ()
+ );
+ while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
+ print STDERR "Record #$tid in $on has the same set of values as $sid\n";
+ for ( my $i = 0; $i < @columns; $i++ ) {
+ print STDERR "\t$columns[$i] => '$set[$i]'\n";
+ }
+ $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'};
+ }
+}
+
+sub load_record {
+ my ($table, $id) = @_;
+ my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
+ return $sth->fetchrow_hashref('NAME_lc');
+}
+
+sub delete_record {
+ my ($table, $id) = (@_);
+ print "Deleting record #$id in $table\n" if $opt{'verbose'};
+ my $query = "DELETE FROM $table WHERE id = ?";
+ $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
+ return execute_query( $query, $id );
+}
+
+sub create_record {
+ print "Creating a record in $_[0]\n" if $opt{'verbose'};
+ $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
+ return $RT::Handle->Insert( @_ );
+}
+
+sub update_records {
+ my $table = shift;
+ my $where = shift;
+ my $what = shift;
+
+ my (@where_cols, @where_binds);
+ while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }
+
+ my (@what_cols, @what_binds);
+ while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }
+
+ print "Updating record(s) in $table\n" if $opt{'verbose'};
+ my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
+ ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
+ $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
+ return execute_query( $query, @what_binds, @where_binds );
+}
+
+sub execute_query {
+ my ($query, @binds) = @_;
+
+ print "Executing query: $query\n\n" if $opt{'verbose'};
+
+ my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
+ $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
+ return $sth;
+}
+
+{ my %cached_answer;
+sub prompt {
+ my $action = shift;
+ my $msg = shift;
+ my $token = shift || join ':', caller;
+
+ return 0 unless $opt{'resolve'};
+ return 1 if $opt{'force'};
+
+ return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+ print $msg, "\n";
+ print "$action ALL records with the same defect? [N]: ";
+ my $a = <STDIN>;
+ return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
+ return $cached_answer{ $token } = 0;
+} }
+
+{ my %cached_answer;
+sub prompt_action {
+ my $actions = shift;
+ my $msg = shift;
+ my $token = shift || join ':', caller;
+
+ return '' unless $opt{'resolve'};
+ return lc substr $actions->[0], 0, 1 if $opt{'force'};
+ return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+ print $msg, "\n";
+ print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
+ my $a = <STDIN>;
+ chomp $a;
+ return $cached_answer{ $token } = '' unless $a;
+ foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
+ return $cached_answer{ $token } = lc substr $a, 0, 1;
+ }
+ return $cached_answer{ $token } = '';
+} }
+
+{ my %cached_answer;
+sub prompt_integer {
+ my $action = shift;
+ my $msg = shift;
+ my $token = shift || join ':', caller;
+
+ return 0 unless $opt{'resolve'};
+ return 0 if $opt{'force'};
+
+ return $cached_answer{ $token } if exists $cached_answer{ $token };
+
+ print $msg, "\n";
+ print "$action ALL records with the same defect? [0]: ";
+ my $a = <STDIN>; chomp $a; $a = int($a);
+ return $cached_answer{ $token } = $a;
+} }
+
+1;
+
+__END__
+
+=head1 NAME
+
+rt-validator - check and correct validity of records in RT's database
+
+=head1 SYNOPSIS
+
+ rt-validator --check
+ rt-validator --check --verbose
+ rt-validator --check --verbose --resolve
+ rt-validator --check --verbose --resolve --force
+
+=head1 DESCRIPTION
+
+This script checks integrity of records in RT's DB. May delete some invalid
+records or ressurect accidentally deleted.
+
+=head1 OPTIONS
+
+=over
+
+=item check
+
+ mandatory.
+
+ it's equal to -c
+
+=item verbose
+
+ print additional info to STDOUT
+ it's equal to -v
+
+=item resolve
+
+ enable resolver that can delete or create some records
+
+=item force
+
+ resolve without asking questions
+
+=back
+
diff --git a/rt/sbin/standalone_httpd b/rt/sbin/standalone_httpd
new file mode 100755
index 000000000..c451a7370
--- /dev/null
+++ b/rt/sbin/standalone_httpd
@@ -0,0 +1,285 @@
+#!/usr/bin/perl -w
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 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 {
+ die <<EOT if ${^TAINT};
+RT does not run under Perl's "taint mode". Remove -T from the command
+line, or remove the PerlTaintCheck parameter from your mod_perl
+configuration.
+EOT
+
+ require File::Spec;
+ my @libs = ("/opt/rt3/lib", "/opt/rt3/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 Getopt::Long;
+no warnings 'once';
+
+if (grep { m/help/ } @ARGV) {
+ require Pod::Usage;
+ print Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+require RT;
+RT->LoadConfig();
+RT->InitPluginPaths();
+RT->InitLogging();
+require Module::Refresh if RT->Config->Get('DevelMode');
+
+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->Init( Heavy => 1 );
+
+ my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post');
+ unless ( $status ) {
+ print STDERR $msg, "\n\n";
+ exit -1;
+ }
+}
+
+# we must disconnect DB before fork
+if ($RT::Handle) {
+ $RT::Handle->dbh->disconnect if $RT::Handle->dbh;
+ $RT::Handle->dbh(undef);
+ undef $RT::Handle;
+}
+
+require RT::Interface::Web::Handler;
+my $app = RT::Interface::Web::Handler->PSGIApp;
+
+if ($ENV{RT_TESTING}) {
+ my $screen_logger = $RT::Logger->remove('screen');
+ require Log::Dispatch::Perl;
+ $RT::Logger->add(
+ Log::Dispatch::Perl->new(
+ name => 'rttest',
+ min_level => $screen_logger->min_level,
+ action => {
+ error => 'warn',
+ critical => 'warn'
+ }
+ )
+ );
+ require Plack::Middleware::Test::StashWarnings;
+ $app = Plack::Middleware::Test::StashWarnings->wrap($app);
+}
+
+# when used as a psgi file
+if (caller) {
+ return $app;
+}
+
+
+# load appropriate server
+
+require Plack::Runner;
+
+my $is_fastcgi = $0 =~ m/fcgi$/;
+my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
+ $is_fastcgi ? ( server => 'FCGI' )
+ : (),
+ env => 'deployment' );
+
+# figure out the port
+my $port;
+
+# handle "rt-server 8888" for back-compat, but complain about it
+if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) {
+ warn "Deprecated: please run $0 --port $ARGV[0] instead\n";
+ unshift @ARGV, '--port';
+}
+
+my @args = @ARGV;
+
+use List::MoreUtils 'last_index';
+my $last_index = last_index { $_ eq '--port' } @args;
+
+my $explicit_port;
+
+if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) {
+ $explicit_port = $args[$last_index+1];
+ $port = $explicit_port;
+
+ # inform the rest of the system what port we manually chose
+ my $old_app = $app;
+ $app = sub {
+ my $env = shift;
+
+ $env->{'rt.explicit_port'} = $port;
+
+ $old_app->($env, @_);
+ };
+}
+else {
+ # default to the configured WebPort and inform Plack::Runner
+ $port = RT->Config->Get('WebPort') || '8080';
+ push @args, '--port', $port;
+}
+
+push @args, '--server', 'Standalone' if RT->InstallMode;
+push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args;
+
+$r->parse_options(@args);
+
+delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything
+
+unless ($r->{env} eq 'development') {
+ push @{$r->{options}}, server_ready => sub {
+ my($args) = @_;
+ my $name = $args->{server_software} || ref($args); # $args is $server
+ my $host = $args->{host} || 0;
+ my $proto = $args->{proto} || 'http';
+ print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n";
+ };
+}
+eval { $r->run($app) };
+if (my $err = $@) {
+ handle_startup_error($err);
+}
+
+exit 0;
+
+sub handle_startup_error {
+ my $err = shift;
+ if ( $err =~ /listen/ ) {
+ 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 the port is already in use or you're running @{[$0]}
+as someone other than your system's "root" user. You may also specify a
+temporary port with: $0 --port <port>
+EOF
+
+ if ($explicit_port) {
+ print STDERR
+ "Please check your system configuration or choose another port\n\n";
+ }
+}
+
+__END__
+
+=head1 NAME
+
+rt-server - RT standalone server
+
+=head1 SYNOPSIS
+
+ # runs prefork server listening on port 8080, requires Starlet
+ rt-server --port 8080
+
+ # runs server listening on port 8080
+ rt-server --server Standalone --port 8080
+ # or
+ standalone_httpd --port 8080
+
+ # runs other PSGI server on port 8080
+ rt-server --server Starman --port 8080