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