summaryrefslogtreecommitdiff
path: root/rt/sbin
diff options
context:
space:
mode:
Diffstat (limited to 'rt/sbin')
-rw-r--r--rt/sbin/rt-attributes-viewer.in31
-rw-r--r--rt/sbin/rt-clean-sessions.in19
-rw-r--r--rt/sbin/rt-dump-metadata.in53
-rw-r--r--rt/sbin/rt-email-dashboards.in21
-rw-r--r--rt/sbin/rt-email-digest.in35
-rwxr-xr-xrt/sbin/rt-email-group-admin.in18
-rw-r--r--rt/sbin/rt-fulltext-indexer.in508
-rw-r--r--rt/sbin/rt-importer.in283
-rwxr-xr-xrt/sbin/rt-message-catalog270
-rw-r--r--rt/sbin/rt-preferences-viewer.in29
-rw-r--r--rt/sbin/rt-serializer.in399
-rw-r--r--rt/sbin/rt-server.fcgi.in150
-rw-r--r--rt/sbin/rt-server.in150
-rw-r--r--rt/sbin/rt-session-viewer.in31
-rw-r--r--rt/sbin/rt-setup-database.in277
-rw-r--r--rt/sbin/rt-setup-fulltext-index.in119
-rwxr-xr-xrt/sbin/rt-shredder.in175
-rw-r--r--rt/sbin/rt-test-dependencies.in315
-rw-r--r--rt/sbin/rt-validate-aliases.in32
-rw-r--r--rt/sbin/rt-validator.in460
-rw-r--r--rt/sbin/standalone_httpd.in150
21 files changed, 1977 insertions, 1548 deletions
diff --git a/rt/sbin/rt-attributes-viewer.in b/rt/sbin/rt-attributes-viewer.in
index 2c021aae2..03141581c 100644
--- a/rt/sbin/rt-attributes-viewer.in
+++ b/rt/sbin/rt-attributes-viewer.in
@@ -50,44 +50,27 @@ use strict;
use warnings;
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
}
+
}
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, 'help|h', );
+use RT::Interface::CLI qw(Init);
+Init();
my $id = shift;
-
-if ( $opt{help} || !$id ) {
- require Pod::Usage;
- Pod::Usage::pod2usage({ verbose => 2 });
- exit;
-}
-
-require RT;
-RT::LoadConfig();
-RT::Init();
+Pod::Usage::pod2usage({ verbose => 2 }) unless $id;
require RT::Attribute;
my $attr = RT::Attribute->new( RT->SystemUser );
diff --git a/rt/sbin/rt-clean-sessions.in b/rt/sbin/rt-clean-sessions.in
index 48a652571..beed22a19 100644
--- a/rt/sbin/rt-clean-sessions.in
+++ b/rt/sbin/rt-clean-sessions.in
@@ -50,27 +50,20 @@ use strict;
use warnings;
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
}
+
}
use Getopt::Long;
@@ -102,9 +95,9 @@ require RT;
RT::LoadConfig();
if( $opt{'debug'} ) {
- RT->Config->Set( LogToScreen => 'debug' );
+ RT->Config->Set( LogToSTDERR => 'debug' );
} else {
- RT->Config->Set( LogToScreen => undef );
+ RT->Config->Set( LogToSTDERR => undef );
}
RT::ConnectToDatabase();
diff --git a/rt/sbin/rt-dump-metadata.in b/rt/sbin/rt-dump-metadata.in
index 29c44d763..2b5747645 100644
--- a/rt/sbin/rt-dump-metadata.in
+++ b/rt/sbin/rt-dump-metadata.in
@@ -54,22 +54,15 @@ use warnings;
binmode( STDOUT, ":utf8" );
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
- my @libs = ( "@RT_LIB_PATH@", "@LOCAL_LIB_PATH@" );
+ require Cwd;
+ my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- } else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -77,26 +70,16 @@ BEGIN {
}
-use Getopt::Long;
+use RT::Interface::CLI qw(Init);
my %opt;
-GetOptions( \%opt, "help|h",
+Init( \%opt,
"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 => [
@@ -104,11 +87,6 @@ my %Ignore = (
id Created Creator LastUpdated LastUpdatedBy
)
],
- Templates => [
- qw(
- TranslationOf
- )
- ],
);
my $SystemUserId = RT->SystemUser->Id;
@@ -117,7 +95,6 @@ my @classes = qw(
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;
@@ -126,7 +103,8 @@ foreach my $class (@classes) {
$objects->Limit(
FIELD => 'Domain',
OPERATOR => '=',
- VALUE => 'UserDefined'
+ VALUE => 'UserDefined',
+ CASESENSITIVE => 0,
) if $class eq 'Groups';
if ( $class eq 'CustomFields' ) {
@@ -182,6 +160,7 @@ OBJECT:
foreach my $key ( map "$record$_", ( '', 'Id' ) ) {
next unless exists $rv->{$key};
my $id = $rv->{$key} or next;
+ next unless $id =~ /^\d+$/;
my $obj = "RT::$record"->new( RT->SystemUser );
$obj->LoadByCols( Id => $id ) or next;
$rv->{$key} = $obj->__Value('Name') || 0;
@@ -244,7 +223,7 @@ OBJECT:
# An internal user group
if ( /^SystemInternal$/ ) {
$rv->{GroupDomain} = $group->Domain;
- $rv->{GroupType} = $group->Type;
+ $rv->{GroupType} = $group->Name;
}
# An individual user
elsif ( /^ACLEquivalence$/ ) {
@@ -269,19 +248,9 @@ OBJECT:
$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 } ) {
+ if ( RT::Attributes->require ) {
my $attributes = $obj->Attributes;
while ( my $attribute = $attributes->Next ) {
my $content = $attribute->Content;
diff --git a/rt/sbin/rt-email-dashboards.in b/rt/sbin/rt-email-dashboards.in
index 6b7dd2d2d..1daba86b7 100644
--- a/rt/sbin/rt-email-dashboards.in
+++ b/rt/sbin/rt-email-dashboards.in
@@ -50,23 +50,15 @@ use strict;
use warnings;
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -89,10 +81,7 @@ if ($opts{'help'}) {
require RT;
require RT::Interface::CLI;
-RT::Interface::CLI->import(qw{ CleanEnv loc });
-
-# Clean out all the nasties from the environment
-CleanEnv();
+RT::Interface::CLI->import(qw{ loc });
# Load the config file
RT::LoadConfig();
@@ -130,7 +119,7 @@ are taken to be in the user's timezone if available, UTC otherwise.
You'll need to have cron run this script every hour. Here's an example crontab
entry to do this.
- 0 * * * * @PERL@ /opt/rt4/local/sbin/rt-email-dashboards
+ 0 * * * * @RT_SBIN_PATH_R@/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.
diff --git a/rt/sbin/rt-email-digest.in b/rt/sbin/rt-email-digest.in
index 50e130ad5..8dade9441 100644
--- a/rt/sbin/rt-email-digest.in
+++ b/rt/sbin/rt-email-digest.in
@@ -49,23 +49,15 @@
use warnings;
use strict;
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -76,10 +68,9 @@ BEGIN {
use Date::Format qw( strftime );
use Getopt::Long;
use RT;
-use RT::Interface::CLI qw( CleanEnv loc );
+use RT::Interface::CLI qw( loc );
use RT::Interface::Email;
-CleanEnv();
RT::LoadConfig();
RT::Init();
@@ -268,7 +259,7 @@ sub find_transactions {
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;
+ $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn;
$sent_transactions->{$user}->{ $txn->id } = $txn;
}
}
@@ -312,12 +303,14 @@ sub build_digest_for_user {
# 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 ');
+ my $top = $tkt_txns->{$txn}->Attachments->First;
+
+ # $top contains the top-most RT::Attachment with our
+ # outgoing message. It may not be the MIME part with
+ # the content. Print a few headers from it for
+ # clarity's sake.
+ $contents_body .= "From: " . $top->GetHeader('From') . "\n";
+ my $date = $top->GetHeader('Date ');
unless ($date) {
my $txn_obj = RT::Transaction->new( RT->SystemUser );
$txn_obj->Load($txn);
@@ -330,7 +323,7 @@ sub build_digest_for_user {
@{ [ localtime( $date_obj->Unix ) ] } );
}
$contents_body .= "Date: $date\n\n";
- $contents_body .= $msg->Content . "\n";
+ $contents_body .= $tkt_txns->{$txn}->ContentObj->Content . "\n";
$contents_body .= "-------\n";
} # foreach transaction
} # foreach ticket
diff --git a/rt/sbin/rt-email-group-admin.in b/rt/sbin/rt-email-group-admin.in
index 06ff5c343..17a0850be 100755
--- a/rt/sbin/rt-email-group-admin.in
+++ b/rt/sbin/rt-email-group-admin.in
@@ -46,6 +46,7 @@
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
+
=head1 NAME
rt-email-group-admin - Command line tool for administrating NotifyGroup actions
@@ -73,7 +74,7 @@ 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
@@ -87,23 +88,15 @@ use warnings;
use strict;
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -399,6 +392,7 @@ sub delete {
require RT::Scrips;
my $scrips = RT::Scrips->new( RT->SystemUser );
$scrips->Limit( FIELD => 'ScripAction', VALUE => $action->id );
+ $scrips->FindAllRows;
if ( $scrips->Count ) {
my @sid;
while( my $s = $scrips->Next ) {
diff --git a/rt/sbin/rt-fulltext-indexer.in b/rt/sbin/rt-fulltext-indexer.in
index a55eb4734..bd55adb9a 100644
--- a/rt/sbin/rt-fulltext-indexer.in
+++ b/rt/sbin/rt-fulltext-indexer.in
@@ -48,80 +48,44 @@
# END BPS TAGGED BLOCK }}}
use strict;
use warnings;
-no warnings 'once';
+use 5.010;
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
}
+
}
-BEGIN {
- use RT;
- RT::LoadConfig();
- RT::Init();
-};
+use RT -init;
use RT::Interface::CLI ();
+use HTML::Entities;
-my %OPT = (
- help => 0,
- debug => 0,
- quiet => 0,
-);
-my @OPT_LIST = qw(help|h! debug! quiet);
+use Getopt::Long qw(GetOptions);
+my %OPT = ( memory => '2M', limit => 0 );
+GetOptions( \%OPT,
+ "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);
-}
+ "all!",
+ "limit=i",
-use Getopt::Long qw(GetOptions);
-GetOptions( \%OPT, @OPT_LIST );
+ "memory=s",
+);
+$OPT{limit} ||= 200;
-if ( $OPT{'help'} ) {
- RT::Interface::CLI->ShowHelp(
- Sections => 'NAME|DESCRIPTION|'. uc($db_type),
- );
-}
+RT::Interface::CLI->ShowHelp if $OPT{help};
use Fcntl ':flock';
if ( !flock main::DATA, LOCK_EX | LOCK_NB ) {
@@ -135,7 +99,9 @@ if ( !flock main::DATA, LOCK_EX | LOCK_NB ) {
}
}
-my $fts_config = RT->Config->Get('FullTextSearch') || {};
+my $db_type = RT->Config->Get('DatabaseType');
+my $fts_config = $ENV{RT_FTS_CONFIG} ? JSON::from_json($ENV{RT_FTS_CONFIG})
+ : RT->Config->Get('FullTextSearch') || {};
unless ( $fts_config->{'Enable'} ) {
print STDERR <<EOT;
@@ -163,9 +129,8 @@ if ( $db_type eq 'Oracle' ) {
$index, $OPT{'memory'}
);
exit;
-} elsif ( $db_type eq 'mysql' ) {
- unless ($OPT{'xmlpipe2'}) {
- print STDERR <<EOT;
+} elsif ( $fts_config->{Sphinx} ) {
+ print STDERR <<EOT;
Updates to the external Sphinx index are done via running the sphinx
`indexer` tool:
@@ -173,287 +138,217 @@ Updates to the external Sphinx index are done via running the sphinx
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 => \@_,
- );
+ exit 1;
}
-sub filter {
- my $type = shift;
- return goto_specific(
- suffix => $type,
- arguments => \@_,
- );
+# Skip ACL checks. This saves a large number of unnecessary queries
+# (for tickets, ACLs, and users) which are unnecessary, as we are
+# running as the system user.
+{
+ no warnings 'redefine';
+ no warnings 'once';
+ *RT::Attachment::_Value = \&DBIx::SearchBuilder::Record::_Value;
+ *RT::Attachments::Next = \&DBIx::SearchBuilder::Next;
}
-sub extract {
- my $type = shift;
- return goto_specific(
- suffix => $type,
- error => "No way to convert $type attachment into text",
- arguments => \@_,
- );
+my $LAST;
+if ($db_type eq 'mysql') {
+ process_mysql();
+} elsif ($db_type eq 'Pg') {
+ process_pg();
}
-sub process {
- return goto_specific(
- suffix => $db_type,
- error => "No processer for $db_type DB",
- arguments => \@_,
- );
-}
+sub attachment_loop {
+ my $subref = shift;
+ my $table = $fts_config->{'Table'};
+ $LAST //= 0;
+
+ # Fetch in batches of size --limit
+ {
+ # Indexes all text/plain and text/html attachments
+ my $attachments = RT::Attachments->new( RT->SystemUser );
+ $attachments->Limit(
+ FIELD => 'ContentType',
+ OPERATOR => 'IN',
+ VALUE => ['text/plain', 'text/html'],
+ );
+ $attachments->Limit( FIELD => 'id', OPERATOR => '>', VALUE => $LAST );
+ $attachments->OrderBy( FIELD => 'id', ORDER => 'asc' );
+ $attachments->RowsPerPage( $OPT{'limit'} );
-sub finalize {
- return goto_specific(
- suffix => $db_type,
- arguments => \@_,
- );
-}
+ # Call back to the DB-specific part
+ $subref->($attachments);
-sub clean {
- return goto_specific(
- suffix => $db_type,
- arguments => \@_,
- );
-}
+ $LAST = $attachments->Last->id if $attachments->Count;
-{
-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;
+ redo if $OPT{'all'} and $attachments->Count == $OPT{'limit'};
+ }
}
-sub process_mysql {
- my ($type, $attachment, $text) = (@_);
-
- my $doc = sphinx_template();
+sub process_bulk_insert {
+ my $dbh = $RT::Handle->dbh;
+ my ($statement, $error) = @_;
+
+ # Doing large inserts is faster than individual statements, but
+ # comes at a parsing cost; cache the statement handles (99% of which
+ # will be the same size) for a notable (2x) speed gain.
+ my %sthandles;
+
+ $sthandles{1} =
+ $dbh->prepare($statement->(1));
+
+ attachment_loop( sub {
+ my ($attachments) = @_;
+ my @insert;
+ my $found = 0;
+ while ( my $a = $attachments->Next ) {
+ debug("Found attachment #". $a->id );
+ my $text = $a->Content // "";
+ HTML::Entities::decode_entities($text) if $a->ContentType eq "text/html";
+ push @insert, $text, $a->id;
+ $found++;
+ }
+ return unless $found;
- my $element = $doc->createElement('sphinx:document');
- $element->setAttribute( id => $attachment->id );
- $element->appendTextChild( content => $$text );
+ # $found should be the limit size on all but the last go-around.
+ $sthandles{$found} ||= $dbh->prepare($statement->($found));
- $doc->documentElement->appendChild( $element );
-}
+ return if eval { $sthandles{$found}->execute(@insert); };
-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 );
- }
+ # We can catch and recover from some errors; re-do row-by-row to
+ # know which row had which errors
+ while (@insert) {
+ my ($content, $id) = splice(@insert,0,2);
+ next if eval { $sthandles{1}->execute($content, $id); };
+ $error->($id, $content);
- return $doc;
+ # If this was a semi-expected error, insert an empty
+ # tsvector, so we count this row as "indexed" for
+ # purposes of knowing where to pick up
+ eval { $sthandles{1}->execute( "", $id ) }
+ or die "Failed to insert empty row for attachment $id: " . $dbh->errstr;
+ }
+ });
}
-sub finalize_mysql {
- my ($type, $attachments) = @_;
- sphinx_template()->toFH(*STDOUT, 1);
-}
+sub process_mysql {
+ my $dbh = $RT::Handle->dbh;
+ my $table = $fts_config->{'Table'};
-sub clean_mysql {
- $doc = undef;
+ ($LAST) = $dbh->selectrow_array("SELECT MAX(id) FROM $table");
+
+ my $insert = $fts_config->{Engine} eq "MyISAM" ? "INSERT DELAYED" : "INSERT";
+
+ process_bulk_insert(
+ sub {
+ my ($n) = @_;
+ return "$insert INTO $table(Content, id) VALUES "
+ . join(", ", ("(?,?)") x $n);
+ },
+ sub {
+ my ($id) = @_;
+ if ($dbh->err == 1366 and $dbh->state eq "HY000") {
+ warn "Attachment $id cannot be indexed. Most probably it contains invalid UTF8 bytes. ".
+ "Error: ". $dbh->errstr;
+ } else {
+ die "Attachment $id cannot be indexed: " . $dbh->errstr;
+ }
+ }
+ );
}
-}
-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',
- );
+sub process_pg {
+ if ( $fts_config->{'Table'} ne 'Attachments' ) {
+ process_pg_insert();
+ } else {
+ process_pg_update();
}
- $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) = (@_);
-
+sub process_pg_insert {
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;
+ ($LAST) = $dbh->selectrow_array("SELECT MAX(id) FROM $table");
+
+ process_bulk_insert(
+ sub {
+ my ($n) = @_;
+ return "INSERT INTO $table($column, id) VALUES "
+ . join(", ", ("(TO_TSVECTOR(?),?)") x $n);
+ },
+ sub {
+ my ($id) = @_;
+ if ( $dbh->err == 7 && $dbh->state eq '54000' ) {
+ warn "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 $id cannot be indexed. Most probably it contains invalid UTF8 bytes. ".
+ "Error: ". $dbh->errstr;
+ } else {
+ die "Attachment $id cannot be indexed: " . $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 process_pg_update {
+ my $dbh = $RT::Handle->dbh;
+ my $column = $fts_config->{'Column'};
-sub extract_text {
- my $attachment = shift;
- my $text = $attachment->Content;
- return undef unless defined $text && length($text);
- return \$text;
-}
+ ($LAST) = $dbh->selectrow_array("SELECT MAX(id) FROM Attachments WHERE $column IS NOT NULL");
-sub attachments_html {
- my $res = shift;
- $res->Limit( FIELD => 'ContentType', VALUE => 'text/html' );
- return $res;
-}
+ my $sth = $dbh->prepare("UPDATE Attachments SET $column = TO_TSVECTOR(?) WHERE id = ?");
-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;
-}
+ attachment_loop( sub {
+ my ($attachments) = @_;
+ my @insert;
+ while ( my $a = $attachments->Next ) {
+ debug("Found attachment #". $a->id );
-sub extract_html {
- my $attachment = shift;
- my $text = $attachment->Content;
- return undef unless defined $text && length($text);
-# the rich text editor generates html entities for characters
-# but Pg doesn't index them, so decode to something it can index.
- require HTML::Entities;
- HTML::Entities::decode_entities($text);
- return \$text;
-}
+ my $text = $a->Content // "";
+ HTML::Entities::decode_entities($text) if $a->ContentType eq "text/html";
-sub goto_specific {
- my %args = (@_);
+ push @insert, [$text, $a->id];
+ }
- 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;
+ # Try in one database transaction; if it fails, we roll it back
+ # and try one statement at a time.
+ $dbh->begin_work;
+ my $ok = 1;
+ for (@insert) {
+ $ok = eval { $sth->execute( $_->[0], $_->[1] ) };
+ last unless $ok;
+ }
+ if ($ok) {
+ $dbh->commit;
+ return;
+ }
+ $dbh->rollback;
+
+ # Things didn't go well. Retry the UPDATE statements one row at
+ # a time, outside of the transaction.
+ for (@insert) {
+ my ($content, $id) = ($_->[0], $_->[1]);
+ next if eval { $sth->execute( $content, $id ) };
+ if ( $dbh->err == 7 && $dbh->state eq '54000' ) {
+ warn "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 $id cannot be indexed. Most probably it contains invalid UTF8 bytes. ".
+ "Error: ". $dbh->errstr;
+ } else {
+ die "Attachment $id cannot be indexed: " . $dbh->errstr;
+ }
+
+ # If this was a semi-expected error, insert an empty
+ # tsvector, so we count this row as "indexed" for
+ # purposes of knowing where to pick up
+ eval { $sth->execute( "", $id ) }
+ or die "Failed to insert empty row for attachment $id: " . $dbh->errstr;
+ }
+ });
}
@@ -472,11 +367,6 @@ 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-importer.in b/rt/sbin/rt-importer.in
new file mode 100644
index 000000000..8b5bd3230
--- /dev/null
+++ b/rt/sbin/rt-importer.in
@@ -0,0 +1,283 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 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 = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+
+}
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+@RT::Record::ISA = qw( DBIx::SearchBuilder::Record RT::Base );
+
+use RT::Migrate;
+use RT::Migrate::Importer::File;
+use Getopt::Long;
+use Pod::Usage qw//;
+use Time::HiRes qw//;
+
+my %OPT = (resume => 1);
+GetOptions(
+ \%OPT,
+ "help|?",
+ "quiet|q!",
+ "list|l!",
+
+ "resume!",
+ "originalid|i=s",
+
+ "ask",
+ "ignore-errors",
+
+ "dump=s@",
+) or Pod::Usage::pod2usage();
+
+Pod::Usage::pod2usage(-verbose => 1) if $OPT{help};
+
+Pod::Usage::pod2usage() unless @ARGV == 1;
+my ($dir) = @ARGV;
+$dir =~ s|/$||;
+die "No such directory $dir\n" unless -d $dir;
+die "$dir doesn't appear to contain serialized data\n"
+ unless -f "$dir/001.dat";
+
+if ($OPT{dump}) {
+ die "Dumping objects only works in conjunction with --list\n"
+ unless $OPT{list};
+
+ $OPT{dump} = [ split /,/, join(',', @{$OPT{dump}}) ];
+}
+
+my $error_handler;
+if ($OPT{ask}) {
+ die "Interactive mode (--ask) doesn't work when STDERR and STDIN aren't terminals.\n"
+ unless -t STDERR and -t STDIN;
+
+ $error_handler = sub {
+ my $importer = shift;
+ local $| = 1;
+ print STDERR "\n", @_, "\n";
+ print STDERR "Hit any key to abort import, or type 'ignore' to continue anyway.\n";
+ print STDERR "Continuing may leave you with a corrupt database. > ";
+ chomp( my $resp = <STDIN> );
+ return lc($resp) eq 'ignore';
+ };
+}
+elsif ($OPT{'ignore-errors'}) {
+ $error_handler = sub {
+ my $importer = shift;
+ warn "Ignoring error: ", @_;
+ return 1;
+ };
+}
+
+my $import = RT::Migrate::Importer::File->new(
+ Directory => $dir,
+ OriginalId => $OPT{originalid},
+ DumpObjects => $OPT{dump},
+ Resume => $OPT{resume},
+ HandleError => $error_handler,
+);
+
+if ($import->Metadata and -t STDOUT and not $OPT{quiet}) {
+ $import->Progress(
+ RT::Migrate::progress(
+ counts => sub { $import->ObjectCount },
+ max => $import->Metadata->{ObjectCount},
+ )
+ );
+}
+
+my $log = RT::Migrate::setup_logging( $dir => 'importer.log' );
+print "Logging warnings and errors to $log\n" if $log;
+
+my %counts;
+if ($OPT{list}) {
+ %counts = $import->List;
+
+ my $org = $import->Organization;
+ print "=========== Dump of $org ===========\n\n";
+} else {
+ %counts = $import->Import;
+
+ my $org = $import->Organization;
+ print "========== Import of $org ==========\n\n";
+}
+
+print "Total object counts:\n";
+for (sort {$counts{$b} <=> $counts{$a}} keys %counts) {
+ printf "%8d %s\n", $counts{$_}, $_;
+}
+
+my @missing = $import->Missing;
+if (@missing) {
+ warn "The following UIDs were expected but never observed:\n";
+ warn " $_\n" for @missing;
+}
+
+my @invalid = $import->Invalid;
+if (@invalid) {
+ warn "The following UIDs (serialized => imported) referred to objects missing from the original database:\n";
+ for my $info (@invalid) {
+ my $uid = delete $info->{uid};
+ my $obj = $import->LookupObj($uid);
+ warn sprintf " %s => %s (%s)\n",
+ $uid,
+ ($obj && $obj->Id ? $obj->UID : '(not imported)'),
+ join(", ", map { "$_ => $info->{$_}" }
+ grep { defined $info->{$_} }
+ sort keys %$info);
+ }
+}
+
+if ($log and -s $log) {
+ print STDERR "\n! Some warnings or errors occurred during import."
+ ."\n! Please see $log for details.\n\n";
+}
+
+exit @missing;
+
+=head1 NAME
+
+rt-importer - Import a serialized RT database on top of the current one
+
+=head1 SYNOPSIS
+
+ rt-importer path/to/export/directory
+
+This script is used to import the contents of a dump created by
+C<rt-serializer>. It will create all of the objects in the dump in the
+current database; this may include users, queues, and tickets.
+
+It is possible to stop the import process with ^C; it can be later
+resumed by re-running the importer.
+
+=head2 OPTIONS
+
+=over
+
+=item B<--list>
+
+Print a summary of the data contained in the dump.
+
+=item B<--originalid> I<cfname>
+
+Places the original ticket organization and ID into a global custom
+field with the given name. If no global ticket custom field with that
+name is found in the current database, it will create one.
+
+=item B<--ask>
+
+Prompt for action when an error occurs inserting a record into the
+database. This can often happen when importing data from very old RTs
+where some attachments (usually spam) contain invalid UTF-8.
+
+The importer will pause and ask if you want to ignore the error and
+continue on or abort (potentially to restart later). Ignoring errors
+will result in missing records in the database, which may cause database
+integrity problems later. If you ignored any errors, you should run
+C<rt-validator> after import.
+
+=item B<--ignore-errors>
+
+Ignore all record creation errors and continue on when importing. This
+is equivalent to running with C<--ask> and manually typing "ignore" at
+every prompt. You should always run C<rt-validator> after importing
+with errors ignored.
+
+B<This option can be dangerous and leave you with a broken RT!>
+
+=item B<--dump> I<class>[,I<class>]
+
+Prints L<Data::Dumper> representations of the objects of type I<class> in the
+serialized data. This is mostly useful for debugging.
+
+Works only in conjunction with C<--list>.
+
+=back
+
+
+=head1 CLONED DATA
+
+Some dumps may have been taken as complete clones of the RT system,
+which are only suitable for inserting into a schema with no data in it.
+You can setup the required database state for the receiving RT instance
+by running:
+
+ @RT_SBIN_PATH_R@/rt-setup-database --action create,schema,acl --prompt-for-dba-password
+
+The normal C<make initdb> step will B<not> work because it also inserts
+core system data.
+
+
+=cut
diff --git a/rt/sbin/rt-message-catalog b/rt/sbin/rt-message-catalog
deleted file mode 100755
index bade9897a..000000000
--- a/rt/sbin/rt-message-catalog
+++ /dev/null
@@ -1,270 +0,0 @@
-#!/usr/bin/env perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2015 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 Locale::PO;
-use Getopt::Long;
-use File::Temp 'tempdir';
-
-use constant PO_DIR => 'share/po';
-
-my %commands = (
- stats => { },
- shrink => { 'update!' => 1, 'keep=s@' => [] },
- clean => { 'update!' => 1 },
- rosetta => { 'boundary=i' => 20 },
- extract => { },
-);
-
-my $command = shift;
-usage() unless $command;
-usage("Unknown command '$command'")
- unless $commands{ $command };
-
-my $opt = $commands{ $command };
-my %opt = ();
-if ( $opt && keys %$opt ) {
- while ( my ($k, $v) = each %$opt ) {
- my ($target) = ($k =~ /^(.*?)(?:[:!+=|]|$)/);
- $opt{$target} = $v;
- }
- GetOptions( \%opt, keys %$opt );
-}
-
-{ no strict 'refs'; &$command( \%opt, @ARGV ); }
-
-exit;
-
-sub stats {
- my %opt = %{ shift() };
- my $dir = shift || PO_DIR;
-
- my $max = 0;
- my %res = ();
-
- use constant TRANSLATED => 0;
- use constant DISTINCT => 1;
-
- foreach my $po_file (<$dir/*.po>) {
- my $array = Locale::PO->load_file_asarray( $po_file );
-
- $res{$po_file} = [0, 0];
-
- my $size = 0;
- foreach my $entry ( splice @$array, 1 ) {
- next if $entry->reference && $entry->reference =~ /NOT FOUND IN SOURCE/;
- $size++;
- next unless $entry->dequote( $entry->msgstr );
- $res{$po_file}[TRANSLATED]++;
- next if $entry->msgstr eq $entry->msgid;
- $res{$po_file}[DISTINCT]++;
- }
- $max = $size if $max < $size;
- }
-
- my $legend = "<file>: <translated>[(<distinct>)]/<size> (<%>)";
-
- print "\n$legend\n\n";
-
- foreach my $po_file ( sort { $res{$b}[TRANSLATED] <=> $res{$a}[TRANSLATED] } keys %res ) {
- my ($tr, $dist) = @{ $res{$po_file} };
- my $perc = int($tr*1000/$max)/10;
- if ( $tr == $dist ) {
- printf "%s:\t%d/%d\t(%.1f%%)\n", $po_file, $tr, $max, $perc;
- } else {
- printf "%s:\t%d(%d)/%d\t(%.1f%%)\n", $po_file, $tr, $dist, $max, $perc;
- }
- }
-
- print "\n$legend\n";
-}
-
-sub shrink {
- my %opt = %{ shift() };
- my $dir = shift || PO_DIR;
-
- my %keep = map { $_ => 1 } @{ $opt{'keep'} };
-
- my %stats = ();
-
- foreach my $po_file (<$dir/*.po>) {
- my $array = Locale::PO->load_file_asarray( $po_file );
- $stats{ $po_file } = { };
- foreach my $entry ( splice @$array, 1 ) {
- if ( !$keep{'not-referenced'} && $entry->reference && $entry->reference =~ /NOT FOUND IN SOURCE/ ) {
- $stats{ $po_file }{'not-referenced'}++;
- next;
- }
- elsif ( !$keep{'not-translated'} && !$entry->dequote( $entry->msgstr ) ) {
- $stats{ $po_file }{'not-translated'}++;
- next;
- }
- elsif ( !$keep{'equal'} && $entry->msgstr eq $entry->msgid ) {
- $stats{ $po_file }{'equal'}++;
- next;
- }
- push @$array, $entry;
- }
- $stats{ $po_file }{'total'} += $_ for values %{ $stats{ $po_file } };
- Locale::PO->save_file_fromarray($po_file, $array) if $opt{'update'};
- }
-
- my $legend = "<file>: <total> (<details>)";
- print "\n$legend\n\n";
-
- foreach my $po_file ( sort { $stats{$a}{'total'} <=> $stats{$b}{'total'} } keys %stats ) {
- my $res = sprintf "%s:\t%d ", $po_file, $stats{ $po_file }{'total'};
- my @tmp;
- foreach ( qw(not-referenced not-translated equal) ) {
- next unless my $v = $stats{ $po_file }{ $_ };
- push @tmp, "$_: $v";
- }
- if ( @tmp > 1 ) {
- $res .= " (". join( ', ', @tmp ) .")";
- }
- elsif ( @tmp == 1 ) {
- $res .= " (". (split /:/, $tmp[0])[0] .")";
- }
- print $res, "\n";
- }
-
- print "\n$legend\n";
-}
-
-sub clean {
- my %opt = %{ shift() };
- $opt{'keep'} = [qw(not-translated equal)];
- return shrink( \%opt, @_ );
-}
-
-sub rosetta {
- my %opt = %{ shift() };
- my $url = shift or die 'must provide Rosetta download url or directory with new po files';
-
- my $dir;
- if ( $url =~ m{^[a-z]+://} ) {
- $dir = tempdir();
- my ($fname) = $url =~ m{([^/]+)$};
-
- print "Downloading $url\n";
- require LWP::Simple;
- LWP::Simple::getstore($url => "$dir/$fname");
-
- print "Extracting $dir/$fname\n";
- require Archive::Extract;
- my $ae = Archive::Extract->new(archive => "$dir/$fname");
- my $ok = $ae->extract( to => $dir );
- }
- elsif ( -e $url && -d _ ) {
- $dir = $url;
- }
- else {
- die "Is not URL or directory: '$url'";
- }
-
- my @files = ( <$dir/rt/*.po>, <$dir/*.po> );
- unless ( @files ) {
- print STDERR "No files in $dir/rt/*.po and $dir/*.po\n";
- exit;
- }
-
- require Locale::Maketext::Extract;
- Locale::Maketext::Lexicon::set_option('use_fuzzy', 1);
- Locale::Maketext::Lexicon::set_option('allow_empty', 1);
-
- require Locale::PO;
-
- for ( @files ) {
- my ($lang) = m/([\w_]+)\.po/;
- my $fn_orig = PO_DIR . "/$lang.po";
-
- print "$_ -> $fn_orig\n";
-
- # retain the "NOT FOUND IN SOURCE" entries
- my $tmp = File::Temp->new;
- system("sed -e 's/^#~ //' $_ > $tmp");
- my $ext = Locale::Maketext::Extract->new;
- $ext->read_po($tmp);
-
- my $po_orig = Locale::PO->load_file_ashash( -e $fn_orig? $fn_orig : PO_DIR . '/rt.pot' );
- # don't want empty vales to override ours.
- # don't want fuzzy flag as when uploading to rosetta again it's not accepted by rosetta.
- foreach my $msgid ($ext->msgids) {
- my $entry = $po_orig->{Locale::PO->quote($msgid)} or next;
- my $msgstr = $entry->dequote($entry->{msgstr}) or next;
- $ext->set_msgstr($msgid, $msgstr)
- if $ext->msgstr($msgid) eq '' && $msgstr;
- }
- if ( $opt{'boundary'} && $lang !~ /^en(_[A-Z]{2})?$/ ) { # en[_**] are exceptional
- my @ids = $ext->msgids;
- my $translated = 0;
- foreach my $id ( @ids ) {
- next unless $ext->msgstr( $id );
- next if $ext->msgstr( $id ) eq $id;
- $translated++;
- }
- my $perc = int($translated/@ids * 100 + 0.5);
- if ( $perc < $opt{'boundary'} ) {
- print "Only $perc% translated for '$lang' when $opt{'boundary'}% required.\n";
- print "Deleting '$fn_orig'...\n";
- unlink $fn_orig;
- next;
- }
- }
- $ext->write_po($fn_orig);
- }
- extract({});
-}
-
-sub extract {
- shift;
- system($^X, 'devel/tools/extract-message-catalog', @_);
-}
-
diff --git a/rt/sbin/rt-preferences-viewer.in b/rt/sbin/rt-preferences-viewer.in
index 810cfc866..64d8e9ce9 100644
--- a/rt/sbin/rt-preferences-viewer.in
+++ b/rt/sbin/rt-preferences-viewer.in
@@ -50,42 +50,25 @@ use strict;
use warnings;
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$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();
+use RT::Interface::CLI qw(Init);
+my %opt;
+Init( \%opt, 'user|u=s', 'option|o=s' );
require RT::Attributes;
my $attrs = RT::Attributes->new( RT->SystemUser );
diff --git a/rt/sbin/rt-serializer.in b/rt/sbin/rt-serializer.in
new file mode 100644
index 000000000..0e0174472
--- /dev/null
+++ b/rt/sbin/rt-serializer.in
@@ -0,0 +1,399 @@
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2015 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 = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+
+}
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+@RT::Record::ISA = qw( DBIx::SearchBuilder::Record RT::Base );
+
+use RT::Migrate;
+use RT::Migrate::Serializer::File;
+use Getopt::Long;
+use Pod::Usage qw//;
+use Time::HiRes qw//;
+
+my %OPT;
+GetOptions(
+ \%OPT,
+ "help|?",
+ "verbose|v!",
+ "quiet|q!",
+
+ "directory|d=s",
+ "force|f!",
+ "size|s=i",
+
+ "users!",
+ "groups!",
+ "deleted!",
+
+ "scrips!",
+ "tickets!",
+ "acls!",
+
+ "clone",
+ "incremental",
+
+ "gc=i",
+ "page=i",
+) or Pod::Usage::pod2usage();
+
+Pod::Usage::pod2usage(-verbose => 1) if $OPT{help};
+
+my %args;
+$args{Directory} = $OPT{directory};
+$args{Force} = $OPT{force};
+$args{MaxFileSize} = $OPT{size} if $OPT{size};
+
+$args{AllUsers} = $OPT{users} if defined $OPT{users};
+$args{AllGroups} = $OPT{groups} if defined $OPT{groups};
+$args{FollowDeleted} = $OPT{deleted} if defined $OPT{deleted};
+
+$args{FollowScrips} = $OPT{scrips} if defined $OPT{scrips};
+$args{FollowTickets} = $OPT{tickets} if defined $OPT{tickets};
+$args{FollowACL} = $OPT{acls} if defined $OPT{acls};
+
+$args{Clone} = $OPT{clone} if $OPT{clone};
+$args{Incremental} = $OPT{incremental} if $OPT{incremental};
+
+$args{GC} = defined $OPT{gc} ? $OPT{gc} : 5000;
+$args{Page} = defined $OPT{page} ? $OPT{page} : 100;
+
+if (($OPT{clone} or $OPT{incremental})
+ and grep { /^(users|groups|deleted|scrips|tickets|acls)$/ } keys %OPT) {
+ die "You cannot specify object types when cloning.\n\nPlease see $0 --help.\n";
+}
+
+my $walker;
+
+my $gnuplot = `which gnuplot`;
+my $msg = "";
+if (-t STDOUT and not $OPT{verbose} and not $OPT{quiet}) {
+ $args{Progress} = RT::Migrate::progress(
+ top => \&gnuplot,
+ bottom => sub { print "\n$msg"; $msg = ""; },
+ counts => sub { $walker->ObjectCount },
+ max => { estimate() },
+ );
+ $args{MessageHandler} = sub {
+ print "\r", " "x60, "\r", $_[-1]; $msg = $_[-1];
+ };
+ $args{Verbose} = 0;
+}
+$args{Verbose} = 0 if $OPT{quiet};
+
+
+$walker = RT::Migrate::Serializer::File->new( %args );
+
+my $log = RT::Migrate::setup_logging( $walker->{Directory} => 'serializer.log' );
+print "Logging warnings and errors to $log\n" if $log;
+
+print "Beginning database serialization...";
+my %counts = $walker->Export;
+
+my @files = $walker->Files;
+print "Wrote @{[scalar @files]} files:\n";
+print " $_\n" for @files;
+print "\n";
+
+print "Total object counts:\n";
+for (sort {$counts{$b} <=> $counts{$a}} keys %counts) {
+ printf "%8d %s\n", $counts{$_}, $_;
+}
+
+if ($log and -s $log) {
+ print STDERR "\n! Some warnings or errors occurred during serialization."
+ ."\n! Please see $log for details.\n\n";
+} else {
+ unlink $log;
+}
+
+sub estimate {
+ $| = 1;
+ my %e;
+
+ # Expected types we'll serialize
+ my @types = map {"RT::$_"} qw/
+ Queue Ticket Transaction Attachment Link
+ User Group GroupMember Attribute
+ CustomField CustomFieldValue
+ ObjectCustomField ObjectCustomFieldValue
+ /;
+
+ for my $class (@types) {
+ print "Estimating $class count...";
+ my $collection = $class . "s";
+ if ($collection->require) {
+ my $objs = $collection->new( RT->SystemUser );
+ $objs->FindAllRows;
+ $objs->UnLimit;
+ $objs->{allow_deleted_search} = 1 if $class eq "RT::Ticket";
+ $e{$class} = $objs->DBIx::SearchBuilder::Count;
+ }
+ print "\r", " "x60, "\r";
+ }
+
+ return %e;
+}
+
+
+sub gnuplot {
+ my ($elapsed, $rows, $cols) = @_;
+ my $length = $walker->StackSize;
+ my $file = $walker->Directory . "/progress.plot";
+ open(my $dat, ">>", $file);
+ printf $dat "%10.3f\t%8d\n", $elapsed, $length;
+ close $dat;
+
+ if ($rows <= 24 or not $gnuplot) {
+ print "\n\n";
+ } elsif ($elapsed) {
+ my $gnuplot = qx|
+ gnuplot -e '
+ set term dumb $cols @{[$rows - 12]};
+ set xlabel "Seconds";
+ unset key;
+ set xrange [0:*];
+ set yrange [0:*];
+ set title "Queue length";
+ plot "$file" using 1:2 with lines
+ '
+ |;
+ if ($? == 0 and $gnuplot) {
+ $gnuplot =~ s/^(\s*\n)//;
+ print $gnuplot;
+ unlink $file;
+ } else {
+ warn "Couldn't run gnuplot (\$? == $?): $!\n";
+ }
+ } else {
+ print "\n" for 1..($rows - 13);
+ }
+}
+
+=head1 NAME
+
+rt-serializer - Serialize an RT database to disk
+
+=head1 SYNOPSIS
+
+ rt-validator --check && rt-serializer
+
+This script is used to write out the entire RT database to disk, for
+later import into a different RT instance. It requires that the data in
+the database be self-consistent, in order to do so; please make sure
+that the database being exported passes validation by L<rt-validator>
+before attempting to use C<rt-serializer>.
+
+While running, it will attempt to estimate the number of remaining
+objects to be serialized; these estimates are pessimistic, and will be
+incorrect if C<--no-users>, C<--no-groups>, or C<--no-tickets> are used.
+
+If the controlling terminal is large enough (more than 25 columns high)
+and the C<gnuplot> program is installed, it will also show a textual
+graph of the queue size over time.
+
+=head2 OPTIONS
+
+=over
+
+=item B<--directory> I<name>
+
+The name of the output directory to write data files to, which should
+not exist yet; it is a fatal error if it does. Defaults to
+C<< ./I<$Organization>:I<Date>/ >>, where I<$Organization> is as set in
+F<RT_SiteConfig.pm>, and I<Date> is today's date.
+
+=item B<--force>
+
+Remove the output directory before starting.
+
+=item B<--size> I<megabytes>
+
+By default, C<rt-serializer> chunks its output into data files which are
+around 32Mb in size; this option is used to set a different threshold
+size, in megabytes. Note that this is the threshold after which it
+rotates to writing a new file, and is as such the I<lower bound> on the
+size of each output file.
+
+=item B<--no-users>
+
+By default, all privileged users are serialized; passing C<--no-users>
+limits it to only those users which are referenced by serialized tickets
+and history, and are thus necessary for internal consistency.
+
+=item B<--no-groups>
+
+By default, all groups are serialized; passing C<--no-groups> limits it
+to only system-internal groups, which are needed for internal
+consistency.
+
+=item B<--no-deleted>
+
+By default, all tickets, including deleted tickets, are serialized;
+passing C<--no-deleted> skips deleted tickets during serialization.
+
+=item B<--scrips>
+
+No scrips or templates are serialized by default; this option forces all
+scrips and templates to be serialized.
+
+=item B<--acls>
+
+No ACLs are serialized by default; this option forces all ACLs to be
+serialized.
+
+=item B<--no-tickets>
+
+Skip serialization of all ticket data.
+
+=item B<--clone>
+
+Serializes your entire database, creating a clone. This option should
+be used if you want to migrate your RT database from one database type
+to another (e.g. MySQL to Postgres). It is an error to combine
+C<--clone> with any option that limits object types serialized. No
+dependency walking is performed when cloning. C<rt-importer> will detect
+that your serialized data set was generated by a clone.
+
+=item B<--incremental>
+
+Will generate an incremenal serialized dataset using the data stored in
+your IncrementalRecords database table. This assumes that you have created
+that table and run RT using the Record_Local.pm shim as documented in
+C<docs/incremental-export/>.
+
+=item B<--gc> I<n>
+
+Adjust how often the garbage collection sweep is done; lower numbers are
+more frequent. See L</GARBAGE COLLECTION>.
+
+=item B<--page> I<n>
+
+Adjust how many rows are pulled from the database in a single query. Disable
+paging by setting this to 0. Defaults to 100.
+
+Keep in mind that rows from RT's Attachments table are the limiting factor when
+determining page size. You should likely be aiming for 60-75% of your total
+memory on an otherwise unloaded box.
+
+=item B<--quiet>
+
+Do not show graphical progress UI.
+
+=item B<--verbose>
+
+Do not show graphical progress UI, but rather log was each row is
+written out.
+
+=back
+
+=head1 GARBAGE COLLECTION
+
+C<rt-serializer> maintains a priority queue of objects to serialize, or
+searches which may result in objects to serialize. When inserting into
+this queue, it does no checking if the object in question is already in
+the queue, or if the search will contain any results. These checks are
+done when the object reaches the front of the queue, or during periodic
+garbage collection.
+
+During periodic garbage collection, the entire queue is swept for
+objects which have already been serialized, occur more than once in the
+queue, and searches which contain no results in the database. This is
+done to reduce the memory footprint of the serialization process, and is
+triggered when enough new objects have been placed in the queue. This
+parameter is tunable via the C<--gc> parameter, which defaults to
+running garbage collection every 5,000 objects inserted into the queue;
+smaller numbers will result in more frequent garbage collection.
+
+The default of 5,000 is roughly tuned based on a database with several
+thousand tickets, but optimal values will vary wildly depending on
+database configuration and size. Values as low as 25 have provided
+speedups with smaller databases; if speed is a factor, experimenting
+with different C<--gc> values may be helpful. Note that there are
+significant boundary condition changes in serialization rate, as the
+queue empties and fills, causing the time estimates to be rather
+imprecise near the start and end of the process.
+
+Setting C<--gc> to 0 turns off all garbage collection. Be aware that
+this will bloat the memory usage of the serializer. Any negative value
+for C<--gc> turns off periodic garbage collection and instead objects
+already serialized or in the queue are checked for at the time they
+would be inserted.
+
+=cut
+
diff --git a/rt/sbin/rt-server.fcgi.in b/rt/sbin/rt-server.fcgi.in
index 8caefdb78..8be361395 100644
--- a/rt/sbin/rt-server.fcgi.in
+++ b/rt/sbin/rt-server.fcgi.in
@@ -49,30 +49,24 @@
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
+}
+# fix lib paths, some may be relative
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -90,17 +84,19 @@ if (grep { m/help/ } @ARGV) {
}
require RT;
+die "Wrong version of RT $RT::VERSION found; need @RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.*"
+ unless $RT::VERSION =~ /^@RT_VERSION_MAJOR@\.@RT_VERSION_MINOR@\./;
+
RT->LoadConfig();
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.
@@ -143,127 +139,27 @@ if ($RT::Handle) {
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);
-}
-
+require RT::PlackRunner;
# when used as a psgi file
if (caller) {
- return $app;
+ return RT::PlackRunner->app;
}
-# load appropriate server
-
-require Plack::Runner;
+my $r = RT::PlackRunner->new( RT->InstallMode ? ( server => 'Standalone' ) :
+ $0 =~ /standalone/ ? ( server => 'Standalone' ) :
+ $0 =~ /fcgi$/ ? ( server => 'FCGI', env => "deployment" )
+ : ( server => 'Starlet', env => "deployment" ) );
+$r->parse_options(@ARGV);
-my $is_fastcgi = $0 =~ m/fcgi$/;
-my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
- $is_fastcgi ? ( server => 'FCGI' )
- : (),
- env => 'deployment' );
+# Try to clean up wrong-permissions var/
+$SIG{INT} = sub {
+ local $@;
+ system("chown", "-R", "@WEB_USER@:@WEB_GROUP@", "@RT_VAR_PATH_R@");
+ exit 0;
+} if $> == 0;
-# 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";
- }
-}
+$r->run;
__END__
diff --git a/rt/sbin/rt-server.in b/rt/sbin/rt-server.in
index 8caefdb78..8be361395 100644
--- a/rt/sbin/rt-server.in
+++ b/rt/sbin/rt-server.in
@@ -49,30 +49,24 @@
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
+}
+# fix lib paths, some may be relative
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -90,17 +84,19 @@ if (grep { m/help/ } @ARGV) {
}
require RT;
+die "Wrong version of RT $RT::VERSION found; need @RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.*"
+ unless $RT::VERSION =~ /^@RT_VERSION_MAJOR@\.@RT_VERSION_MINOR@\./;
+
RT->LoadConfig();
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.
@@ -143,127 +139,27 @@ if ($RT::Handle) {
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);
-}
-
+require RT::PlackRunner;
# when used as a psgi file
if (caller) {
- return $app;
+ return RT::PlackRunner->app;
}
-# load appropriate server
-
-require Plack::Runner;
+my $r = RT::PlackRunner->new( RT->InstallMode ? ( server => 'Standalone' ) :
+ $0 =~ /standalone/ ? ( server => 'Standalone' ) :
+ $0 =~ /fcgi$/ ? ( server => 'FCGI', env => "deployment" )
+ : ( server => 'Starlet', env => "deployment" ) );
+$r->parse_options(@ARGV);
-my $is_fastcgi = $0 =~ m/fcgi$/;
-my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
- $is_fastcgi ? ( server => 'FCGI' )
- : (),
- env => 'deployment' );
+# Try to clean up wrong-permissions var/
+$SIG{INT} = sub {
+ local $@;
+ system("chown", "-R", "@WEB_USER@:@WEB_GROUP@", "@RT_VAR_PATH_R@");
+ exit 0;
+} if $> == 0;
-# 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";
- }
-}
+$r->run;
__END__
diff --git a/rt/sbin/rt-session-viewer.in b/rt/sbin/rt-session-viewer.in
index 3bbc447e7..85cd204ba 100644
--- a/rt/sbin/rt-session-viewer.in
+++ b/rt/sbin/rt-session-viewer.in
@@ -50,44 +50,27 @@ use strict;
use warnings;
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
}
+
}
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, 'help|h', );
+use RT::Interface::CLI qw(Init);
+Init();
my $session_id = shift;
-
-if ( $opt{help} || !$session_id ) {
- require Pod::Usage;
- Pod::Usage::pod2usage({ verbose => 2 });
- exit;
-}
-
-require RT;
-RT::LoadConfig();
-RT::Init();
+Pod::Usage::pod2usage({ verbose => 2 }) unless $session_id;
require RT::Interface::Web::Session;
my %session;
diff --git a/rt/sbin/rt-setup-database.in b/rt/sbin/rt-setup-database.in
index 64d97da2c..caeaebae3 100644
--- a/rt/sbin/rt-setup-database.in
+++ b/rt/sbin/rt-setup-database.in
@@ -48,27 +48,20 @@
# END BPS TAGGED BLOCK }}}
use strict;
use warnings;
+use 5.010;
use vars qw($Nobody $SystemUser $item);
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -78,11 +71,11 @@ BEGIN {
use Term::ReadKey;
use Getopt::Long;
+use Data::GUID;
$| = 1; # unbuffer all output.
my %args = (
- dba => '@DB_DBA@',
package => 'RT',
);
GetOptions(
@@ -91,6 +84,7 @@ GetOptions(
'force', 'debug',
'dba=s', 'dba-password=s', 'prompt-for-dba-password', 'package=s',
'datafile=s', 'datadir=s', 'skip-create', 'root-password-file=s',
+ 'package=s', 'ext-version=s',
'upgrade-from=s', 'upgrade-to=s',
'help|h',
);
@@ -108,9 +102,10 @@ 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)$/ );
+RT->Config->Set( LogToSTDERR => 'warning')
+ unless ( RT->Config->Get( 'LogToSTDERR' )
+ && RT->Config->Get( 'LogToSTDERR' ) =~ /^(debug|info|notice)$/ );
+RT::InitLogging();
# get customized root password
my $root_password;
@@ -136,7 +131,7 @@ if ( @actions > 1 && $args{'datafile'} ) {
exit(-1);
}
foreach ( @actions ) {
- unless ( /^(?:init|create|drop|schema|acl|coredata|insert|upgrade)$/ ) {
+ unless ( /^(?:init|create|drop|schema|acl|indexes|coredata|insert|upgrade)$/ ) {
print STDERR "$0 called with an invalid --action parameter.\n";
exit(-1);
}
@@ -201,6 +196,17 @@ 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";
+my $package = $args{'package'} || 'RT';
+my $ext_version = $args{'ext-version'};
+my $full_id = Data::GUID->new->as_string;
+
+my $log_actions = 0;
+if ($args{'package'} ne 'RT') {
+ RT->ConnectToDatabase();
+ RT->InitSystemObjects();
+ $log_actions = 1;
+}
+
foreach my $action ( @actions ) {
no strict 'refs';
my ($status, $msg) = *{ 'action_'. $action }{'CODE'}->( %args );
@@ -243,8 +249,28 @@ sub action_schema {
my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'schema' );
return ($status, $msg) unless $status;
+ my $individual_id = Data::GUID->new->as_string();
+ my %upgrade_data = (
+ action => 'schema',
+ filename => Cwd::abs_path($args{'datafile'} || $args{'datadir'} || ''),
+ stage => 'before',
+ full_id => $full_id,
+ individual_id => $individual_id,
+ );
+ $upgrade_data{'ext_version'} = $ext_version if $ext_version;
+ RT->System->AddUpgradeHistory($package => \%upgrade_data) if $log_actions;
+
print "Now populating database schema.\n";
- return RT::Handle->InsertSchema( $dbh, $args{'datafile'} || $args{'datadir'} );
+ my @ret = RT::Handle->InsertSchema( $dbh, $args{'datafile'} || $args{'datadir'} );
+
+ %upgrade_data = (
+ stage => 'after',
+ individual_id => $individual_id,
+ return_value => [ @ret ],
+ );
+ RT->System->AddUpgradeHistory($package => \%upgrade_data) if $log_actions;
+
+ return @ret;
}
sub action_acl {
@@ -253,8 +279,63 @@ sub action_acl {
my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'acl' );
return ($status, $msg) unless $status;
+ my $individual_id = Data::GUID->new->as_string();
+ my %upgrade_data = (
+ action => 'acl',
+ filename => Cwd::abs_path($args{'datafile'} || $args{'datadir'} || ''),
+ stage => 'before',
+ full_id => $full_id,
+ individual_id => $individual_id,
+ );
+ $upgrade_data{'ext_version'} = $ext_version if $ext_version;
+ RT->System->AddUpgradeHistory($package => \%upgrade_data) if $log_actions;
+
print "Now inserting database ACLs.\n";
- return RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} );
+ my @ret = RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} );
+
+ %upgrade_data = (
+ stage => 'after',
+ individual_id => $individual_id,
+ return_value => [ @ret ],
+ );
+ RT->System->AddUpgradeHistory($package => \%upgrade_data) if $log_actions;
+
+ return @ret;
+}
+
+sub action_indexes {
+ my %args = @_;
+ RT->ConnectToDatabase;
+ my $individual_id = Data::GUID->new->as_string();
+ my %upgrade_data = (
+ action => 'indexes',
+ filename => Cwd::abs_path($args{'datafile'} || $args{'datadir'} || ''),
+ stage => 'before',
+ full_id => $full_id,
+ individual_id => $individual_id,
+ );
+ $upgrade_data{'ext_version'} = $ext_version if $ext_version;
+ RT->System->AddUpgradeHistory($package => \%upgrade_data) if $log_actions;
+
+ my $dbh = get_admin_dbh();
+ $RT::Handle = RT::Handle->new;
+ $RT::Handle->dbh( $dbh );
+ RT::InitLogging();
+
+ print "Now inserting database indexes.\n";
+ my @ret = RT::Handle->InsertIndexes( $dbh, $args{'datafile'} || $args{'datadir'} );
+
+ $RT::Handle = RT::Handle->new;
+ $RT::Handle->dbh( undef );
+ RT->ConnectToDatabase;
+ %upgrade_data = (
+ stage => 'after',
+ individual_id => $individual_id,
+ return_value => [ @ret ],
+ );
+ RT->System->AddUpgradeHistory($package => \%upgrade_data) if $log_actions;
+
+ return @ret;
}
sub action_coredata {
@@ -262,7 +343,6 @@ sub action_coredata {
$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;
@@ -271,9 +351,15 @@ sub action_coredata {
}
sub action_insert {
+ state $RAN_INIT;
my %args = @_;
- $RT::Handle = RT::Handle->new;
- RT::Init();
+ unless ($RAN_INIT) {
+ $RT::Handle = RT::Handle->new;
+ RT::Init();
+ $RAN_INIT++;
+ }
+ $log_actions = 1;
+
my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'insert' );
return ($status, $msg) unless $status;
@@ -282,29 +368,54 @@ sub action_insert {
$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 $individual_id = Data::GUID->new->as_string();
+ my %upgrade_data = (
+ action => 'insert',
+ filename => Cwd::abs_path($file),
+ stage => 'before',
+ full_id => $full_id,
+ individual_id => $individual_id
+ );
+ $upgrade_data{'ext_version'} = $ext_version if $ext_version;
+
+ open my $handle, '<', $file or warn "Unable to open $file: $!";
+ $upgrade_data{content} = do {local $/; <$handle>} if $handle;
+
+ RT->System->AddUpgradeHistory($package => \%upgrade_data);
+
+ my @ret;
+
+ my $upgrade = sub { @ret = $RT::Handle->InsertData( $file, $root_password ) };
+
+ for my $file (@{$args{backcompat} || []}) {
+ my $lines = do {local $/; local @ARGV = ($file); <>};
+ my $sub = eval "sub {\n# line 1 $file\n$lines\n}";
+ unless ($sub) {
+ warn "Failed to load backcompat $file: $@";
+ next;
}
+ my $current = $upgrade;
+ $upgrade = sub { $sub->($current) };
}
- my @ret = $RT::Handle->InsertData( $file, $root_password );
+ $upgrade->();
+
+ # XXX Reconnecting to insert the history entry
+ # until we can sort out removing
+ # the disconnect at the end of InsertData.
+ RT->ConnectToDatabase();
+
+ %upgrade_data = (
+ stage => 'after',
+ individual_id => $individual_id,
+ return_value => [ @ret ],
+ );
+
+ RT->System->AddUpgradeHistory($package => \%upgrade_data);
+
+ my $db_type = RT->Config->Get('DatabaseType');
+ $RT::Handle->Disconnect() unless $db_type eq 'SQLite';
- # 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;
}
@@ -386,15 +497,62 @@ sub action_upgrade {
}
}
- print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n";
- _yesno() or exit(-2) unless $args{'force'};
+ unless ( $args{'force'} ) {
+ print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n";
+ _yesno() or exit(-2);
+ }
+
+ RT->ConnectToDatabase();
+ RT->InitSystemObjects();
+ $log_actions = 1;
+
+ RT->System->AddUpgradeHistory($package => {
+ type => 'full upgrade',
+ action => 'upgrade',
+ stage => 'before',
+ from => $upgrading_from,
+ to => $upgrading_to,
+ versions => [@versions],
+ full_id => $full_id,
+ individual_id => $full_id
+ });
+
+ # Ensure that the Attributes column is big enough to hold the
+ # upgrade steps we're going to add; this step exists in 4.0.6 for
+ # mysql, but that may be too late. Run it as soon as possible.
+ if (RT->Config->Get('DatabaseType') eq 'mysql'
+ and RT::Handle::cmp_version( $upgrading_from, '4.0.6') < 0) {
+ my $dbh = get_admin_dbh();
+ # Before the binary switch in 3.7.87, we want to alter text ->
+ # longtext, not blob -> longblob
+ if (RT::Handle::cmp_version( $upgrading_from, '3.7.87') < 0) {
+ $dbh->do("ALTER TABLE Attributes MODIFY Content LONGTEXT")
+ } else {
+ $dbh->do("ALTER TABLE Attributes MODIFY Content LONGBLOB")
+ }
+ }
+ my $previous = $upgrading_from;
my ( $ret, $msg );
foreach my $n ( 0..$#versions ) {
my $v = $versions[$n];
+ my $individual_id = Data::GUID->new->as_string();
+
my @back = grep {-e $_} map {"$base_dir/$versions[$_]/backcompat"} $n+1..$#versions;
print "Processing $v\n";
+
+ RT->System->AddUpgradeHistory($package => {
+ action => 'upgrade',
+ type => 'individual upgrade',
+ stage => 'before',
+ from => $previous,
+ to => $v,
+ full_id => $full_id,
+ individual_id => $individual_id,
+ });
+
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;
@@ -403,11 +561,33 @@ sub action_upgrade {
( $ret, $msg ) = action_acl( %tmp );
return ( $ret, $msg ) unless $ret;
}
+ if ( -e "$base_dir/$v/indexes" ) {
+ ( $ret, $msg ) = action_indexes( %tmp );
+ return ( $ret, $msg ) unless $ret;
+ }
if ( -e "$base_dir/$v/content" ) {
( $ret, $msg ) = action_insert( %tmp );
return ( $ret, $msg ) unless $ret;
}
+
+ # XXX: Another connect since the insert called
+ # previous to this step will disconnect.
+
+ RT->ConnectToDatabase();
+
+ RT->System->AddUpgradeHistory($package => {
+ stage => 'after',
+ individual_id => $individual_id,
+ });
+
+ $previous = $v;
}
+
+ RT->System->AddUpgradeHistory($package => {
+ stage => 'after',
+ individual_id => $full_id,
+ });
+
return 1;
}
@@ -596,6 +776,17 @@ administrator privileges
for 'init' and 'insert': rather than using the default administrative password
for RT's "root" user, use the password in this file.
+=item package
+
+the name of the entity performing a create or upgrade. Used for logging changes
+in the DB. Defaults to RT, otherwise it should be the fully qualified package name
+of the extension or plugin making changes to the DB.
+
+=item ext-version
+
+current version of extension making a change. Not needed for RT since RT has a
+more elaborate system to track upgrades across multiple versions.
+
=item upgrade-from
for 'upgrade': specifies the version to upgrade from, and do not prompt
@@ -607,3 +798,5 @@ for 'upgrade': specifies the version to upgrade to, and do not prompt
for it if it appears to be a valid version.
=back
+
+=cut
diff --git a/rt/sbin/rt-setup-fulltext-index.in b/rt/sbin/rt-setup-fulltext-index.in
index fe571851f..bffd6dd87 100644
--- a/rt/sbin/rt-setup-fulltext-index.in
+++ b/rt/sbin/rt-setup-fulltext-index.in
@@ -51,27 +51,20 @@ use warnings;
no warnings 'once';
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
}
+
}
BEGIN {
@@ -84,7 +77,7 @@ use RT::Interface::CLI ();
my %DB = (
type => scalar RT->Config->Get('DatabaseType'),
user => scalar RT->Config->Get('DatabaseUser'),
- admin => '@DB_DBA@',
+ admin => scalar RT->Config->Get('DatabaseAdmin'),
admin_password => undef,
);
@@ -98,7 +91,7 @@ my %OPT = (
my %DEFAULT;
if ( $DB{'type'} eq 'Pg' ) {
%DEFAULT = (
- table => 'Attachments',
+ table => 'AttachmentsIndex',
column => 'ContentIndex',
);
}
@@ -128,6 +121,7 @@ GetOptions(
'dba=s' => \$DB{'admin'},
'dba-password=s' => \$DB{'admin_password'},
+ 'limit=i' => \$DB{'batch-size'},
) or show_help();
if ( $OPT{'help'} || (!$DB{'admin'} && $DB{'type'} eq 'Oracle' ) ) {
@@ -138,7 +132,59 @@ my $dbh = $RT::Handle->dbh;
$dbh->{'RaiseError'} = 1;
$dbh->{'PrintError'} = 1;
+# MySQL could either be native of sphinx; find out which
+if ($DB{'type'} eq "mysql") {
+ my $index_type = lc($OPT{'index-type'} || '');
+
+ # Default to sphinx on < 5.6, and error if they provided mysql
+ my $msg;
+ if ($RT::Handle->dbh->{mysql_serverversion} < 50600) {
+ $msg = "Complete support for full-text search requires MySQL 5.6 or higher. For prior\n"
+ ."versions such as yours, full-text indexing can either be provided using MyISAM\n"
+ ."tables, or the external Sphinx indexer. Using MyISAM tables requires that your\n"
+ ."database be tuned to support them, as RT uses InnoDB tables for all other content.\n"
+ ."Using Sphinx will require recompiling MySQL. Which indexing solution would you\n"
+ ."prefer?"
+ } else {
+ $msg = "MySQL 5.6 and above support native full-text indexing; for compatibility\n"
+ ."with earlier versions of RT, the external Sphinx indexer is still supported.\n"
+ ."Which indexing solution would you prefer?"
+ }
+
+ while ( $index_type ne 'sphinx' and $index_type ne 'mysql' ) {
+ $index_type = lc prompt(
+ message => $msg,
+ default => 'mysql',
+ silent => !$OPT{'ask'},
+ );
+ };
+ $DB{'type'} = $index_type;
+}
+
if ( $DB{'type'} eq 'mysql' ) {
+ # MySQL 5.6 has FTS on InnoDB "text" columns -- which the
+ # Attachments table doesn't have, but we can make it have.
+ my $table = $OPT{'table'} || prompt(
+ message => "Enter the name of a new MySQL table that will be used to store the\n"
+ . "full-text content and indexes:",
+ default => $DEFAULT{'table'},
+ silent => !$OPT{'ask'},
+ );
+ do_error_is_ok( dba_handle() => "DROP TABLE $table" )
+ unless $OPT{'dryrun'};
+
+ my $engine = $RT::Handle->dbh->{mysql_serverversion} < 50600 ? "MyISAM" : "InnoDB";
+ my $schema = "CREATE TABLE $table ( "
+ ."id INT UNSIGNED AUTO_INCREMENT NOT NULL PRIMARY KEY,"
+ ."Content LONGTEXT ) ENGINE=$engine CHARACTER SET utf8";
+ insert_schema( $schema );
+
+ insert_data( Table => $table, Engine => $engine );
+
+ insert_schema( "CREATE FULLTEXT INDEX $table ON $table(Content)" );
+
+ print_rt_config( Table => $table );
+} elsif ($DB{'type'} eq 'sphinx') {
check_sphinx();
my $table = $OPT{'table'} || prompt(
message => "Enter name of a new MySQL table that will be used to connect to the\n"
@@ -170,7 +216,7 @@ if ( $DB{'type'} eq 'mysql' ) {
my $schema = <<END;
CREATE TABLE $table (
- id INTEGER UNSIGNED NOT NULL,
+ id BIGINT NOT NULL,
weight INTEGER NOT NULL,
query VARCHAR(3072) NOT NULL,
INDEX(query)
@@ -202,7 +248,9 @@ 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.
+configure it to better suit your needs. It assumes that you create the
+$var_path/sphinx/ directory, and that is is writable by the sphinx
+user.
source rt {
type = mysql
@@ -244,6 +292,8 @@ searchd {
seamless_rotate = 1
preopen_indexes = 0
unlink_old = 1
+ # For sphinx >= 1.10:
+ binlog_path = $var_path/sphinx/
}
END
@@ -254,7 +304,7 @@ elsif ( $DB{'type'} eq 'Pg' ) {
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.",
+ . "table. Creating a new table makes initial indexing faster.",
default => $DEFAULT{'table'},
silent => !$OPT{'ask'},
);
@@ -264,32 +314,39 @@ elsif ( $DB{'type'} eq 'Pg' ) {
silent => !$OPT{'ask'},
);
- my $schema;
+ my @schema;
my $drop;
if ( lc($table) eq 'attachments' ) {
$drop = "ALTER TABLE $table DROP COLUMN $column";
- $schema = "ALTER TABLE $table ADD COLUMN $column tsvector";
+ push @schema, "ALTER TABLE $table ADD COLUMN $column tsvector";
} else {
$drop = "DROP TABLE $table";
- $schema = "CREATE TABLE $table ( "
- ."id INTEGER NOT NULL,"
- ."$column tsvector )";
+ push @schema, split /;\n+/, <<SCHEMA;
+CREATE TABLE $table (
+ id SERIAL,
+ $column tsvector
+);
+GRANT SELECT, INSERT, UPDATE, DELETE ON $table TO "$DB{user}"
+SCHEMA
}
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',
+ message => "You may choose between GiST or GIN indexes; the GiST takes less space on\n"
+ . "disk and is faster to update, but is an order of magnitude slower to query.",
+ default => 'GIN',
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)");
+ insert_schema( $_ ) for @schema;
+
+ insert_data( Table => $table, Column => $column );
+
+ insert_schema( "CREATE INDEX ${column}_idx ON $table USING $index_type($column)" );
print_rt_config( Table => $table, Column => $column );
}
@@ -682,6 +739,16 @@ sub insert_schema {
}
}
+sub insert_data {
+ return if $OPT{dryrun};
+
+ print "Indexing existing data...\n";
+
+ $ENV{RT_FTS_CONFIG} = JSON::to_json( {Enable => 1, Indexed => 1, @_});
+ system( "$RT::SbinPath/rt-fulltext-indexer", "--all",
+ ($DB{'batch-size'} ? ("--limit", $DB{'batch-size'}) : ()));
+}
+
=head1 NAME
rt-setup-fulltext-index - Create indexes for full text search
diff --git a/rt/sbin/rt-shredder.in b/rt/sbin/rt-shredder.in
index e172a753e..a6cb6f47d 100755
--- a/rt/sbin/rt-shredder.in
+++ b/rt/sbin/rt-shredder.in
@@ -46,6 +46,7 @@
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
+
=head1 NAME
rt-shredder - Script which wipe out tickets from RT DB
@@ -111,23 +112,15 @@ use strict;
use warnings FATAL => 'all';
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -156,7 +149,7 @@ my $shredder = RT::Shredder->new;
file_name => $opt{'sqldump'},
from_storage => 0,
} ) };
- if( $@ ) {
+ if( $@ ) {
print STDERR "ERROR: Couldn't open SQL dump file: $@\n";
exit 1 if $opt{'sqldump'};
@@ -164,7 +157,7 @@ my $shredder = RT::Shredder->new;
unless( $opt{'force'} ) {
exit 0 unless prompt_yN( "Do you want to proceed?" );
}
- } else {
+ } else {
print "SQL dump file is '". $plugin->FileName ."'\n";
}
}
@@ -185,95 +178,95 @@ if( $@ ) {
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?" );
+ 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->UID ." 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;
+ 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;
+ 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";
+ 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;
+ }
+
+ 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);
- }
+ 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 );
+ }
+ return RT::Shredder->CastObjectsToRecords( Objects => \@res );
}
sub _process_search_plugin {
@@ -304,22 +297,22 @@ sub _process_dump_plugin {
sub show_plugin_list
{
- print "Plugins list:\n";
- print "\t$_\n" foreach( grep !/^Base$/, keys %plugins );
- exit(1);
+ 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);
+ my( $name ) = @_;
+ require RT::Shredder::POD;
+ unless( $plugins{ $name } ) {
+ print "Couldn't find plugin '$name'\n";
+ show_plugin_list();
+ }
+ RT::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 );
+ RT::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT );
+ exit(1);
}
exit(0);
diff --git a/rt/sbin/rt-test-dependencies.in b/rt/sbin/rt-test-dependencies.in
index 505d18add..0f24192da 100644
--- a/rt/sbin/rt-test-dependencies.in
+++ b/rt/sbin/rt-test-dependencies.in
@@ -64,27 +64,22 @@ 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',
+ 'install!',
+ 'with-MYSQL', 'with-PG', 'with-SQLITE', 'with-ORACLE',
+ 'with-FASTCGI', 'with-MODPERL1', 'with-MODPERL2', 'with-STANDALONE',
- 'with-DEV',
+ 'with-DEVELOPER',
'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',
+ 'siteinstall!',
'help|h',
);
@@ -167,6 +162,10 @@ sub conclude {
0, $module->{error} );
}
}
+
+ print "\nPerl library path for @PERL@:\n";
+ print " $_\n" for @INC;
+
exit 1;
}
}
@@ -189,125 +188,124 @@ sub set_dep {
}
$deps{'CORE'} = [ text_to_hash( << '.') ];
-Class::Accessor 0.34
+Apache::Session 1.53
+CGI 3.38
+CGI::Cookie 1.20
+CGI::Emulate::PSGI
+CGI::PSGI 0.12
+Class::Accessor::Fast
+Crypt::Eksblowfish
+CSS::Squish 0.06
+Data::GUID
+Date::Extract 0.02
+Date::Manip
DateTime 0.44
+DateTime::Format::Natural 0.67
DateTime::Locale 0.40
+DBI 1.37
+DBIx::SearchBuilder 1.65
+Devel::GlobalDestruction
+Devel::StackTrace 1.19
Digest::base
Digest::MD5 2.27
Digest::SHA
-DBI 1.37
-Class::ReturnValue 0.40
-DBIx::SearchBuilder 1.59
-Text::Template 1.44
+Email::Address 1.897
+Email::Address::List 0.02
+Encode 2.64
+Errno
+File::Glob
File::ShareDir
File::Spec 0.8
+File::Temp 0.19
+HTML::Entities
+HTML::FormatText::WithLinks 0.14
+HTML::FormatText::WithLinks::AndTables
+HTML::Mason 1.43
+HTML::Mason::PSGIHandler 0.52
HTML::Quoted
+HTML::RewriteAttributes 0.05
HTML::Scrubber 0.08
-HTML::TreeBuilder
-HTML::FormatText
-Log::Dispatch 2.23
-Sys::Syslog 0.16
+HTTP::Message 6.0
+IPC::Run3
+JSON
+LWP::Simple
+List::MoreUtils
Locale::Maketext 1.06
+Locale::Maketext::Fuzzy 0.11
Locale::Maketext::Lexicon 0.32
-Locale::Maketext::Fuzzy
-MIME::Entity 5.425
+Log::Dispatch 2.30
+Mail::Header 2.12
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
+MIME::Entity 5.504
+Module::Refresh 0.03
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
+Plack 1.0002
+Plack::Handler::Starlet
+Regexp::Common
Regexp::Common::net::CIDR
Regexp::IPv6
-.
-
-$deps{'MASON'} = [ text_to_hash( << '.') ];
-HTML::Mason 1.43
-Errno
-Digest::MD5 2.27
-CGI::Cookie 1.20
+Role::Basic 0.12
+Scalar::Util
Storable 2.08
-Apache::Session 1.53
-XML::RSS 1.05
+Symbol::Global::Name 0.04
+Sys::Syslog 0.16
+Text::Password::Pronounceable
+Text::Quoted 2.07
+Text::Template 1.44
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
+Text::Wrapper
+Time::HiRes
+Time::ParseDate
+Tree::Simple 1.04
+UNIVERSAL::require
+XML::RSS 1.05
.
-set_dep( PSGI => CGI => 4.00 ) if $] > 5.019003;
-
+set_dep( CORE => 'Symbol::Global::Name' => 0.05 ) if $] >= 5.019003;
+set_dep( CORE => 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
+Getopt::Long
LWP::Protocol::https
+LWP::UserAgent 6.0
Mozilla::CA
+Net::SSL
+Pod::Usage
.
$deps{'CLI'} = [ text_to_hash( << '.') ];
Getopt::Long 2.24
-LWP
HTTP::Request::Common
-Text::ParseWords
-Term::ReadLine
+LWP
Term::ReadKey
+Term::ReadLine
+Text::ParseWords
.
-$deps{'DEV'} = [ text_to_hash( << '.') ];
+$deps{'DEVELOPER'} = [ 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
+File::Which
+Locale::PO
Log::Dispatch::Perl
-Test::WWW::Mechanize::PSGI
+Mojo::DOM
Plack::Middleware::Test::StashWarnings 0.08
+Set::Tiny
+String::ShellQuote 0 # needed for gnupg-incoming.t
+Test::Builder 0.90 # needed for is_passing
+Test::Deep 0 # needed for shredder tests
+Test::Email
+Test::Expect 0.31
Test::LongString
+Test::MockTime
Test::NoWarnings
-Locale::PO
+Test::Pod
+Test::Warn
+Test::WWW::Mechanize 1.30
+Test::WWW::Mechanize::PSGI
+WWW::Mechanize 1.52
+XML::Simple
.
$deps{'FASTCGI'} = [ text_to_hash( << '.') ];
@@ -316,13 +314,12 @@ FCGI::ProcManager
.
$deps{'MODPERL1'} = [ text_to_hash( << '.') ];
-Apache::Request
Apache::DBI 0.92
+Apache::Request
.
$deps{'MODPERL2'} = [ text_to_hash( << '.') ];
Apache::DBI
-HTML::Mason 1.36
.
$deps{'MYSQL'} = [ text_to_hash( << '.') ];
@@ -333,7 +330,7 @@ $deps{'ORACLE'} = [ text_to_hash( << '.') ];
DBD::Oracle
.
-$deps{'POSTGRESQL'} = [ text_to_hash( << '.') ];
+$deps{'PG'} = [ text_to_hash( << '.') ];
DBIx::SearchBuilder 1.66
DBD::Pg 1.43
.
@@ -343,22 +340,25 @@ DBD::SQLite 1.00
.
$deps{'GPG'} = [ text_to_hash( << '.') ];
+File::Which
GnuPG::Interface
PerlIO::eol
.
-$deps{'ICAL'} = [ text_to_hash( << '.') ];
-Data::ICal
+$deps{'SMIME'} = [ text_to_hash( << '.') ];
+Crypt::X509
+File::Which
+String::ShellQuote
.
-$deps{'SMTP'} = [ text_to_hash( << '.') ];
-Net::SMTP
+$deps{'ICAL'} = [ text_to_hash( << '.') ];
+Data::ICal
.
$deps{'DASHBOARDS'} = [ text_to_hash( << '.') ];
-HTML::RewriteAttributes 0.05
MIME::Types
URI 1.59
+URI::QueryParam
.
$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ];
@@ -368,7 +368,7 @@ IPC::Run 0.90
$deps{'GD'} = [ text_to_hash( << '.') ];
GD
-GD::Graph
+GD::Graph 1.47
GD::Text
.
@@ -377,13 +377,12 @@ Convert::Color
.
$deps{'HTML-DOC'} = [ text_to_hash( <<'.') ];
-Pod::Simple 3.24
HTML::Entities
+Pod::Simple 3.24
.
my %AVOID = (
'DBD::Oracle' => [qw(1.23)],
- 'Email::Address' => [qw(1.893 1.894)],
'Devel::StackTrace' => [qw(1.28 1.29)],
);
@@ -463,7 +462,7 @@ sub test_dep {
}
else {
no warnings 'deprecated';
- eval "use $module $version ()";
+ eval "{ local \$ENV{__WARN__}; use $module $version () }";
if ( my $error = $@ ) {
return 0 unless wantarray;
@@ -471,6 +470,10 @@ sub test_dep {
$error =~ s/at \(eval \d+\) line \d+\.$//;
undef $error if $error =~ /this is only/;
+ my $path = $module;
+ $path =~ s{::}{/}g;
+ undef $error if defined $error and $error =~ /^Can't locate $path\.pm in \@INC/;
+
return ( 0, $error );
}
@@ -490,6 +493,27 @@ sub resolve_dep {
my $module = shift;
my $version = shift;
+ unless (defined $args{siteinstall}) {
+ require Config;
+ my %uniq;
+ my @order = grep {($_ eq $Config::Config{sitelibexp}
+ or $_ eq $Config::Config{privlibexp})
+ and not $uniq{$_}++} @INC;
+ if ($] < 5.011 and @order == 2
+ and $order[0] eq $Config::Config{sitelibexp}
+ and $order[1] eq $Config::Config{privlibexp}) {
+
+ print "\n";
+ print "Patched perl, with site_perl before core in \@INC, detected.\n";
+ print "Installing dual-life modules into site_perl so they are not\n";
+ print "later overridden by the distribution's package.\n";
+
+ $args{siteinstall} = 1;
+ } else {
+ $args{siteinstall} = 0;
+ }
+ }
+
print "\nInstall module $module\n";
my $ext = $ENV{'RT_FIX_DEPS_CMD'} || $ENV{'PERL_PREFER_CPAN_CLIENT'};
@@ -509,6 +533,12 @@ Please run `@PERL@ -MCPAN -e shell` to configure it.
END
exit(1);
}
+
+ my $installdirs = $CPAN::Config->{makepl_arg} ||= "";
+ $installdirs =~ s/(\bINSTALLDIRS=\S+|$)/ INSTALLDIRS=site/
+ if $args{siteinstall};
+ local $CPAN::Config->{makepl_arg} = $installdirs;
+
my $rv = eval { require CPAN; CPAN::Shell->install($module) };
return $rv unless $@;
@@ -552,55 +582,14 @@ END
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};
+ eval {require 5.010_001};
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.");
+ print_found("5.10.1", 0, sprintf("RT requires Perl v5.10.1 or newer. Your current Perl is v%vd", $^V));
exit(1);
} else {
- print_found( sprintf(">=5.8.3(%vd)", $^V), 1 );
+ print_found( sprintf(">=5.10.1(%vd)", $^V), 1 );
}
}
@@ -658,35 +647,35 @@ list the status of all dependencies, rather than just the missing ones.
=item --with-mysql
- database interface for mysql
+database interface for mysql
+
+=item --with-pg
-=item --with-postgresql
+database interface for postgresql
- database interface for postgresql
+=item --with-oracle
-=item with-oracle
-
- database interface for oracle
+database interface for oracle
-=item with-sqlite
+=item --with-sqlite
- database interface and driver for sqlite (unsupported)
+database interface and driver for sqlite (unsupported)
-=item with-fastcgi
+=item --with-fastcgi
- libraries needed to support the fastcgi handler
+libraries needed to support the fastcgi handler
-=item with-modperl1
+=item --with-modperl1
- libraries needed to support the modperl 1 handler
+libraries needed to support the modperl 1 handler
-=item with-modperl2
+=item --with-modperl2
- libraries needed to support the modperl 2 handler
+libraries needed to support the modperl 2 handler
-=item with-dev
+=item --with-developer
- tools needed for RT development
+tools needed for RT development
=back
diff --git a/rt/sbin/rt-validate-aliases.in b/rt/sbin/rt-validate-aliases.in
index 3db308aa1..93e28db4d 100644
--- a/rt/sbin/rt-validate-aliases.in
+++ b/rt/sbin/rt-validate-aliases.in
@@ -64,6 +64,7 @@ BEGIN { # BEGIN RT CMD BOILERPLATE
}
unshift @INC, $lib;
}
+
}
require RT;
@@ -172,7 +173,7 @@ while (my $q = $queues->Next) {
if (not $value) {
my @other = grep {$_ ne $global{$setting}} @{$seen{lc $q->Name}{$action} || []};
- warn "CorrespondAddress not set on $qname, but in aliases as "
+ warn "$setting not set on $qname, but in aliases as "
.join(" and ", @other) . "\n" if @other;
next;
}
@@ -341,3 +342,32 @@ sub parse_line {
return ();
}
}
+
+__END__
+
+=head1 NAME
+
+rt-validate-aliases - Check an MTA alias file against RT queue configuration
+
+=head1 SYNOPSIS
+
+rt-validate-aliases [options] /etc/aliases
+
+=head1 OPTIONS
+
+=over
+
+=item C<--prefix>
+
+An expected address prefix used in the alias file
+
+=item C<--url>
+
+The root URL of your RT server (the same URL you expect to be passed to
+rt-mailgate)
+
+=item C<--host>
+
+The host part of your RT email addresses
+
+=back
diff --git a/rt/sbin/rt-validator.in b/rt/sbin/rt-validator.in
index fafc85e10..16432a31b 100644
--- a/rt/sbin/rt-validator.in
+++ b/rt/sbin/rt-validator.in
@@ -50,23 +50,15 @@ use strict;
use warnings;
# fix lib paths, some may be relative
-BEGIN {
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -74,31 +66,26 @@ BEGIN {
}
-use Getopt::Long;
+use RT::Interface::CLI qw(Init);
my %opt = ();
-GetOptions(
+Init(
\%opt,
'check|c',
'resolve',
'force',
'verbose|v',
- 'help|h',
+ 'links-only',
);
-if ( $opt{help} || !$opt{check} ) {
- require Pod::Usage;
- print Pod::Usage::pod2usage( { verbose => 2 } );
- exit;
-}
+Pod::Usage::pod2usage( { verbose => 2 } ) unless $opt{check};
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.
+cases there is not enough data to resurect a missing record, but records which
+refer to a missing record 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.
@@ -108,10 +95,6 @@ END
<STDIN>;
}
-use RT;
-RT::LoadConfig();
-RT::Init();
-
my $dbh = $RT::Handle->dbh;
my $db_type = RT->Config->Get('DatabaseType');
@@ -123,6 +106,7 @@ my %TYPE = (
my @models = qw(
ACE
+ Article
Attachment
Attribute
CachedGroupMember
@@ -138,6 +122,7 @@ my @models = qw(
ScripAction
ScripCondition
Scrip
+ ObjectScrip
Template
Ticket
Transaction
@@ -160,6 +145,7 @@ $redo_on{'Delete'} = {
Queues => [],
Scrips => [],
+ ObjectScrips => [],
ScripActions => [],
ScripConditions => [],
Templates => [],
@@ -216,7 +202,7 @@ foreach my $table ( qw(Users Groups) ) {
." The script can either create the missing record in Principals"
." or delete the record in $table.";
my ($type) = ($table =~ /^(.*)s$/);
- check_integrity(
+ return check_integrity(
$table, 'id' => 'Principals', 'id',
join_condition => 't.PrincipalType = ?',
bind_values => [ $type ],
@@ -244,7 +230,7 @@ foreach my $table ( qw(Users Groups) ) {
." In some cases it's possible to manually resurrect such records,"
." but this utility can only delete records.";
- check_integrity(
+ return check_integrity(
'Principals', 'id' => $table, 'id',
condition => 's.PrincipalType = ?',
bind_values => [ $table =~ /^(.*)s$/ ],
@@ -259,8 +245,9 @@ foreach my $table ( qw(Users Groups) ) {
}
push @CHECKS, 'User <-> ACL equivalence group' => sub {
+ my $res = 1;
# from user to group
- check_integrity(
+ $res *= check_integrity(
'Users', 'id' => 'Groups', 'Instance',
join_condition => 't.Domain = ? AND t.Type = ?',
bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
@@ -276,7 +263,7 @@ push @CHECKS, 'User <-> ACL equivalence group' => sub {
},
);
# from group to user
- check_integrity(
+ $res *= check_integrity(
'Groups', 'Instance' => 'Users', 'id',
condition => 's.Domain = ? AND s.Type = ?',
bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
@@ -290,25 +277,27 @@ push @CHECKS, 'User <-> ACL equivalence group' => sub {
},
);
# one ACL equiv group for each user
- check_uniqueness(
+ $res *= check_uniqueness(
'Groups',
columns => ['Instance'],
condition => '.Domain = ? AND .Type = ?',
bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
);
+ return $res;
};
# 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(
+ my $res = 1;
+ $res *= check_integrity(
'Queues', 'id' => 'Groups', 'Instance',
join_condition => 't.Domain = ?',
bind_values => [ 'RT::Queue-Role' ],
);
# from group to queue
- check_integrity(
+ $res *= check_integrity(
'Groups', 'Instance' => 'Queues', 'id',
condition => 's.Domain = ?',
bind_values => [ 'RT::Queue-Role' ],
@@ -321,19 +310,21 @@ push @CHECKS, 'Queues <-> Role Groups' => sub {
delete_record( 'Groups', $id );
},
);
+ return $res;
};
# 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(
+ my $res = 1;
+ $res *= check_integrity(
'Tickets', 'id' => 'Groups', 'Instance',
join_condition => 't.Domain = ?',
bind_values => [ 'RT::Ticket-Role' ],
);
# from group to ticket
- check_integrity(
+ $res *= check_integrity(
'Groups', 'Instance' => 'Tickets', 'id',
condition => 's.Domain = ?',
bind_values => [ 'RT::Ticket-Role' ],
@@ -346,12 +337,13 @@ push @CHECKS, 'Tickets <-> Role Groups' => sub {
delete_record( 'Groups', $id );
},
);
+ return $res;
};
# additional CHECKS on groups
push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
# Check that Domain, Instance and Type are unique
- check_uniqueness(
+ return check_uniqueness(
'Groups',
columns => ['Domain', 'Instance', 'Type'],
condition => '.Domain LIKE ?',
@@ -360,7 +352,7 @@ push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
};
push @CHECKS, 'System internal group uniqueness' => sub {
- check_uniqueness(
+ return check_uniqueness(
'Groups',
columns => ['Instance', 'Type'],
condition => '.Domain = ?',
@@ -370,7 +362,7 @@ push @CHECKS, 'System internal group uniqueness' => sub {
# CHECK that user defined group names are unique
push @CHECKS, 'User Defined Group Name uniqueness' => sub {
- check_uniqueness(
+ return check_uniqueness(
'Groups',
columns => ['Name'],
condition => '.Domain = ?',
@@ -394,7 +386,8 @@ 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(
+ my $res = 1;
+ $res *= check_integrity(
'GroupMembers', 'GroupId' => 'Groups', 'id',
action => sub {
my $id = shift;
@@ -403,7 +396,7 @@ push @CHECKS, 'GMs -> Groups, Members' => sub {
delete_record( 'GroupMembers', $id );
},
);
- check_integrity(
+ $res *= check_integrity(
'GroupMembers', 'MemberId' => 'Principals', 'id',
action => sub {
my $id = shift;
@@ -412,12 +405,14 @@ push @CHECKS, 'GMs -> Groups, Members' => sub {
delete_record( 'GroupMembers', $id );
},
);
+ return $res;
};
# CGM and GM
push @CHECKS, 'CGM vs. GM' => sub {
+ my $res = 1;
# all GM record should be duplicated in CGM
- check_integrity(
+ $res *= check_integrity(
GroupMembers => ['GroupId', 'MemberId'],
CachedGroupMembers => ['GroupId', 'MemberId'],
join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
@@ -440,7 +435,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
},
);
# all first level CGM records should have a GM record
- check_integrity(
+ $res *= check_integrity(
CachedGroupMembers => ['GroupId', 'MemberId'],
GroupMembers => ['GroupId', 'MemberId'],
condition => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
@@ -456,7 +451,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
},
);
# each group should have a CGM record where MemberId == GroupId
- check_integrity(
+ $res *= check_integrity(
Groups => ['id', 'id'],
CachedGroupMembers => ['GroupId', 'MemberId'],
join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
@@ -483,7 +478,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
# and back, each record in CGM with MemberId == GroupId without exceptions
# should reference a group
- check_integrity(
+ $res *= check_integrity(
CachedGroupMembers => ['GroupId', 'MemberId'],
Groups => ['id', 'id'],
condition => "s.GroupId = s.MemberId",
@@ -498,7 +493,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
},
);
# Via
- check_integrity(
+ $res *= check_integrity(
CachedGroupMembers => 'Via',
CachedGroupMembers => 'id',
action => sub {
@@ -514,7 +509,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
# for every CGM where ImmediateParentId != GroupId there should be
# matching parent record (first level)
- check_integrity(
+ $res *= check_integrity(
CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
CachedGroupMembers => ['GroupId', 'MemberId'],
join_condition => 't.Via = t.id',
@@ -532,7 +527,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
# for every CGM where ImmediateParentId != GroupId there should be
# matching "grand" parent record
- check_integrity(
+ $res *= check_integrity(
CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
condition => 's.ImmediateParentId != s.GroupId',
@@ -578,6 +573,7 @@ END
my $sth = execute_query( $query );
while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
+ $res = 0;
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->(
@@ -586,11 +582,14 @@ END
);
}
}
+
+ return $res;
};
# Tickets
push @CHECKS, 'Tickets -> other' => sub {
- check_integrity(
+ my $res = 1;
+ $res *= check_integrity(
'Tickets', 'EffectiveId' => 'Tickets', 'id',
action => sub {
my $id = shift;
@@ -602,19 +601,34 @@ push @CHECKS, 'Tickets -> other' => sub {
delete_record( 'Tickets', $id );
},
);
- check_integrity(
+ $res *= check_integrity(
'Tickets', 'Queue' => 'Queues', 'id',
);
- check_integrity(
+ $res *= check_integrity(
'Tickets', 'Owner' => 'Users', 'id',
+ action => sub {
+ my ($id, %prop) = @_;
+ return unless my $replace_with = prompt_integer(
+ 'Replace',
+ "Column Owner should point to a user, but there is record #$id in Tickets\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.",
+ "Tickets.Owner -> user #$prop{Owner}"
+ );
+ update_records( 'Tickets', { id => $id, Owner => $prop{Owner} }, { Owner => $replace_with } );
+ },
);
# XXX: check that owner is only member of owner role group
+ return $res;
};
push @CHECKS, 'Transactions -> other' => sub {
+ my $res = 1;
foreach my $model ( @models ) {
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'ObjectId' => m2t($model), 'id',
condition => 's.ObjectType = ?',
bind_values => [ "RT::$model" ],
@@ -629,13 +643,13 @@ push @CHECKS, 'Transactions -> other' => sub {
);
}
# type = CustomField
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'Field' => 'CustomFields', 'id',
condition => 's.Type = ?',
bind_values => [ 'CustomField' ],
);
# type = Take, Untake, Force, Steal or Give
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'OldValue' => 'Users', 'id',
condition => 's.Type IN (?, ?, ?, ?, ?)',
bind_values => [ qw(Take Untake Force Steal Give) ],
@@ -649,7 +663,7 @@ push @CHECKS, 'Transactions -> other' => sub {
delete_record( 'Transactions', $id );
},
);
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'NewValue' => 'Users', 'id',
condition => 's.Type IN (?, ?, ?, ?, ?)',
bind_values => [ qw(Take Untake Force Steal Give) ],
@@ -664,7 +678,7 @@ push @CHECKS, 'Transactions -> other' => sub {
},
);
# type = DelWatcher
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'OldValue' => 'Principals', 'id',
condition => 's.Type = ?',
bind_values => [ 'DelWatcher' ],
@@ -679,7 +693,7 @@ push @CHECKS, 'Transactions -> other' => sub {
},
);
# type = AddWatcher
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'NewValue' => 'Principals', 'id',
condition => 's.Type = ?',
bind_values => [ 'AddWatcher' ],
@@ -694,22 +708,11 @@ push @CHECKS, 'Transactions -> other' => sub {
},
);
-# 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 = DeleteLink or AddLink
+# handled in 'Links: *' checks as {New,Old}Value store URIs
# type = Set, Field = Queue
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'NewValue' => 'Queues', 'id',
condition => 's.Type = ? AND s.Field = ?',
bind_values => [ 'Set', 'Queue' ],
@@ -723,7 +726,7 @@ push @CHECKS, 'Transactions -> other' => sub {
delete_record( 'Transactions', $id );
},
);
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'OldValue' => 'Queues', 'id',
condition => 's.Type = ? AND s.Field = ?',
bind_values => [ 'Set', 'Queue' ],
@@ -738,17 +741,19 @@ push @CHECKS, 'Transactions -> other' => sub {
},
);
# Reminders
- check_integrity(
+ $res *= check_integrity(
'Transactions', 'NewValue' => 'Tickets', 'id',
join_condition => 't.Type = ?',
condition => 's.Type IN (?, ?, ?)',
bind_values => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
);
+ return $res;
};
# Attachments
push @CHECKS, 'Attachments -> other' => sub {
- check_integrity(
+ my $res = 1;
+ $res *= check_integrity(
Attachments => 'TransactionId', Transactions => 'id',
action => sub {
my $id = shift;
@@ -758,7 +763,7 @@ push @CHECKS, 'Attachments -> other' => sub {
delete_record( 'Attachments', $id );
},
);
- check_integrity(
+ $res *= check_integrity(
Attachments => 'Parent', Attachments => 'id',
action => sub {
my $id = shift;
@@ -768,64 +773,75 @@ push @CHECKS, 'Attachments -> other' => sub {
delete_record( 'Attachments', $id );
},
);
- check_integrity(
+ $res *= check_integrity(
Attachments => 'Parent',
Attachments => 'id',
join_condition => 's.TransactionId = t.TransactionId',
);
+ return $res;
};
push @CHECKS, 'CustomFields and friends' => sub {
+ my $res = 1;
#XXX: ObjectCustomFields needs more love
- check_integrity(
+ $res *= check_integrity(
'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
);
- check_integrity(
+ $res *= check_integrity(
'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
);
foreach my $model ( @models ) {
- check_integrity(
+ $res *= check_integrity(
'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
condition => 's.ObjectType = ?',
bind_values => [ "RT::$model" ],
);
}
+ return $res;
};
push @CHECKS, Templates => sub {
- check_integrity(
+ return check_integrity(
'Templates', 'Queue' => 'Queues', 'id',
);
};
push @CHECKS, Scrips => sub {
- check_integrity(
- 'Scrips', 'Queue' => 'Queues', 'id',
- );
- check_integrity(
+ my $res = 1;
+ $res *= check_integrity(
'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
);
- check_integrity(
+ $res *= check_integrity(
'Scrips', 'ScripAction' => 'ScripActions', 'id',
);
- check_integrity(
- 'Scrips', 'Template' => 'Templates', 'id',
+ $res *= check_integrity(
+ 'Scrips', 'Template' => 'Templates', 'Name',
+ );
+ $res *= check_integrity(
+ 'ObjectScrips', 'Scrip' => 'Scrips', 'id',
);
+ $res *= check_integrity(
+ 'ObjectScrips', 'ObjectId' => 'Queues', 'id',
+ );
+ return $res;
};
push @CHECKS, Attributes => sub {
+ my $res = 1;
foreach my $model ( @models ) {
- check_integrity(
+ $res *= check_integrity(
'Attributes', 'ObjectId' => m2t($model), 'id',
condition => 's.ObjectType = ?',
bind_values => [ "RT::$model" ],
);
}
+ return $res;
};
# Fix situations when Creator or LastUpdatedBy references ACL equivalence
# group of a user instead of user
push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
+ my $res = 1;
my %fix = ();
foreach my $model ( @models ) {
my $class = "RT::$model";
@@ -855,6 +871,7 @@ END
my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
+ $res = 0;
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 );
@@ -877,16 +894,18 @@ END
}
$redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
}
+ return $res;
};
push @CHECKS, 'LastUpdatedBy and Creator' => sub {
+ my $res = 1;
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(
+ $res *= check_integrity(
$table, $column => 'Users', 'id',
action => sub {
my ($id, %prop) = @_;
@@ -904,13 +923,210 @@ push @CHECKS, 'LastUpdatedBy and Creator' => sub {
);
}
}
+ return $res;
+};
+
+push @CHECKS, 'Links: wrong organization' => sub {
+ my $res = 1;
+ my @URI_USES = (
+ { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
+ { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
+ { model => 'Link', column => 'Target' },
+ { model => 'Link', column => 'Base' },
+ );
+
+ my $right_org = RT->Config->Get('Organization');
+ my @rt_uris = rt_uri_modules();
+ foreach my $package (@rt_uris) {
+
+ my $rt_uri = $package->new( $RT::SystemUser );
+ my $scheme = $rt_uri->Scheme;
+ my $prefix = $rt_uri->LocalURIPrefix;
+
+ foreach my $use ( @URI_USES ) {
+ my $table = m2t( $use->{'model'} );
+ my $column = $use->{'column'};
+
+ my $query = "SELECT id, $column FROM $table WHERE"
+ . " $column LIKE ? AND $column NOT LIKE ?";
+ my @binds = (sql_escape_like($scheme) ."://%", sql_escape_like($prefix) ."%");
+
+ while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
+ $query .= " AND $k = ?";
+ push @binds, $v;
+ }
+ my $sth = execute_query( $query, @binds );
+ while ( my ($id, $value) = $sth->fetchrow_array ) {
+ $res = 0;
+ print STDERR "Record #$id in $table. Value of $column column most probably is an incorrect link\n";
+ my ($wrong_org) = ( $value =~ m{^\Q$scheme\E://(.+)/[^/]+/[0-9]*$} );
+ next unless my $replace_with = prompt(
+ 'Replace',
+ "Column $column in $table is a link. There is record #$id that has a"
+ ." local scheme of '$scheme', but its organization is '$wrong_org'"
+ ." instead of '$right_org'. Most probably the Organization was"
+ ." changed from '$wrong_org' to '$right_org' at some point. It is"
+ ." generally a good idea to replace these wrong links.\n",
+ "Links: wrong organization $wrong_org"
+ );
+
+ print "Updating record(s) in $table\n" if $opt{'verbose'};
+ my $wrong_prefix = $scheme . '://'. $wrong_org;
+ my $query = "UPDATE $table SET $column = ". sql_concat('?', "SUBSTR($column, ?)")
+ ." WHERE $column LIKE ?";
+ execute_query( $query, $prefix, length($wrong_prefix)+1, sql_escape_like($wrong_prefix) .'/%' );
+
+ $redo_check{'Links: wrong organization'} = 1;
+ $redo_check{'Links: LocalX for non-ticket'} = 1;
+ last; # plenty of chances we covered all cases with one update
+ }
+ }
+ } # end foreach my $package (@rt_uris)
+ return $res;
+};
+
+push @CHECKS, 'Links: LocalX for non-ticket' => sub {
+ my $res = 1;
+ my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
+ my $scheme = $rt_uri->Scheme;
+ my $prefix = $rt_uri->LocalURIPrefix;
+ my $table = m2t('Link');
+
+ foreach my $dir ( 'Target', 'Base' ) {
+ # we look only at links with correct organization, previouse check deals
+ # with incorrect orgs
+ my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir NOT LIKE ?";
+ my @binds = (sql_escape_like($prefix) ."/%", sql_escape_like($prefix) ."/ticket/%");
+
+ my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
+ while ( my ($id, $value) = $sth->fetchrow_array ) {
+ $res = 0;
+ print STDERR "Record #$id in $table. Value of Local$dir is not 0\n";
+ next unless my $replace_with = prompt(
+ 'Replace',
+ "Column Local$dir in $table should be 0 if $dir column is not link"
+ ." to a ticket. It's ok to replace with 0.\n",
+ );
+
+ print "Updating record(s) in $table\n" if $opt{'verbose'};
+ execute_query( "UPDATE $table SET Local$dir = 0 WHERE $where", @binds );
+ $redo_check{'Links: wrong organization'} = 1;
+
+ last; # we covered all cases with one update
+ }
+ }
+ return $res;
+};
+
+push @CHECKS, 'Links: LocalX != X' => sub {
+ my $res = 1;
+ my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
+ my $scheme = $rt_uri->Scheme;
+ my $prefix = $rt_uri->LocalURIPrefix .'/ticket/';
+ my $table = m2t('Link');
+
+ foreach my $dir ( 'Target', 'Base' ) {
+ # we limit to $dir = */ticket/* so it doesn't conflict with previouse check
+ # previouse check is more important as there was a bug in RT when Local$dir
+ # was set for not tickets
+ # XXX: we have issue with MergedInto links - "LocalX !~ X"
+ my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir != ". sql_concat('?', "Local$dir")
+ ." AND Type != ?";
+ my @binds = (sql_escape_like($prefix) ."%", $prefix, 'MergedInto');
+
+ my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
+ while ( my ($id, $value) = $sth->fetchrow_array ) {
+ $res = 0;
+ print STDERR "Record #$id in $table. Value of $dir doesn't match ticket id in Local$dir\n";
+ next unless my $replace_with = prompt(
+ 'Replace',
+ "For ticket links column $dir in $table table should end with"
+ ." ticket id from Local$dir. It's probably ok to fix $dir column.\n",
+ );
+
+ print "Updating record(s) in $table\n" if $opt{'verbose'};
+ execute_query(
+ "UPDATE $table SET $dir = ". sql_concat('?', "Local$dir") ." WHERE $where",
+ $prefix, @binds
+ );
+
+ last; # we covered all cases with one update
+ }
+ }
+ return $res;
};
+
+push @CHECKS, 'Links: missing object' => sub {
+ my $res = 1;
+ my @URI_USES = (
+ { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
+ { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
+ { model => 'Link', column => 'Target' },
+ { model => 'Link', column => 'Base' },
+ );
+
+ my @rt_uris = rt_uri_modules();
+ foreach my $package (@rt_uris) {
+
+ my $rt_uri = $package->new( $RT::SystemUser );
+ my $scheme = $rt_uri->Scheme;
+ my $prefix = $rt_uri->LocalURIPrefix;
+
+ foreach my $use ( @URI_USES ) {
+ my $stable = m2t( $use->{'model'} );
+ my $scolumn = $use->{'column'};
+
+ foreach my $tmodel ( @models ) {
+ my $tclass = 'RT::'. $tmodel;
+ my $ttable = m2t($tmodel);
+
+ my $tprefix = $prefix .'/'. ($tclass eq 'RT::Ticket'? 'ticket' : $tclass) .'/';
+
+ $tprefix = $prefix . '/article/' if $tclass eq 'RT::Article';
+
+ my $query = "SELECT s.id FROM $stable s LEFT JOIN $ttable t "
+ ." ON t.id = ". sql_str2int("SUBSTR(s.$scolumn, ?)")
+ ." WHERE s.$scolumn LIKE ? AND t.id IS NULL";
+ my @binds = (length($tprefix) + 1, sql_escape_like($tprefix).'%');
+
+ while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
+ $query .= " AND s.$k = ?";
+ push @binds, $v;
+ }
+
+ my $sth = execute_query( $query, @binds );
+ while ( my ($sid) = $sth->fetchrow_array ) {
+ $res = 0;
+ print STDERR "Link in $scolumn column in record #$sid in $stable table points"
+ ." to not existing object.\n";
+ next unless prompt(
+ 'Delete',
+ "Column $scolumn in $stable table is a link to an object that doesn't exist."
+ ." You can delete such records, however make sure there is no other"
+ ." errors with links.\n",
+ 'Link to a missing object in $ttable'
+ );
+
+ delete_record($stable, $sid);
+ }
+ }
+ }
+ } # end foreach my $package (@rt_uris)
+ return $res;
+};
+
+
my %CHECKS = @CHECKS;
@do_check = do { my $i = 1; grep $i++%2, @CHECKS };
+if ($opt{'links-only'}) {
+ @do_check = grep { /^Links:/ } @do_check;
+}
+
+my $status = 1;
while ( my $check = shift @do_check ) {
- $CHECKS{ $check }->();
+ $status *= $CHECKS{ $check }->();
foreach my $redo ( keys %redo_check ) {
die "check $redo doesn't exist" unless $CHECKS{ $redo };
@@ -919,6 +1135,19 @@ while ( my $check = shift @do_check ) {
push @do_check, $redo;
}
}
+exit 1 unless $status;
+exit 0;
+
+=head2 check_integrity
+
+Takes two (table name, column(s)) pairs. First pair
+is reference we check and second is destination that
+must exist. Array reference can be used for multiple
+columns.
+
+Returns 0 if a record is missing or 1 otherwise.
+
+=cut
sub check_integrity {
my ($stable, @scols) = (shift, shift);
@@ -954,15 +1183,21 @@ sub check_integrity {
push @binds, 0;
}
+ my $res = 1;
+
my $sth = execute_query( $query, @binds );
while ( my ($sid, @set) = $sth->fetchrow_array ) {
+ $res = 0;
+
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'};
+ $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) )
+ if $args{'action'};
}
+ return $res;
}
sub describe {
@@ -1022,13 +1257,16 @@ sub check_uniqueness {
$args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (),
$args{'extra_values'}? (@{ $args{'extra_values'} }): ()
);
+ my $res = 1;
while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
+ $res = 0;
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'};
}
+ return $res;
}
sub load_record {
@@ -1079,6 +1317,30 @@ sub execute_query {
return $sth;
}
+sub sql_concat {
+ return $_[0] if @_ <= 1;
+
+ my $db_type = RT->Config->Get('DatabaseType');
+ if ( $db_type eq 'Pg' || $db_type eq 'SQLite' ) {
+ return '('. join( ' || ', @_ ) .')';
+ }
+ return sql_concat('CONCAT('. join( ', ', splice @_, 0, 2 ).')', @_);
+}
+
+sub sql_str2int {
+ my $db_type = RT->Config->Get('DatabaseType');
+ if ( $db_type eq 'Pg' ) {
+ return "($_[0])::integer";
+ }
+ return $_[0];
+}
+
+sub sql_escape_like {
+ my ($string) = @_;
+ $string =~ s/([%_\\])/\\$1/g;
+ return $string;
+}
+
{ my %cached_answer;
sub prompt {
my $action = shift;
@@ -1135,6 +1397,20 @@ sub prompt_integer {
return $cached_answer{ $token } = $a;
} }
+# Find all RT::URI modules RT has loaded
+
+sub rt_uri_modules {
+ my @uris = grep /^RT\/URI\/.+\.pm$/, keys %INC;
+ my @uri_modules;
+ foreach my $uri_path (@uris){
+ next if $uri_path =~ /base\.pm$/; # Skip base RT::URI object
+ $uri_path = substr $uri_path, 0, -3; # chop off .pm
+ push @uri_modules, join '::', split '/', $uri_path;
+ }
+
+ return @uri_modules;
+}
+
1;
__END__
@@ -1178,5 +1454,9 @@ records or ressurect accidentally deleted.
resolve without asking questions
+=item links-only
+
+ only run the Link validation routines, useful if you changed your Organization
+
=back
diff --git a/rt/sbin/standalone_httpd.in b/rt/sbin/standalone_httpd.in
index 8caefdb78..8be361395 100644
--- a/rt/sbin/standalone_httpd.in
+++ b/rt/sbin/standalone_httpd.in
@@ -49,30 +49,24 @@
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
+}
+# fix lib paths, some may be relative
+BEGIN { # BEGIN RT CMD BOILERPLATE
require File::Spec;
+ require Cwd;
my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
my $bin_path;
for my $lib (@libs) {
unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
+ $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
$lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
}
unshift @INC, $lib;
@@ -90,17 +84,19 @@ if (grep { m/help/ } @ARGV) {
}
require RT;
+die "Wrong version of RT $RT::VERSION found; need @RT_VERSION_MAJOR@.@RT_VERSION_MINOR@.*"
+ unless $RT::VERSION =~ /^@RT_VERSION_MAJOR@\.@RT_VERSION_MINOR@\./;
+
RT->LoadConfig();
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.
@@ -143,127 +139,27 @@ if ($RT::Handle) {
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);
-}
-
+require RT::PlackRunner;
# when used as a psgi file
if (caller) {
- return $app;
+ return RT::PlackRunner->app;
}
-# load appropriate server
-
-require Plack::Runner;
+my $r = RT::PlackRunner->new( RT->InstallMode ? ( server => 'Standalone' ) :
+ $0 =~ /standalone/ ? ( server => 'Standalone' ) :
+ $0 =~ /fcgi$/ ? ( server => 'FCGI', env => "deployment" )
+ : ( server => 'Starlet', env => "deployment" ) );
+$r->parse_options(@ARGV);
-my $is_fastcgi = $0 =~ m/fcgi$/;
-my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
- $is_fastcgi ? ( server => 'FCGI' )
- : (),
- env => 'deployment' );
+# Try to clean up wrong-permissions var/
+$SIG{INT} = sub {
+ local $@;
+ system("chown", "-R", "@WEB_USER@:@WEB_GROUP@", "@RT_VAR_PATH_R@");
+ exit 0;
+} if $> == 0;
-# 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";
- }
-}
+$r->run;
__END__
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-14 04:14:29 +0000