diff options
Diffstat (limited to 'rt/sbin')
-rwxr-xr-x | rt/sbin/rt-attributes-viewer | 122 | ||||
-rwxr-xr-x | rt/sbin/rt-clean-sessions | 190 | ||||
-rwxr-xr-x | rt/sbin/rt-dump-metadata | 357 | ||||
-rwxr-xr-x | rt/sbin/rt-email-dashboards | 173 | ||||
-rwxr-xr-x | rt/sbin/rt-email-digest | 380 | ||||
-rwxr-xr-x | rt/sbin/rt-email-group-admin | 527 | ||||
-rwxr-xr-x | rt/sbin/rt-fulltext-indexer | 479 | ||||
-rwxr-xr-x | rt/sbin/rt-preferences-viewer | 149 | ||||
-rwxr-xr-x | rt/sbin/rt-server | 285 | ||||
-rwxr-xr-x | rt/sbin/rt-server.fcgi | 285 | ||||
-rwxr-xr-x | rt/sbin/rt-session-viewer | 121 | ||||
-rwxr-xr-x | rt/sbin/rt-setup-database | 609 | ||||
-rwxr-xr-x | rt/sbin/rt-setup-fulltext-index | 720 | ||||
-rwxr-xr-x | rt/sbin/rt-shredder | 325 | ||||
-rwxr-xr-x | rt/sbin/rt-test-dependencies | 694 | ||||
-rwxr-xr-x | rt/sbin/rt-validate-aliases | 343 | ||||
-rwxr-xr-x | rt/sbin/rt-validator | 1182 | ||||
-rwxr-xr-x | rt/sbin/standalone_httpd | 285 |
18 files changed, 0 insertions, 7226 deletions
diff --git a/rt/sbin/rt-attributes-viewer b/rt/sbin/rt-attributes-viewer deleted file mode 100755 index 35449e0ec..000000000 --- a/rt/sbin/rt-attributes-viewer +++ /dev/null @@ -1,122 +0,0 @@ -#!/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 deleted file mode 100755 index 02e1901d0..000000000 --- a/rt/sbin/rt-clean-sessions +++ /dev/null @@ -1,190 +0,0 @@ -#!/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 deleted file mode 100755 index a2ebe3622..000000000 --- a/rt/sbin/rt-dump-metadata +++ /dev/null @@ -1,357 +0,0 @@ -#!/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 deleted file mode 100755 index 7c797ab25..000000000 --- a/rt/sbin/rt-email-dashboards +++ /dev/null @@ -1,173 +0,0 @@ -#!/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 deleted file mode 100755 index 6efab1190..000000000 --- a/rt/sbin/rt-email-digest +++ /dev/null @@ -1,380 +0,0 @@ -#!/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-group-admin b/rt/sbin/rt-email-group-admin deleted file mode 100755 index bfbdccd27..000000000 --- a/rt/sbin/rt-email-group-admin +++ /dev/null @@ -1,527 +0,0 @@ -#!/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 deleted file mode 100755 index cdcc78e15..000000000 --- a/rt/sbin/rt-fulltext-indexer +++ /dev/null @@ -1,479 +0,0 @@ -#!/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 deleted file mode 100755 index e9d6ce337..000000000 --- a/rt/sbin/rt-preferences-viewer +++ /dev/null @@ -1,149 +0,0 @@ -#!/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 deleted file mode 100755 index c451a7370..000000000 --- a/rt/sbin/rt-server +++ /dev/null @@ -1,285 +0,0 @@ -#!/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 deleted file mode 100755 index c451a7370..000000000 --- a/rt/sbin/rt-server.fcgi +++ /dev/null @@ -1,285 +0,0 @@ -#!/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 deleted file mode 100755 index 0f6c4e420..000000000 --- a/rt/sbin/rt-session-viewer +++ /dev/null @@ -1,121 +0,0 @@ -#!/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 deleted file mode 100755 index 5d7f21cef..000000000 --- a/rt/sbin/rt-setup-database +++ /dev/null @@ -1,609 +0,0 @@ -#!/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 deleted file mode 100755 index e27a27010..000000000 --- a/rt/sbin/rt-setup-fulltext-index +++ /dev/null @@ -1,720 +0,0 @@ -#!/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 deleted file mode 100755 index 27d57a24f..000000000 --- a/rt/sbin/rt-shredder +++ /dev/null @@ -1,325 +0,0 @@ -#!/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-test-dependencies b/rt/sbin/rt-test-dependencies deleted file mode 100755 index 99520aaa7..000000000 --- a/rt/sbin/rt-test-dependencies +++ /dev/null @@ -1,694 +0,0 @@ -#!/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-validate-aliases b/rt/sbin/rt-validate-aliases deleted file mode 100755 index 0953f9300..000000000 --- a/rt/sbin/rt-validate-aliases +++ /dev/null @@ -1,343 +0,0 @@ -#!/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 deleted file mode 100755 index db6c1e914..000000000 --- a/rt/sbin/rt-validator +++ /dev/null @@ -1,1182 +0,0 @@ -#!/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 deleted file mode 100755 index c451a7370..000000000 --- a/rt/sbin/standalone_httpd +++ /dev/null @@ -1,285 +0,0 @@ -#!/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 |