diff options
Diffstat (limited to 'rt/sbin')
35 files changed, 4310 insertions, 5626 deletions
diff --git a/rt/sbin/extract-message-catalog b/rt/sbin/extract-message-catalog deleted file mode 100644 index f6a7f8505..000000000 --- a/rt/sbin/extract-message-catalog +++ /dev/null @@ -1,382 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -# Portions Copyright 2002 Autrijus Tang <autrijus@autrijus.org> - -use strict; - -use File::Find; -use File::Copy; -use Regexp::Common; -use Carp; - -use vars qw($DEBUG $FILECAT); - -$DEBUG = 1; - -# po dir is for extensions -@ARGV = (<lib/RT/I18N/*.po>, <lib/RT/I18N/*.pot>, <po/*.po>, <po/*.pot>) unless @ARGV; - -$FILECAT = {}; - -# extract all strings and stuff them into $FILECAT -# scan html dir for extensions -File::Find::find( { wanted => \&extract_strings_from_code, follow => 1 }, qw(bin sbin lib share html etc) ); - -# remove msgid with $ in it. XXX: perhaps give some warnings here -$FILECAT = { map { $_ => $FILECAT->{$_} } grep { !m/\$/ } keys %$FILECAT }; - -# ensure proper escaping and [_1] => %1 transformation -foreach my $str ( sort keys %{$FILECAT} ) { - my $entry = $FILECAT->{$str}; - my $oldstr = $str; - - $str =~ s/\\/\\\\/g; - $str =~ s/\"/\\"/g; - $str =~ s/((?<!~)(?:~~)*)\[_(\d+)\]/$1%$2/g; - $str =~ s/((?<!~)(?:~~)*)\[([A-Za-z#*]\w*),([^\]]+)\]/"$1%$2(".escape($3).")"/eg; - $str =~ s/~([\[\]])/$1/g; - - delete $FILECAT->{$oldstr}; - $FILECAT->{$str} = $entry; -} - -# update all language dictionaries -foreach my $dict (@ARGV) { - $dict = "lib/RT/I18N/$dict.pot" if ( $dict eq 'rt' ); - $dict = "lib/RT/I18N/$dict.po" unless -f $dict or $dict =~ m!/!; - - my $lang = $dict; - $lang =~ s|.*/||; - $lang =~ s|\.po$||; - $lang =~ s|\.pot$||; - - update($lang, $dict); -} - - -# {{{ pull strings out of the code. - -sub extract_strings_from_code { - my $file = $_; - - local $/; - return if ( -d $_ ); - return - if ( $File::Find::dir =~ - qr!lib/blib|lib/t/autogen|var|m4|local|share/fonts! ); - return if ( /\.(?:pot|po|bak|gif|png|psd|jpe?g|svg|css|js)$/ ); - return if ( /~|,D|,B$|extract-message-catalog$|tweak-template-locstring$/ ); - return if ( /^[\.#]/ ); - return if ( -f "$_.in" ); - - print "Looking at $File::Find::name\n"; - my $filename = $File::Find::name; - $filename =~ s'^\./''; - $filename =~ s'\.in$''; - - unless (open _, '<', $file) { - print "Cannot open $file for reading ($!), skipping.\n"; - return; - } - - my $re_space_wo_nl = qr{(?!\n)\s}; - my $re_loc_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc $re_space_wo_nl* $}mx; - my $re_loc_qw_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_qw $re_space_wo_nl* $}mx; - my $re_loc_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_pair $re_space_wo_nl* $}mx; - my $re_loc_left_pair_suffix = qr{$re_space_wo_nl* \# $re_space_wo_nl* loc_left_pair $re_space_wo_nl* $}mx; - my $re_delim = $RE{delimited}{-delim=>q{'"}}{-keep}; - - $_ = <_>; - - # Mason filter: <&|/l>...</&> - my $line = 1; - while (m!\G.*?<&\|/l(.*?)&>(.*?)</&>!sg) { - my ( $vars, $str ) = ( $1, $2 ); - $vars =~ s/[\n\r]//g; - $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext! - $str =~ s/\\'/\'/g; - #print "STR IS $str\n"; - push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ]; - } - - # Localization function: loc(...) - $line = 1; - pos($_) = 0; - while (m/\G.*?\bloc$RE{balanced}{-parens=>'()'}{-keep}/sg) { - my $match = $1; - $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext! - - my ( $vars, $str ); - if ( $match =~ - /\(\s*($re_delim)(.*?)\s*\)$/so ) { - - $str = substr( $1, 1, -1 ); # $str comes before $vars now - $vars = $9; - } - else { - next; - } - - $vars =~ s/[\n\r]//g; - $str =~ s/\\'/\'/g; - - push @{ $FILECAT->{$str} }, [ $filename, $line, $vars ]; - } - - # Comment-based mark: "..." # loc - $line = 1; - pos($_) = 0; - while (m/\G.*?($re_delim)[\}\)\],;]*$re_loc_suffix/smgo) { - my $str = $1; - $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext! - unless ( defined $str ) { - warn "Couldn't process loc at $filename:$line"; - next; - } - $str = substr($str, 1, -1); - $str =~ s/\\'/\'/g; - push @{ $FILECAT->{$str} }, [ $filename, $line, '' ]; - } - - # Comment-based qw mark: "qw(...)" # loc_qw - $line = 1; - pos($_) = 0; - while (m/\G.*?(?:(qw\([^)]+\))[\}\)\],;]*)?$re_loc_qw_suffix/smgo) { - my $str = $1; - $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext! - unless ( defined $str ) { - warn "Couldn't process loc_qw at $filename:$line"; - next; - } - foreach my $value (eval($str)) { - push @{ $FILECAT->{$value} }, [ $filename, $line, '' ]; - } - } - - # Comment-based left pair mark: "..." => ... # loc_left_pair - $line = 1; - pos($_) = 0; - while (m/\G.*?(?:(\w+)\s*=>[^#\n]+?)?$re_loc_left_pair_suffix/smgo) { - my $key = $1; - $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext! - unless ( defined $key ) { - warn "Couldn't process loc_left_pair at $filename:$line"; - next; - } - $key =~ s/\\'/\'/g; - push @{ $FILECAT->{$key} }, [ $filename, $line, '' ]; - } - - # Comment-based pair mark: "..." => "..." # loc_pair - $line = 1; - pos($_) = 0; - while (m/\G.*?(?:(\w+)\s*=>\s*($re_delim)[\}\)\],;]*)?$re_loc_pair_suffix/smgo) { - my $key = $1; - my $val = $2; - $line += ( () = ( $& =~ /\n/g ) ); # cryptocontext! - unless ( defined $key && defined $val ) { - warn "Couldn't process loc_pair at $filename:$line"; - next; - } - $val = substr($val, 1, -1); - $key =~ s/\\'/\'/g; - $val =~ s/\\'/\'/g; - push @{ $FILECAT->{$key} }, [ $filename, $line, '' ]; - push @{ $FILECAT->{$val} }, [ $filename, $line, '' ]; - } - - close (_); -} -# }}} extract from strings - -sub update { - my $lang = shift; - my $file = shift; - my ( %Lexicon, %Header); - my $out = ''; - - unless (!-e $file or -w $file) { - warn "Can't write to $lang, skipping...\n"; - return; - } - - print "Updating $lang...\n"; - - my @lines; - @lines = (<LEXICON>) if open LEXICON, '<', $file; - @lines = grep { !/^(#(:|\.)\s*|$)/ } @lines; - while (@lines) { - my $msghdr = ""; - $msghdr .= shift @lines while ( $lines[0] && $lines[0] !~ /^(#~ )?msgid/ ); - - my $msgid = ""; - -# '#~ ' is the prefix of launchpad for msg that's not found the the source -# we'll remove the prefix later so we can still show them with our own mark - - $msgid .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgid|")/ ); - my $msgstr = ""; - $msgstr .= shift @lines while ( $lines[0] && $lines[0] =~ /^(#~ )?(msgstr|")/ ); - - last unless $msgid; - - chomp $msgid; - chomp $msgstr; - - $msgid =~ s/^#~ //mg; - $msgstr =~ s/^#~ //mg; - - $msgid =~ s/^msgid "(.*)"\s*?$/$1/m or warn "$msgid in $file"; - - if ( $msgid eq '' ) { - # null msgid, msgstr will have head info - $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/ms or warn "$msgstr in $file"; - } - else { - $msgstr =~ s/^msgstr "(.*)"\s*?$/$1/m or warn "$msgstr in $file"; - } - - if ( $msgid ne '' ) { - for my $msg ( \$msgid, \$msgstr ) { - if ( $$msg =~ /\n/ ) { - my @lines = split /\n/, $$msg; - $$msg = - shift @lines; # first line don't need to handle any more - for (@lines) { - if (/^"(.*)"\s*$/) { - $$msg .= $1; - } - } - } - - # convert \\n back to \n - $$msg =~ s/(?!\\)\\n/\n/g; - } - } - - $Lexicon{$msgid} = $msgstr; - $Header{$msgid} = $msghdr; - } - - my $is_english = ( $lang =~ /^en(?:[^A-Za-z]|$)/ ); - - foreach my $str ( sort keys %{$FILECAT} ) { - $Lexicon{$str} ||= ''; - } - foreach ( sort keys %Lexicon ) { - my $f = join ( ' ', sort map $_->[0].":".$_->[1], @{ $FILECAT->{$_} } ); - my $nospace = $_; - $nospace =~ s/ +$//; - - if ( !$Lexicon{$_} and $Lexicon{$nospace} ) { - $Lexicon{$_} = - $Lexicon{$nospace} . ( ' ' x ( length($_) - length($nospace) ) ); - } - - next if !length( $Lexicon{$_} ) and $is_english; - - my %seen; - $out .= $Header{$_} if exists $Header{$_}; - - - - next if (!$f && $_ && !$Lexicon{$_}); - if ( $f && $f !~ /^\s+$/ ) { - - $out .= "#: $f\n"; - } - elsif ($_) { - $out .= "#: NOT FOUND IN SOURCE\n"; - } - foreach my $entry ( grep { $_->[2] } @{ $FILECAT->{$_} } ) { - my ( $file, $line, $var ) = @{$entry}; - $var =~ s/^\s*,\s*//; - $var =~ s/\s*$//; - $out .= "#. ($var)\n" unless $seen{$var}++; - } - $out .= 'msgid ' . fmt($_) . "msgstr \"$Lexicon{$_}\"\n\n"; - } - - open( PO, '>', $file ) or die "Couldn't open '$file' for writing: $!"; - print PO $out; - close PO; - - return 1; -} - -sub escape { - my $text = shift; - $text =~ s/\b_(\d+)/%$1/; - return $text; -} - -sub fmt { - my $str = shift; - return "\"$str\"\n" unless $str =~ /\n/; - - my $multi_line = ($str =~ /\n(?!\z)/); - $str =~ s/\n/\\n"\n"/g; - - if ($str =~ /\n"$/) { - chop $str; - } - else { - $str .= "\"\n"; - } - return $multi_line ? qq(""\n"$str) : qq("$str); -} - - -__END__ -# Local variables: -# c-indentation-style: bsd -# c-basic-offset: 4 -# indent-tabs-mode: nil -# End: -# vim: expandtab shiftwidth=4: diff --git a/rt/sbin/factory b/rt/sbin/factory deleted file mode 100644 index a1d1f3e34..000000000 --- a/rt/sbin/factory +++ /dev/null @@ -1,520 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -use DBI; - -die "Usage: $0 database namespace" if @ARGV != 2; - -my $database = shift; -my $namespace = shift; - -my $CollectionBaseclass = 'RT::SearchBuilder'; -my $RecordBaseclass = 'RT::Record'; - -my $driver = 'mysql'; -my $hostname = 'localhost'; -my $user = 'root'; -my $password = ''; - - -my $LicenseBlock = << '.'; -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2008 Best Practical Solutions, LLC -# <jesse@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -. - -my $Attribution = << '.'; - -# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>) -# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST. -# -# !! DO NOT EDIT THIS FILE !! -# - -use strict; -. - -my $dsn = "DBI:$driver:database=$database;host=$hostname"; - -my $dbh = DBI->connect( $dsn, $user, $password ); - -#get all tables out of database -my @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables(); - -my ( %tablemap, $typemap, %modulemap ); - -foreach my $table (@tables) { - $table =~ s/\`//g; - next if ($table eq 'sessions'); - $table = ucfirst($table); - $table =~ s/field/Field/; - $table =~ s/group/Group/; - $table =~ s/custom/Custom/; - $table =~ s/member/Member/; - $table =~ s/Scripaction/ScripAction/g; - $table =~ s/condition/Condition/g; - $table =~ s/value/Value/; - $table =~ s/Acl/ACL/g; - $tablemap{$table} = $table; - $modulemap{$table} = $table; - if ( $table =~ /^(.*)s$/ ) { - $tablemap{$1} = $table; - $modulemap{$1} = $1; - } -} -$tablemap{'CreatedBy'} = 'User'; -$tablemap{'UpdatedBy'} = 'User'; - -my %typemap; -$typemap{'id'} = 'ro'; -$typemap{'Creator'} = 'auto'; -$typemap{'Created'} = 'auto'; -$typemap{'Updated'} = 'auto'; -$typemap{'UpdatedBy'} = 'auto'; -$typemap{'LastUpdated'} = 'auto'; -$typemap{'LastUpdatedBy'} = 'auto'; - -foreach my $table (@tables) { - next if ($table eq 'sessions'); - my $tablesingle = $table; - $tablesingle =~ s/s$//; - my $tableplural = $tablesingle . "s"; - - if ( $tablesingle eq 'ACL' ) { - $tablesingle = "ACE"; - $tableplural = "ACL"; - } - - my %requirements; - - my $CollectionClassName = $namespace . "::" . $tableplural; - my $RecordClassName = $namespace . "::" . $tablesingle; - - my $path = $namespace; - $path =~ s/::/\//g; - - my $RecordClassPath = $path . "/" . $tablesingle . ".pm"; - my $CollectionClassPath = $path . "/" . $tableplural . ".pm"; - - #create a collection class - my $CreateInParams; - my $CreateOutParams; - my $ClassAccessible = ""; - my $FieldsPod = ""; - my $CreatePod = ""; - my $RecordInit = ""; - my %fields; - - - my $introspection = $dbh->prepare("SELECT * from $table where id is null"); - $introspection->execute(); - my @names =@{ $introspection->{'NAME'}}; - my @types = @{$introspection->{'TYPE'}}; - my @is_blob = @{$introspection->{'mysql_is_blob'}}; - my @is_num = @{$introspection->{'mysql_is_num'}}; - - my %blobness = (); - my %sqltypes = (); - my %numeric = (); - foreach my $name (@names) { - $sqltypes{$name} = shift @types; - $blobness{$name} = (shift @is_blob || "0"); - $numeric{$name} = (shift @is_num || "0"); - } - - - my $sth = $dbh->prepare("DESCRIBE $table"); - $sth->execute; - - while ( my $row = $sth->fetchrow_hashref() ) { - my $field = $row->{'Field'}; - my $type = $row->{'Type'}; - my $default = $row->{'Default'}; - my $length = 0; - if ($type =~ /^(?:.*?)\((\d+)\)$/) { - $length = $1; - } - $fields{$field} = 1; - - #generate the 'accessible' datastructure - - no warnings 'uninitialized'; - - if ( $typemap{$field} eq 'auto' ) { - $ClassAccessible .= " $field => - {read => 1, auto => 1,"; - } - elsif ( $typemap{$field} eq 'ro' ) { - $ClassAccessible .= " $field => - {read => 1,"; - } - else { - $ClassAccessible .= " $field => - {read => 1, write => 1,"; - - } - $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, "; - $ClassAccessible .= " type => '$type', default => '$default'},\n"; - - #generate pod for the accessible fields - $FieldsPod .= " -=head2 $field - -Returns the current value of $field. -(In the database, $field is stored as $type.) - -"; - - unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) { - $FieldsPod .= " - -=head2 Set$field VALUE - - -Set $field to VALUE. -Returns (1, 'Status message') on success and (0, 'Error Message') on failure. -(In the database, $field will be stored as a $type.) - -"; - } - - $FieldsPod .= " -=cut - -"; - - if ( $modulemap{$field} ) { - $FieldsPod .= " -=head2 ${field}Obj - -Returns the $modulemap{$field} Object which has the id returned by $field - - -=cut - -sub ${field}Obj { - my \$self = shift; - my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser); - \$$field->Load(\$self->__Value('$field')); - return(\$$field); -} -"; - $requirements{ $tablemap{$field} } = - "use ${namespace}::$modulemap{$field};"; - - } - - unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) { - - #generate create statement - $CreateInParams .= " $field => '$default',\n"; - $CreateOutParams .= - " $field => \$args{'$field'},\n"; - - #gerenate pod for the create statement - $CreatePod .= " $type '$field'"; - $CreatePod .= " defaults to '$default'" if ($default); - $CreatePod .= ".\n"; - - } - - } - - my $Create = " -sub Create { - my \$self = shift; - my \%args = ( -$CreateInParams - \@_); - \$self->SUPER::Create( -$CreateOutParams); - -} -"; - $CreatePod .= "\n=cut\n\n"; - - my $CollectionClass = $LicenseBlock . $Attribution . - - " - -=head1 NAME - - $CollectionClassName -- Class Description - -=head1 SYNOPSIS - - use $CollectionClassName - -=head1 DESCRIPTION - - -=head1 METHODS - -=cut - -package $CollectionClassName; - -use $CollectionBaseclass; -use $RecordClassName; - -use vars qw( \@ISA ); -\@ISA= qw($CollectionBaseclass); - - -sub _Init { - my \$self = shift; - \$self->{'table'} = '$table'; - \$self->{'primary_key'} = 'id'; - -"; - - if ( $fields{'SortOrder'} ) { - - $CollectionClass .= " - - # By default, order by SortOrder - \$self->OrderByCols( - { ALIAS => 'main', - FIELD => 'SortOrder', - ORDER => 'ASC' }, - { ALIAS => 'main', - FIELD => 'id', - ORDER => 'ASC' }, - ); -"; - } - $CollectionClass .= " - return ( \$self->SUPER::_Init(\@_) ); -} - - -=head2 NewItem - -Returns an empty new $RecordClassName item - -=cut - -sub NewItem { - my \$self = shift; - return($RecordClassName->new(\$self->CurrentUser)); -} -" . MagicImport($CollectionClassName); - - my $RecordClassHeader = $Attribution . " - -=head1 NAME - -$RecordClassName - - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -=head1 METHODS - -=cut - -package $RecordClassName; -use $RecordBaseclass; -"; - - foreach my $key ( keys %requirements ) { - $RecordClassHeader .= $requirements{$key} . "\n"; - } - $RecordClassHeader .= " - -use vars qw( \@ISA ); -\@ISA= qw( $RecordBaseclass ); - -sub _Init { - my \$self = shift; - - \$self->Table('$table'); - \$self->SUPER::_Init(\@_); -} - -"; - - my $RecordClass = $LicenseBlock . $RecordClassHeader . " - -$RecordInit - -=head2 Create PARAMHASH - -Create takes a hash of values and creates a row in the database: - -$CreatePod - -$Create - -$FieldsPod - -sub _CoreAccessible { - { - -$ClassAccessible - } -}; - -" . MagicImport($RecordClassName); - - print "About to make $RecordClassPath, $CollectionClassPath\n"; - `mkdir -p $path`; - - open( RECORD, '>', $RecordClassPath ) or die $!; - print RECORD $RecordClass; - close(RECORD); - - open( COL, '>', $CollectionClassPath ) or die $!; - print COL $CollectionClass; - close(COL); - -} - -sub MagicImport { - my $class = shift; - - #if (exists \$warnings::{unimport}) { - # no warnings qw(redefine); - - my $path = $class; - $path =~ s#::#/#gi; - - - my $content = " - eval \"require @{[$class]}_Overlay\"; - if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) { - die \$@; - }; - - eval \"require @{[$class]}_Vendor\"; - if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) { - die \$@; - }; - - eval \"require @{[$class]}_Local\"; - if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) { - die \$@; - }; - - - - -=head1 SEE ALSO - -This class allows \"overlay\" methods to be placed -into the following files _Overlay is for a System overlay by the original author, -_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations. - -These overlay files can contain new subs or subs to replace existing subs in this module. - -Each of these files should begin with the line - - no warnings qw(redefine); - -so that perl does not kick and scream when you redefine a subroutine or variable in your overlay. - -@{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local - -=cut - - -1; -"; - - return $content; -} - -# }}} - diff --git a/rt/sbin/license_tag b/rt/sbin/license_tag deleted file mode 100644 index 9ddf82e2d..000000000 --- a/rt/sbin/license_tag +++ /dev/null @@ -1,261 +0,0 @@ -#!/usr/bin/perl - - -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -my $LICENSE = <<'EOL'; - -COPYRIGHT: - -This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC - <sales@bestpractical.com> - -(Except where explicitly superseded by other copyright notices) - - -LICENSE: - -This work is made available to you under the terms of Version 2 of -the GNU General Public License. A copy of that license should have -been provided with this software, but in any event can be snarfed -from www.gnu.org. - -This work is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301 or visit their web page on the internet at -http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. - - -CONTRIBUTION SUBMISSION POLICY: - -(The following paragraph is not intended to limit the rights granted -to you to modify and distribute this software under the terms of -the GNU General Public License and is only of importance to you if -you choose to contribute your changes and enhancements to the -community by submitting them to Best Practical Solutions, LLC.) - -By intentionally submitting any modifications, corrections or -derivatives to this work, or any other work intended for use with -Request Tracker, to Best Practical Solutions, LLC, you confirm that -you are the copyright holder for those contributions and you grant -Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -royalty-free, perpetual, license to use, copy, create derivative -works based on those contributions, and sublicense and distribute -those contributions and any derivatives thereof. - -EOL - -use File::Find; - -my @MAKE = qw(Makefile); - -File::Find::find({ no_chdir => 1, wanted => \&tag_pm}, 'lib'); -File::Find::find({ no_chdir => 1, wanted => \&tag_mason}, 'share/html'); -File::Find::find({ no_chdir => 1, wanted => \&tag_script}, 'sbin'); -File::Find::find({ no_chdir => 1, wanted => \&tag_script}, 'bin'); -File::Find::find({ no_chdir => 1, wanted => \&tag_script}, 'etc/upgrade'); -tag_makefile ('Makefile.in'); -tag_makefile ('README'); - - -sub tag_mason { - my $pm = $_; - return unless (-f $pm); - return if $pm =~ /images/ || $pm =~ /\.(?:png|jpe?g|gif)$/; - open( FILE, '<', $pm ) or die "Failed to open $pm"; - my $file = (join "", <FILE>); - close (FILE); - print "$pm - "; - return if another_license($pm => $file) && print "has different license\n"; - - my $pmlic = $LICENSE; - $pmlic =~ s/^/%# /mg; - $pmlic =~ s/\s*$//mg; - if ($file =~ /^%# BEGIN BPS TAGGED BLOCK {{{/ms) { - print "has license section"; - $file =~ s/^%# BEGIN BPS TAGGED BLOCK {{{(.*?)%# END BPS TAGGED BLOCK }}}/%# BEGIN BPS TAGGED BLOCK {{{\n$pmlic\n%# END BPS TAGGED BLOCK }}}/ms; - - - } else { - print "no license section"; - $file ="%# BEGIN BPS TAGGED BLOCK {{{\n$pmlic\n%# END BPS TAGGED BLOCK }}}\n". $file; - } - $file =~ s/%# END BPS TAGGED BLOCK }}}(\n+)/%# END BPS TAGGED BLOCK }}}\n/mg; - print "\n"; - - - - - open( FILE, '>', $pm ) or die "couldn't write new file"; - print FILE $file; - close FILE; - -} - - -sub tag_makefile { - my $pm = shift; - open( FILE, '<', $pm ) or die "Failed to open $pm"; - my $file = (join "", <FILE>); - close (FILE); - print "$pm - "; - return if another_license($pm => $file) && print "has different license\n"; - - my $pmlic = $LICENSE; - $pmlic =~ s/^/# /mg; - $pmlic =~ s/\s*$//mg; - if ($file =~ /^# BEGIN BPS TAGGED BLOCK {{{/ms) { - print "has license section"; - $file =~ s/^# BEGIN BPS TAGGED BLOCK {{{(.*?)# END BPS TAGGED BLOCK }}}/# BEGIN BPS TAGGED BLOCK {{{\n$pmlic\n# END BPS TAGGED BLOCK }}}/ms; - - - } else { - print "no license section"; - $file ="# BEGIN BPS TAGGED BLOCK {{{\n$pmlic\n# END BPS TAGGED BLOCK }}}\n". $file; - } - $file =~ s/# END BPS TAGGED BLOCK }}}(\n+)/# END BPS TAGGED BLOCK }}}\n/mg; - print "\n"; - - - - - open( FILE, '>', $pm ) or die "couldn't write new file"; - print FILE $file; - close FILE; - -} - - -sub tag_pm { - my $pm = $_; - next unless $pm =~ /\.pm/s; - open( FILE, '<', $pm ) or die "Failed to open $pm"; - my $file = (join "", <FILE>); - close (FILE); - print "$pm - "; - return if another_license($pm => $file) && print "has different license\n"; - - my $pmlic = $LICENSE; - $pmlic =~ s/^/# /mg; - $pmlic =~ s/\s*$//mg; - if ($file =~ /^# BEGIN BPS TAGGED BLOCK {{{/ms) { - print "has license section"; - $file =~ s/^# BEGIN BPS TAGGED BLOCK {{{(.*?)# END BPS TAGGED BLOCK }}}/# BEGIN BPS TAGGED BLOCK {{{\n$pmlic\n# END BPS TAGGED BLOCK }}}/ms; - - - } else { - print "no license section"; - $file ="# BEGIN BPS TAGGED BLOCK {{{\n$pmlic\n# END BPS TAGGED BLOCK }}}\n". $file; - } - $file =~ s/# END BPS TAGGED BLOCK }}}(\n+)/# END BPS TAGGED BLOCK }}}\n\n/mg; - print "\n"; - - - - - open( FILE, '>', $pm ) or die "couldn't write new file $pm"; - print FILE $file; - close FILE; - -} - - -sub tag_script { - my $pm = $_; - return unless (-f $pm); - open( FILE, '<', $pm ) or die "Failed to open $pm"; - my $file = (join "", <FILE>); - close (FILE); - print "$pm - "; - return if another_license($pm => $file) && print "has different license\n"; - - my $pmlic = $LICENSE; - $pmlic =~ s/^/# /msg; - $pmlic =~ s/\s*$//mg; - if ($file =~ /^# BEGIN BPS TAGGED BLOCK {{{/ms) { - print "has license section"; - $file =~ s/^# BEGIN BPS TAGGED BLOCK {{{(.*?)# END BPS TAGGED BLOCK }}}/# BEGIN BPS TAGGED BLOCK {{{\n$pmlic\n# END BPS TAGGED BLOCK }}}/ms; - - - } else { - print "no license section"; - if ($file =~ /^(#!.*?)\n/) { - - my $lic ="# BEGIN BPS TAGGED BLOCK {{{\n$pmlic\n# END BPS TAGGED BLOCK }}}\n"; - $file =~ s/^(#!.*?)\n/$1\n$lic/; - - } - } - $file =~ s/# END BPS TAGGED BLOCK }}}(\n+)/# END BPS TAGGED BLOCK }}}\n/mg; - print "\n"; - - - open( FILE, '>', $pm ) or die "couldn't write new file"; - print FILE $file; - close FILE; - -} - -sub another_license { - my $name = shift; - my $file = shift; - - return 1 if ($name =~ /(?:FCKEditor|scriptaculous)/i); - - return 0 if $file =~ /Copyright\s+\(c\)\s+\d\d\d\d-\d\d\d\d Best Practical Solutions/i; - return 1 if $file =~ /\b(copyright|GPL|Public Domain)\b/i; # common - return 1 if $file =~ /\(c\)\s+\d\d\d\d(?:-\d\d\d\d)?/i; # prototype - return 0; -} - diff --git a/rt/sbin/merge-rosetta.pl b/rt/sbin/merge-rosetta.pl deleted file mode 100644 index 06eedf098..000000000 --- a/rt/sbin/merge-rosetta.pl +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -exec('sbin/rt-message-catalog', 'rosetta', @ARGV); diff --git a/rt/sbin/rt-attributes-viewer.in b/rt/sbin/rt-attributes-viewer.in index ce9f5f7a2..c776f1a8c 100644 --- a/rt/sbin/rt-attributes-viewer.in +++ b/rt/sbin/rt-attributes-viewer.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -73,21 +73,16 @@ BEGIN { } } -my $id = shift; -usage() unless $id; - -sub usage { - print STDERR <<END; -Usage: $0 <attribute id> - -Description: +use Getopt::Long; +my %opt; +GetOptions( \%opt, 'help|h', ); -This script deserializes and print content of an attribute defined -by <attribute id>. May be useful for developers and for troubleshooting -problems. +my $id = shift; -END - exit 1; +if ( $opt{help} || !$id ) { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; } require RT; @@ -95,7 +90,7 @@ RT::LoadConfig(); RT::Init(); require RT::Attribute; -my $attr = RT::Attribute->new( do { no warnings 'once'; $RT::SystemUser } ); +my $attr = RT::Attribute->new( RT->SystemUser ); $attr->Load( $id ); unless ( $attr->id ) { print STDERR "Couldn't load attribute #$id\n"; @@ -108,3 +103,20 @@ $res{$_} = $attr->$_() foreach qw(ObjectType ObjectId Name Description Content C use Data::Dumper; print "Content of attribute #$id: ". Dumper( \%res ); +__END__ + +=head1 NAME + +rt-attributes-viewer - show the content of an attribute + +=head1 SYNOPSIS + + # show the content of attribute 2 + rt-attributes-viewer 2 + +=head1 DESCRIPTION + +This script deserializes and print content of an attribute defined +by <attribute id>. May be useful for developers and for troubleshooting +problems. + diff --git a/rt/sbin/rt-clean-sessions b/rt/sbin/rt-clean-sessions deleted file mode 100755 index c3dc20143..000000000 --- a/rt/sbin/rt-clean-sessions +++ /dev/null @@ -1,190 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -use warnings; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } -} - -use Getopt::Long; -my %opt; -GetOptions( \%opt, "older=s", "debug", "help", "skip-user"); - - -if ( $opt{help} ) { - require Pod::Usage; - import Pod::Usage; - pod2usage({ -message => "RT Session cleanup tool\n", verbose => 1 }); - exit 1; -} - - -if( $opt{'older'} ) { - unless( $opt{'older'} =~ /^\s*([0-9]+)\s*(H|D|M|Y)?$/i ) { - print STDERR "wrong format of the 'older' argumnet\n"; - exit(1); - } - my ($num,$unit) = ($1, uc($2 ||'D')); - my %factor = ( H => 60*60 ); - $factor{'D'} = $factor{'H'}*24; - $factor{'M'} = $factor{'D'}*31; - $factor{'Y'} = $factor{'D'}*365; - $opt{'older'} = $num * $factor{ $unit }; -} - -require RT; -RT::LoadConfig(); - -if( $opt{'debug'} ) { - RT->Config->Set( LogToScreen => 'debug' ); -} else { - RT->Config->Set( LogToScreen => undef ); -} - -RT::ConnectToDatabase(); -RT::InitLogging(); - -require RT::Interface::Web::Session; - -if( $opt{'older'} or my $alogoff = int RT->Config->Get('AutoLogoff') ) { - my $min; - foreach ($alogoff*60, $opt{'older'}) { - next unless $_; - $min = $_ unless $min; - $min = $_ if $_ < $min; - } - - RT::Interface::Web::Session->ClearOld( $min ); -} - -RT::Interface::Web::Session->ClearByUser - unless $opt{'skip-user'}; - -exit(0); - -__END__ - -=head1 NAME - -rt-clean-sessions - clean old and duplicate RT sessions - -=head1 SYNOPSIS - - rt-clean-sessions [--debug] [--older <NUM>[H|D|M|Y]] - - rt-clean-sessions - rt-clean-sessions --debug - rt-clean-sessions --older 10D - rt-clean-sessions --debug --older 1M - rt-clean-sessions --older 10D --skip-user - -=head1 DESCRIPTION - -Script cleans RT sessions from DB or dir with sessions data. -Leaves in DB only one session per RT user and sessions that aren't older -than specified(see options). - -Script is safe because data in the sessions is temporary and can be deleted. - -=head1 OPTIONS - -=over 4 - -=item older - -Date interval in the C<< <NUM>[<unit>] >> format. Default unit is D(ays), -H(our), M(onth) and Y(ear) are also supported. - -For example: C<rt-clean-sessions --older 1M> would delete all sessions that are -older than 1 month. - -=item skip-user - -By default only one session per user left in the DB, so users that have -sessions on multiple computers or in different browsers will be logged out. -Use this option to avoid this. - -=item debug - -Turn on debug output. - -=back - -=head1 NOTES - -Functionality similar to this is implemented in -html/Elements/SetupSessionCookie ; however, that does not guarantee -that a session will be removed from disk and database soon after the -timeout expires. This script, if run from a cron job, will ensure -that the timed out sessions are actually removed from disk; the Mason -component just ensures that the old sessions are not reusable before -the cron job gets to them. - -=cut diff --git a/rt/sbin/rt-clean-sessions.in b/rt/sbin/rt-clean-sessions.in index 4ec6c49ad..24ee86837 100644 --- a/rt/sbin/rt-clean-sessions.in +++ b/rt/sbin/rt-clean-sessions.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -75,14 +75,13 @@ BEGIN { use Getopt::Long; my %opt; -GetOptions( \%opt, "older=s", "debug", "help", "skip-user"); +GetOptions( \%opt, "older=s", "debug", "help|h", "skip-user" ); if ( $opt{help} ) { require Pod::Usage; - import Pod::Usage; - pod2usage({ -message => "RT Session cleanup tool\n", verbose => 1 }); - exit 1; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; } @@ -113,7 +112,8 @@ RT::InitLogging(); require RT::Interface::Web::Session; -if( $opt{'older'} or my $alogoff = int RT->Config->Get('AutoLogoff') ) { +my $alogoff = int RT->Config->Get('AutoLogoff'); +if ( $opt{'older'} or $alogoff ) { my $min; foreach ($alogoff*60, $opt{'older'}) { next unless $_; @@ -137,13 +137,13 @@ rt-clean-sessions - clean old and duplicate RT sessions =head1 SYNOPSIS - rt-clean-sessions [--debug] [--older <NUM>[H|D|M|Y]] + rt-clean-sessions [--debug] [--older <NUM>[H|D|M|Y]] - rt-clean-sessions - rt-clean-sessions --debug - rt-clean-sessions --older 10D - rt-clean-sessions --debug --older 1M - rt-clean-sessions --older 10D --skip-user + rt-clean-sessions + rt-clean-sessions --debug + rt-clean-sessions --older 10D + rt-clean-sessions --debug --older 1M + rt-clean-sessions --older 10D --skip-user =head1 DESCRIPTION diff --git a/rt/sbin/rt-dump-database b/rt/sbin/rt-dump-database deleted file mode 100755 index f460e8648..000000000 --- a/rt/sbin/rt-dump-database +++ /dev/null @@ -1,199 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; - -# As we specify that XML is UTF-8 and we output it to STDOUT, we must be sure -# it is UTF-8 so further XMLin will not break -binmode(STDOUT, ":utf8"); - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use RT; -use XML::Simple; - -RT::LoadConfig(); -RT::Init(); - -my $LocalOnly = @ARGV ? shift(@ARGV) : 1; - -my %RV; -my %Ignore = ( - All => [qw( - id Created Creator LastUpdated LastUpdatedBy - )], - Templates => [qw( - TranslationOf - )], -); - -my $SystemUserId = $RT::SystemUser->Id; -my @classes = qw( - Users Groups Queues ScripActions ScripConditions - Templates Scrips ACL CustomFields -); -foreach my $class (@classes) { - require "RT/$class.pm"; - my $objects = "RT::$class"->new($RT::SystemUser); - $objects->{find_disabled_rows} = 1; - $objects->UnLimit; - - if ($class eq 'CustomFields') { - $objects->OrderByCols( - { FIELD => 'LookupType' }, - { FIELD => 'SortOrder' }, - { FIELD => 'Id' }, - ); - } - else { - $objects->OrderBy( FIELD => 'Id' ); - } - - if ($LocalOnly) { - next if $class eq 'ACL'; # XXX - would go into infinite loop - XXX - $objects->Limit( FIELD => 'LastUpdatedBy', OPERATOR => '!=', VALUE => $SystemUserId ) - unless $class eq 'Groups'; - $objects->Limit( FIELD => 'Id', OPERATOR => '!=', VALUE => $SystemUserId ) - if $class eq 'Users'; - $objects->Limit( FIELD => 'Domain', OPERATOR => '=', VALUE => 'UserDefined' ) - if $class eq 'Groups'; - } - - my %fields; - while (my $obj = $objects->Next) { - next if $obj->can('LastUpdatedBy') and $obj->LastUpdatedBy == $SystemUserId; - - if (!%fields) { - %fields = map { $_ => 1 } keys %{$obj->_ClassAccessible}; - delete @fields{ - @{$Ignore{$class}||=[]}, - @{$Ignore{All}||=[]}, - }; - } - - my $rv; - # next if $obj-> # skip default names - foreach my $field (sort keys %fields) { - my $value = $obj->__Value($field); - $rv->{$field} = $value if ( defined ($value) && length($value) ); - } - delete $rv->{Disabled} unless $rv->{Disabled}; - - foreach my $record (map { /ACL/ ? 'ACE' : substr($_, 0, -1) } @classes) { - foreach my $key (map "$record$_", ('', 'Id')) { - next unless exists $rv->{$key}; - my $id = $rv->{$key} or next; - my $obj = "RT::$record"->new($RT::SystemUser); - $obj->LoadByCols( Id => $id ) or next; - $rv->{$key} = $obj->__Value('Name') || 0; - } - } - - if ($class eq 'Users' and defined $obj->Privileged) { - $rv->{Privileged} = int($obj->Privileged); - } - elsif ($class eq 'CustomFields') { - my $values = $obj->Values; - while (my $value = $values->Next) { - push @{$rv->{Values}}, { - map { ($_ => $value->__Value($_)) } qw( - Name Description SortOrder - ), - }; - } - } - - if (eval { require RT::Attributes; 1 }) { - my $attributes = $obj->Attributes; - while (my $attribute = $attributes->Next) { - my $content = $attribute->Content; - $rv->{Attributes}{$attribute->Name} = $content if length($content); - } - } - - push @{$RV{$class}}, $rv; - } -} - -print(<< "."); -no strict; use XML::Simple; *_ = XMLin(do { local \$/; readline(DATA) }, ForceArray => [qw( - @classes Values -)], NoAttr => 1, SuppressEmpty => ''); *\$_ = (\$_{\$_} || []) for keys \%_; 1; # vim: ft=xml -__DATA__ -. - -print XMLout( - { map { ($_ => ($RV{$_} || [])) } @classes }, - RootName => 'InitialData', - NoAttr => 1, - SuppressEmpty => '', - XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>', -); diff --git a/rt/sbin/rt-dump-database.in b/rt/sbin/rt-dump-database.in deleted file mode 100755 index b913f2ed1..000000000 --- a/rt/sbin/rt-dump-database.in +++ /dev/null @@ -1,199 +0,0 @@ -#!@PERL@ -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; - -# As we specify that XML is UTF-8 and we output it to STDOUT, we must be sure -# it is UTF-8 so further XMLin will not break -binmode(STDOUT, ":utf8"); - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("@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; -use XML::Simple; - -RT::LoadConfig(); -RT::Init(); - -my $LocalOnly = @ARGV ? shift(@ARGV) : 1; - -my %RV; -my %Ignore = ( - All => [qw( - id Created Creator LastUpdated LastUpdatedBy - )], - Templates => [qw( - TranslationOf - )], -); - -my $SystemUserId = $RT::SystemUser->Id; -my @classes = qw( - Users Groups Queues ScripActions ScripConditions - Templates Scrips ACL CustomFields -); -foreach my $class (@classes) { - require "RT/$class.pm"; - my $objects = "RT::$class"->new($RT::SystemUser); - $objects->{find_disabled_rows} = 1; - $objects->UnLimit; - - if ($class eq 'CustomFields') { - $objects->OrderByCols( - { FIELD => 'LookupType' }, - { FIELD => 'SortOrder' }, - { FIELD => 'Id' }, - ); - } - else { - $objects->OrderBy( FIELD => 'Id' ); - } - - if ($LocalOnly) { - next if $class eq 'ACL'; # XXX - would go into infinite loop - XXX - $objects->Limit( FIELD => 'LastUpdatedBy', OPERATOR => '!=', VALUE => $SystemUserId ) - unless $class eq 'Groups'; - $objects->Limit( FIELD => 'Id', OPERATOR => '!=', VALUE => $SystemUserId ) - if $class eq 'Users'; - $objects->Limit( FIELD => 'Domain', OPERATOR => '=', VALUE => 'UserDefined' ) - if $class eq 'Groups'; - } - - my %fields; - while (my $obj = $objects->Next) { - next if $obj->can('LastUpdatedBy') and $obj->LastUpdatedBy == $SystemUserId; - - if (!%fields) { - %fields = map { $_ => 1 } keys %{$obj->_ClassAccessible}; - delete @fields{ - @{$Ignore{$class}||=[]}, - @{$Ignore{All}||=[]}, - }; - } - - my $rv; - # next if $obj-> # skip default names - foreach my $field (sort keys %fields) { - my $value = $obj->__Value($field); - $rv->{$field} = $value if ( defined ($value) && length($value) ); - } - delete $rv->{Disabled} unless $rv->{Disabled}; - - foreach my $record (map { /ACL/ ? 'ACE' : substr($_, 0, -1) } @classes) { - foreach my $key (map "$record$_", ('', 'Id')) { - next unless exists $rv->{$key}; - my $id = $rv->{$key} or next; - my $obj = "RT::$record"->new($RT::SystemUser); - $obj->LoadByCols( Id => $id ) or next; - $rv->{$key} = $obj->__Value('Name') || 0; - } - } - - if ($class eq 'Users' and defined $obj->Privileged) { - $rv->{Privileged} = int($obj->Privileged); - } - elsif ($class eq 'CustomFields') { - my $values = $obj->Values; - while (my $value = $values->Next) { - push @{$rv->{Values}}, { - map { ($_ => $value->__Value($_)) } qw( - Name Description SortOrder - ), - }; - } - } - - if (eval { require RT::Attributes; 1 }) { - my $attributes = $obj->Attributes; - while (my $attribute = $attributes->Next) { - my $content = $attribute->Content; - $rv->{Attributes}{$attribute->Name} = $content if length($content); - } - } - - push @{$RV{$class}}, $rv; - } -} - -print(<< "."); -no strict; use XML::Simple; *_ = XMLin(do { local \$/; readline(DATA) }, ForceArray => [qw( - @classes Values -)], NoAttr => 1, SuppressEmpty => ''); *\$_ = (\$_{\$_} || []) for keys \%_; 1; # vim: ft=xml -__DATA__ -. - -print XMLout( - { map { ($_ => ($RV{$_} || [])) } @classes }, - RootName => 'InitialData', - NoAttr => 1, - SuppressEmpty => '', - XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>', -); diff --git a/rt/sbin/rt-dump-metadata.in b/rt/sbin/rt-dump-metadata.in new file mode 100644 index 000000000..f58371f5d --- /dev/null +++ b/rt/sbin/rt-dump-metadata.in @@ -0,0 +1,251 @@ +#!@PERL@ -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; + +# As we specify that XML is UTF-8 and we output it to STDOUT, we must be sure +# it is UTF-8 so further XMLin will not break +binmode( STDOUT, ":utf8" ); + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ( "@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 Getopt::Long; +my %opt; +GetOptions( \%opt, "help|h" ); + +if ( $opt{help} ) { + require Pod::Usage; + Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +require RT; +require XML::Simple; + +RT::LoadConfig(); +RT::Init(); + +my $LocalOnly = @ARGV ? shift(@ARGV) : 1; + +my %RV; +my %Ignore = ( + All => [ + qw( + id Created Creator LastUpdated LastUpdatedBy + ) + ], + Templates => [ + qw( + TranslationOf + ) + ], +); + +my $SystemUserId = RT->SystemUser->Id; +my @classes = qw( + Users Groups Queues ScripActions ScripConditions + Templates Scrips ACL CustomFields + ); +foreach my $class (@classes) { + require "RT/$class.pm"; + my $objects = "RT::$class"->new( RT->SystemUser ); + $objects->{find_disabled_rows} = 1; + $objects->UnLimit; + + if ( $class eq 'CustomFields' ) { + $objects->OrderByCols( + { FIELD => 'LookupType' }, + { FIELD => 'SortOrder' }, + { FIELD => 'Id' }, + ); + } else { + $objects->OrderBy( FIELD => 'Id' ); + } + + if ($LocalOnly) { + next if $class eq 'ACL'; # XXX - would go into infinite loop - XXX + $objects->Limit( + FIELD => 'LastUpdatedBy', + OPERATOR => '!=', + VALUE => $SystemUserId + ) unless $class eq 'Groups'; + $objects->Limit( + FIELD => 'Id', + OPERATOR => '!=', + VALUE => $SystemUserId + ) if $class eq 'Users'; + $objects->Limit( + FIELD => 'Domain', + OPERATOR => '=', + VALUE => 'UserDefined' + ) if $class eq 'Groups'; + } + + my %fields; + while ( my $obj = $objects->Next ) { + next + if $obj->can('LastUpdatedBy') + and $obj->LastUpdatedBy == $SystemUserId; + + if ( !%fields ) { + %fields = map { $_ => 1 } keys %{ $obj->_ClassAccessible }; + delete @fields{ @{ $Ignore{$class} ||= [] }, + @{ $Ignore{All} ||= [] }, }; + } + + my $rv; + + # next if $obj-> # skip default names + foreach my $field ( sort keys %fields ) { + my $value = $obj->__Value($field); + $rv->{$field} = $value if ( defined($value) && length($value) ); + } + delete $rv->{Disabled} unless $rv->{Disabled}; + + foreach my $record ( map { /ACL/ ? 'ACE' : substr( $_, 0, -1 ) } + @classes ) + { + foreach my $key ( map "$record$_", ( '', 'Id' ) ) { + next unless exists $rv->{$key}; + my $id = $rv->{$key} or next; + my $obj = "RT::$record"->new( RT->SystemUser ); + $obj->LoadByCols( Id => $id ) or next; + $rv->{$key} = $obj->__Value('Name') || 0; + } + } + + if ( $class eq 'Users' and defined $obj->Privileged ) { + $rv->{Privileged} = int( $obj->Privileged ); + } elsif ( $class eq 'CustomFields' ) { + my $values = $obj->Values; + while ( my $value = $values->Next ) { + push @{ $rv->{Values} }, { + map { ( $_ => $value->__Value($_) ) } + qw( + Name Description SortOrder + ), + }; + } + } + + if ( eval { require RT::Attributes; 1 } ) { + my $attributes = $obj->Attributes; + while ( my $attribute = $attributes->Next ) { + my $content = $attribute->Content; + $rv->{Attributes}{ $attribute->Name } = $content + if length($content); + } + } + + push @{ $RV{$class} }, $rv; + } +} + +print(<< "."); +no strict; use XML::Simple; *_ = XMLin(do { local \$/; readline(DATA) }, ForceArray => [qw( + @classes Values +)], NoAttr => 1, SuppressEmpty => ''); *\$_ = (\$_{\$_} || []) for keys \%_; 1; # vim: ft=xml +__DATA__ +. + +print XML::Simple::XMLout( + { map { ( $_ => ( $RV{$_} || [] ) ) } @classes }, + RootName => 'InitialData', + NoAttr => 1, + SuppressEmpty => '', + XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>', +); + +__END__ + +=head1 NAME + +rt-dump-metadata - dump configuration metadata from an RT database + +=head1 SYNOPSIS + + rt-dump-metdata [ 0 ] + +=head1 DESCRIPTION + +C<rt-dump-metadata> is a tool that dumps configuration metadata from the +Request Tracker database into XML format, suitable for feeding into +C<rt-setup-database>. To dump and load a full RT database, you should generally +use the native database tools instead, as well as performing any necessary +steps from UPGRADING. + +When run without arguments, the metadata dump will only include 'local' +configuration changes, i.e. those done manually in the web interface. + +When run with the argument '0', the dump will include all configuration +metadata. + +This is NOT a tool for backing up an RT database. + diff --git a/rt/sbin/rt-email-dashboards b/rt/sbin/rt-email-dashboards deleted file mode 100755 index b64ccd843..000000000 --- a/rt/sbin/rt-email-dashboards +++ /dev/null @@ -1,568 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -use warnings; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use RT; -use RT::Interface::CLI qw{ CleanEnv loc }; - -use Getopt::Long; -use HTML::Mason; -use HTML::RewriteAttributes::Resources; -use HTML::RewriteAttributes::Links; -use MIME::Types; -use POSIX 'tzset'; -use File::Temp 'tempdir'; - -# Clean out all the nasties from the environment -CleanEnv(); - -# Load the config file -RT::LoadConfig(); - -# Connect to the database and get RT::SystemUser and RT::Nobody loaded -RT::Init(); - -require RT::Interface::Web; -require RT::Interface::Web::Handler; -require RT::Dashboard; -$HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new; - -no warnings 'once'; - -# Read in the options -my %opts; -GetOptions( \%opts, - "help", "dryrun", "verbose", "debug", "epoch=i", "all", "skip-acl" -); - -if ($opts{'help'}) { - require Pod::Usage; - import Pod::Usage; - pod2usage(-message => "RT Email Dashboards\n", -verbose => 1); - exit 1; -} - -# helper functions -sub verbose { print loc(@_), "\n" if $opts{debug} || $opts{verbose}; 1 } -sub debug { print loc(@_), "\n" if $opts{debug}; 1 } -sub error { $RT::Logger->error(loc(@_)); verbose(@_); 1 } -sub warning { $RT::Logger->warning(loc(@_)); verbose(@_); 1 } - -my $now = $opts{epoch} || time; -verbose "Using time [_1]", scalar localtime($now); - -my $from = get_from(); -debug "Sending email from [_1]", $from; - -# look through each user for her subscriptions -my $Users = RT::Users->new($RT::SystemUser); -$Users->LimitToPrivileged; - -while (defined(my $user = $Users->Next)) { - if ($user->PrincipalObj->Disabled) { - debug "Skipping over " - . $user->Name - . " due to having a disabled account."; - next; - } - - my ($hour, $dow, $dom) = hour_dow_dom_in($user->Timezone || RT->Config->Get('Timezone')); - $hour .= ':00'; - debug "Checking [_1]'s subscriptions: hour [_2], dow [_3], dom [_4]", - $user->Name, $hour, $dow, $dom; - - my $currentuser = RT::CurrentUser->new; - $currentuser->LoadByName($user->Name); - - # look through this user's subscriptions, are any supposed to be generated - # right now? - for my $subscription ($user->Attributes->Named('Subscription')) { - my $counter = $subscription->SubValue('Counter') || 0; - - if (!$opts{all}) { - debug "Checking against subscription with frequency [_1], hour [_2], dow [_3], dom [_4]", - $subscription->SubValue('Frequency'), $subscription->SubValue('Hour'), - $subscription->SubValue('Dow'), $subscription->SubValue('Dom'); - - next if $subscription->SubValue('Frequency') eq 'never'; - - # correct hour? - next if $subscription->SubValue('Hour') ne $hour; - - # if weekly, correct day of week? - if ( $subscription->SubValue('Frequency') eq 'weekly' ) { - next if $subscription->SubValue('Dow') ne $dow; - my $fow = $subscription->SubValue('Fow') || 1; - if ( $counter % $fow ) { - $subscription->SetSubValues( Counter => $counter + 1 ) - unless $opts{'dryrun'}; - next; - } - } - - # if monthly, correct day of month? - elsif ($subscription->SubValue('Frequency') eq 'monthly') { - next if $subscription->SubValue('Dom') != $dom; - } - - elsif ($subscription->SubValue('Frequency') eq 'm-f') { - next if $dow eq 'Sunday' || $dow eq 'Saturday'; - } - } - - my $email = $subscription->SubValue('Recipient') - || $user->EmailAddress; - - eval { send_dashboard($currentuser, $email, $subscription) }; - if ( $@ ) { - error 'Caught exception: ' . $@; - } - else { - $subscription->SetSubValues( - Counter => $counter + 1 ) - unless $opts{'dryrun'}; - } - } -} - -sub send_dashboard { - my ($currentuser, $email, $subscription) = @_; - - my $rows = $subscription->SubValue('Rows'); - - my $dashboard = RT::Dashboard->new($currentuser); - - my ($ok, $msg) = $dashboard->LoadById($subscription->SubValue('DashboardId')); - - # failed to load dashboard. perhaps it was deleted or it changed privacy - if (!$ok) { - warning "Unable to load dashboard [_1] of subscription [_2] for user [_3]: [_4]", - $subscription->SubValue('DashboardId'), - $subscription->Id, - $currentuser->Name, - $msg; - - my $ok = RT::Interface::Email::SendEmailUsingTemplate( - From => $from, - To => $email, - Template => 'Error: Missing dashboard', - Arguments => { - SubscriptionObj => $subscription, - }, - ); - - # only delete the subscription if the email looks like it went through - if ($ok) { - my ($deleted, $msg) = $subscription->Delete(); - if ($deleted) { - verbose("Deleted an obsolete subscription: [_1]", $msg); - } - else { - warning("Unable to delete an obsolete subscription: [_1]", $msg); - } - } - else { - warning("Unable to notify [_1] of an obsolete subscription", $currentuser->Name); - } - - return; - } - - verbose 'Creating dashboard "[_1]" for user "[_2]":', - $dashboard->Name, - $currentuser->Name; - - if ($opts{'dryrun'}) { - print << "SUMMARY"; - Dashboard: @{[ $dashboard->Name ]} - User: @{[ $currentuser->Name ]} <$email> -SUMMARY - return; - } - - $HTML::Mason::Commands::session{CurrentUser} = $currentuser; - my $contents = run_component( - '/Dashboards/Render.html', - id => $dashboard->Id, - Preview => 0, - ); - - for (@{ RT->Config->Get('EmailDashboardRemove') || [] }) { - $contents =~ s/$_//g; - } - - debug "Got [_1] characters of output.", length $contents; - - $contents = HTML::RewriteAttributes::Links->rewrite( - $contents, - RT->Config->Get('WebURL') . '/Dashboards/Render.html', - ); - - email_dashboard($currentuser, $email, $dashboard, $subscription, $contents); -} - -sub email_dashboard { - my ($currentuser, $email, $dashboard, $subscription, $content) = @_; - - verbose 'Sending dashboard "[_1]" to user [_2] <[_3]>', - $dashboard->Name, - $currentuser->Name, - $email; - - my $subject = sprintf '[%s] ' . RT->Config->Get('DashboardSubject'), - RT->Config->Get('rtname'), - ucfirst($subscription->SubValue('Frequency')), - $dashboard->Name; - - my $entity = build_email($content, $from, $email, $subject); - - my $ok = RT::Interface::Email::SendEmail( - Entity => $entity, - ); - - debug "Done sending dashboard to [_1] <[_2]>", - $currentuser->Name, $email - and return if $ok; - - error 'Failed to email dashboard to user [_1] <[_2]>', - $currentuser->Name, $email; -} - -sub build_email { - my ($content, $from, $to, $subject) = @_; - my @parts; - my %cid_of; - - $content = HTML::RewriteAttributes::Resources->rewrite($content, sub { - my $uri = shift; - - # already attached this object - return "cid:$cid_of{$uri}" if $cid_of{$uri}; - - $cid_of{$uri} = time() . $$ . int(rand(1e6)); - my ($data, $filename, $mimetype, $encoding) = get_resource($uri); - - # downgrade non-text strings, because all strings are utf8 by - # default, which is wrong for non-text strings. - if ( $mimetype !~ m{text/} ) { - utf8::downgrade( $data, 1 ) or warning "downgrade $data failed"; - } - - push @parts, MIME::Entity->build( - Top => 0, - Data => $data, - Type => $mimetype, - Encoding => $encoding, - Disposition => 'inline', - Name => $filename, - 'Content-Id' => $cid_of{$uri}, - ); - - return "cid:$cid_of{$uri}"; - }, - inline_css => sub { - my $uri = shift; - my ($content) = get_resource($uri); - return $content; - }, - inline_imports => 1, - ); - - my $entity = MIME::Entity->build( - From => $from, - To => $to, - Subject => $subject, - Type => "multipart/mixed", - ); - - $entity->attach( - Data => Encode::encode_utf8($content), - Type => 'text/html', - Charset => 'UTF-8', - Disposition => 'inline', - ); - - for my $part (@parts) { - $entity->add_part($part); - } - - return $entity; -} - -sub get_from { - RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail') -} - -{ - my $mason; - my $outbuf = ''; - my $data_dir = ''; - - sub mason { - unless ($mason) { - debug "Creating Mason object."; - - # user may not have permissions on the data directory, so create a - # new one - $data_dir = tempdir(CLEANUP => 1); - - $mason = HTML::Mason::Interp->new( - RT::Interface::Web::Handler->DefaultHandlerArgs, - out_method => \$outbuf, - autohandler_name => '', # disable forced login and more - data_dir => $data_dir, - ); - } - return $mason; - } - - sub run_component { - mason->exec(@_); - my $ret = $outbuf; - $outbuf = ''; - return $ret; - } -} - -{ - my %cache; - - sub hour_dow_dom_in { - my $tz = shift; - return @{$cache{$tz}} if exists $cache{$tz}; - - my ($hour, $dow, $dom); - - { - local $ENV{'TZ'} = $tz; - ## Using POSIX::tzset fixes a bug where the TZ environment variable - ## is cached. - tzset(); - (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now); - } - tzset(); # return back previous value - - $hour = "0$hour" - if length($hour) == 1; - $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow]; - - return @{$cache{$tz}} = ($hour, $dow, $dom); - } -} - -sub get_resource { - my $uri = URI->new(shift); - my ($content, $filename, $mimetype, $encoding); - - verbose "Getting resource [_1]", $uri; - - # strip out the equivalent of WebURL, so we start at the correct / - my $path = $uri->path; - my $webpath = RT->Config->Get('WebPath'); - $path =~ s/^\Q$webpath//; - - # add a leading / if needed - $path = "/$path" - unless $path =~ m{^/}; - - # grab the query arguments - my %args; - for (split /&/, ($uri->query||'')) { - my ($k, $v) = /^(.*?)=(.*)$/ - or die "Unable to parse query parameter '$_'"; - - for ($k, $v) { s/%(..)/chr hex $1/ge } - - # no value yet, simple key=value - if (!exists $args{$k}) { - $args{$k} = $v; - } - # already have key=value, need to upgrade it to key=[value1, value2] - elsif (!ref($args{$k})) { - $args{$k} = [$args{$k}, $v]; - } - # already key=[value1, value2], just add the new value - else { - push @{ $args{$k} }, $v; - } - } - - debug "Running component '[_1]'", $path; - $content = run_component($path, %args); - - # guess at the filename from the component name - $filename = $1 if $path =~ m{^.*/(.*?)$}; - - # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP - ($mimetype, $encoding) = MIME::Types::by_suffix($filename); - - my $content_type = $HTML::Mason::Commands::r->content_type; - if ($content_type) { - $mimetype = $content_type; - - # strip down to just a MIME type - $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/; - } - - #If all else fails then some conservative and general-purpose defaults are: - $mimetype ||= 'application/octet-stream'; - $encoding ||= 'base64'; - - debug "Resource [_1]: length=[_2] filename='[_3]' mimetype='[_4]', encoding='[_5]'", - $uri, - length($content), - $filename, - $mimetype, - $encoding; - - return ($content, $filename, $mimetype, $encoding); -} - -package RT::Dashboard::FakeRequest; -sub new { bless {}, shift } -sub header_out { shift } -sub headers_out { shift } -sub content_type { - my $self = shift; - $self->{content_type} = shift if @_; - return $self->{content_type}; -} - -=head1 NAME - -rt-email-dashboards - Send email dashboards - -=head1 SYNOPSIS - - /opt/rt3/local/sbin/rt-email-dashboards [options] - -=head1 DESCRIPTION - -This tool will send users email based on how they have subscribed to -dashboards. A dashboard is a set of saved searches, the subscription controls -how often that dashboard is sent and how it's displayed. - -Each subscription has an hour, and possibly day of week or day of month. These -are taken to be in the user's timezone if available, UTC otherwise. - -=head1 SETUP - -You'll need to have cron run this script every hour. Here's an example crontab -entry to do this. - - 0 * * * * /usr/bin/perl /opt/rt3/local/sbin/rt-email-dashboards - -This will run the script every hour on the hour. This may need some further -tweaking to be run as the correct user. - -=head1 OPTIONS - -This tool supports a few options. Most are for debugging. - -=over 8 - -=item --help - -Display this documentation - -=item --dryrun - -Figure out which dashboards would be sent, but don't actually generate them - -=item --epoch SECONDS - -Instead of using the current time to figure out which dashboards should be -sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would -be Oct 12 19:06:58 GMT 2007). - -=item --verbose - -Print out some tracing information (such as which dashboards are being -generated and sent out) - -=item --debug - -Print out more tracing information (such as each user and subscription that is -being considered) - -=item --all - -Ignore subscription frequency when considering each dashboard (should only be -used with --dryrun) - -=back - -=cut - diff --git a/rt/sbin/rt-email-dashboards.in b/rt/sbin/rt-email-dashboards.in index 50dad2f9b..aa5ce649f 100644 --- a/rt/sbin/rt-email-dashboards.in +++ b/rt/sbin/rt-email-dashboards.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -74,431 +74,39 @@ BEGIN { } -use RT; -use RT::Interface::CLI qw{ CleanEnv loc }; - -use Getopt::Long; -use HTML::Mason; -use HTML::RewriteAttributes::Resources; -use HTML::RewriteAttributes::Links; -use MIME::Types; -use POSIX 'tzset'; -use File::Temp 'tempdir'; - -# Clean out all the nasties from the environment -CleanEnv(); - -# Load the config file -RT::LoadConfig(); - -# Connect to the database and get RT::SystemUser and RT::Nobody loaded -RT::Init(); - -require RT::Interface::Web; -require RT::Interface::Web::Handler; -require RT::Dashboard; -$HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new; - -no warnings 'once'; - # Read in the options my %opts; +use Getopt::Long; GetOptions( \%opts, - "help", "dryrun", "verbose", "debug", "epoch=i", "all", "skip-acl" + "help|h", "dryrun", "time=i", "epoch=i", "all" ); if ($opts{'help'}) { require Pod::Usage; - import Pod::Usage; - pod2usage(-message => "RT Email Dashboards\n", -verbose => 1); - exit 1; + print Pod::Usage::pod2usage(-verbose => 2); + exit; } -# helper functions -sub verbose { print loc(@_), "\n" if $opts{debug} || $opts{verbose}; 1 } -sub debug { print loc(@_), "\n" if $opts{debug}; 1 } -sub error { $RT::Logger->error(loc(@_)); verbose(@_); 1 } -sub warning { $RT::Logger->warning(loc(@_)); verbose(@_); 1 } - -my $now = $opts{epoch} || time; -verbose "Using time [_1]", scalar localtime($now); - -my $from = get_from(); -debug "Sending email from [_1]", $from; - -# look through each user for her subscriptions -my $Users = RT::Users->new($RT::SystemUser); -$Users->LimitToPrivileged; - -while (defined(my $user = $Users->Next)) { - if ($user->PrincipalObj->Disabled) { - debug "Skipping over " - . $user->Name - . " due to having a disabled account."; - next; - } - - my ($hour, $dow, $dom) = hour_dow_dom_in($user->Timezone || RT->Config->Get('Timezone')); - $hour .= ':00'; - debug "Checking [_1]'s subscriptions: hour [_2], dow [_3], dom [_4]", - $user->Name, $hour, $dow, $dom; - - my $currentuser = RT::CurrentUser->new; - $currentuser->LoadByName($user->Name); - - # look through this user's subscriptions, are any supposed to be generated - # right now? - for my $subscription ($user->Attributes->Named('Subscription')) { - my $counter = $subscription->SubValue('Counter') || 0; - - if (!$opts{all}) { - debug "Checking against subscription with frequency [_1], hour [_2], dow [_3], dom [_4]", - $subscription->SubValue('Frequency'), $subscription->SubValue('Hour'), - $subscription->SubValue('Dow'), $subscription->SubValue('Dom'); - - next if $subscription->SubValue('Frequency') eq 'never'; - - # correct hour? - next if $subscription->SubValue('Hour') ne $hour; - - # if weekly, correct day of week? - if ( $subscription->SubValue('Frequency') eq 'weekly' ) { - next if $subscription->SubValue('Dow') ne $dow; - my $fow = $subscription->SubValue('Fow') || 1; - if ( $counter % $fow ) { - $subscription->SetSubValues( Counter => $counter + 1 ) - unless $opts{'dryrun'}; - next; - } - } - - # if monthly, correct day of month? - elsif ($subscription->SubValue('Frequency') eq 'monthly') { - next if $subscription->SubValue('Dom') != $dom; - } - - elsif ($subscription->SubValue('Frequency') eq 'm-f') { - next if $dow eq 'Sunday' || $dow eq 'Saturday'; - } - } - - my $email = $subscription->SubValue('Recipient') - || $user->EmailAddress; - - eval { send_dashboard($currentuser, $email, $subscription) }; - if ( $@ ) { - error 'Caught exception: ' . $@; - } - else { - $subscription->SetSubValues( - Counter => $counter + 1 ) - unless $opts{'dryrun'}; - } - } -} - -sub send_dashboard { - my ($currentuser, $email, $subscription) = @_; - - my $rows = $subscription->SubValue('Rows'); - - my $dashboard = RT::Dashboard->new($currentuser); - - my ($ok, $msg) = $dashboard->LoadById($subscription->SubValue('DashboardId')); - - # failed to load dashboard. perhaps it was deleted or it changed privacy - if (!$ok) { - warning "Unable to load dashboard [_1] of subscription [_2] for user [_3]: [_4]", - $subscription->SubValue('DashboardId'), - $subscription->Id, - $currentuser->Name, - $msg; - - my $ok = RT::Interface::Email::SendEmailUsingTemplate( - From => $from, - To => $email, - Template => 'Error: Missing dashboard', - Arguments => { - SubscriptionObj => $subscription, - }, - ); - - # only delete the subscription if the email looks like it went through - if ($ok) { - my ($deleted, $msg) = $subscription->Delete(); - if ($deleted) { - verbose("Deleted an obsolete subscription: [_1]", $msg); - } - else { - warning("Unable to delete an obsolete subscription: [_1]", $msg); - } - } - else { - warning("Unable to notify [_1] of an obsolete subscription", $currentuser->Name); - } - - return; - } - - verbose 'Creating dashboard "[_1]" for user "[_2]":', - $dashboard->Name, - $currentuser->Name; - - if ($opts{'dryrun'}) { - print << "SUMMARY"; - Dashboard: @{[ $dashboard->Name ]} - User: @{[ $currentuser->Name ]} <$email> -SUMMARY - return; - } - - $HTML::Mason::Commands::session{CurrentUser} = $currentuser; - my $contents = run_component( - '/Dashboards/Render.html', - id => $dashboard->Id, - Preview => 0, - ); - - for (@{ RT->Config->Get('EmailDashboardRemove') || [] }) { - $contents =~ s/$_//g; - } - - debug "Got [_1] characters of output.", length $contents; - - $contents = HTML::RewriteAttributes::Links->rewrite( - $contents, - RT->Config->Get('WebURL') . '/Dashboards/Render.html', - ); - - email_dashboard($currentuser, $email, $dashboard, $subscription, $contents); -} - -sub email_dashboard { - my ($currentuser, $email, $dashboard, $subscription, $content) = @_; - - verbose 'Sending dashboard "[_1]" to user [_2] <[_3]>', - $dashboard->Name, - $currentuser->Name, - $email; - - my $subject = sprintf '[%s] ' . RT->Config->Get('DashboardSubject'), - RT->Config->Get('rtname'), - ucfirst($subscription->SubValue('Frequency')), - $dashboard->Name; - - my $entity = build_email($content, $from, $email, $subject); - - my $ok = RT::Interface::Email::SendEmail( - Entity => $entity, - ); - - debug "Done sending dashboard to [_1] <[_2]>", - $currentuser->Name, $email - and return if $ok; - - error 'Failed to email dashboard to user [_1] <[_2]>', - $currentuser->Name, $email; -} +require RT; +require RT::Interface::CLI; +RT::Interface::CLI->import(qw{ CleanEnv loc }); -sub build_email { - my ($content, $from, $to, $subject) = @_; - my @parts; - my %cid_of; - - $content = HTML::RewriteAttributes::Resources->rewrite($content, sub { - my $uri = shift; - - # already attached this object - return "cid:$cid_of{$uri}" if $cid_of{$uri}; - - $cid_of{$uri} = time() . $$ . int(rand(1e6)); - my ($data, $filename, $mimetype, $encoding) = get_resource($uri); - - # downgrade non-text strings, because all strings are utf8 by - # default, which is wrong for non-text strings. - if ( $mimetype !~ m{text/} ) { - utf8::downgrade( $data, 1 ) or warning "downgrade $data failed"; - } - - push @parts, MIME::Entity->build( - Top => 0, - Data => $data, - Type => $mimetype, - Encoding => $encoding, - Disposition => 'inline', - Name => $filename, - 'Content-Id' => $cid_of{$uri}, - ); - - return "cid:$cid_of{$uri}"; - }, - inline_css => sub { - my $uri = shift; - my ($content) = get_resource($uri); - return $content; - }, - inline_imports => 1, - ); - - my $entity = MIME::Entity->build( - From => $from, - To => $to, - Subject => $subject, - Type => "multipart/mixed", - ); - - $entity->attach( - Data => Encode::encode_utf8($content), - Type => 'text/html', - Charset => 'UTF-8', - Disposition => 'inline', - ); - - for my $part (@parts) { - $entity->add_part($part); - } - - return $entity; -} - -sub get_from { - RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail') -} - -{ - my $mason; - my $outbuf = ''; - my $data_dir = ''; - - sub mason { - unless ($mason) { - debug "Creating Mason object."; - - # user may not have permissions on the data directory, so create a - # new one - $data_dir = tempdir(CLEANUP => 1); - - $mason = HTML::Mason::Interp->new( - RT::Interface::Web::Handler->DefaultHandlerArgs, - out_method => \$outbuf, - autohandler_name => '', # disable forced login and more - data_dir => $data_dir, - ); - } - return $mason; - } - - sub run_component { - mason->exec(@_); - my $ret = $outbuf; - $outbuf = ''; - return $ret; - } -} - -{ - my %cache; - - sub hour_dow_dom_in { - my $tz = shift; - return @{$cache{$tz}} if exists $cache{$tz}; - - my ($hour, $dow, $dom); - - { - local $ENV{'TZ'} = $tz; - ## Using POSIX::tzset fixes a bug where the TZ environment variable - ## is cached. - tzset(); - (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now); - } - tzset(); # return back previous value - - $hour = "0$hour" - if length($hour) == 1; - $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow]; - - return @{$cache{$tz}} = ($hour, $dow, $dom); - } -} - -sub get_resource { - my $uri = URI->new(shift); - my ($content, $filename, $mimetype, $encoding); - - verbose "Getting resource [_1]", $uri; - - # strip out the equivalent of WebURL, so we start at the correct / - my $path = $uri->path; - my $webpath = RT->Config->Get('WebPath'); - $path =~ s/^\Q$webpath//; - - # add a leading / if needed - $path = "/$path" - unless $path =~ m{^/}; - - # grab the query arguments - my %args; - for (split /&/, ($uri->query||'')) { - my ($k, $v) = /^(.*?)=(.*)$/ - or die "Unable to parse query parameter '$_'"; - - for ($k, $v) { s/%(..)/chr hex $1/ge } - - # no value yet, simple key=value - if (!exists $args{$k}) { - $args{$k} = $v; - } - # already have key=value, need to upgrade it to key=[value1, value2] - elsif (!ref($args{$k})) { - $args{$k} = [$args{$k}, $v]; - } - # already key=[value1, value2], just add the new value - else { - push @{ $args{$k} }, $v; - } - } - - debug "Running component '[_1]'", $path; - $content = run_component($path, %args); - - # guess at the filename from the component name - $filename = $1 if $path =~ m{^.*/(.*?)$}; - - # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP - ($mimetype, $encoding) = MIME::Types::by_suffix($filename); - - my $content_type = $HTML::Mason::Commands::r->content_type; - if ($content_type) { - $mimetype = $content_type; - - # strip down to just a MIME type - $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/; - } - - #If all else fails then some conservative and general-purpose defaults are: - $mimetype ||= 'application/octet-stream'; - $encoding ||= 'base64'; +# Clean out all the nasties from the environment +CleanEnv(); - debug "Resource [_1]: length=[_2] filename='[_3]' mimetype='[_4]', encoding='[_5]'", - $uri, - length($content), - $filename, - $mimetype, - $encoding; +# Load the config file +RT::LoadConfig(); - return ($content, $filename, $mimetype, $encoding); -} +# Connect to the database and get RT::SystemUser and RT::Nobody loaded +RT::Init(); -package RT::Dashboard::FakeRequest; -sub new { bless {}, shift } -sub header_out { shift } -sub headers_out { shift } -sub content_type { - my $self = shift; - $self->{content_type} = shift if @_; - return $self->{content_type}; -} +require RT::Dashboard::Mailer; +RT::Dashboard::Mailer->MailDashboards( + All => $opts{all}, + DryRun => $opts{dryrun}, + Time => ($opts{time} || $opts{epoch} || time), # epoch is the old-style + Opts => \%opts, +); =head1 NAME @@ -506,7 +114,7 @@ rt-email-dashboards - Send email dashboards =head1 SYNOPSIS - /opt/rt3/local/sbin/rt-email-dashboards [options] + rt-email-dashboards [options] =head1 DESCRIPTION @@ -522,7 +130,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/rt3/local/sbin/rt-email-dashboards + 0 * * * * @PERL@ /opt/rt4/local/sbin/rt-email-dashboards This will run the script every hour on the hour. This may need some further tweaking to be run as the correct user. @@ -533,34 +141,31 @@ This tool supports a few options. Most are for debugging. =over 8 +=item -h + =item --help Display this documentation =item --dryrun -Figure out which dashboards would be sent, but don't actually generate them +Figure out which dashboards would be sent, but don't actually generate or email +any of them -=item --epoch SECONDS +=item --time SECONDS Instead of using the current time to figure out which dashboards should be sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would be Oct 12 19:06:58 GMT 2007). -=item --verbose - -Print out some tracing information (such as which dashboards are being -generated and sent out) - -=item --debug +=item --epoch SECONDS -Print out more tracing information (such as each user and subscription that is -being considered) +Back-compat for --time SECONDS. =item --all Ignore subscription frequency when considering each dashboard (should only be -used with --dryrun) +used with --dryrun for testing and debugging) =back diff --git a/rt/sbin/rt-email-digest b/rt/sbin/rt-email-digest deleted file mode 100755 index e26dde890..000000000 --- a/rt/sbin/rt-email-digest +++ /dev/null @@ -1,337 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use warnings; -use strict; - -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use Date::Format qw( strftime ); -use Getopt::Long; -use RT; -use RT::Interface::CLI qw( CleanEnv loc ); -use RT::Interface::Email; - -CleanEnv(); -RT::LoadConfig(); -RT::Init(); - -sub usage { - my ($error) = @_; - print loc("Usage: ") . "$0 -m (daily|weekly) [--print] [--help]\n"; - print loc( - "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.", - $0 - ) . "\n"; - print "\n\t-m, --mode\t" - . loc("Specify whether this is a daily or weekly run.") . "\n"; - print "\t-p, --print\t" - . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent") - . "\n"; - print "\t-h, --help\t" . loc("Print this message") . "\n"; - - if ( $error eq 'help' ) { - exit 0; - } else { - print loc("Error") . ": " . loc($error) . "\n"; - exit 1; - } -} - -my ( $frequency, $print, $help ) = ( '', '', '' ); -GetOptions( - 'mode=s' => \$frequency, - 'print' => \$print, - 'help' => \$help, -); - -usage('help') if $help; -usage("Mode argument must be 'daily' or 'weekly'") - unless $frequency =~ /^(daily|weekly)$/; - -run( $frequency, $print ); - -sub run { - my $frequency = shift; - my $print = shift; - -## Find all the tickets that have been modified within the time frame -## described by $frequency. - - my ( $all_digest, $sent_transactions ) = find_transactions($frequency); - -## Iterate through our huge hash constructing the digest message -## for each user and sending it. - - foreach my $user ( keys %$all_digest ) { - my ( $contents_list, $contents_body ) = build_digest_for_user( $user, $all_digest->{$user} ); - # Now we have a content head and a content body. We can send a message. - if ( send_digest( $user, $contents_list, $contents_body ) ) { - print "Sent message to $user\n"; - mark_transactions_sent( $frequency, $user, values %{$sent_transactions->{$user}} ) unless ($print); - } else { - print "Failed to send message to $user\n"; - } - } -} -exit 0; - -# Subroutines. - -sub send_digest { - my ( $to, $index, $messages ) = @_; - - # Combine the index and the messages. - - my $body = "============== Tickets with activity in the last " - . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n"; - - $body .= $index; - $body .= "\n\n============== Messages recorded in the last " - . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n"; - $body .= $messages; - - # Load our template. If we cannot load the template, abort - # immediately rather than failing through many loops. - my $digest_template = RT::Template->new( RT->SystemUser ); - my ( $ret, $msg ) = $digest_template->Load('Email Digest'); - unless ($ret) { - print loc("Failed to load template") - . " 'Email Digest': " - . $msg - . ". Cannot continue.\n"; - exit 1; - } - ( $ret, $msg ) = $digest_template->Parse( Argument => $body ); - unless ($ret) { - print loc("Failed to parse template") - . " 'Email Digest'. Cannot continue.\n"; - exit 1; - } - - # Set our sender and recipient. - $digest_template->MIMEObj->head->replace( 'From', RT::Config->Get('CorrespondAddress') ); - $digest_template->MIMEObj->head->replace( 'To', $to ); - - if ($print) { - $digest_template->MIMEObj->print; - return 1; - } else { - return RT::Interface::Email::SendEmail( Entity => $digest_template->MIMEObj) - } -} - -=item mark_transactions_sent( $frequency, $user, @txn_list ); - -Takes a frequency string (either 'daily' or 'weekly'), a user and one or more -transaction objects as its arguments. Marks the given deferred -notifications as sent. - -=cut - -sub mark_transactions_sent { - my ( $freq, $user, @txns ) = @_; - return unless $freq =~ /(daily|weekly)/; - return unless @txns; - foreach my $txn (@txns) { - - # Grab the attribute, mark the "sent" as true, and store the new - # value. - if ( my $attr = $txn->FirstAttribute('DeferredRecipients') ) { - my $deferred = $attr->Content; - $deferred->{$freq}->{$user}->{'_sent'} = 1; - $txn->SetAttribute( - Name => 'DeferredRecipients', - Description => 'Deferred recipients for this message', - Content => $deferred, - ); - } - } -} - -sub since_date { - my $frequency = shift; - - # Specify a short time for digest overlap, in case we aren't starting - # this process exactly on time. - my $OVERLAP_HEDGE = -30; - - my $since_date = RT::Date->new( RT->SystemUser ); - $since_date->Set( Format => 'unix', Value => time() ); - if ( $frequency eq 'daily' ) { - $since_date->AddDays(-1); - } else { - $since_date->AddDays(-7); - } - - $since_date->AddSeconds($OVERLAP_HEDGE); - - return $since_date; -} - -sub find_transactions { - my $frequency = shift; - my $since_date = since_date($frequency); - - my $txns = RT::Transactions->new( RT->SystemUser ); - - # First limit to recent transactions. - $txns->Limit( - FIELD => 'Created', - OPERATOR => '>', - VALUE => $since_date->ISO - ); - - # Next limit to ticket transactions. - $txns->Limit( - FIELD => 'ObjectType', - OPERATOR => '=', - VALUE => 'RT::Ticket', - ENTRYAGGREGATOR => 'AND' - ); - my $all_digest = {}; - my $sent_transactions = {}; - - while ( my $txn = $txns->Next ) { - my $ticket = $txn->Ticket; - my $queue = $txn->TicketObj->QueueObj->Name; - # Xxx todo - may clobber if two queues have the same name - foreach my $user ( $txn->DeferredRecipients($frequency) ) { - $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn->ContentObj; - $sent_transactions->{$user}->{ $txn->id } = $txn; - } - } - - return ( $all_digest, $sent_transactions ); -} - -sub build_digest_for_user { - my $user = shift; - my $user_digest = shift; - - my $contents_list = ''; # Holds the digest index. - my $contents_body = ''; # Holds the digest body. - - # Has the user been disabled since a message was deferred on his/her - # behalf? - my $user_obj = RT::User->new( RT->SystemUser ); - $user_obj->LoadByEmail($user); - if ( $user_obj->PrincipalObj->Disabled ) { - print STDERR loc("Skipping disabled user") . " $user\n"; - next; - } - - print loc("Message for user") . " $user:\n\n" if $print; - foreach my $queue ( keys %$user_digest ) { - $contents_list .= "Queue $queue:\n"; - $contents_body .= "Queue $queue:\n"; - foreach my $ticket ( sort keys %{ $user_digest->{$queue} } ) { - my $tkt_txns = $user_digest->{$queue}->{$ticket}; - my $ticket_obj = RT::Ticket->new( RT->SystemUser ); - $ticket_obj->Load($ticket); - - # Spit out the index entry for this ticket. - my $ticket_title = sprintf( - "#%d %s [%s]\t%s\n", - $ticket, $ticket_obj->Status, $ticket_obj->OwnerObj->Name, - $ticket_obj->Subject - ); - $contents_list .= $ticket_title; - - # Spit out the messages for the transactions on this ticket. - $contents_body .= "\n== $ticket_title\n"; - foreach my $txn ( sort keys %$tkt_txns ) { - my $msg = $tkt_txns->{$txn}; - - # $msg contains an RT::Attachment with our outgoing - # message. Print a few headers for clarity's sake. - $contents_body .= "From: " . $msg->GetHeader('From') . "\n"; - my $date = $msg->GetHeader('Date '); - unless ($date) { - my $txn_obj = RT::Transaction->new( RT->SystemUser ); - $txn_obj->Load($txn); - my $date_obj = RT::Date->new( RT->SystemUser ); - $date_obj->Set( - Format => 'sql', - Value => $txn_obj->Created - ); - $date = strftime( '%a, %d %b %Y %H:%M:%S %z', - @{ [ localtime( $date_obj->Unix ) ] } ); - } - $contents_body .= "Date: $date\n\n"; - $contents_body .= $msg->Content . "\n"; - $contents_body .= "-------\n"; - } # foreach transaction - } # foreach ticket - } # foreach queue - - return ( $contents_list, $contents_body ); - -} diff --git a/rt/sbin/rt-email-digest.in b/rt/sbin/rt-email-digest.in index 5730717f2..fd257fa77 100644 --- a/rt/sbin/rt-email-digest.in +++ b/rt/sbin/rt-email-digest.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -85,7 +85,7 @@ RT::Init(); sub usage { my ($error) = @_; - print loc("Usage: ") . "$0 -m (daily|weekly) [--print] [--help]\n"; + print loc("Usage:") . " $0 -m (daily|weekly) [--print] [--help]\n"; print loc( "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.", $0 @@ -188,13 +188,13 @@ sub send_digest { } } -=item mark_transactions_sent( $frequency, $user, @txn_list ); - -Takes a frequency string (either 'daily' or 'weekly'), a user and one or more -transaction objects as its arguments. Marks the given deferred -notifications as sent. - -=cut +# =item mark_transactions_sent( $frequency, $user, @txn_list ); +# +# Takes a frequency string (either 'daily' or 'weekly'), a user and one or more +# transaction objects as its arguments. Marks the given deferred +# notifications as sent. +# +# =cut sub mark_transactions_sent { my ( $freq, $user, @txns ) = @_; @@ -335,3 +335,42 @@ sub build_digest_for_user { return ( $contents_list, $contents_body ); } + +__END__ + +=head1 NAME + +rt-email-digest - dispatch deferred notifications as a per-user digest + +=head1 SYNOPSIS + + rt-email-digest -m (daily|weekly) [--print] [--help] + +=head1 DESCRIPTION + +This script is a tool to dispatch all deferred RT notifications as a per-user +object. + +=head1 OPTIONS + +=over + +=item mode + +Specify whether this is a daily or weekly run. + +--mode is equal to -m + +=item print + +Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent + +--print is equal to -p + +=item help + +Print this message + +--help is equal to -h + +=back diff --git a/rt/sbin/rt-email-group-admin b/rt/sbin/rt-email-group-admin deleted file mode 100755 index 169ef9ab6..000000000 --- a/rt/sbin/rt-email-group-admin +++ /dev/null @@ -1,508 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -=head1 NAME - -rt-email-group-admin - Command line tool for administrating NotifyGroup actions - -=head1 SYNOPSIS - - rt-email-group-admin --list - rt-email-group-admin --create 'Notify foo team' --group Foo - rt-email-group-admin --create 'Notify foo team as comment' --comment --group Foo - rt-email-group-admin --create 'Notify group Foo and Bar' --group Foo --group Bar - rt-email-group-admin --create 'Notify user foo@bar.com' --user foo@bar.com - rt-email-group-admin --create 'Notify VIPs' --user vip1@bar.com - rt-email-group-admin --add 'Notify VIPs' --user vip2@bar.com --group vip1 --user vip3@foo.com - rt-email-group-admin --rename 'Notify VIPs' --newname 'Inform VIPs' - rt-email-group-admin --switch 'Notify VIPs' - rt-email-group-admin --delete 'Notify user foo@bar.com' - -=head1 DESCRIPTION - -This script list, create, modify or delete scrip actions in the RT DB. Once -you've created an action you can use it in a scrip. - -For example you can create the following action using this script: - - rt-email-group-admin --create 'Notify developers' --group 'Development Team' - -Then you can add the followoing scrip to your Bugs queue: - - Condition: On Create - Action: Notify developers - Template: Transaction - Stage: TransactionCreate - -Your development team will be notified on every new ticket in the queue. - -=cut - -use warnings; -use strict; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use RT; -RT::LoadConfig; -RT::Init; - -require RT::Principal; -require RT::User; -require RT::Group; -require RT::ScripActions; - -use Getopt::Long qw(GetOptions); - -our $cmd = 'usage'; -our $opts = {}; - -sub parse_args { - my $tmp; - Getopt::Long::Configure( "pass_through" ); - if ( GetOptions( 'list' => \$tmp ) && $tmp ) { - $cmd = 'list'; - } - elsif ( GetOptions( 'create=s' => \$tmp ) && $tmp ) { - $cmd = 'create'; - $opts->{'name'} = $tmp; - $opts->{'groups'} = []; - $opts->{'users'} = []; - GetOptions( 'comment' => \$opts->{'comment'} ); - GetOptions( 'group:s@' => $opts->{'groups'} ); - GetOptions( 'user:s@' => $opts->{'users'} ); - unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) { - usage(); - exit(-1); - } - } - elsif ( GetOptions( 'add=s' => \$tmp ) && $tmp ) { - $cmd = 'add'; - $opts->{'name'} = $tmp; - $opts->{'groups'} = []; - $opts->{'users'} = []; - GetOptions( 'group:s@' => $opts->{'groups'} ); - GetOptions( 'user:s@' => $opts->{'users'} ); - unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) { - usage(); - exit(-1); - } - } - elsif ( GetOptions( 'switch=s' => \$tmp ) && $tmp ) { - $cmd = 'switch'; - $opts->{'name'} = $tmp; - } - elsif ( GetOptions( 'rename=s' => \$tmp ) && $tmp ) { - $cmd = 'rename'; - $opts->{'name'} = $tmp; - GetOptions( 'newname=s' => \$opts->{'newname'} ); - unless ( $opts->{'newname'} ) { - usage(); - exit(-1); - } - } - elsif ( GetOptions( 'delete=s' => \$tmp ) && $tmp) { - $cmd = 'delete'; - $opts->{'name'} = $tmp; - } else { - $cmd = 'usage'; - } - - return; -} - -sub usage { - local $@; - eval "require Pod::PlainText;"; - if ( $@ ) { - print "see `perldoc $0`\n"; - } else { - my $parser = Pod::PlainText->new( sentence => 0, width => 78 ); - $parser->parse_from_file( $0 ); - } -} - -parse_args(); - -{ - eval "main::$cmd()"; - if ( $@ ) { - print STDERR $@ ."\n"; - } -} - -exit(0); - -=head1 USAGE - -rt-email-group-admin --COMMAND ARGS - -=head1 COMMANDS - -=head2 list - -Lists actions and its descriptions. - -=cut - -sub list { - my $actions = _get_our_actions(); - while( my $a = $actions->Next ) { - _list( $a ); - } - return; -} - -sub _list { - my $action = shift; - - print "Name: ". $action->Name() ."\n"; - print "Module: ". $action->ExecModule() ."\n"; - - my @princ = argument_to_list( $action ); - - print "Members: \n"; - foreach( @princ ) { - my $obj = RT::Principal->new( $RT::SystemUser ); - $obj->Load( $_ ); - next unless $obj->id; - - print "\t". $obj->PrincipalType; - print "\t=> ". $obj->Object->Name; - print "(Disabled!!!)" if $obj->Disabled; - print "\n"; - } - print "\n"; - return; -} - -=head2 create NAME [--comment] [--group GNAME] [--user UNAME] - -Creates new action with NAME and adds users and/or groups to its -recipient list. Would be notify as comment if --comment specified. - -=cut - -sub create { - my $actions = RT::ScripActions->new( $RT::SystemUser ); - $actions->Limit( - FIELD => 'Name', - VALUE => $opts->{'name'}, - ); - if ( $actions->Count ) { - print STDERR "ScripAction '". $opts->{'name'} ."' allready exists\n"; - exit(-1); - } - - my @groups = _check_groups( @{ $opts->{'groups'} } ); - my @users = _check_users( @{ $opts->{'users'} } ); - unless ( @users + @groups ) { - print STDERR "List of groups and users is empty\n"; - exit(-1); - } - - my $action = __create_empty( $opts->{'name'}, $opts->{'comment'} ); - - __add( $action, $_ ) foreach( @users ); - __add( $action, $_ ) foreach( @groups ); - - return; -} - -sub __create_empty { - my $name = shift; - my $as_comment = shift || 0; - require RT::ScripAction; - my $action = RT::ScripAction->new( $RT::SystemUser ); - $action->Create( - Name => $name, - Description => "Created with rt-email-group-admin script", - ExecModule => $as_comment? 'NotifyGroupAsComment': 'NotifyGroup', - Argument => '', - ); - - return $action; -} - -sub _check_groups -{ - return grep { $_ ? 1: do { print STDERR "Group '$_' skipped, doesn't exist\n"; 0; } } - map { __check_group($_) } @_; -} - -sub __check_group -{ - my $instance = shift; - require RT::Group; - my $obj = RT::Group->new( $RT::SystemUser ); - $obj->LoadUserDefinedGroup( $instance ); - return $obj->id ? $obj : undef; -} - -sub _check_users -{ - return grep { $_ ? 1: do { print STDERR "User '$_' skipped, doesn't exist\n"; 0; } } - map { __check_user($_) } @_; -} - -sub __check_user -{ - my $instance = shift; - require RT::User; - my $obj = RT::User->new( $RT::SystemUser ); - $obj->Load( $instance ); - return $obj->id ? $obj : undef; -} - -=head2 add NAME [--group GNAME] [--user UNAME] - -Adds groups and/or users to recipients of the action NAME. - -=cut - -sub add { - my $action = _get_action_by_name( $opts->{'name'} ); - unless ( $action ) { - print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n"; - exit(-1); - } - - my @groups = _check_groups( @{ $opts->{'groups'} } ); - my @users = _check_users( @{ $opts->{'users'} } ); - - unless ( @users + @groups ) { - print STDERR "List of groups and users is empty\n"; - exit(-1); - } - - __add( $action, $_ ) foreach @users; - __add( $action, $_ ) foreach @groups; - - return; -} - -sub __add -{ - my $action = shift; - my $obj = shift; - - my @cur = argument_to_list( $action ); - - my $id = $obj->id; - return if grep $_ == $id, @cur; - - push @cur, $id; - - return $action->__Set( Field => 'Argument', Value => join(',', @cur) ); -} - -=head2 delete NAME - -Deletes action NAME if scrips doesn't use it. - -=cut - -sub delete { - my $action = _get_action_by_name( $opts->{'name'} ); - unless ( $action ) { - print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n"; - exit(-1); - } - - require RT::Scrips; - my $scrips = RT::Scrips->new( $RT::SystemUser ); - $scrips->Limit( FIELD => 'ScripAction', VALUE => $action->id ); - if ( $scrips->Count ) { - my @sid; - while( my $s = $scrips->Next ) { - push @sid, $s->id; - } - print STDERR "ScripAction '". $opts->{'name'} ."'" - . " is in use by Scrip(s) ". join( ", ", map "#$_", @sid ) - . "\n"; - exit(-1); - } - - return __delete( $action ); -} - -sub __delete { - require DBIx::SearchBuilder::Record; - return DBIx::SearchBuilder::Record::Delete( shift ); -} - -sub _get_action_by_name { - my $name = shift; - my $actions = _get_our_actions(); - $actions->Limit( - FIELD => 'Name', - VALUE => $name - ); - - if ( $actions->Count > 1 ) { - print STDERR "More then one ScripAction with name '$name'\n"; - } - - return $actions->First; -} - -=head2 switch NAME - -Switch action NAME from notify as correspondence to comment and back. - -=cut - -sub switch { - my $action = _get_action_by_name( $opts->{'name'} ); - unless ( $action ) { - print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n"; - exit(-1); - } - - my %h = ( - NotifyGroup => 'NotifyGroupAsComment', - NotifyGroupAsComment => 'NotifyGroup' - ); - - return $action->__Set( - Field => 'ExecModule', - Value => $h{ $action->ExecModule } - ); -} - -=head2 rename NAME --newname NEWNAME - -Renames action NAME to NEWNAME. - -=cut - -sub rename { - my $action = _get_action_by_name( $opts->{'name'} ); - unless ( $action ) { - print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n"; - exit(-1); - } - - my $actions = RT::ScripActions->new( $RT::SystemUser ); - $actions->Limit( FIELD => 'Name', VALUE => $opts->{'newname'} ); - if ( $actions->Count ) { - print STDERR "ScripAction '". $opts->{'newname'} ."' allready exists\n"; - exit(-1); - } - - return $action->__Set( - Field => 'Name', - Value => $opts->{'newname'}, - ); -} - -=head2 NOTES - -If command has option --group or --user then you can use it more then once, -if other is not specified. - -=cut - -############### -#### Utils #### -############### - -sub argument_to_list { - my $action = shift; - require RT::Action::NotifyGroup; - return RT::Action::NotifyGroup->__SplitArg( $action->Argument ); -} - -sub _get_our_actions { - my $actions = RT::ScripActions->new( $RT::SystemUser ); - $actions->Limit( - FIELD => 'ExecModule', - VALUE => 'NotifyGroup', - ENTRYAGGREGATOR => 'OR', - ); - $actions->Limit( - FIELD => 'ExecModule', - VALUE => 'NotifyGroupAsComment', - ENTRYAGGREGATOR => 'OR', - ); - - return $actions; -} - -=head1 AUTHOR - -Ruslan U. Zakirov E<lt>ruz@bestpractical.comE<gt> - -=head1 SEE ALSO - -L<RT::Action::NotifyGroup>, L<RT::Action::NotifyGroupAsComment> - -=cut diff --git a/rt/sbin/rt-email-group-admin.in b/rt/sbin/rt-email-group-admin.in index 600486005..0e32525d9 100755 --- a/rt/sbin/rt-email-group-admin.in +++ b/rt/sbin/rt-email-group-admin.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -111,23 +111,14 @@ BEGIN { } -use RT; -RT::LoadConfig; -RT::Init; - -require RT::Principal; -require RT::User; -require RT::Group; -require RT::ScripActions; - use Getopt::Long qw(GetOptions); +Getopt::Long::Configure( "pass_through" ); our $cmd = 'usage'; our $opts = {}; sub parse_args { my $tmp; - Getopt::Long::Configure( "pass_through" ); if ( GetOptions( 'list' => \$tmp ) && $tmp ) { $cmd = 'list'; } @@ -180,18 +171,28 @@ sub parse_args { } sub usage { - local $@; - eval "require Pod::PlainText;"; - if ( $@ ) { - print "see `perldoc $0`\n"; - } else { - my $parser = Pod::PlainText->new( sentence => 0, width => 78 ); - $parser->parse_from_file( $0 ); - } + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); +} + +my $help; +if ( GetOptions( 'help|h' => \$help ) && $help ) { + usage(); + exit; } parse_args(); +require RT; +RT->LoadConfig; +RT->Init; + +require RT::Principal; +require RT::User; +require RT::Group; +require RT::ScripActions; + + { eval "main::$cmd()"; if ( $@ ) { @@ -231,7 +232,7 @@ sub _list { print "Members: \n"; foreach( @princ ) { - my $obj = RT::Principal->new( $RT::SystemUser ); + my $obj = RT::Principal->new( RT->SystemUser ); $obj->Load( $_ ); next unless $obj->id; @@ -252,7 +253,7 @@ recipient list. Would be notify as comment if --comment specified. =cut sub create { - my $actions = RT::ScripActions->new( $RT::SystemUser ); + my $actions = RT::ScripActions->new( RT->SystemUser ); $actions->Limit( FIELD => 'Name', VALUE => $opts->{'name'}, @@ -281,7 +282,7 @@ sub __create_empty { my $name = shift; my $as_comment = shift || 0; require RT::ScripAction; - my $action = RT::ScripAction->new( $RT::SystemUser ); + my $action = RT::ScripAction->new( RT->SystemUser ); $action->Create( Name => $name, Description => "Created with rt-email-group-admin script", @@ -302,7 +303,7 @@ sub __check_group { my $instance = shift; require RT::Group; - my $obj = RT::Group->new( $RT::SystemUser ); + my $obj = RT::Group->new( RT->SystemUser ); $obj->LoadUserDefinedGroup( $instance ); return $obj->id ? $obj : undef; } @@ -317,7 +318,7 @@ sub __check_user { my $instance = shift; require RT::User; - my $obj = RT::User->new( $RT::SystemUser ); + my $obj = RT::User->new( RT->SystemUser ); $obj->Load( $instance ); return $obj->id ? $obj : undef; } @@ -378,7 +379,7 @@ sub delete { } require RT::Scrips; - my $scrips = RT::Scrips->new( $RT::SystemUser ); + my $scrips = RT::Scrips->new( RT->SystemUser ); $scrips->Limit( FIELD => 'ScripAction', VALUE => $action->id ); if ( $scrips->Count ) { my @sid; @@ -451,7 +452,7 @@ sub rename { exit(-1); } - my $actions = RT::ScripActions->new( $RT::SystemUser ); + my $actions = RT::ScripActions->new( RT->SystemUser ); $actions->Limit( FIELD => 'Name', VALUE => $opts->{'newname'} ); if ( $actions->Count ) { print STDERR "ScripAction '". $opts->{'newname'} ."' allready exists\n"; @@ -482,7 +483,7 @@ sub argument_to_list { } sub _get_our_actions { - my $actions = RT::ScripActions->new( $RT::SystemUser ); + my $actions = RT::ScripActions->new( RT->SystemUser ); $actions->Limit( FIELD => 'ExecModule', VALUE => 'NotifyGroup', diff --git a/rt/sbin/rt-fulltext-indexer b/rt/sbin/rt-fulltext-indexer new file mode 100755 index 000000000..2a6b07e39 --- /dev/null +++ b/rt/sbin/rt-fulltext-indexer @@ -0,0 +1,453 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; +use warnings; +no warnings 'once'; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +BEGIN { + use RT; + RT::LoadConfig(); + RT::Init(); +}; +use RT::Interface::CLI (); + +my %OPT = ( + help => 0, + debug => 0, +); +my @OPT_LIST = qw(help|h! debug!); + +my $db_type = RT->Config->Get('DatabaseType'); +if ( $db_type eq 'Pg' ) { + %OPT = ( + %OPT, + limit => 0, + all => 0, + ); + push @OPT_LIST, 'limit=i', 'all!'; +} +elsif ( $db_type eq 'mysql' ) { + %OPT = ( + %OPT, + limit => 0, + all => 0, + xmlpipe2 => 0, + ); + push @OPT_LIST, 'limit=i', 'all!', 'xmlpipe2!'; +} +elsif ( $db_type eq 'Oracle' ) { + %OPT = ( + %OPT, + memory => '2M', + ); + push @OPT_LIST, qw(memory=s); +} + +use Getopt::Long qw(GetOptions); +GetOptions( \%OPT, @OPT_LIST ); + +if ( $OPT{'help'} ) { + RT::Interface::CLI->ShowHelp( + Sections => 'NAME|DESCRIPTION|'. uc($db_type), + ); +} + +my $fts_config = RT->Config->Get('FullTextSearch') || {}; +unless ( $fts_config->{'Enable'} ) { + print STDERR <<EOT; + +Full text search is disabled in your RT configuration. Run +/opt/rt3/sbin/rt-setup-fulltext-index to configure and enable it. + +EOT + exit 1; +} +unless ( $fts_config->{'Indexed'} ) { + print STDERR <<EOT; + +Full text search is enabled in your RT configuration, but not with any +full-text database indexing -- hence this tool is not required. Read +the documentation for %FullTextSearch in your RT_Config for more details. + +EOT + exit 1; +} + +if ( $db_type eq 'Oracle' ) { + my $index = $fts_config->{'IndexName'} || 'rt_fts_index'; + $RT::Handle->dbh->do( + "begin ctx_ddl.sync_index(?, ?); end;", undef, + $index, $OPT{'memory'} + ); + exit; +} elsif ( $db_type eq 'mysql' ) { + unless ($OPT{'xmlpipe2'}) { + print STDERR <<EOT; + +Updates to the external Sphinx index are done via running the sphinx +`indexer` tool: + + indexer rt + +EOT + exit 1; + } +} + +my @types = qw(text html); +foreach my $type ( @types ) { + REDO: + my $attachments = attachments($type); + $attachments->Limit( + FIELD => 'id', + OPERATOR => '>', + VALUE => last_indexed($type) + ); + $attachments->OrderBy( FIELD => 'id', ORDER => 'asc' ); + $attachments->RowsPerPage( $OPT{'limit'} || 100 ); + + my $found = 0; + while ( my $a = $attachments->Next ) { + next if filter( $type, $a ); + debug("Found attachment #". $a->id ); + my $txt = extract($type, $a) or next; + $found++; + process( $type, $a, $txt ); + debug("Processed attachment #". $a->id ); + } + finalize( $type, $attachments ) if $found; + clean( $type ); + goto REDO if $OPT{'all'} and $attachments->Count == ($OPT{'limit'} || 100) +} + +sub attachments { + my $type = shift; + my $res = RT::Attachments->new( RT->SystemUser ); + my $txn_alias = $res->Join( + ALIAS1 => 'main', + FIELD1 => 'TransactionId', + TABLE2 => 'Transactions', + FIELD2 => 'id', + ); + $res->Limit( + ALIAS => $txn_alias, + FIELD => 'ObjectType', + VALUE => 'RT::Ticket', + ); + my $ticket_alias = $res->Join( + ALIAS1 => $txn_alias, + FIELD1 => 'ObjectId', + TABLE2 => 'Tickets', + FIELD2 => 'id', + ); + $res->Limit( + ALIAS => $ticket_alias, + FIELD => 'Status', + OPERATOR => '!=', + VALUE => 'deleted' + ); + + return goto_specific( + suffix => $type, + error => "Don't know how to find $type attachments", + arguments => [$res], + ); +} + +sub last_indexed { + my ($type) = (@_); + return goto_specific( + suffix => $db_type, + error => "Don't know how to find last indexed $type attachment for $db_type DB", + arguments => \@_, + ); +} + +sub filter { + my $type = shift; + return goto_specific( + suffix => $type, + arguments => \@_, + ); +} + +sub extract { + my $type = shift; + return goto_specific( + suffix => $type, + error => "No way to convert $type attachment into text", + arguments => \@_, + ); +} + +sub process { + return goto_specific( + suffix => $db_type, + error => "No processer for $db_type DB", + arguments => \@_, + ); +} + +sub finalize { + return goto_specific( + suffix => $db_type, + arguments => \@_, + ); +} + +sub clean { + return goto_specific( + suffix => $db_type, + arguments => \@_, + ); +} + +{ +sub last_indexed_mysql { + my $type = shift; + my $attr = $RT::System->FirstAttribute('LastIndexedAttachments'); + return 0 unless $attr; + return 0 unless exists $attr->{ $type }; + return $attr->{ $type } || 0; +} + +sub process_mysql { + my ($type, $attachment, $text) = (@_); + + my $doc = sphinx_template(); + + my $element = $doc->createElement('sphinx:document'); + $element->setAttribute( id => $attachment->id ); + $element->appendTextChild( content => $$text ); + + $doc->documentElement->appendChild( $element ); +} + +my $doc = undef; +sub sphinx_template { + return $doc if $doc; + + require XML::LibXML; + $doc = XML::LibXML::Document->new('1.0', 'UTF-8'); + my $root = $doc->createElement('sphinx:docset'); + $doc->setDocumentElement( $root ); + + my $schema = $doc->createElement('sphinx:schema'); + $root->appendChild( $schema ); + foreach ( qw(content) ) { + my $field = $doc->createElement('sphinx:field'); + $field->setAttribute( name => $_ ); + $schema->appendChild( $field ); + } + + return $doc; +} + +sub finalize_mysql { + my ($type, $attachments) = @_; + sphinx_template()->toFH(*STDOUT, 1); +} + +sub clean_mysql { + $doc = undef; +} + +} + +sub last_indexed_pg { + my $type = shift; + my $attachments = attachments( $type ); + my $alias = 'main'; + if ( $fts_config->{'Table'} && $fts_config->{'Table'} ne 'Attachments' ) { + $alias = $attachments->Join( + TYPE => 'left', + FIELD1 => 'id', + TABLE2 => $fts_config->{'Table'}, + FIELD2 => 'id', + ); + } + $attachments->Limit( + ALIAS => $alias, + FIELD => $fts_config->{'Column'}, + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + $attachments->OrderBy( FIELD => 'id', ORDER => 'desc' ); + $attachments->RowsPerPage( 1 ); + my $res = $attachments->First; + return 0 unless $res; + return $res->id; +} + +sub process_pg { + my ($type, $attachment, $text) = (@_); + + my $dbh = $RT::Handle->dbh; + my $table = $fts_config->{'Table'}; + my $column = $fts_config->{'Column'}; + + my $query; + if ( $table ) { + if ( my ($id) = $dbh->selectrow_array("SELECT id FROM $table WHERE id = ?", undef, $attachment->id) ) { + $query = "UPDATE $table SET $column = to_tsvector(?) WHERE id = ?"; + } else { + $query = "INSERT INTO $table($column, id) VALUES(to_tsvector(?), ?)"; + } + } else { + $query = "UPDATE Attachments SET $column = to_tsvector(?) WHERE id = ?"; + } + + my $status = eval { $dbh->do( $query, undef, $$text, $attachment->id ) }; + unless ( $status ) { + if ($dbh->errstr =~ /string is too long for tsvector/) { + warn "Attachment @{[$attachment->id]} not indexed, as it contains too many unique words to be indexed"; + } else { + die "error: ". $dbh->errstr; + } + } +} + +sub attachments_text { + my $res = shift; + $res->Limit( FIELD => 'ContentType', VALUE => 'text/plain' ); + return $res; +} + +sub extract_text { + my $attachment = shift; + my $text = $attachment->Content; + return undef unless defined $text && length($text); + return \$text; +} + +sub attachments_html { + my $res = shift; + $res->Limit( FIELD => 'ContentType', VALUE => 'text/html' ); + return $res; +} + +sub filter_html { + my $attachment = shift; + if ( my $parent = $attachment->ParentObj ) { +# skip html parts that are alternatives + return 1 if $parent->id + && $parent->ContentType eq 'mulitpart/alternative'; + } + return 0; +} + +sub extract_html { + my $attachment = shift; + my $text = $attachment->Content; + return undef unless defined $text && length($text); +# TODO: html -> text + return \$text; +} + +sub goto_specific { + my %args = (@_); + + my $func = (caller(1))[3]; + $func =~ s/.*:://; + my $call = $func ."_". lc $args{'suffix'}; + unless ( defined &$call ) { + return undef unless $args{'error'}; + require Carp; Carp::croak( $args{'error'} ); + } + @_ = @{ $args{'arguments'} }; + goto &$call; +} + + +# helper functions +sub debug { print @_, "\n" if $OPT{debug}; 1 } +sub error { $RT::Logger->error(_(@_)); 1 } +sub warning { $RT::Logger->warn(_(@_)); 1 } + +=head1 NAME + +rt-fulltext-indexer - Indexer for full text search + +=head1 DESCRIPTION + +This is a helper script to keep full text indexes in sync with data. +Read F<docs/full_text_indexing.pod> for complete details on how and when +to run it. + +=head1 AUTHOR + +Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>, +Alex Vandiver E<lt>alexmv@bestpractical.comE<gt> + +=cut + diff --git a/rt/sbin/rt-fulltext-indexer.in b/rt/sbin/rt-fulltext-indexer.in new file mode 100644 index 000000000..7e31cac84 --- /dev/null +++ b/rt/sbin/rt-fulltext-indexer.in @@ -0,0 +1,453 @@ +#!@PERL@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; +use warnings; +no warnings 'once'; + +# 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; + } +} + +BEGIN { + use RT; + RT::LoadConfig(); + RT::Init(); +}; +use RT::Interface::CLI (); + +my %OPT = ( + help => 0, + debug => 0, +); +my @OPT_LIST = qw(help|h! debug!); + +my $db_type = RT->Config->Get('DatabaseType'); +if ( $db_type eq 'Pg' ) { + %OPT = ( + %OPT, + limit => 0, + all => 0, + ); + push @OPT_LIST, 'limit=i', 'all!'; +} +elsif ( $db_type eq 'mysql' ) { + %OPT = ( + %OPT, + limit => 0, + all => 0, + xmlpipe2 => 0, + ); + push @OPT_LIST, 'limit=i', 'all!', 'xmlpipe2!'; +} +elsif ( $db_type eq 'Oracle' ) { + %OPT = ( + %OPT, + memory => '2M', + ); + push @OPT_LIST, qw(memory=s); +} + +use Getopt::Long qw(GetOptions); +GetOptions( \%OPT, @OPT_LIST ); + +if ( $OPT{'help'} ) { + RT::Interface::CLI->ShowHelp( + Sections => 'NAME|DESCRIPTION|'. uc($db_type), + ); +} + +my $fts_config = RT->Config->Get('FullTextSearch') || {}; +unless ( $fts_config->{'Enable'} ) { + print STDERR <<EOT; + +Full text search is disabled in your RT configuration. Run +@RT_SBIN_PATH_R@/rt-setup-fulltext-index to configure and enable it. + +EOT + exit 1; +} +unless ( $fts_config->{'Indexed'} ) { + print STDERR <<EOT; + +Full text search is enabled in your RT configuration, but not with any +full-text database indexing -- hence this tool is not required. Read +the documentation for %FullTextSearch in your RT_Config for more details. + +EOT + exit 1; +} + +if ( $db_type eq 'Oracle' ) { + my $index = $fts_config->{'IndexName'} || 'rt_fts_index'; + $RT::Handle->dbh->do( + "begin ctx_ddl.sync_index(?, ?); end;", undef, + $index, $OPT{'memory'} + ); + exit; +} elsif ( $db_type eq 'mysql' ) { + unless ($OPT{'xmlpipe2'}) { + print STDERR <<EOT; + +Updates to the external Sphinx index are done via running the sphinx +`indexer` tool: + + indexer rt + +EOT + exit 1; + } +} + +my @types = qw(text html); +foreach my $type ( @types ) { + REDO: + my $attachments = attachments($type); + $attachments->Limit( + FIELD => 'id', + OPERATOR => '>', + VALUE => last_indexed($type) + ); + $attachments->OrderBy( FIELD => 'id', ORDER => 'asc' ); + $attachments->RowsPerPage( $OPT{'limit'} || 100 ); + + my $found = 0; + while ( my $a = $attachments->Next ) { + next if filter( $type, $a ); + debug("Found attachment #". $a->id ); + my $txt = extract($type, $a) or next; + $found++; + process( $type, $a, $txt ); + debug("Processed attachment #". $a->id ); + } + finalize( $type, $attachments ) if $found; + clean( $type ); + goto REDO if $OPT{'all'} and $attachments->Count == ($OPT{'limit'} || 100) +} + +sub attachments { + my $type = shift; + my $res = RT::Attachments->new( RT->SystemUser ); + my $txn_alias = $res->Join( + ALIAS1 => 'main', + FIELD1 => 'TransactionId', + TABLE2 => 'Transactions', + FIELD2 => 'id', + ); + $res->Limit( + ALIAS => $txn_alias, + FIELD => 'ObjectType', + VALUE => 'RT::Ticket', + ); + my $ticket_alias = $res->Join( + ALIAS1 => $txn_alias, + FIELD1 => 'ObjectId', + TABLE2 => 'Tickets', + FIELD2 => 'id', + ); + $res->Limit( + ALIAS => $ticket_alias, + FIELD => 'Status', + OPERATOR => '!=', + VALUE => 'deleted' + ); + + return goto_specific( + suffix => $type, + error => "Don't know how to find $type attachments", + arguments => [$res], + ); +} + +sub last_indexed { + my ($type) = (@_); + return goto_specific( + suffix => $db_type, + error => "Don't know how to find last indexed $type attachment for $db_type DB", + arguments => \@_, + ); +} + +sub filter { + my $type = shift; + return goto_specific( + suffix => $type, + arguments => \@_, + ); +} + +sub extract { + my $type = shift; + return goto_specific( + suffix => $type, + error => "No way to convert $type attachment into text", + arguments => \@_, + ); +} + +sub process { + return goto_specific( + suffix => $db_type, + error => "No processer for $db_type DB", + arguments => \@_, + ); +} + +sub finalize { + return goto_specific( + suffix => $db_type, + arguments => \@_, + ); +} + +sub clean { + return goto_specific( + suffix => $db_type, + arguments => \@_, + ); +} + +{ +sub last_indexed_mysql { + my $type = shift; + my $attr = $RT::System->FirstAttribute('LastIndexedAttachments'); + return 0 unless $attr; + return 0 unless exists $attr->{ $type }; + return $attr->{ $type } || 0; +} + +sub process_mysql { + my ($type, $attachment, $text) = (@_); + + my $doc = sphinx_template(); + + my $element = $doc->createElement('sphinx:document'); + $element->setAttribute( id => $attachment->id ); + $element->appendTextChild( content => $$text ); + + $doc->documentElement->appendChild( $element ); +} + +my $doc = undef; +sub sphinx_template { + return $doc if $doc; + + require XML::LibXML; + $doc = XML::LibXML::Document->new('1.0', 'UTF-8'); + my $root = $doc->createElement('sphinx:docset'); + $doc->setDocumentElement( $root ); + + my $schema = $doc->createElement('sphinx:schema'); + $root->appendChild( $schema ); + foreach ( qw(content) ) { + my $field = $doc->createElement('sphinx:field'); + $field->setAttribute( name => $_ ); + $schema->appendChild( $field ); + } + + return $doc; +} + +sub finalize_mysql { + my ($type, $attachments) = @_; + sphinx_template()->toFH(*STDOUT, 1); +} + +sub clean_mysql { + $doc = undef; +} + +} + +sub last_indexed_pg { + my $type = shift; + my $attachments = attachments( $type ); + my $alias = 'main'; + if ( $fts_config->{'Table'} && $fts_config->{'Table'} ne 'Attachments' ) { + $alias = $attachments->Join( + TYPE => 'left', + FIELD1 => 'id', + TABLE2 => $fts_config->{'Table'}, + FIELD2 => 'id', + ); + } + $attachments->Limit( + ALIAS => $alias, + FIELD => $fts_config->{'Column'}, + OPERATOR => 'IS NOT', + VALUE => 'NULL', + ); + $attachments->OrderBy( FIELD => 'id', ORDER => 'desc' ); + $attachments->RowsPerPage( 1 ); + my $res = $attachments->First; + return 0 unless $res; + return $res->id; +} + +sub process_pg { + my ($type, $attachment, $text) = (@_); + + my $dbh = $RT::Handle->dbh; + my $table = $fts_config->{'Table'}; + my $column = $fts_config->{'Column'}; + + my $query; + if ( $table ) { + if ( my ($id) = $dbh->selectrow_array("SELECT id FROM $table WHERE id = ?", undef, $attachment->id) ) { + $query = "UPDATE $table SET $column = to_tsvector(?) WHERE id = ?"; + } else { + $query = "INSERT INTO $table($column, id) VALUES(to_tsvector(?), ?)"; + } + } else { + $query = "UPDATE Attachments SET $column = to_tsvector(?) WHERE id = ?"; + } + + my $status = eval { $dbh->do( $query, undef, $$text, $attachment->id ) }; + unless ( $status ) { + if ($dbh->errstr =~ /string is too long for tsvector/) { + warn "Attachment @{[$attachment->id]} not indexed, as it contains too many unique words to be indexed"; + } else { + die "error: ". $dbh->errstr; + } + } +} + +sub attachments_text { + my $res = shift; + $res->Limit( FIELD => 'ContentType', VALUE => 'text/plain' ); + return $res; +} + +sub extract_text { + my $attachment = shift; + my $text = $attachment->Content; + return undef unless defined $text && length($text); + return \$text; +} + +sub attachments_html { + my $res = shift; + $res->Limit( FIELD => 'ContentType', VALUE => 'text/html' ); + return $res; +} + +sub filter_html { + my $attachment = shift; + if ( my $parent = $attachment->ParentObj ) { +# skip html parts that are alternatives + return 1 if $parent->id + && $parent->ContentType eq 'mulitpart/alternative'; + } + return 0; +} + +sub extract_html { + my $attachment = shift; + my $text = $attachment->Content; + return undef unless defined $text && length($text); +# TODO: html -> text + return \$text; +} + +sub goto_specific { + my %args = (@_); + + my $func = (caller(1))[3]; + $func =~ s/.*:://; + my $call = $func ."_". lc $args{'suffix'}; + unless ( defined &$call ) { + return undef unless $args{'error'}; + require Carp; Carp::croak( $args{'error'} ); + } + @_ = @{ $args{'arguments'} }; + goto &$call; +} + + +# helper functions +sub debug { print @_, "\n" if $OPT{debug}; 1 } +sub error { $RT::Logger->error(_(@_)); 1 } +sub warning { $RT::Logger->warn(_(@_)); 1 } + +=head1 NAME + +rt-fulltext-indexer - Indexer for full text search + +=head1 DESCRIPTION + +This is a helper script to keep full text indexes in sync with data. +Read F<docs/full_text_indexing.pod> for complete details on how and when +to run it. + +=head1 AUTHOR + +Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>, +Alex Vandiver E<lt>alexmv@bestpractical.comE<gt> + +=cut + diff --git a/rt/sbin/rt-message-catalog b/rt/sbin/rt-message-catalog index dfb8ce3a4..070f6b2f3 100755 --- a/rt/sbin/rt-message-catalog +++ b/rt/sbin/rt-message-catalog @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -51,6 +51,9 @@ use warnings; use Locale::PO; use Getopt::Long; +use File::Temp 'tempdir'; + +use constant PO_DIR => 'share/po'; my %commands = ( stats => { }, @@ -81,7 +84,7 @@ exit; sub stats { my %opt = %{ shift() }; - my $dir = shift || 'lib/RT/I18N'; + my $dir = shift || PO_DIR; my $max = 0; my %res = (); @@ -125,7 +128,7 @@ sub stats { sub shrink { my %opt = %{ shift() }; - my $dir = shift || 'lib/RT/I18N'; + my $dir = shift || PO_DIR; my %keep = map { $_ => 1 } @{ $opt{'keep'} }; @@ -183,12 +186,11 @@ sub clean { sub rosetta { my %opt = %{ shift() }; - my $url = shift or die 'must provide rosseta download url or directory with new po files'; + my $url = shift or die 'must provide Rosetta download url or directory with new po files'; my $dir; - if ( $url =~ m/^[a-z]+:\/\// ) { - require File::Temp; - $dir = File::Temp::tempdir(); + if ( $url =~ m{^[a-z]+://} ) { + $dir = tempdir(); my ($fname) = $url =~ m{([^/]+)$}; print "Downloading $url\n"; @@ -207,7 +209,7 @@ sub rosetta { die "Is not URL or directory: '$url'"; } - my @files = <$dir/rt/*.po>, <$dir/*.po>; + my @files = ( <$dir/rt/*.po>, <$dir/*.po> ); unless ( @files ) { print STDERR "No files in $dir/rt/*.po and $dir/*.po\n"; exit; @@ -221,18 +223,17 @@ sub rosetta { for ( @files ) { my ($lang) = m/([\w_]+)\.po/; - my $fn_orig = "lib/RT/I18N/$lang.po"; + my $fn_orig = PO_DIR . "/$lang.po"; print "$_ -> $fn_orig\n"; # retain the "NOT FOUND IN SOURCE" entries - require File::Temp; 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 : 'lib/RT/I18N/rt.pot' ); + 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) { @@ -264,6 +265,6 @@ sub rosetta { sub extract { shift; - system($^X, 'sbin/extract-message-catalog', @_); + system($^X, 'devel/tools/extract-message-catalog', @_); } diff --git a/rt/sbin/rt-attributes-viewer b/rt/sbin/rt-preferences-viewer.in index 1ae83217b..1c32f879e 100755..100644 --- a/rt/sbin/rt-attributes-viewer +++ b/rt/sbin/rt-preferences-viewer.in @@ -1,9 +1,9 @@ -#!/usr/bin/perl +#!@PERL@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -52,7 +52,7 @@ use warnings; # fix lib paths, some may be relative BEGIN { require File::Spec; - my @libs = ("lib", "local/lib"); + my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); my $bin_path; for my $lib (@libs) { @@ -73,38 +73,77 @@ BEGIN { } } -my $id = shift; -usage() unless $id; +use Getopt::Long; +my %opt; +GetOptions( \%opt, 'help|h', 'user|u=s', 'option|o=s' ); -sub usage { - print STDERR <<END; -Usage: $0 <attribute id> - -Description: - -This script deserializes and print content of an attribute defined -by <attribute id>. May be useful for developers and for troubleshooting -problems. - -END - exit 1; +if ( $opt{help} ) { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; } require RT; RT::LoadConfig(); RT::Init(); -require RT::Attribute; -my $attr = RT::Attribute->new( do { no warnings 'once'; $RT::SystemUser } ); -$attr->Load( $id ); -unless ( $attr->id ) { - print STDERR "Couldn't load attribute #$id\n"; - exit 1; -} +require RT::Attributes; +my $attrs = RT::Attributes->new( RT->SystemUser ); +$attrs->Limit( FIELD => 'Name', VALUE => 'Pref-RT::System-1' ); +$attrs->Limit( FIELD => 'ObjectType', VALUE => 'RT::User' ); -my %res = (); -$res{$_} = $attr->$_() foreach qw(ObjectType ObjectId Name Description Content ContentType); +if ($opt{user}) { + my $user = RT::User->new( RT->SystemUser ); + my ($val, $msg) = $user->Load($opt{user}); + unless ($val) { + RT->Logger->error("Unable to load $opt{user}: $msg"); + exit(1); + } + $attrs->Limit( FIELD => 'ObjectId', VALUE => $user->Id ); +} use Data::Dumper; -print "Content of attribute #$id: ". Dumper( \%res ); +$Data::Dumper::Terse = 1; + +while (my $attr = $attrs->Next ) { + my $user = RT::User->new( RT->SystemUser ); + my ($val, $msg) = $user->Load($attr->ObjectId); + unless ($val) { + RT->Logger->warn("Unable to load User ".$attr->ObjectId." $msg"); + next; + } + next if $user->Disabled; + + my $content = $attr->Content; + if ( my $config_name = $opt{option} ) { + if ( exists $content->{$config_name} ) { + my $setting = $content->{$config_name}; + print $user->Name, "\t$config_name: $setting\n"; + } + } else { + print $user->Name, " => ", Dumper($content); + } + +} + +__END__ + +=head1 NAME + +rt-preferences-viewer - show user defined preferences + +=head1 SYNOPSIS + + rt-preferences-viewer + + rt-preferences-viewer --user=falcone + show only the falcone user's preferences + + rt-preferences-viewer --option=EmailFrequency + show users who have set the EmailFrequence config option + +=head1 DESCRIPTION +This script shows user settings of preferences. If a user is using the system +default, it will not be listed. You can limit to a user name or id or to users +with a particular option set. diff --git a/rt/sbin/rt-server b/rt/sbin/rt-server deleted file mode 100755 index f932ce8b4..000000000 --- a/rt/sbin/rt-server +++ /dev/null @@ -1,129 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use warnings; -use strict; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use RT; -RT::LoadConfig(); -RT->InitLogging(); -if (RT->Config->Get('DevelMode')) { require Module::Refresh; } - -RT::CheckPerlRequirements(); -RT->InitPluginPaths(); - -my $port = shift @ARGV || RT->Config->Get('WebPort') || '8080'; - - -require RT::Handle; -my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; - -unless ( $integrity ) { - print STDERR <<EOF; - -RT couldn't connect to the database where tickets are stored. -If this is a new installation of RT, you should visit the URL below -to configure RT and initialize your database. - -If this is an existing RT installation, this may indicate a database -connectivity problem. - -The error RT got back when trying to connect to your database was: - -$msg - -EOF - - require RT::Installer; - # don't enter install mode if the file exists but is unwritable - if (-e RT::Installer->ConfigFile && !-w _) { - die "Since your configuration exists but is not writable, I'm refusing to do anything.\n"; - } - - RT->Config->Set( 'LexiconLanguages' => '*' ); - RT::I18N->Init; - - RT->InstallMode(1); -} else { - RT->ConnectToDatabase(); - RT->InitSystemObjects(); - RT->InitClasses(); - RT->InitPlugins(); -} - -require RT::Interface::Web::Standalone; -my $server = RT::Interface::Web::Standalone->new; -$server->net_server('RT::Interface::Web::Standalone::PreFork'); -$server->port($port); -$server->run(); - diff --git a/rt/sbin/rt-server.fcgi.in b/rt/sbin/rt-server.fcgi.in new file mode 100644 index 000000000..45c377088 --- /dev/null +++ b/rt/sbin/rt-server.fcgi.in @@ -0,0 +1,283 @@ +#!@PERL@ -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use warnings; +use strict; + +# fix lib paths, some may be relative +BEGIN { + die <<EOT if ${^TAINT}; +RT does not run under Perl's "taint mode". Remove -T from the command +line, or remove the PerlTaintCheck parameter from your mod_perl +configuration. +EOT + + require File::Spec; + my @libs = ("@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 Getopt::Long; +no warnings 'once'; + +if (grep { m/help/ } @ARGV) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +require RT; +RT->LoadConfig(); +RT->InitLogging(); +require Module::Refresh if RT->Config->Get('DevelMode'); + +require RT::Handle; +my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + +unless ( $integrity ) { + print STDERR <<EOF; + +RT couldn't connect to the database where tickets are stored. +If this is a new installation of RT, you should visit the URL below +to configure RT and initialize your database. + +If this is an existing RT installation, this may indicate a database +connectivity problem. + +The error RT got back when trying to connect to your database was: + +$msg + +EOF + + require RT::Installer; + # don't enter install mode if the file exists but is unwritable + if (-e RT::Installer->ConfigFile && !-w _) { + die 'Since your configuration exists (' + . RT::Installer->ConfigFile + . ") but is not writable, I'm refusing to do anything.\n"; + } + + RT->Config->Set( 'LexiconLanguages' => '*' ); + RT::I18N->Init; + + RT->InstallMode(1); +} else { + RT->Init(); + + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post'); + unless ( $status ) { + print STDERR $msg, "\n\n"; + exit -1; + } +} + +# we must disconnect DB before fork +if ($RT::Handle) { + $RT::Handle->dbh(undef); + undef $RT::Handle; +} + +require RT::Interface::Web::Handler; +my $app = RT::Interface::Web::Handler->PSGIApp; + +if ($ENV{RT_TESTING}) { + my $screen_logger = $RT::Logger->remove('screen'); + require Log::Dispatch::Perl; + $RT::Logger->add( + Log::Dispatch::Perl->new( + name => 'rttest', + min_level => $screen_logger->min_level, + action => { + error => 'warn', + critical => 'warn' + } + ) + ); + require Plack::Middleware::Test::StashWarnings; + $app = Plack::Middleware::Test::StashWarnings->wrap($app); +} + +# when used as a psgi file +if (caller) { + return $app; +} + + +# load appropriate server + +require Plack::Runner; + +my $is_fastcgi = $0 =~ m/fcgi$/; +my $r = Plack::Runner->new( $0 =~ 'standalone' ? ( server => 'Standalone' ) : + $is_fastcgi ? ( server => 'FCGI' ) + : (), + env => 'deployment' ); + +# figure out the port +my $port; + +# handle "rt-server 8888" for back-compat, but complain about it +if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) { + warn "Deprecated: please run $0 --port $ARGV[0] instead\n"; + unshift @ARGV, '--port'; +} + +my @args = @ARGV; + +use List::MoreUtils 'last_index'; +my $last_index = last_index { $_ eq '--port' } @args; + +my $explicit_port; + +if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) { + $explicit_port = $args[$last_index+1]; + $port = $explicit_port; + + # inform the rest of the system what port we manually chose + my $old_app = $app; + $app = sub { + my $env = shift; + + $env->{'rt.explicit_port'} = $port; + + $old_app->($env, @_); + }; +} +else { + # default to the configured WebPort and inform Plack::Runner + $port = RT->Config->Get('WebPort') || '8080'; + push @args, '--port', $port; +} + +push @args, '--server', 'Standalone' if RT->InstallMode; +push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args; + +$r->parse_options(@args); + +delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything + +unless ($r->{env} eq 'development') { + push @{$r->{options}}, server_ready => sub { + my($args) = @_; + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }; +} +eval { $r->run($app) }; +if (my $err = $@) { + handle_startup_error($err); +} + +exit 0; + +sub handle_startup_error { + my $err = shift; + if ( $err =~ /listen/ ) { + handle_bind_error(); + } else { + die + "Something went wrong while trying to run RT's standalone web server:\n\t" + . $err; + } +} + + +sub handle_bind_error { + + print STDERR <<EOF; +WARNING: RT couldn't start up a web server on port @{[$port]}. +This is often the case if the port is already in use or you're running @{[$0]} +as someone other than your system's "root" user. You may also specify a +temporary port with: $0 --port <port> +EOF + + if ($explicit_port) { + print STDERR + "Please check your system configuration or choose another port\n\n"; + } +} + +__END__ + +=head1 NAME + +rt-server - RT standalone server + +=head1 SYNOPSIS + + # runs prefork server listening on port 8080, requires Starlet + rt-server --port 8080 + + # runs server listening on port 8080 + rt-server --server Standalone --port 8080 + # or + standalone_httpd --port 8080 + + # runs other PSGI server on port 8080 + rt-server --server Starman --port 8080 diff --git a/rt/sbin/rt-server.in b/rt/sbin/rt-server.in index bf6da6e58..45c377088 100644 --- a/rt/sbin/rt-server.in +++ b/rt/sbin/rt-server.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -51,6 +51,12 @@ use strict; # fix lib paths, some may be relative BEGIN { + die <<EOT if ${^TAINT}; +RT does not run under Perl's "taint mode". Remove -T from the command +line, or remove the PerlTaintCheck parameter from your mod_perl +configuration. +EOT + require File::Spec; my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@"); my $bin_path; @@ -74,16 +80,19 @@ BEGIN { } -use RT; -RT::LoadConfig(); -RT->InitLogging(); -if (RT->Config->Get('DevelMode')) { require Module::Refresh; } - -RT::CheckPerlRequirements(); -RT->InitPluginPaths(); +use Getopt::Long; +no warnings 'once'; -my $port = shift @ARGV || RT->Config->Get('WebPort') || '8080'; +if (grep { m/help/ } @ARGV) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} +require RT; +RT->LoadConfig(); +RT->InitLogging(); +require Module::Refresh if RT->Config->Get('DevelMode'); require RT::Handle; my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; @@ -107,7 +116,9 @@ EOF require RT::Installer; # don't enter install mode if the file exists but is unwritable if (-e RT::Installer->ConfigFile && !-w _) { - die "Since your configuration exists but is not writable, I'm refusing to do anything.\n"; + die 'Since your configuration exists (' + . RT::Installer->ConfigFile + . ") but is not writable, I'm refusing to do anything.\n"; } RT->Config->Set( 'LexiconLanguages' => '*' ); @@ -115,15 +126,158 @@ EOF RT->InstallMode(1); } else { - RT->ConnectToDatabase(); - RT->InitSystemObjects(); - RT->InitClasses(); - RT->InitPlugins(); + RT->Init(); + + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post'); + unless ( $status ) { + print STDERR $msg, "\n\n"; + exit -1; + } +} + +# we must disconnect DB before fork +if ($RT::Handle) { + $RT::Handle->dbh(undef); + undef $RT::Handle; +} + +require RT::Interface::Web::Handler; +my $app = RT::Interface::Web::Handler->PSGIApp; + +if ($ENV{RT_TESTING}) { + my $screen_logger = $RT::Logger->remove('screen'); + require Log::Dispatch::Perl; + $RT::Logger->add( + Log::Dispatch::Perl->new( + name => 'rttest', + min_level => $screen_logger->min_level, + action => { + error => 'warn', + critical => 'warn' + } + ) + ); + require Plack::Middleware::Test::StashWarnings; + $app = Plack::Middleware::Test::StashWarnings->wrap($app); +} + +# when used as a psgi file +if (caller) { + return $app; +} + + +# load appropriate server + +require Plack::Runner; + +my $is_fastcgi = $0 =~ m/fcgi$/; +my $r = Plack::Runner->new( $0 =~ 'standalone' ? ( server => 'Standalone' ) : + $is_fastcgi ? ( server => 'FCGI' ) + : (), + env => 'deployment' ); + +# figure out the port +my $port; + +# handle "rt-server 8888" for back-compat, but complain about it +if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) { + warn "Deprecated: please run $0 --port $ARGV[0] instead\n"; + unshift @ARGV, '--port'; +} + +my @args = @ARGV; + +use List::MoreUtils 'last_index'; +my $last_index = last_index { $_ eq '--port' } @args; + +my $explicit_port; + +if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) { + $explicit_port = $args[$last_index+1]; + $port = $explicit_port; + + # inform the rest of the system what port we manually chose + my $old_app = $app; + $app = sub { + my $env = shift; + + $env->{'rt.explicit_port'} = $port; + + $old_app->($env, @_); + }; +} +else { + # default to the configured WebPort and inform Plack::Runner + $port = RT->Config->Get('WebPort') || '8080'; + push @args, '--port', $port; +} + +push @args, '--server', 'Standalone' if RT->InstallMode; +push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args; + +$r->parse_options(@args); + +delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything + +unless ($r->{env} eq 'development') { + push @{$r->{options}}, server_ready => sub { + my($args) = @_; + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }; +} +eval { $r->run($app) }; +if (my $err = $@) { + handle_startup_error($err); +} + +exit 0; + +sub handle_startup_error { + my $err = shift; + if ( $err =~ /listen/ ) { + handle_bind_error(); + } else { + die + "Something went wrong while trying to run RT's standalone web server:\n\t" + . $err; + } } -require RT::Interface::Web::Standalone; -my $server = RT::Interface::Web::Standalone->new; -$server->net_server('RT::Interface::Web::Standalone::PreFork'); -$server->port($port); -$server->run(); +sub handle_bind_error { + + print STDERR <<EOF; +WARNING: RT couldn't start up a web server on port @{[$port]}. +This is often the case if the port is already in use or you're running @{[$0]} +as someone other than your system's "root" user. You may also specify a +temporary port with: $0 --port <port> +EOF + + if ($explicit_port) { + print STDERR + "Please check your system configuration or choose another port\n\n"; + } +} + +__END__ + +=head1 NAME + +rt-server - RT standalone server + +=head1 SYNOPSIS + + # runs prefork server listening on port 8080, requires Starlet + rt-server --port 8080 + + # runs server listening on port 8080 + rt-server --server Standalone --port 8080 + # or + standalone_httpd --port 8080 + + # runs other PSGI server on port 8080 + rt-server --server Starman --port 8080 diff --git a/rt/sbin/rt-session-viewer b/rt/sbin/rt-session-viewer index 4a9cf09aa..4a9cf09aa 100644..100755 --- a/rt/sbin/rt-session-viewer +++ b/rt/sbin/rt-session-viewer diff --git a/rt/sbin/rt-setup-database.in b/rt/sbin/rt-setup-database.in index 125708847..2efb9f329 100644 --- a/rt/sbin/rt-setup-database.in +++ b/rt/sbin/rt-setup-database.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -76,34 +76,57 @@ BEGIN { } -#This drags in RT's config.pm -# We do it in a begin block because RT::Handle needs to know the type to do its -# inheritance -BEGIN { - use RT; - RT::LoadConfig(); - RT::InitClasses(); -} - use Term::ReadKey; use Getopt::Long; $| = 1; # unbuffer all output. -my %args; +my %args = ( + dba => '@DB_DBA@', +); GetOptions( \%args, 'action=s', 'force', 'debug', 'dba=s', 'dba-password=s', 'prompt-for-dba-password', - 'datafile=s', 'datadir=s' + 'datafile=s', 'datadir=s', 'skip-create', 'root-password-file=s', + 'help|h', ); -unless ( $args{'action'} ) { - help(); - exit(-1); +no warnings 'once'; +if ( $args{help} || ! $args{'action'} ) { + require Pod::Usage; + Pod::Usage::pod2usage({ verbose => 2 }); + exit; +} + +require RT; +RT->LoadConfig(); +RT->InitClasses(); + +# Force warnings to be output to STDERR if we're not already logging +# them at a higher level +RT->Config->Set( LogToScreen => 'warning') + unless ( RT->Config->Get( 'LogToScreen' ) + && RT->Config->Get( 'LogToScreen' ) =~ /^(debug|info|notice)$/ ); + +# get customized root password +my $root_password; +if ( $args{'root-password-file'} ) { + open( my $fh, '<', $args{'root-password-file'} ) + or die "Couldn't open 'args{'root-password-file'}' for reading: $!"; + $root_password = <$fh>; + chomp $root_password; + my $min_length = RT->Config->Get('MinimumPasswordLength'); + if ($min_length) { + die +"password needs to be at least $min_length long, please check file '$args{'root-password-file'}'" + if length $root_password < $min_length; + } + close $fh; } + # check and setup @actions my @actions = grep $_, split /,/, $args{'action'}; if ( @actions > 1 && $args{'datafile'} ) { @@ -124,7 +147,11 @@ foreach ( @actions ) { # convert init to multiple actions my $init = 0; if ( $actions[0] eq 'init' ) { - @actions = qw(create schema acl coredata insert); + if ($args{'skip-create'}) { + @actions = qw(schema coredata insert); + } else { + @actions = qw(create schema acl coredata insert); + } $init = 1; } @@ -154,20 +181,25 @@ my $dba_pass = exists($args{'dba-password'}) ? $args{'dba-password'} : $ENV{'RT_DBA_PASSWORD'}; -if ( !$args{force} && ( !defined $dba_pass || $args{'prompt-for-dba-password'} ) ) { - $dba_pass = get_dba_password(); - chomp $dba_pass if defined($dba_pass); +if ($args{'skip-create'}) { + $dba_user = $db_user; + $dba_pass = $db_pass; +} else { + if ( !$args{force} && ( !defined $dba_pass || $args{'prompt-for-dba-password'} ) ) { + $dba_pass = get_dba_password(); + chomp $dba_pass if defined($dba_pass); + } } print "Working with:\n" ."Type:\t$db_type\nHost:\t$db_host\nName:\t$db_name\n" - ."User:\t$db_user\nDBA:\t$dba_user\n"; + ."User:\t$db_user\nDBA:\t$dba_user" . ($args{'skip-create'} ? ' (No DBA)' : '') . "\n"; foreach my $action ( @actions ) { no strict 'refs'; my ($status, $msg) = *{ 'action_'. $action }{'CODE'}->( %args ); error($action, $msg) unless $status; - print $msg ."\n" if $msg; + print $msg .".\n" if $msg; print "Done.\n"; } @@ -215,35 +247,59 @@ sub action_acl { my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'pre' ); return ($status, $msg) unless $status; - print "Now inserting database ACLs\n"; + print "Now inserting database ACLs.\n"; return RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} ); } sub action_coredata { my %args = @_; - $RT::Handle = new RT::Handle; + $RT::Handle = RT::Handle->new; $RT::Handle->dbh( undef ); RT::ConnectToDatabase(); RT::InitLogging(); my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'pre' ); return ($status, $msg) unless $status; - print "Now inserting RT core system objects\n"; + print "Now inserting RT core system objects.\n"; return $RT::Handle->InsertInitialData; } sub action_insert { my %args = @_; - $RT::Handle = new RT::Handle; + $RT::Handle = RT::Handle->new; RT::Init(); my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'pre' ); return ($status, $msg) unless $status; - print "Now inserting data\n"; + print "Now inserting data.\n"; my $file = $args{'datafile'}; $file = $RT::EtcPath . "/initialdata" if $init && !$file; $file ||= $args{'datadir'}."/content"; - return $RT::Handle->InsertData( $file ); + + # Slurp in backcompat + my %removed; + my @back = @{$args{backcompat} || []}; + if (@back) { + my @lines = do {local @ARGV = @back; <>}; + for (@lines) { + s/\#.*//; + next unless /\S/; + my ($class, @fields) = split; + $class->_BuildTableAttributes; + $RT::Logger->debug("Temporarily removing @fields from $class"); + $removed{$class}{$_} = delete $RT::Record::_TABLE_ATTR->{$class}{$_} + for @fields; + } + } + + my @ret = $RT::Handle->InsertData( $file, $root_password ); + + # Put back the fields we chopped off + for my $class (keys %removed) { + $RT::Record::_TABLE_ATTR->{$class}{$_} = $removed{$class}{$_} + for keys %{$removed{$class}}; + } + return @ret; } sub action_upgrade { @@ -262,7 +318,7 @@ sub action_upgrade { $upgrading_from = scalar <STDIN>; chomp $upgrading_from; $upgrading_from =~ s/\s+//g; - } while $upgrading_from !~ /^\d+\.\d+\.\d+$/; + } while $upgrading_from !~ /^\d+\.\d+\.\w+$/; my $upgrading_to = $RT::VERSION; return (0, "The current version $upgrading_to is lower than $upgrading_from") @@ -271,11 +327,16 @@ sub action_upgrade { return (1, "The version $upgrading_to you're upgrading to is up to date") if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) == 0; - my @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to); - - return (1, "No DB changes between $upgrading_from and $upgrading_to") + my @versions = get_versions_from_to($base_dir, $upgrading_from, undef); + return (1, "No DB changes since $upgrading_from") unless @versions; + if (RT::Handle::cmp_version($versions[-1], $upgrading_to) > 0) { + print "\n***** There are upgrades for $versions[-1], which is later than $upgrading_to,\n"; + print "***** which you are nominally upgrading to. Upgrading to $versions[-1] instead.\n"; + $upgrading_to = $versions[-1]; + } + print "\nGoing to apply following upgrades:\n"; print map "* $_\n", @versions; @@ -292,7 +353,7 @@ sub action_upgrade { chomp $custom_upgrading_to; $custom_upgrading_to =~ s/\s+//g; last unless $custom_upgrading_to; - } while $custom_upgrading_to !~ /^\d+\.\d+\.\d+$/; + } while $custom_upgrading_to !~ /^\d+\.\d+\.\w+$/; if ( $custom_upgrading_to ) { return ( @@ -322,17 +383,23 @@ sub action_upgrade { print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n"; _yesno() or exit(-2) unless $args{'force'}; - foreach my $v ( @versions ) { + my ( $ret, $msg ); + foreach my $n ( 0..$#versions ) { + my $v = $versions[$n]; + my @back = grep {-e $_} map {"$base_dir/$versions[$_]/backcompat"} $n+1..$#versions; print "Processing $v\n"; - my %tmp = (%args, datadir => "$base_dir/$v", datafile => undef); + my %tmp = (%args, datadir => "$base_dir/$v", datafile => undef, backcompat => \@back); if ( -e "$base_dir/$v/schema.$db_type" ) { - action_schema( %tmp ); + ( $ret, $msg ) = action_schema( %tmp ); + return ( $ret, $msg ) unless $ret; } if ( -e "$base_dir/$v/acl.$db_type" ) { - action_acl( %tmp ); + ( $ret, $msg ) = action_acl( %tmp ); + return ( $ret, $msg ) unless $ret; } if ( -e "$base_dir/$v/content" ) { - action_insert( %tmp ); + ( $ret, $msg ) = action_insert( %tmp ); + return ( $ret, $msg ) unless $ret; } } return 1; @@ -346,7 +413,7 @@ sub get_versions_from_to { closedir $dh; return - grep RT::Handle::cmp_version($_, $to) <= 0, + grep defined $to ? RT::Handle::cmp_version($_, $to) <= 0 : 1, grep RT::Handle::cmp_version($_, $from) > 0, sort RT::Handle::cmp_version @versions; } @@ -372,13 +439,10 @@ sub get_dba_password { return ($password); } -=head2 get_system_dbh - -Returns L<DBI> database handle connected to B<system> with DBA credentials. +# get_system_dbh +# Returns L<DBI> database handle connected to B<system> with DBA credentials. +# See also L<RT::Handle/SystemDSN>. -See also L<RT::Handle/SystemDSN>. - -=cut sub get_system_dbh { return _get_dbh( RT::Handle->SystemDSN, $dba_user, $dba_pass ); @@ -388,13 +452,11 @@ sub get_admin_dbh { return _get_dbh( RT::Handle->DSN, $dba_user, $dba_pass ); } -=head2 get_rt_dbh [USER, PASSWORD] - -Returns L<DBI> database handle connected to RT database, -you may specify credentials(USER and PASSWORD) to connect -with. By default connects with credentials from RT config. +# get_rt_dbh [USER, PASSWORD] -=cut +# Returns L<DBI> database handle connected to RT database, +# you may specify credentials(USER and PASSWORD) to connect +# with. By default connects with credentials from RT config. sub get_rt_dbh { return _get_dbh( RT::Handle->DSN, $db_user, $db_pass ); @@ -423,54 +485,106 @@ sub _yesno { $x =~ /^y/i; } -sub help { +1; - print <<EOF; +__END__ -$0: Set up RT's database +=head1 NAME ---action init Initialize the database. This is combination of - multiple actions listed below. Create DB, schema, - setup acl, insert core data and initial data. +rt-setup-database - Set up RT's database - upgrade Apply all needed schema/acl/content updates (will ask - for version to upgrade from) +=head1 SYNOPSIS - create Create the database. + rt-setup-database --action ... - drop Drop the database. - This will ERASE ALL YOUR DATA +=head1 OPTIONS - schema Initialize only the database schema - To use a local or supplementary datafile, specify it - using the '--datadir' option below. +=over - acl Initialize only the database ACLs - To use a local or supplementary datafile, specify it - using the '--datadir' option below. +=item action - coredata Insert data into RT's database. This data is required - for normal functioning of any RT instance. +Several actions can be combined using comma separated list. - insert Insert data into RT's database. - By default, will use RT's installation data. - To use a local or supplementary datafile, specify it - using the '--datafile' option below. +=over -Several actions can be combined using comma separated list. +=item init ---datafile /path/to/datafile ---datadir /path/to/ Used to specify a path to find the local - database schema and acls to be installed. +Initialize the database. This is combination of multiple actions listed below. +Create DB, schema, setup acl, insert core data and initial data. +=item upgrade ---dba dba's username ---dba-password dba's password ---prompt-for-dba-password Ask for the database administrator's password interactively +Apply all needed schema/acl/content updates (will ask for version to upgrade +from) +=item create -EOF +Create the database. -} +=item drop -1; +Drop the database. This will B<ERASE ALL YOUR DATA>. + +=item schema + +Initialize only the database schema + +To use a local or supplementary datafile, specify it using the '--datadir' +option below. + +=item acl + +Initialize only the database ACLs + +To use a local or supplementary datafile, specify it using the '--datadir' +option below. + +=item coredata + +Insert data into RT's database. This data is required for normal functioning of +any RT instance. + +=item insert + +Insert data into RT's database. By default, will use RT's installation data. +To use a local or supplementary datafile, specify it using the '--datafile' +option below. + +=back + +=item datafile + +file path of the data you want to action on + +e.g. C<--datafile /path/to/datafile> + +=item datadir + +Used to specify a path to find the local database schema and acls to be +installed. + +e.g. C<--datadir /path/to/> + +=item dba + +dba's username + +=item dba-password + +dba's password + +=item prompt-for-dba-password + +Ask for the database administrator's password interactively + +=item skip-create + +for 'init': skip creating the database and the user account, so we don't need +administrator privileges + +=item root-password-file + +for 'init' and 'insert': rather than using the default administrative password +for RT's "root" user, use the password in this file. + +=back diff --git a/rt/sbin/rt-setup-fulltext-index b/rt/sbin/rt-setup-fulltext-index new file mode 100755 index 000000000..862581544 --- /dev/null +++ b/rt/sbin/rt-setup-fulltext-index @@ -0,0 +1,714 @@ +#!/usr/bin/perl +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; +use warnings; +no warnings 'once'; + +# fix lib paths, some may be relative +BEGIN { + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } +} + +BEGIN { + use RT; + RT::LoadConfig(); + RT::Init(); +}; +use RT::Interface::CLI (); + +my %DB = ( + type => scalar RT->Config->Get('DatabaseType'), + user => scalar RT->Config->Get('DatabaseUser'), + admin => 'freeside', + admin_password => undef, +); + +my %OPT = ( + help => 0, + ask => 1, + dryrun => 0, + attachments => 1, +); + +my %DEFAULT; +if ( $DB{'type'} eq 'Pg' ) { + %DEFAULT = ( + table => 'Attachments', + column => 'ContentIndex', + ); +} +elsif ( $DB{'type'} eq 'mysql' ) { + %DEFAULT = ( + table => 'AttachmentsIndex', + ); +} +elsif ( $DB{'type'} eq 'Oracle' ) { + %DEFAULT = ( + prefix => 'rt_fts_', + ); +} + +use Getopt::Long qw(GetOptions); +GetOptions( + 'h|help!' => \$OPT{'help'}, + 'ask!' => \$OPT{'ask'}, + 'dry-run!' => \$OPT{'dryrun'}, + 'attachments!' => \$OPT{'attachments'}, + + 'table=s' => \$OPT{'table'}, + 'column=s' => \$OPT{'column'}, + 'url=s' => \$OPT{'url'}, + 'maxmatches=i' => \$OPT{'maxmatches'}, + 'index-type=s' => \$OPT{'index-type'}, + + 'dba=s' => \$DB{'admin'}, + 'dba-password=s' => \$DB{'admin_password'}, +) or show_help(); + +if ( $OPT{'help'} || (!$DB{'admin'} && $DB{'type'} eq 'Oracle' ) ) { + show_help( !$OPT{'help'} ); +} + +my $dbh = $RT::Handle->dbh; +$dbh->{'RaiseError'} = 1; +$dbh->{'PrintError'} = 1; + +if ( $DB{'type'} eq 'mysql' ) { + check_sphinx(); + my $table = $OPT{'table'} || prompt( + message => "Enter name of a new MySQL table that will be used to connect to the\n" + . "Sphinx server:", + default => $DEFAULT{'table'}, + silent => !$OPT{'ask'}, + ); + my $url = $OPT{'url'} || prompt( + message => "Enter URL of the sphinx search server; this should be of the form\n" + . "sphinx://<server>:<port>/<index name>", + default => 'sphinx://localhost:3312/rt', + silent => !$OPT{'ask'}, + ); + my $maxmatches = $OPT{'maxmatches'} || prompt( + message => "Maximum number of matches to return; this is the maximum number of\n" + . "attachment records returned by the search, not the maximum number\n" + . "of tickets. Both your RT_SiteConfig.pm and your sphinx.conf must\n" + . "agree on this value. Larger values cause your Sphinx server to\n" + . "consume more memory and CPU time per query.", + default => 10000, + silent => !$OPT{'ask'}, + ); + + my $schema = <<END; +CREATE TABLE $table ( + id INTEGER UNSIGNED NOT NULL, + weight INTEGER NOT NULL, + query VARCHAR(3072) NOT NULL, + INDEX(query) +) ENGINE=SPHINX CONNECTION="$url" CHARACTER SET utf8 +END + + do_error_is_ok( dba_handle() => "DROP TABLE $table" ) + unless $OPT{'dryrun'}; + insert_schema( $schema ); + + print_rt_config( Table => $table, MaxMatches => $maxmatches ); + + require URI; + my $urlo = URI->new( $url ); + my ($host, $port) = split /:/, $urlo->authority; + my $index = $urlo->path; + $index =~ s{^/+}{}; + + my $var_path = $RT::VarPath; + + my %sphinx_conf = (); + $sphinx_conf{'host'} = RT->Config->Get('DatabaseHost'); + $sphinx_conf{'db'} = RT->Config->Get('DatabaseName'); + $sphinx_conf{'user'} = RT->Config->Get('DatabaseUser'); + $sphinx_conf{'pass'} = RT->Config->Get('DatabasePassword'); + + print <<END + +Below is a simple Sphinx configuration which can be used to index all +text/plain attachments in your database. This configuration is not +ideal; you should read the Sphinx documentation to understand how to +configure it to better suit your needs. + +source rt { + type = mysql + + sql_host = $sphinx_conf{'host'} + sql_db = $sphinx_conf{'db'} + sql_user = $sphinx_conf{'user'} + sql_pass = $sphinx_conf{'pass'} + + sql_query_pre = SET NAMES utf8 + sql_query = \\ + SELECT a.id, a.content FROM Attachments a \\ + JOIN Transactions txn ON a.TransactionId = txn.id AND txn.ObjectType = 'RT::Ticket' \\ + JOIN Tickets t ON txn.ObjectId = t.id \\ + WHERE a.ContentType = 'text/plain' AND t.Status != 'deleted' + + sql_query_info = SELECT * FROM Attachments WHERE id=\$id +} + +index $index { + source = rt + path = $var_path/sphinx/index + docinfo = extern + charset_type = utf-8 +} + +indexer { + mem_limit = 32M +} + +searchd { + port = $port + log = $var_path/sphinx/searchd.log + query_log = $var_path/sphinx/query.log + read_timeout = 5 + max_children = 30 + pid_file = $var_path/sphinx/searchd.pid + max_matches = $maxmatches + seamless_rotate = 1 + preopen_indexes = 0 + unlink_old = 1 +} + +END + +} +elsif ( $DB{'type'} eq 'Pg' ) { + check_tsvalue(); + my $table = $OPT{'table'} || prompt( + message => "Enter the name of a DB table that will be used to store the Pg tsvector.\n" + . "You may either use the existing Attachments table, or create a new\n" + . "table.", + default => $DEFAULT{'table'}, + silent => !$OPT{'ask'}, + ); + my $column = $OPT{'column'} || prompt( + message => 'Enter the name of a column that will be used to store the Pg tsvector:', + default => $DEFAULT{'column'}, + silent => !$OPT{'ask'}, + ); + + my $schema; + my $drop; + if ( lc($table) eq 'attachments' ) { + $drop = "ALTER TABLE $table DROP COLUMN $column"; + $schema = "ALTER TABLE $table ADD COLUMN $column tsvector"; + } else { + $drop = "DROP TABLE $table"; + $schema = "CREATE TABLE $table ( " + ."id INTEGER NOT NULL," + ."$column tsvector )"; + } + + my $index_type = lc($OPT{'index-type'} || ''); + while ( $index_type ne 'gist' and $index_type ne 'gin' ) { + $index_type = lc prompt( + message => "You may choose between GiST or GIN indexes; the former is several times\n" + . "slower to search, but takes less space on disk and is faster to update.", + default => 'GiST', + silent => !$OPT{'ask'}, + ); + } + + do_error_is_ok( dba_handle() => $drop ) + unless $OPT{'dryrun'}; + insert_schema( $schema ); + insert_schema("CREATE INDEX ${column}_idx ON $table USING $index_type($column)"); + + print_rt_config( Table => $table, Column => $column ); +} +elsif ( $DB{'type'} eq 'Oracle' ) { + { + my $dbah = dba_handle(); + do_print_error( $dbah => 'GRANT CTXAPP TO '. $DB{'user'} ); + do_print_error( $dbah => 'GRANT EXECUTE ON CTXSYS.CTX_DDL TO '. $DB{'user'} ); + } + + my %PREFERENCES = ( + datastore => { + type => 'DIRECT_DATASTORE', + }, + filter => { + type => 'AUTO_FILTER', +# attributes => { +# timeout => 120, # seconds +# timeout_type => 'HEURISTIC', # or 'FIXED' +# }, + }, + lexer => { + type => 'WORLD_LEXER', + }, + word_list => { + type => 'BASIC_WORDLIST', + attributes => { + stemmer => 'AUTO', + fuzzy_match => 'AUTO', +# fuzzy_score => undef, +# fuzzy_numresults => undef, +# substring_index => undef, +# prefix_index => undef, +# prefix_length_min => undef, +# prefix_length_max => undef, +# wlidcard_maxterms => undef, + }, + }, + 'section_group' => { + type => 'NULL_SECTION_GROUP', + }, + + storage => { + type => 'BASIC_STORAGE', + attributes => { + R_TABLE_CLAUSE => 'lob (data) store as (cache)', + I_INDEX_CLAUSE => 'compress 2', + }, + }, + ); + + my @params = (); + push @params, ora_create_datastore( %{ $PREFERENCES{'datastore'} } ); + push @params, ora_create_filter( %{ $PREFERENCES{'filter'} } ); + push @params, ora_create_lexer( %{ $PREFERENCES{'lexer'} } ); + push @params, ora_create_word_list( %{ $PREFERENCES{'word_list'} } ); + push @params, ora_create_stop_list(); + push @params, ora_create_section_group( %{ $PREFERENCES{'section_group'} } ); + push @params, ora_create_storage( %{ $PREFERENCES{'storage'} } ); + + my $index_params = join "\n", @params; + my $index_name = $DEFAULT{prefix} .'index'; + do_error_is_ok( $dbh => "DROP INDEX $index_name" ) + unless $OPT{'dryrun'}; + $dbh->do( + "CREATE INDEX $index_name ON Attachments(Content) + indextype is ctxsys.context parameters(' + $index_params + ')", + ) unless $OPT{'dryrun'}; + + print_rt_config( IndexName => $index_name ); +} +else { + die "Full-text indexes on $DB{type} are not yet supported"; +} + +sub check_tsvalue { + my $dbh = $RT::Handle->dbh; + my $fts = ($dbh->selectrow_array(<<EOQ))[0]; +SELECT 1 FROM information_schema.routines WHERE routine_name = 'plainto_tsquery' +EOQ + unless ($fts) { + print STDERR <<EOT; + +Your PostgreSQL server does not include full-text support. You will +need to upgrade to PostgreSQL version 8.3 or higher to use full-text +indexing. + +EOT + exit 1; + } +} + +sub check_sphinx { + return if $RT::Handle->CheckSphinxSE; + + print STDERR <<EOT; + +Your MySQL server has not been compiled with the Sphinx storage engine +(sphinxse). You will need to recompile MySQL according to the +instructions in Sphinx's documentation at +http://sphinxsearch.com/docs/current.html#sphinxse-installing + +EOT + exit 1; +} + +sub ora_create_datastore { + return sprintf 'datastore %s', ora_create_preference( + @_, + name => 'datastore', + ); +} + +sub ora_create_filter { + my $res = ''; + $res .= sprintf "format column %s\n", ora_create_format_column(); + $res .= sprintf 'filter %s', ora_create_preference( + @_, + name => 'filter', + ); + return $res; +} + +sub ora_create_lexer { + return sprintf 'lexer %s', ora_create_preference( + @_, + name => 'lexer', + ); +} + +sub ora_create_word_list { + return sprintf 'wordlist %s', ora_create_preference( + @_, + name => 'word_list', + ); +} + +sub ora_create_stop_list { + my $file = shift || 'etc/stopwords/en.txt'; + return '' unless -e $file; + + my $name = $DEFAULT{'prefix'} .'stop_list'; + unless ($OPT{'dryrun'}) { + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_stoplist(?); end;', $name ); + + $dbh->do( + 'begin ctx_ddl.create_stoplist(?, ?); end;', + undef, $name, 'BASIC_STOPLIST' + ); + + open( my $fh, '<:utf8', $file ) + or die "couldn't open file '$file': $!"; + while ( my $word = <$fh> ) { + chomp $word; + $dbh->do( + 'begin ctx_ddl.add_stopword(?, ?); end;', + undef, $name, $word + ); + } + close $fh; + } + return sprintf 'stoplist %s', $name; +} + +sub ora_create_section_group { + my %args = @_; + my $name = $DEFAULT{'prefix'} .'section_group'; + unless ($OPT{'dryrun'}) { + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_section_group(?); end;', $name ); + $dbh->do( + 'begin ctx_ddl.create_section_group(?, ?); end;', + undef, $name, $args{'type'} + ); + } + return sprintf 'section group %s', $name; +} + +sub ora_create_storage { + return sprintf 'storage %s', ora_create_preference( + @_, + name => 'storage', + ); +} + +sub ora_create_format_column { + my $column_name = 'ContentOracleFormat'; + return $column_name if $OPT{'dryrun'}; + unless ( + $dbh->column_info( + undef, undef, uc('Attachments'), uc( $column_name ) + )->fetchrow_array + ) { + $dbh->do(qq{ + ALTER TABLE Attachments ADD $column_name VARCHAR2(10) + }); + } + + my $detect_format = qq{ + CREATE OR REPLACE FUNCTION $DEFAULT{prefix}detect_format_simple( + parent IN NUMBER, + type IN VARCHAR2, + encoding IN VARCHAR2, + fname IN VARCHAR2 + ) + RETURN VARCHAR2 + AS + format VARCHAR2(10); + BEGIN + format := CASE + }; + unless ( $OPT{'attachments'} ) { + $detect_format .= qq{ + WHEN fname IS NOT NULL THEN 'ignore' + }; + } + $detect_format .= qq{ + WHEN type = 'text' THEN 'text' + WHEN type = 'text/rtf' THEN 'ignore' + WHEN type LIKE 'text/%' THEN 'text' + WHEN type LIKE 'message/%' THEN 'text' + ELSE 'ignore' + END; + RETURN format; + END; + }; + ora_create_procedure( $detect_format ); + + $dbh->do(qq{ + UPDATE Attachments + SET $column_name = $DEFAULT{prefix}detect_format_simple( + Parent, + ContentType, ContentEncoding, + Filename + ) + WHERE $column_name IS NULL + }); + $dbh->do(qq{ + CREATE OR REPLACE TRIGGER $DEFAULT{prefix}set_format + BEFORE INSERT + ON Attachments + FOR EACH ROW + BEGIN + :new.$column_name := $DEFAULT{prefix}detect_format_simple( + :new.Parent, + :new.ContentType, :new.ContentEncoding, + :new.Filename + ); + END; + }); + return $column_name; +} + +sub ora_create_preference { + my %info = @_; + my $name = $DEFAULT{'prefix'} . $info{'name'}; + return $name if $OPT{'dryrun'}; + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_preference(?); end;', $name ); + $dbh->do( + 'begin ctx_ddl.create_preference(?, ?); end;', + undef, $name, $info{'type'} + ); + return $name unless $info{'attributes'}; + + while ( my ($attr, $value) = each %{ $info{'attributes'} } ) { + $dbh->do( + 'begin ctx_ddl.set_attribute(?, ?, ?); end;', + undef, $name, $attr, $value + ); + } + + return $name; +} + +sub ora_create_procedure { + my $text = shift; + + return if $OPT{'dryrun'}; + my $status = $dbh->do($text, { RaiseError => 0 }); + + # Statement succeeded + return if $status; + + if ( 6550 != $dbh->err ) { + # Utter failure + die $dbh->errstr; + } + else { + my $msg = $dbh->func( 'plsql_errstr' ); + die $dbh->errstr if !defined $msg; + die $msg if $msg; + } +} + +sub dba_handle { + if ( $DB{'type'} eq 'Oracle' ) { + $ENV{'NLS_LANG'} = "AMERICAN_AMERICA.AL32UTF8"; + $ENV{'NLS_NCHAR'} = "AL32UTF8"; + } + my $dsn = do { my $h = new RT::Handle; $h->BuildDSN; $h->DSN }; + my $dbh = DBI->connect( + $dsn, $DB{admin}, $DB{admin_password}, + { RaiseError => 1, PrintError => 1 }, + ); + unless ( $dbh ) { + die "Failed to connect to $dsn as user '$DB{admin}': ". $DBI::errstr; + } + return $dbh; +} + +sub do_error_is_ok { + my $dbh = shift; + local $dbh->{'RaiseError'} = 0; + local $dbh->{'PrintError'} = 0; + return $dbh->do(shift, undef, @_); +} + +sub do_print_error { + my $dbh = shift; + local $dbh->{'RaiseError'} = 0; + local $dbh->{'PrintError'} = 1; + return $dbh->do(shift, undef, @_); +} + +sub prompt { + my %args = ( @_ ); + return $args{'default'} if $args{'silent'}; + + local $| = 1; + print $args{'message'}; + if ( $args{'default'} ) { + print "\n[". $args{'default'} .']: '; + } else { + print ":\n"; + } + + my $res = <STDIN>; + chomp $res; + print "\n"; + return $args{'default'} if !$res && $args{'default'}; + return $res; +} + +sub verbose { print @_, "\n" if $OPT{verbose} || $OPT{verbose}; 1 } +sub debug { print @_, "\n" if $OPT{debug}; 1 } +sub error { $RT::Logger->error( @_ ); verbose(@_); 1 } +sub warning { $RT::Logger->warning( @_ ); verbose(@_); 1 } + +sub show_help { + my $error = shift; + RT::Interface::CLI->ShowHelp( + ExitValue => $error, + Sections => 'NAME|DESCRIPTION', + ); +} + +sub print_rt_config { + my %args = @_; + my $config = <<END; + +You can now configure RT to use the newly-created full-text index by +adding the following to your RT_SiteConfig.pm: + +Set( %FullTextSearch, + Enable => 1, + Indexed => 1, +END + + $config .= sprintf(" %-10s => '$args{$_}',\n",$_) + foreach grep defined $args{$_}, keys %args; + $config .= ");\n"; + + print $config; +} + +sub insert_schema { + my $dbh = dba_handle(); + my $message = "Going to run the following in the DB:"; + my $schema = shift; + print "$message\n"; + my $disp = $schema; + $disp =~ s/^/ /mg; + print "$disp\n\n"; + return if $OPT{'dryrun'}; + + my $res = $dbh->do( $schema ); + unless ( $res ) { + die "Couldn't run DDL query: ". $dbh->errstr; + } +} + +=head1 NAME + +rt-setup-fulltext-index - Create indexes for full text search + +=head1 DESCRIPTION + +This script creates the appropriate tables, columns, functions, and / or +views necessary for full-text searching for your database type. It will +drop any existing indexes in the process. + +Please read F<docs/full_text_indexing.pod> for complete documentation on +full-text indexing for your database type. + +If you have a non-standard database administrator user or password, you +may use the C<--dba> and C<--dba-password> parameters to set them +explicitly: + + rt-setup-fulltext-index --dba sysdba --dba-password 'secret' + +To test what will happen without running any DDL, pass the C<--dryrun> +flag. + +The Oracle index determines which content-types it will index at +creation time. By default, textual message bodies and textual uploaded +attachments (attachments with filenames) are indexed; to ignore textual +attachments, pass the C<--no-attachments> flag when the index is +created. + + +=head1 AUTHOR + +Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>, +Alex Vandiver E<lt>alexmv@bestpractical.comE<gt> + +=cut + diff --git a/rt/sbin/rt-setup-fulltext-index.in b/rt/sbin/rt-setup-fulltext-index.in new file mode 100644 index 000000000..da8089d94 --- /dev/null +++ b/rt/sbin/rt-setup-fulltext-index.in @@ -0,0 +1,714 @@ +#!@PERL@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use strict; +use warnings; +no warnings 'once'; + +# 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; + } +} + +BEGIN { + use RT; + RT::LoadConfig(); + RT::Init(); +}; +use RT::Interface::CLI (); + +my %DB = ( + type => scalar RT->Config->Get('DatabaseType'), + user => scalar RT->Config->Get('DatabaseUser'), + admin => '@DB_DBA@', + admin_password => undef, +); + +my %OPT = ( + help => 0, + ask => 1, + dryrun => 0, + attachments => 1, +); + +my %DEFAULT; +if ( $DB{'type'} eq 'Pg' ) { + %DEFAULT = ( + table => 'Attachments', + column => 'ContentIndex', + ); +} +elsif ( $DB{'type'} eq 'mysql' ) { + %DEFAULT = ( + table => 'AttachmentsIndex', + ); +} +elsif ( $DB{'type'} eq 'Oracle' ) { + %DEFAULT = ( + prefix => 'rt_fts_', + ); +} + +use Getopt::Long qw(GetOptions); +GetOptions( + 'h|help!' => \$OPT{'help'}, + 'ask!' => \$OPT{'ask'}, + 'dry-run!' => \$OPT{'dryrun'}, + 'attachments!' => \$OPT{'attachments'}, + + 'table=s' => \$OPT{'table'}, + 'column=s' => \$OPT{'column'}, + 'url=s' => \$OPT{'url'}, + 'maxmatches=i' => \$OPT{'maxmatches'}, + 'index-type=s' => \$OPT{'index-type'}, + + 'dba=s' => \$DB{'admin'}, + 'dba-password=s' => \$DB{'admin_password'}, +) or show_help(); + +if ( $OPT{'help'} || (!$DB{'admin'} && $DB{'type'} eq 'Oracle' ) ) { + show_help( !$OPT{'help'} ); +} + +my $dbh = $RT::Handle->dbh; +$dbh->{'RaiseError'} = 1; +$dbh->{'PrintError'} = 1; + +if ( $DB{'type'} eq 'mysql' ) { + check_sphinx(); + my $table = $OPT{'table'} || prompt( + message => "Enter name of a new MySQL table that will be used to connect to the\n" + . "Sphinx server:", + default => $DEFAULT{'table'}, + silent => !$OPT{'ask'}, + ); + my $url = $OPT{'url'} || prompt( + message => "Enter URL of the sphinx search server; this should be of the form\n" + . "sphinx://<server>:<port>/<index name>", + default => 'sphinx://localhost:3312/rt', + silent => !$OPT{'ask'}, + ); + my $maxmatches = $OPT{'maxmatches'} || prompt( + message => "Maximum number of matches to return; this is the maximum number of\n" + . "attachment records returned by the search, not the maximum number\n" + . "of tickets. Both your RT_SiteConfig.pm and your sphinx.conf must\n" + . "agree on this value. Larger values cause your Sphinx server to\n" + . "consume more memory and CPU time per query.", + default => 10000, + silent => !$OPT{'ask'}, + ); + + my $schema = <<END; +CREATE TABLE $table ( + id INTEGER UNSIGNED NOT NULL, + weight INTEGER NOT NULL, + query VARCHAR(3072) NOT NULL, + INDEX(query) +) ENGINE=SPHINX CONNECTION="$url" CHARACTER SET utf8 +END + + do_error_is_ok( dba_handle() => "DROP TABLE $table" ) + unless $OPT{'dryrun'}; + insert_schema( $schema ); + + print_rt_config( Table => $table, MaxMatches => $maxmatches ); + + require URI; + my $urlo = URI->new( $url ); + my ($host, $port) = split /:/, $urlo->authority; + my $index = $urlo->path; + $index =~ s{^/+}{}; + + my $var_path = $RT::VarPath; + + my %sphinx_conf = (); + $sphinx_conf{'host'} = RT->Config->Get('DatabaseHost'); + $sphinx_conf{'db'} = RT->Config->Get('DatabaseName'); + $sphinx_conf{'user'} = RT->Config->Get('DatabaseUser'); + $sphinx_conf{'pass'} = RT->Config->Get('DatabasePassword'); + + print <<END + +Below is a simple Sphinx configuration which can be used to index all +text/plain attachments in your database. This configuration is not +ideal; you should read the Sphinx documentation to understand how to +configure it to better suit your needs. + +source rt { + type = mysql + + sql_host = $sphinx_conf{'host'} + sql_db = $sphinx_conf{'db'} + sql_user = $sphinx_conf{'user'} + sql_pass = $sphinx_conf{'pass'} + + sql_query_pre = SET NAMES utf8 + sql_query = \\ + SELECT a.id, a.content FROM Attachments a \\ + JOIN Transactions txn ON a.TransactionId = txn.id AND txn.ObjectType = 'RT::Ticket' \\ + JOIN Tickets t ON txn.ObjectId = t.id \\ + WHERE a.ContentType = 'text/plain' AND t.Status != 'deleted' + + sql_query_info = SELECT * FROM Attachments WHERE id=\$id +} + +index $index { + source = rt + path = $var_path/sphinx/index + docinfo = extern + charset_type = utf-8 +} + +indexer { + mem_limit = 32M +} + +searchd { + port = $port + log = $var_path/sphinx/searchd.log + query_log = $var_path/sphinx/query.log + read_timeout = 5 + max_children = 30 + pid_file = $var_path/sphinx/searchd.pid + max_matches = $maxmatches + seamless_rotate = 1 + preopen_indexes = 0 + unlink_old = 1 +} + +END + +} +elsif ( $DB{'type'} eq 'Pg' ) { + check_tsvalue(); + my $table = $OPT{'table'} || prompt( + message => "Enter the name of a DB table that will be used to store the Pg tsvector.\n" + . "You may either use the existing Attachments table, or create a new\n" + . "table.", + default => $DEFAULT{'table'}, + silent => !$OPT{'ask'}, + ); + my $column = $OPT{'column'} || prompt( + message => 'Enter the name of a column that will be used to store the Pg tsvector:', + default => $DEFAULT{'column'}, + silent => !$OPT{'ask'}, + ); + + my $schema; + my $drop; + if ( lc($table) eq 'attachments' ) { + $drop = "ALTER TABLE $table DROP COLUMN $column"; + $schema = "ALTER TABLE $table ADD COLUMN $column tsvector"; + } else { + $drop = "DROP TABLE $table"; + $schema = "CREATE TABLE $table ( " + ."id INTEGER NOT NULL," + ."$column tsvector )"; + } + + my $index_type = lc($OPT{'index-type'} || ''); + while ( $index_type ne 'gist' and $index_type ne 'gin' ) { + $index_type = lc prompt( + message => "You may choose between GiST or GIN indexes; the former is several times\n" + . "slower to search, but takes less space on disk and is faster to update.", + default => 'GiST', + silent => !$OPT{'ask'}, + ); + } + + do_error_is_ok( dba_handle() => $drop ) + unless $OPT{'dryrun'}; + insert_schema( $schema ); + insert_schema("CREATE INDEX ${column}_idx ON $table USING $index_type($column)"); + + print_rt_config( Table => $table, Column => $column ); +} +elsif ( $DB{'type'} eq 'Oracle' ) { + { + my $dbah = dba_handle(); + do_print_error( $dbah => 'GRANT CTXAPP TO '. $DB{'user'} ); + do_print_error( $dbah => 'GRANT EXECUTE ON CTXSYS.CTX_DDL TO '. $DB{'user'} ); + } + + my %PREFERENCES = ( + datastore => { + type => 'DIRECT_DATASTORE', + }, + filter => { + type => 'AUTO_FILTER', +# attributes => { +# timeout => 120, # seconds +# timeout_type => 'HEURISTIC', # or 'FIXED' +# }, + }, + lexer => { + type => 'WORLD_LEXER', + }, + word_list => { + type => 'BASIC_WORDLIST', + attributes => { + stemmer => 'AUTO', + fuzzy_match => 'AUTO', +# fuzzy_score => undef, +# fuzzy_numresults => undef, +# substring_index => undef, +# prefix_index => undef, +# prefix_length_min => undef, +# prefix_length_max => undef, +# wlidcard_maxterms => undef, + }, + }, + 'section_group' => { + type => 'NULL_SECTION_GROUP', + }, + + storage => { + type => 'BASIC_STORAGE', + attributes => { + R_TABLE_CLAUSE => 'lob (data) store as (cache)', + I_INDEX_CLAUSE => 'compress 2', + }, + }, + ); + + my @params = (); + push @params, ora_create_datastore( %{ $PREFERENCES{'datastore'} } ); + push @params, ora_create_filter( %{ $PREFERENCES{'filter'} } ); + push @params, ora_create_lexer( %{ $PREFERENCES{'lexer'} } ); + push @params, ora_create_word_list( %{ $PREFERENCES{'word_list'} } ); + push @params, ora_create_stop_list(); + push @params, ora_create_section_group( %{ $PREFERENCES{'section_group'} } ); + push @params, ora_create_storage( %{ $PREFERENCES{'storage'} } ); + + my $index_params = join "\n", @params; + my $index_name = $DEFAULT{prefix} .'index'; + do_error_is_ok( $dbh => "DROP INDEX $index_name" ) + unless $OPT{'dryrun'}; + $dbh->do( + "CREATE INDEX $index_name ON Attachments(Content) + indextype is ctxsys.context parameters(' + $index_params + ')", + ) unless $OPT{'dryrun'}; + + print_rt_config( IndexName => $index_name ); +} +else { + die "Full-text indexes on $DB{type} are not yet supported"; +} + +sub check_tsvalue { + my $dbh = $RT::Handle->dbh; + my $fts = ($dbh->selectrow_array(<<EOQ))[0]; +SELECT 1 FROM information_schema.routines WHERE routine_name = 'plainto_tsquery' +EOQ + unless ($fts) { + print STDERR <<EOT; + +Your PostgreSQL server does not include full-text support. You will +need to upgrade to PostgreSQL version 8.3 or higher to use full-text +indexing. + +EOT + exit 1; + } +} + +sub check_sphinx { + return if $RT::Handle->CheckSphinxSE; + + print STDERR <<EOT; + +Your MySQL server has not been compiled with the Sphinx storage engine +(sphinxse). You will need to recompile MySQL according to the +instructions in Sphinx's documentation at +http://sphinxsearch.com/docs/current.html#sphinxse-installing + +EOT + exit 1; +} + +sub ora_create_datastore { + return sprintf 'datastore %s', ora_create_preference( + @_, + name => 'datastore', + ); +} + +sub ora_create_filter { + my $res = ''; + $res .= sprintf "format column %s\n", ora_create_format_column(); + $res .= sprintf 'filter %s', ora_create_preference( + @_, + name => 'filter', + ); + return $res; +} + +sub ora_create_lexer { + return sprintf 'lexer %s', ora_create_preference( + @_, + name => 'lexer', + ); +} + +sub ora_create_word_list { + return sprintf 'wordlist %s', ora_create_preference( + @_, + name => 'word_list', + ); +} + +sub ora_create_stop_list { + my $file = shift || 'etc/stopwords/en.txt'; + return '' unless -e $file; + + my $name = $DEFAULT{'prefix'} .'stop_list'; + unless ($OPT{'dryrun'}) { + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_stoplist(?); end;', $name ); + + $dbh->do( + 'begin ctx_ddl.create_stoplist(?, ?); end;', + undef, $name, 'BASIC_STOPLIST' + ); + + open( my $fh, '<:utf8', $file ) + or die "couldn't open file '$file': $!"; + while ( my $word = <$fh> ) { + chomp $word; + $dbh->do( + 'begin ctx_ddl.add_stopword(?, ?); end;', + undef, $name, $word + ); + } + close $fh; + } + return sprintf 'stoplist %s', $name; +} + +sub ora_create_section_group { + my %args = @_; + my $name = $DEFAULT{'prefix'} .'section_group'; + unless ($OPT{'dryrun'}) { + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_section_group(?); end;', $name ); + $dbh->do( + 'begin ctx_ddl.create_section_group(?, ?); end;', + undef, $name, $args{'type'} + ); + } + return sprintf 'section group %s', $name; +} + +sub ora_create_storage { + return sprintf 'storage %s', ora_create_preference( + @_, + name => 'storage', + ); +} + +sub ora_create_format_column { + my $column_name = 'ContentOracleFormat'; + return $column_name if $OPT{'dryrun'}; + unless ( + $dbh->column_info( + undef, undef, uc('Attachments'), uc( $column_name ) + )->fetchrow_array + ) { + $dbh->do(qq{ + ALTER TABLE Attachments ADD $column_name VARCHAR2(10) + }); + } + + my $detect_format = qq{ + CREATE OR REPLACE FUNCTION $DEFAULT{prefix}detect_format_simple( + parent IN NUMBER, + type IN VARCHAR2, + encoding IN VARCHAR2, + fname IN VARCHAR2 + ) + RETURN VARCHAR2 + AS + format VARCHAR2(10); + BEGIN + format := CASE + }; + unless ( $OPT{'attachments'} ) { + $detect_format .= qq{ + WHEN fname IS NOT NULL THEN 'ignore' + }; + } + $detect_format .= qq{ + WHEN type = 'text' THEN 'text' + WHEN type = 'text/rtf' THEN 'ignore' + WHEN type LIKE 'text/%' THEN 'text' + WHEN type LIKE 'message/%' THEN 'text' + ELSE 'ignore' + END; + RETURN format; + END; + }; + ora_create_procedure( $detect_format ); + + $dbh->do(qq{ + UPDATE Attachments + SET $column_name = $DEFAULT{prefix}detect_format_simple( + Parent, + ContentType, ContentEncoding, + Filename + ) + WHERE $column_name IS NULL + }); + $dbh->do(qq{ + CREATE OR REPLACE TRIGGER $DEFAULT{prefix}set_format + BEFORE INSERT + ON Attachments + FOR EACH ROW + BEGIN + :new.$column_name := $DEFAULT{prefix}detect_format_simple( + :new.Parent, + :new.ContentType, :new.ContentEncoding, + :new.Filename + ); + END; + }); + return $column_name; +} + +sub ora_create_preference { + my %info = @_; + my $name = $DEFAULT{'prefix'} . $info{'name'}; + return $name if $OPT{'dryrun'}; + do_error_is_ok( $dbh => 'begin ctx_ddl.drop_preference(?); end;', $name ); + $dbh->do( + 'begin ctx_ddl.create_preference(?, ?); end;', + undef, $name, $info{'type'} + ); + return $name unless $info{'attributes'}; + + while ( my ($attr, $value) = each %{ $info{'attributes'} } ) { + $dbh->do( + 'begin ctx_ddl.set_attribute(?, ?, ?); end;', + undef, $name, $attr, $value + ); + } + + return $name; +} + +sub ora_create_procedure { + my $text = shift; + + return if $OPT{'dryrun'}; + my $status = $dbh->do($text, { RaiseError => 0 }); + + # Statement succeeded + return if $status; + + if ( 6550 != $dbh->err ) { + # Utter failure + die $dbh->errstr; + } + else { + my $msg = $dbh->func( 'plsql_errstr' ); + die $dbh->errstr if !defined $msg; + die $msg if $msg; + } +} + +sub dba_handle { + if ( $DB{'type'} eq 'Oracle' ) { + $ENV{'NLS_LANG'} = "AMERICAN_AMERICA.AL32UTF8"; + $ENV{'NLS_NCHAR'} = "AL32UTF8"; + } + my $dsn = do { my $h = new RT::Handle; $h->BuildDSN; $h->DSN }; + my $dbh = DBI->connect( + $dsn, $DB{admin}, $DB{admin_password}, + { RaiseError => 1, PrintError => 1 }, + ); + unless ( $dbh ) { + die "Failed to connect to $dsn as user '$DB{admin}': ". $DBI::errstr; + } + return $dbh; +} + +sub do_error_is_ok { + my $dbh = shift; + local $dbh->{'RaiseError'} = 0; + local $dbh->{'PrintError'} = 0; + return $dbh->do(shift, undef, @_); +} + +sub do_print_error { + my $dbh = shift; + local $dbh->{'RaiseError'} = 0; + local $dbh->{'PrintError'} = 1; + return $dbh->do(shift, undef, @_); +} + +sub prompt { + my %args = ( @_ ); + return $args{'default'} if $args{'silent'}; + + local $| = 1; + print $args{'message'}; + if ( $args{'default'} ) { + print "\n[". $args{'default'} .']: '; + } else { + print ":\n"; + } + + my $res = <STDIN>; + chomp $res; + print "\n"; + return $args{'default'} if !$res && $args{'default'}; + return $res; +} + +sub verbose { print @_, "\n" if $OPT{verbose} || $OPT{verbose}; 1 } +sub debug { print @_, "\n" if $OPT{debug}; 1 } +sub error { $RT::Logger->error( @_ ); verbose(@_); 1 } +sub warning { $RT::Logger->warning( @_ ); verbose(@_); 1 } + +sub show_help { + my $error = shift; + RT::Interface::CLI->ShowHelp( + ExitValue => $error, + Sections => 'NAME|DESCRIPTION', + ); +} + +sub print_rt_config { + my %args = @_; + my $config = <<END; + +You can now configure RT to use the newly-created full-text index by +adding the following to your RT_SiteConfig.pm: + +Set( %FullTextSearch, + Enable => 1, + Indexed => 1, +END + + $config .= sprintf(" %-10s => '$args{$_}',\n",$_) + foreach grep defined $args{$_}, keys %args; + $config .= ");\n"; + + print $config; +} + +sub insert_schema { + my $dbh = dba_handle(); + my $message = "Going to run the following in the DB:"; + my $schema = shift; + print "$message\n"; + my $disp = $schema; + $disp =~ s/^/ /mg; + print "$disp\n\n"; + return if $OPT{'dryrun'}; + + my $res = $dbh->do( $schema ); + unless ( $res ) { + die "Couldn't run DDL query: ". $dbh->errstr; + } +} + +=head1 NAME + +rt-setup-fulltext-index - Create indexes for full text search + +=head1 DESCRIPTION + +This script creates the appropriate tables, columns, functions, and / or +views necessary for full-text searching for your database type. It will +drop any existing indexes in the process. + +Please read F<docs/full_text_indexing.pod> for complete documentation on +full-text indexing for your database type. + +If you have a non-standard database administrator user or password, you +may use the C<--dba> and C<--dba-password> parameters to set them +explicitly: + + rt-setup-fulltext-index --dba sysdba --dba-password 'secret' + +To test what will happen without running any DDL, pass the C<--dryrun> +flag. + +The Oracle index determines which content-types it will index at +creation time. By default, textual message bodies and textual uploaded +attachments (attachments with filenames) are indexed; to ignore textual +attachments, pass the C<--no-attachments> flag when the index is +created. + + +=head1 AUTHOR + +Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>, +Alex Vandiver E<lt>alexmv@bestpractical.comE<gt> + +=cut + diff --git a/rt/sbin/rt-shredder b/rt/sbin/rt-shredder deleted file mode 100755 index 3a9db9d24..000000000 --- a/rt/sbin/rt-shredder +++ /dev/null @@ -1,323 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -=head1 NAME - -rt-shredder - Script which wipe out tickets from RT DB - -=head1 SYNOPSIS - - rt-shredder --plugin list - rt-shredder --plugin help-Tickets - rt-shredder --plugin 'Tickets=query,Queue="general" and Status="deleted"' - - rt-shredder --sqldump unshred.sql --plugin ... - rt-shredder --force --plugin ... - -=head1 DESCRIPTION - -rt-shredder - is script that allow you to wipe out objects -from RT DB. This script uses API that L<RT::Shredder> module adds to RT. -Script can be used as example of usage of the shredder API. - -=head1 USAGE - -You can use several options to control which objects script -should wipeout. - -=head1 OPTIONS - -=head2 --sqldump <filename> - -Outputs INSERT queiries into file. This dump can be used to restore data -after wiping out. - -By default creates files -F<< <RT_home>/var/data/RT-Shredder/<ISO_date>-XXXX.sql >> - -=head2 --object (DEPRECATED) - -Option has been deprecated, use plugin C<Objects> instead. - -=head2 --plugin '<plugin name>[=<arg>,<val>[;<arg>,<val>]...]' - -You can use plugins to select RT objects with various conditions. -See also --plugin list and --plugin help options. - -=head2 --plugin list - -Output list of the available plugins. - -=head2 --plugin help-<plugin name> - -Outputs help for specified plugin. - -=head2 --force - -Script doesn't ask any questions. - -=head1 SEE ALSO - -L<RT::Shredder> - -=cut - -use strict; -use warnings FATAL => 'all'; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use RT::Shredder (); -use Getopt::Long qw(GetOptions); -use File::Spec (); - -use RT::Shredder::Plugin (); -# prefetch list of plugins -our %plugins = RT::Shredder::Plugin->List; - -our %opt; -parse_args(); - -RT::Shredder::Init( %opt ); -my $shredder = new RT::Shredder; - -{ - my $plugin = eval { $shredder->AddDumpPlugin( Arguments => { - file_name => $opt{'sqldump'}, - from_storage => 0, - } ) }; - if( $@ ) { - print STDERR "ERROR: Couldn't open SQL dump file: $@\n"; - exit 1 if $opt{'sqldump'}; - - print STDERR "WARNING: It's strongly recommended to use '--sqldump <filename>' option\n"; - unless( $opt{'force'} ) { - exit 0 unless prompt_yN( "Do you want to proceed?" ); - } - } else { - print "SQL dump file is '". $plugin->FileName ."'\n"; - } -} - -my @objs = process_plugins( $shredder ); -prompt_delete_objs( \@objs ) unless $opt{'force'}; - -$shredder->PutObjects( Objects => $_ ) foreach @objs; -eval { $shredder->WipeoutAll }; -if( $@ ) { - require RT::Shredder::Exceptions; - if( my $e = RT::Shredder::Exception::Info->caught ) { - print "\nERROR: $e\n\n"; - exit 1; - } - die $@; -} - -sub prompt_delete_objs -{ - my( $objs ) = @_; - unless( @$objs ) { - print "Objects list is empty, try refine search options\n"; - exit 0; - } - my $list = "Next ". scalar( @$objs ) ." objects would be deleted:\n"; - foreach my $o( @$objs ) { - $list .= "\t". $o->_AsString ." object\n"; - } - print $list; - exit(0) unless prompt_yN( "Do you want to proceed?" ); -} - -sub prompt_yN -{ - my $text = shift; - print "$text [y/N] "; - unless( <STDIN> =~ /^(?:y|yes)$/i ) { - return 0; - } - return 1; -} - -sub usage -{ - require RT::Shredder::POD; - RT::Shredder::POD::shredder_cli( $0, \*STDOUT ); - exit 1; -} - -sub parse_args -{ - my $tmp; - Getopt::Long::Configure( "pass_through" ); - my @objs = (); - if( GetOptions( 'object=s' => \@objs ) && @objs ) { - print STDERR "Option --object had been deprecated, use plugin 'Objects' instead\n"; - exit(1); - } - - my @plugins = (); - if( GetOptions( 'plugin=s' => \@plugins ) && @plugins ) { - $opt{'plugin'} = \@plugins; - foreach my $str( @plugins ) { - if( $str =~ /^\s*list\s*$/ ) { - show_plugin_list(); - } elsif( $str =~ /^\s*help-(\w+)\s*$/ ) { - show_plugin_help( $1 ); - } elsif( $str =~ /^(\w+)(=.*)?$/ && !$plugins{$1} ) { - print "Couldn't find plugin '$1'\n"; - show_plugin_list(); - } - } - } - - # other options make no sense without previouse - usage() unless keys %opt; - - if( GetOptions( 'force' => \$tmp ) && $tmp ) { - $opt{'force'}++; - } - $tmp = undef; - if( GetOptions( 'sqldump=s' => \$tmp ) && $tmp ) { - $opt{'sqldump'} = $tmp; - } - return; -} - -sub process_plugins -{ - my $shredder = shift; - - my @res; - foreach my $str( @{ $opt{'plugin'} } ) { - my $plugin = new RT::Shredder::Plugin; - my( $status, $msg ) = $plugin->LoadByString( $str ); - unless( $status ) { - print STDERR "Couldn't load plugin\n"; - print STDERR "Error: $msg\n"; - exit(1); - } - if ( lc $plugin->Type eq 'search' ) { - push @res, _process_search_plugin( $shredder, $plugin ); - } - elsif ( lc $plugin->Type eq 'dump' ) { - _process_dump_plugin( $shredder, $plugin ); - } - } - return RT::Shredder->CastObjectsToRecords( Objects => \@res ); -} - -sub _process_search_plugin { - my ($shredder, $plugin) = @_; - my ($status, @objs) = $plugin->Run; - unless( $status ) { - print STDERR "Couldn't run plugin\n"; - print STDERR "Error: $objs[1]\n"; - exit(1); - } - - my $msg; - ($status, $msg) = $plugin->SetResolvers( Shredder => $shredder ); - unless( $status ) { - print STDERR "Couldn't set conflicts resolver\n"; - print STDERR "Error: $msg\n"; - exit(1); - } - return @objs; -} - -sub _process_dump_plugin { - my ($shredder, $plugin) = @_; - $shredder->AddDumpPlugin( - Object => $plugin, - ); -} - -sub show_plugin_list -{ - print "Plugins list:\n"; - print "\t$_\n" foreach( grep !/^Base$/, keys %plugins ); - exit(1); -} - -sub show_plugin_help -{ - my( $name ) = @_; - require RT::Shredder::POD; - unless( $plugins{ $name } ) { - print "Couldn't find plugin '$name'\n"; - show_plugin_list(); - } - RT::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 ); - RT::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT ); - exit(1); -} - -exit(0); diff --git a/rt/sbin/rt-shredder.in b/rt/sbin/rt-shredder.in index 946121c75..c0655dbe1 100755 --- a/rt/sbin/rt-shredder.in +++ b/rt/sbin/rt-shredder.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -74,7 +74,7 @@ should wipeout. =head2 --sqldump <filename> -Outputs INSERT queiries into file. This dump can be used to restore data +Outputs INSERT queries into file. This dump can be used to restore data after wiping out. By default creates files @@ -147,7 +147,7 @@ our %opt; parse_args(); RT::Shredder::Init( %opt ); -my $shredder = new RT::Shredder; +my $shredder = RT::Shredder->new; { my $plugin = eval { $shredder->AddDumpPlugin( Arguments => { @@ -257,7 +257,7 @@ sub process_plugins my @res; foreach my $str( @{ $opt{'plugin'} } ) { - my $plugin = new RT::Shredder::Plugin; + my $plugin = RT::Shredder::Plugin->new; my( $status, $msg ) = $plugin->LoadByString( $str ); unless( $status ) { print STDERR "Couldn't load plugin\n"; diff --git a/rt/sbin/rt-test-dependencies.in b/rt/sbin/rt-test-dependencies.in index a964e2912..37ef32f64 100644 --- a/rt/sbin/rt-test-dependencies.in +++ b/rt/sbin/rt-test-dependencies.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -60,42 +60,49 @@ GetOptions( \%args, 'v|verbose', 'install', 'with-MYSQL', 'with-POSTGRESQL|with-pg|with-pgsql', 'with-SQLITE', - 'with-ORACLE', 'with-FASTCGI', 'with-FASTCGI-SERVER', - 'with-SPEEDYCGI', 'with-MODPERL1', - 'with-MODPERL2', 'with-DEV', + 'with-ORACLE', 'with-FASTCGI', + 'with-MODPERL1', 'with-MODPERL2', 'with-STANDALONE', + 'with-DEV', + 'with-GPG', 'with-ICAL', 'with-SMTP', 'with-GRAPHVIZ', 'with-GD', 'with-DASHBOARDS', + 'with-USERLOGO', + 'with-SSL-MAILGATE', 'download=s', 'repository=s', - 'list-deps' + 'list-deps', + 'help|h', ); -unless (keys %args) { - help(); - exit(1); +if ( $args{help} ) { + require Pod::Usage; + Pod::Usage::pod2usage( { verbose => 2 } ); + exit; } # Set up defaults my %default = ( 'with-MASON' => 1, + 'with-PSGI' => 0, 'with-CORE' => 1, 'with-CLI' => 1, 'with-MAILGATE' => 1, 'with-DEV' => @RT_DEVEL_MODE@, - 'with-STANDALONE' => 1, 'with-GPG' => @RT_GPG@, 'with-ICAL' => 1, 'with-SMTP' => 1, 'with-GRAPHVIZ' => @RT_GRAPHVIZ@, 'with-GD' => @RT_GD@, - 'with-DASHBOARDS' => 1 + 'with-DASHBOARDS' => 1, + 'with-USERLOGO' => 1, + 'with-SSL-MAILGATE' => @RT_SSL_MAILGATE@, ); $args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default; @@ -156,44 +163,6 @@ sub conclude { } } - -sub help { - - print <<'.'; - -By default, testdeps determine whether you have -installed all the perl modules RT needs to run. - - --install Install missing modules - -The following switches will tell the tool to check for specific dependencies - - --with-mysql Database interface for MySQL - --with-postgresql Database interface for PostgreSQL - --with-oracle Database interface for Oracle - --with-sqlite Database interface and driver for SQLite (unsupported) - - --with-standalone Libraries needed to support the standalone simple pure perl server - --with-fastcgi-server Libraries needed to support the external fastcgi server - --with-fastcgi Libraries needed to support the fastcgi handler - --with-speedycgi Libraries needed to support the speedycgi handler - --with-modperl1 Libraries needed to support the modperl 1 handler - --with-modperl2 Libraries needed to support the modperl 2 handler - - --with-dev Tools needed for RT development - -You can also specify -v or --verbose to list the status of all dependencies, -rather than just the missing ones. - -The "RT_FIX_DEPS_CMD" environment variable, if set, will be used -instead of the standard CPAN shell by --install to install any -required modules. It will be called with the module name, or, if -"RT_FIX_DEPS_CMD" contains a "%s", will replace the "%s" with the -module name before calling the program. -. -} - - sub text_to_hash { my %hash; for my $line ( split /\n/, $_[0] ) { @@ -206,18 +175,23 @@ sub text_to_hash { } $deps{'CORE'} = [ text_to_hash( << '.') ]; +Class::Accessor 0.34 +DateTime 0.44 +DateTime::Locale 0.40 Digest::base Digest::MD5 2.27 Digest::SHA DBI 1.37 Class::ReturnValue 0.40 -DBIx::SearchBuilder 1.54 +DBIx::SearchBuilder 1.59 Text::Template 1.44 File::ShareDir File::Spec 0.8 -HTML::Entities +HTML::Quoted HTML::Scrubber 0.08 -Log::Dispatch 2.0 +HTML::TreeBuilder +HTML::FormatText +Log::Dispatch 2.23 Sys::Syslog 0.16 Locale::Maketext 1.06 Locale::Maketext::Lexicon 0.32 @@ -236,15 +210,20 @@ Regexp::Common Scalar::Util Module::Versions::Report 1.05 Cache::Simple::TimedExpiry -Calendar::Simple -Encode 2.21 +Encode 2.39 CSS::Squish 0.06 File::Glob Devel::StackTrace 1.19 +Text::Password::Pronounceable +Devel::GlobalDestruction +List::MoreUtils +Net::CIDR +Regexp::Common::net::CIDR +Regexp::IPv6 . $deps{'MASON'} = [ text_to_hash( << '.') ]; -HTML::Mason 1.36 +HTML::Mason 1.43 Errno Digest::MD5 2.27 CGI::Cookie 1.20 @@ -254,22 +233,33 @@ XML::RSS 1.05 Text::WikiFormat 0.76 CSS::Squish 0.06 Devel::StackTrace 1.19 +JSON +IPC::Run3 . -$deps{'STANDALONE'} = [ text_to_hash( << '.') ]; -HTTP::Server::Simple 0.34 -HTTP::Server::Simple::Mason 0.14 -Net::Server +$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 . $deps{'MAILGATE'} = [ text_to_hash( << '.') ]; -HTML::TreeBuilder -HTML::FormatText Getopt::Long LWP::UserAgent Pod::Usage . +$deps{'SSL-MAILGATE'} = [ text_to_hash( << '.') ]; +Crypt::SSLeay +Net::SSL +LWP::UserAgent 6.0 +LWP::Protocol::https +Mozilla::CA +. + $deps{'CLI'} = [ text_to_hash( << '.') ]; Getopt::Long 2.24 LWP @@ -280,57 +270,39 @@ Term::ReadKey . $deps{'DEV'} = [ text_to_hash( << '.') ]; +Email::Abstract +Test::Email HTML::Form HTML::TokeParser -WWW::Mechanize -Test::WWW::Mechanize 1.04 +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 -Test::HTTP::Server::Simple 0.09 -Test::HTTP::Server::Simple::StashWarnings 0.02 Log::Dispatch::Perl Test::Warn -Test::Builder 0.77 # needed to fix TODO test -IPC::Run3 +Test::Builder 0.90 # needed for is_passing Test::MockTime -HTTP::Server::Simple::Mason 0.13 Log::Dispatch::Perl +Test::WWW::Mechanize::PSGI +Plack::Middleware::Test::StashWarnings 0.06 +Test::LongString . $deps{'FASTCGI'} = [ text_to_hash( << '.') ]; -CGI 3.38 -FCGI 0.74 -CGI::Fast -. - -$deps{'FASTCGI-SERVER'} = [ text_to_hash( << '.') ]; -CGI 3.38 -CGI::Fast +FCGI FCGI::ProcManager -File::Basename -File::Spec -Getopt::Long -Pod::Usage . -$deps{'SPEEDYCGI'} = [ text_to_hash( << '.') ]; -CGI 3.38 -CGI::SpeedyCGI -. - - $deps{'MODPERL1'} = [ text_to_hash( << '.') ]; -CGI 3.38 Apache::Request Apache::DBI 0.92 . $deps{'MODPERL2'} = [ text_to_hash( << '.') ]; -CGI 3.38 Apache::DBI HTML::Mason 1.36 . @@ -365,14 +337,14 @@ Net::SMTP . $deps{'DASHBOARDS'} = [ text_to_hash( << '.') ]; -HTML::RewriteAttributes 0.02 +HTML::RewriteAttributes 0.04 MIME::Types +URI 1.59 . $deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ]; GraphViz IPC::Run -IPC::Run::SafeHandles . $deps{'GD'} = [ text_to_hash( << '.') ]; @@ -381,6 +353,10 @@ GD::Graph GD::Text . +$deps{'USERLOGO'} = [ text_to_hash( << '.') ]; +Convert::Color +. + my %AVOID = ( 'DBD::Oracle' => [qw(1.23)], ); @@ -396,7 +372,7 @@ check_users(); my %Missing_By_Type = (); foreach my $type (sort grep $args{$_}, keys %args) { - next unless ($type =~ /^with-(.*?)$/); + next unless ($type =~ /^with-(.*?)$/) and $deps{$1}; $type = $1; section("$type dependencies"); @@ -409,6 +385,16 @@ foreach my $type (sort grep $args{$_}, keys %args) { if ( $args{'install'} ) { for my $module (keys %missing) { resolve_dep($module, $missing{$module}{version}); + my $m = $module . '.pm'; + $m =~ s!::!/!g; + if ( delete $INC{$m} ) { + my $symtab = $module . '::'; + no strict 'refs'; + for my $symbol ( keys %{$symtab} ) { + next if substr( $symbol, -2, 2 ) eq '::'; + delete $symtab->{$symbol}; + } + } delete $missing{$module} if test_dep($module, $missing{$module}{version}, $AVOID{$module}); } @@ -474,7 +460,7 @@ sub resolve_dep { print "\nInstall module $module\n"; - my $ext = $ENV{'RT_FIX_DEPS_CMD'}; + my $ext = $ENV{'RT_FIX_DEPS_CMD'} || $ENV{'PERL_PREFER_CPAN_CLIENT'}; unless( $ext ) { my $configured = 1; { @@ -596,6 +582,81 @@ sub check_users { print_found("web group (@WEB_GROUP@)", defined getgrnam("@WEB_GROUP@")); } +1; +__END__ + +=head1 NAME + +rt-test-dependencies - test rt's dependencies + +=head1 SYNOPSIS + + rt-test-dependencies + rt-test-dependencies --install + rt-test-dependencies --with-mysql --with-fastcgi + +=head1 DESCRIPTION + +by default, C<rt-test-dependencies> determines whether you have installed all +the perl modules RT needs to run. + +the "RT_FIX_DEPS_CMD" environment variable, if set, will be used instead of +the standard CPAN shell by --install to install any required modules. it will +be called with the module name, or, if "RT_FIX_DEPS_CMD" contains a "%s", will +replace the "%s" with the module name before calling the program. + +=head1 OPTIONS + +=over + +=item install + + install missing modules + +=item verbose + +list the status of all dependencies, rather than just the missing ones. + +-v is equal to --verbose + +=item specify dependencies + +=over + +=item --with-mysql + + database interface for mysql + +=item --with-postgresql + + database interface for postgresql + +=item with-oracle + + database interface for oracle + +=item with-sqlite + + database interface and driver for sqlite (unsupported) + +=item with-fastcgi + + libraries needed to support the fastcgi handler + +=item with-modperl1 + + libraries needed to support the modperl 1 handler + +=item with-modperl2 + + libraries needed to support the modperl 2 handler + +=item with-dev + + tools needed for RT development + +=back + +=back -1; diff --git a/rt/sbin/rt-validator b/rt/sbin/rt-validator deleted file mode 100755 index d0ba1a71e..000000000 --- a/rt/sbin/rt-validator +++ /dev/null @@ -1,1119 +0,0 @@ -#!/usr/bin/perl -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -use warnings; - -# fix lib paths, some may be relative -BEGIN { - require File::Spec; - my @libs = ("lib", "local/lib"); - my $bin_path; - - for my $lib (@libs) { - unless ( File::Spec->file_name_is_absolute($lib) ) { - unless ($bin_path) { - if ( File::Spec->file_name_is_absolute(__FILE__) ) { - $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; - } - else { - require FindBin; - no warnings "once"; - $bin_path = $FindBin::Bin; - } - } - $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); - } - unshift @INC, $lib; - } - -} - -use Getopt::Long; -my %opt = (); -GetOptions( - \%opt, - 'check|c', - 'resolve', - 'force', - 'verbose|v', -); - -usage() unless $opt{'check'}; -usage_warning() if $opt{'resolve'} && !$opt{'force'}; - -sub usage { - print STDERR <<END; -Usage: $0 options - -Options: - - $0 --check - $0 --check --verbose - $0 --check --verbose --resolve - $0 --check --verbose --resolve --force - ---check - is mandatory argument, you can use -c, as well. ---verbose - print additional info to STDOUT ---resolve - enable resolver that can delete or create some records ---force - resolve without asking questions - -Description: - -This script checks integrity of records in RT's DB. May delete some invalid -records or ressurect accidentally deleted. - -END - exit 1; -} - -sub usage_warning { - print <<END; -This utility can fix some issues with DB by creating or updating. In some -cases there is no enough data to resurect a missing record, but records which -refers to a missing can be deleted. It's up to you to decide what to do. - -In any case it's highly recommended to have a backup before resolving anything. - -Press enter to continue. -END -# Read a line of text, any line of text - <STDIN>; -} - -use RT; -RT::LoadConfig(); -RT::Init(); - -my $dbh = $RT::Handle->dbh; -my $db_type = RT->Config->Get('DatabaseType'); - -my %TYPE = ( - 'Transactions.Field' => 'text', - 'Transactions.OldValue' => 'text', - 'Transactions.NewValue' => 'text', -); - -my @models = qw( - ACE - Attachment - Attribute - CachedGroupMember - CustomField - CustomFieldValue - GroupMember - Group - Link - ObjectCustomField - ObjectCustomFieldValue - Principal - Queue - ScripAction - ScripCondition - Scrip - Template - Ticket - Transaction - User -); - -my %redo_on; -$redo_on{'Delete'} = { - ACL => [], - - Attributes => [], - - Links => [], - - CustomFields => [], - CustomFieldValues => [], - ObjectCustomFields => [], - ObjectCustomFieldValues => [], - - Queues => [], - - Scrips => [], - ScripActions => [], - ScripConditions => [], - Templates => [], - - Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ], - Transactions => [ 'Attachments -> other' ], - - Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ], - Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ], - Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ], - - GroupMembers => [ 'CGM vs. GM' ], - CachedGroupMembers => [ 'CGM vs. GM' ], -}; -$redo_on{'Create'} = { - Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ], - Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ], - GroupMembers => [ 'CGM vs. GM' ], - CachedGroupMembers => [ 'CGM vs. GM' ], -}; - -my %describe_cb; -%describe_cb = ( - Attachments => sub { - my $row = shift; - my $txn_id = $row->{transactionid}; - my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id; - return $res .', '. describe( 'Transactions', $txn_id ); - }, - Transactions => sub { - my $row = shift; - return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid}; - }, -); - -{ my %cache = (); -sub m2t($) { - my $model = shift; - return $cache{$model} if $cache{$model}; - my $class = "RT::$model"; - my $object = $class->new( $RT::SystemUser ); - return $cache{$model} = $object->Table; -} } - -my (@do_check, %redo_check); - -my @CHECKS; -foreach my $table ( qw(Users Groups) ) { - push @CHECKS, "$table -> Principals" => sub { - my $msg = "A record in $table refers not existing record in Principals." - ." The script can either create missing record in Principals" - ." or delete record in $table."; - my ($type) = ($table =~ /^(.*)s$/); - check_integrity( - $table, 'id' => 'Principals', 'id', - join_condition => 't.PrincipalType = ?', - bind_values => [ $type ], - action => sub { - my $id = shift; - return unless my $a = prompt_action( ['Delete', 'create'], $msg ); - - if ( $a eq 'd' ) { - delete_record( $table, $id ); - } - elsif ( $a eq 'c' ) { - my $principal_id = create_record( 'Principals', - id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0 - ); - } - else { - die "Unknown action '$a'"; - } - }, - ); - }; - - push @CHECKS, "Principals -> $table" => sub { - my $msg = "A record in Principals refers not existing record in $table." - ." In some cases it's possible to resurrect manually such records," - ." but this utility can only delete"; - - check_integrity( - 'Principals', 'id' => $table, 'id', - condition => 's.PrincipalType = ?', - bind_values => [ $table =~ /^(.*)s$/ ], - action => sub { - my $id = shift; - return unless prompt( 'Delete', $msg ); - - delete_record( 'Principals', $id ); - }, - ); - }; -} - -push @CHECKS, 'User <-> ACL equivalence group' => sub { - # from user to group - check_integrity( - 'Users', 'id' => 'Groups', 'Instance', - join_condition => 't.Domain = ? AND t.Type = ?', - bind_values => [ 'ACLEquivalence', 'UserEquiv' ], - action => sub { - my $id = shift; - return unless prompt( - 'Create', "Found an user that has no ACL equivalence group." - ); - - my $gid = create_record( 'Groups', - Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id, - ); - }, - ); - # from group to user - check_integrity( - 'Groups', 'Instance' => 'Users', 'id', - condition => 's.Domain = ? AND s.Type = ?', - bind_values => [ 'ACLEquivalence', 'UserEquiv' ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found an user ACL equivalence group, but there is no user." - ); - - delete_record( 'Groups', $id ); - }, - ); - # one ACL equiv group for each user - check_uniqueness( - 'Groups', - columns => ['Instance'], - condition => '.Domain = ? AND .Type = ?', - bind_values => [ 'ACLEquivalence', 'UserEquiv' ], - ); -}; - -# check integrity of Queue role groups -push @CHECKS, 'Queues <-> Role Groups' => sub { - # XXX: we check only that there is at least one group for a queue - # from queue to group - check_integrity( - 'Queues', 'id' => 'Groups', 'Instance', - join_condition => 't.Domain = ?', - bind_values => [ 'RT::Queue-Role' ], - ); - # from group to queue - check_integrity( - 'Groups', 'Instance' => 'Queues', 'id', - condition => 's.Domain = ?', - bind_values => [ 'RT::Queue-Role' ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found role group of not existant queue." - ); - - delete_record( 'Groups', $id ); - }, - ); -}; - -# check integrity of Ticket role groups -push @CHECKS, 'Tickets <-> Role Groups' => sub { - # XXX: we check only that there is at least one group for a queue - # from queue to group - check_integrity( - 'Tickets', 'id' => 'Groups', 'Instance', - join_condition => 't.Domain = ?', - bind_values => [ 'RT::Ticket-Role' ], - ); - # from group to ticket - check_integrity( - 'Groups', 'Instance' => 'Tickets', 'id', - condition => 's.Domain = ?', - bind_values => [ 'RT::Ticket-Role' ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found a role group of not existant ticket." - ); - - delete_record( 'Groups', $id ); - }, - ); -}; - -# additional CHECKS on groups -push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub { - # Check that Domain, Instance and Type are unique - check_uniqueness( - 'Groups', - columns => ['Domain', 'Instance', 'Type'], - condition => '.Domain LIKE ?', - bind_values => [ '%-Role' ], - ); -}; - - -push @CHECKS, 'GMs -> Groups, Members' => sub { - my $msg = "A record in GroupMembers references an object that doesn't exist." - ." May be you deleted a group or principal directly from DB?" - ." Usually it's ok to delete such records."; - check_integrity( - 'GroupMembers', 'GroupId' => 'Groups', 'id', - action => sub { - my $id = shift; - return unless prompt( 'Delete', $msg ); - - delete_record( 'GroupMembers', $id ); - }, - ); - check_integrity( - 'GroupMembers', 'MemberId' => 'Principals', 'id', - action => sub { - my $id = shift; - return unless prompt( 'Delete', $msg ); - - delete_record( 'GroupMembers', $id ); - }, - ); -}; - -# CGM and GM -push @CHECKS, 'CGM vs. GM' => sub { - # all GM record should be duplicated in CGM - check_integrity( - GroupMembers => ['GroupId', 'MemberId'], - CachedGroupMembers => ['GroupId', 'MemberId'], - join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id', - action => sub { - my $id = shift; - return unless prompt( - 'Create', - "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table." - ); - - my $gm = RT::GroupMember->new( $RT::SystemUser ); - $gm->Load( $id ); - die "Couldn't load GM record #$id" unless $gm->id; - my $cgm = create_record( 'CachedGroupMembers', - GroupId => $gm->GroupId, MemberId => $gm->MemberId, - ImmediateParentId => $gm->GroupId, Via => undef, - Disabled => 0, # XXX: we should check integrity of Disabled field - ); - update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } ); - }, - ); - # all first level CGM records should have a GM record - check_integrity( - CachedGroupMembers => ['GroupId', 'MemberId'], - GroupMembers => ['GroupId', 'MemberId'], - condition => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId', - action => sub { - my $id = shift; - return unless prompt( - 'Delete', - "Found a record in CachedGroupMembers for a (Group, Member) pair" - ." that doesn't exist in GroupMembers table." - ); - - delete_record( 'CachedGroupMembers', $id ); - }, - ); - # each group should have a CGM record where MemberId == GroupId - check_integrity( - Groups => ['id', 'id'], - CachedGroupMembers => ['GroupId', 'MemberId'], - join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id', - action => sub { - my $id = shift; - return unless prompt( - 'Create', - "Found a record in Groups that has no direct" - ." duplicate in CachedGroupMembers table." - ); - - my $g = RT::Group->new( $RT::SystemUser ); - $g->Load( $id ); - die "Couldn't load group #$id" unless $g->id; - die "Loaded group by $id has id ". $g->id unless $g->id == $id; - my $cgm = create_record( 'CachedGroupMembers', - GroupId => $id, MemberId => $id, - ImmediateParentId => $id, Via => undef, - Disabled => $g->Disabled, - ); - update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } ); - }, - ); - - # and back, each record in CGM with MemberId == GroupId without exceptions - # should reference a group - check_integrity( - CachedGroupMembers => ['GroupId', 'MemberId'], - Groups => ['id', 'id'], - condition => "s.GroupId = s.MemberId", - action => sub { - my $id = shift; - return unless prompt( - 'Delete', - "Found a record in CachedGroupMembers for a group that doesn't exist." - ); - - delete_record( 'CachedGroupMembers', $id ); - }, - ); - # Via - check_integrity( - CachedGroupMembers => 'Via', - CachedGroupMembers => 'id', - action => sub { - my $id = shift; - return unless prompt( - 'Delete', - "Found a record in CachedGroupMembers with Via referencing not existing record." - ); - - delete_record( 'CachedGroupMembers', $id ); - }, - ); - - # for every CGM where ImmediateParentId != GroupId there should be - # matching parent record (first level) - check_integrity( - CachedGroupMembers => ['ImmediateParentId', 'MemberId'], - CachedGroupMembers => ['GroupId', 'MemberId'], - join_condition => 't.Via = t.id', - condition => 's.ImmediateParentId != s.GroupId', - action => sub { - my $id = shift; - return unless prompt( - 'Delete', - "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table." - ); - - delete_record( 'CachedGroupMembers', $id ); - }, - ); - - # for every CGM where ImmediateParentId != GroupId there should be - # matching "grand" parent record - check_integrity( - CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'], - CachedGroupMembers => ['GroupId', 'MemberId', 'id'], - condition => 's.ImmediateParentId != s.GroupId', - action => sub { - my $id = shift; - return unless prompt( - 'Delete', - "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table." - ); - - delete_record( 'CachedGroupMembers', $id ); - }, - ); - - # CHECK recursive records: - # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1, - # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1 - { - my $query = <<END; -SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via, - cgm1.MemberId AS ImmediateParentId, cgm1.Disabled -FROM - CachedGroupMembers cgm1 - CROSS JOIN GroupMembers gm2 - LEFT JOIN CachedGroupMembers cgm3 ON ( - cgm3.GroupId = cgm1.GroupId - AND cgm3.MemberId = gm2.MemberId - AND cgm3.Via = cgm1.id - AND cgm3.ImmediateParentId = cgm1.MemberId ) -WHERE cgm1.GroupId != cgm1.MemberId -AND gm2.GroupId = cgm1.MemberId -AND cgm3.id IS NULL -END - - my $action = sub { - my %props = @_; - return unless prompt( - 'Create', - "Found records in CachedGroupMembers table without recursive duplicates." - ); - my $cgm = create_record( 'CachedGroupMembers', %props ); - }; - - my $sth = execute_query( $query ); - while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) { - print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,"; - print STDERR " but there is no cached GM record that $m is member of #$g.\n"; - $action->( - GroupId => $g, MemberId => $m, Via => $via, - ImmediateParentId => $ip, Disabled => $dis, - ); - } - } -}; - -# Tickets -push @CHECKS, 'Tickets -> other' => sub { - check_integrity( - 'Tickets', 'EffectiveId' => 'Tickets', 'id', - action => sub { - my $id = shift; - return unless prompt( - 'Delete', - "Found a ticket that's been merged into a ticket that don't exist anymore." - ); - - delete_record( 'Tickets', $id ); - }, - ); - check_integrity( - 'Tickets', 'Queue' => 'Queues', 'id', - ); - check_integrity( - 'Tickets', 'Owner' => 'Users', 'id', - ); - # XXX: check that owner is only member of owner role group -}; - - -push @CHECKS, 'Transactions -> other' => sub { - foreach my $model ( @models ) { - check_integrity( - 'Transactions', 'ObjectId' => m2t($model), 'id', - condition => 's.ObjectType = ?', - bind_values => [ "RT::$model" ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found a transaction without object." - ); - - delete_record( 'Transactions', $id ); - }, - ); - } - # type = CustomField - check_integrity( - 'Transactions', 'Field' => 'CustomFields', 'id', - condition => 's.Type = ?', - bind_values => [ 'CustomField' ], - ); - # type = Take, Untake, Force, Steal or Give - check_integrity( - 'Transactions', 'OldValue' => 'Users', 'id', - condition => 's.Type IN (?, ?, ?, ?, ?)', - bind_values => [ qw(Take Untake Force Steal Give) ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found a transaction regarding changes of Owner," - ." but User with id stored in OldValue column doesn't exist anymore." - ); - - delete_record( 'Transactions', $id ); - }, - ); - check_integrity( - 'Transactions', 'NewValue' => 'Users', 'id', - condition => 's.Type IN (?, ?, ?, ?, ?)', - bind_values => [ qw(Take Untake Force Steal Give) ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found a transaction regarding changes of Owner," - ." but User with id stored in NewValue column doesn't exist anymore." - ); - - delete_record( 'Transactions', $id ); - }, - ); - # type = DelWatcher - check_integrity( - 'Transactions', 'OldValue' => 'Principals', 'id', - condition => 's.Type = ?', - bind_values => [ 'DelWatcher' ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found a transaction describing watchers change," - ." but User with id stored in OldValue column doesn't exist anymore." - ); - - delete_record( 'Transactions', $id ); - }, - ); - # type = AddWatcher - check_integrity( - 'Transactions', 'NewValue' => 'Principals', 'id', - condition => 's.Type = ?', - bind_values => [ 'AddWatcher' ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found a transaction describing watchers change," - ." but User with id stored in NewValue column doesn't exist anymore." - ); - - delete_record( 'Transactions', $id ); - }, - ); - -# XXX: Links need more love, uri is stored instead of id -# # type = DeleteLink -# check_integrity( -# 'Transactions', 'OldValue' => 'Links', 'id', -# condition => 's.Type = ?', -# bind_values => [ 'DeleteLink' ], -# ); -# # type = AddLink -# check_integrity( -# 'Transactions', 'NewValue' => 'Links', 'id', -# condition => 's.Type = ?', -# bind_values => [ 'AddLink' ], -# ); - - # type = Set, Field = Queue - check_integrity( - 'Transactions', 'NewValue' => 'Queues', 'id', - condition => 's.Type = ? AND s.Field = ?', - bind_values => [ 'Set', 'Queue' ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found a transaction describing queue change," - ." but Queue with id stored in NewValue column doesn't exist anymore." - ); - - delete_record( 'Transactions', $id ); - }, - ); - check_integrity( - 'Transactions', 'OldValue' => 'Queues', 'id', - condition => 's.Type = ? AND s.Field = ?', - bind_values => [ 'Set', 'Queue' ], - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found a transaction describing queue change," - ." but Queue with id stored in OldValue column doesn't exist anymore." - ); - - delete_record( 'Transactions', $id ); - }, - ); - # Reminders - check_integrity( - 'Transactions', 'NewValue' => 'Tickets', 'id', - join_condition => 't.Type = ?', - condition => 's.Type IN (?, ?, ?)', - bind_values => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ], - ); -}; - -# Attachments -push @CHECKS, 'Attachments -> other' => sub { - check_integrity( - Attachments => 'TransactionId', Transactions => 'id', - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found an attachment without a transaction." - ); - delete_record( 'Attachments', $id ); - }, - ); - check_integrity( - Attachments => 'Parent', Attachments => 'id', - action => sub { - my $id = shift; - return unless prompt( - 'Delete', "Found an sub-attachment without its parent attachment." - ); - delete_record( 'Attachments', $id ); - }, - ); - check_integrity( - Attachments => 'Parent', - Attachments => 'id', - join_condition => 's.TransactionId = t.TransactionId', - ); -}; - -push @CHECKS, 'CustomFields and friends' => sub { - #XXX: ObjectCustomFields needs more love - check_integrity( - 'CustomFieldValues', 'CustomField' => 'CustomFields', 'id', - ); - check_integrity( - 'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id', - ); - foreach my $model ( @models ) { - check_integrity( - 'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id', - condition => 's.ObjectType = ?', - bind_values => [ "RT::$model" ], - ); - } -}; - -push @CHECKS, Templates => sub { - check_integrity( - 'Templates', 'Queue' => 'Queues', 'id', - ); -}; - -push @CHECKS, Scrips => sub { - check_integrity( - 'Scrips', 'Queue' => 'Queues', 'id', - ); - check_integrity( - 'Scrips', 'ScripCondition' => 'ScripConditions', 'id', - ); - check_integrity( - 'Scrips', 'ScripAction' => 'ScripActions', 'id', - ); - check_integrity( - 'Scrips', 'Template' => 'Templates', 'id', - ); -}; - -push @CHECKS, Attributes => sub { - foreach my $model ( @models ) { - check_integrity( - 'Attributes', 'ObjectId' => m2t($model), 'id', - condition => 's.ObjectType = ?', - bind_values => [ "RT::$model" ], - ); - } -}; - -# Fix situations when Creator or LastUpdatedBy references ACL equivalence -# group of a user instead of user -push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub { - my %fix = (); - foreach my $model ( @models ) { - my $class = "RT::$model"; - my $object = $class->new( $RT::SystemUser ); - foreach my $column ( qw(LastUpdatedBy Creator) ) { - next unless $object->_Accessible( $column, 'auto' ); - - my $table = m2t($model); - my $query = <<END; -SELECT m.id, g.id, g.Instance -FROM - Groups g JOIN $table m ON g.id = m.$column -WHERE - g.Domain = ? - AND g.Type = ? -END - my $action = sub { - my ($gid, $uid) = @_; - return unless prompt( - 'Update', - "Looks like there were a bug in old versions of RT back in 2006\n" - ."that has been fixed. If other checks are ok then it's ok to update\n" - ."these records to point them to users instead of groups" - ); - $fix{ $table }{ $column }{ $gid } = $uid; - }; - - my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' ); - while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) { - print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid"; - print STDERR " when must reference user.\n"; - $action->( $gid, $uid ); - if ( keys( %fix ) > 1000 ) { - $sth->finish; - last; - } - } - } - } - - if ( keys %fix ) { - foreach my $table ( keys %fix ) { - foreach my $column ( keys %{ $fix{ $table } } ) { - my $query = "UPDATE $table SET $column = ? WHERE $column = ?"; - while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) { - update_records( $table, { $column => $gid }, { $column => $uid } ); - } - } - } - $redo_check{'FIX: LastUpdatedBy and Creator'} = 1; - } -}; - -push @CHECKS, 'LastUpdatedBy and Creator' => sub { - foreach my $model ( @models ) { - my $class = "RT::$model"; - my $object = $class->new( $RT::SystemUser ); - my $table = $object->Table; - foreach my $column ( qw(LastUpdatedBy Creator) ) { - next unless $object->_Accessible( $column, 'auto' ); - check_integrity( - $table, $column => 'Users', 'id', - action => sub { - my ($id, %prop) = @_; - return unless my $replace_with = prompt_integer( - 'Replace', - "Column $column should point to a user, but there is record #$id in table $table\n" - ."where it's not true. It's ok to replace these wrong references with id of any user.\n" - ."Note that id you enter is not checked. You can peak any user from your DB, but it's\n" - ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n" - ."or something like that.", - "$table.$column -> user #$prop{$column}" - ); - update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } ); - }, - ); - } - } -}; -my %CHECKS = @CHECKS; - -@do_check = do { my $i = 1; grep $i++%2, @CHECKS }; - -while ( my $check = shift @do_check ) { - $CHECKS{ $check }->(); - - foreach my $redo ( keys %redo_check ) { - die "check $redo doesn't exist" unless $CHECKS{ $redo }; - delete $redo_check{ $redo }; - next if grep $_ eq $redo, @do_check; # don't do twice - push @do_check, $redo; - } -} - -sub check_integrity { - my ($stable, @scols) = (shift, shift); - my ($ttable, @tcols) = (shift, shift); - my %args = @_; - - @scols = @{ $scols[0] } if ref $scols[0]; - @tcols = @{ $tcols[0] } if ref $tcols[0]; - - print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n" - if $opt{'verbose'}; - - my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols) - ." FROM $stable s LEFT JOIN $ttable t" - ." ON (". join( - ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1)) - ) .")" - . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "") - ." WHERE t.id IS NULL" - ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols); - - $query .= " AND ( $args{'condition'} )" if $args{'condition'}; - - my @binds = @{ $args{'bind_values'} || [] }; - if ( $tcols[0] eq 'id' && @tcols == 1 ) { - my $type = $TYPE{"$stable.$scols[0]"} || 'number'; - if ( $type eq 'number' ) { - $query .= " AND s.$scols[0] != ?" - } - elsif ( $type eq 'text' ) { - $query .= " AND s.$scols[0] NOT LIKE ?" - } - push @binds, 0; - } - - my $sth = execute_query( $query, @binds ); - while ( my ($sid, @set) = $sth->fetchrow_array ) { - print STDERR "Record #$sid in $stable references not existent record in $ttable\n"; - for ( my $i = 0; $i < @scols; $i++ ) { - print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n"; - } - print STDERR "\t". describe( $stable, $sid ) ."\n"; - $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'}; - } -} - -sub describe { - my ($table, $id) = @_; - return '' unless my $cb = $describe_cb{ $table }; - - my $row = load_record( $table, $id ); - unless ( $row->{id} ) { - $table =~ s/s$//; - return "$table doesn't exist"; - } - return $cb->( $row ); -} - -sub columns_eq_cond { - my ($la, $lt, $lc, $ra, $rt, $rc) = @_; - my $ltype = $TYPE{"$lt.$lc"} || 'number'; - my $rtype = $TYPE{"$rt.$rc"} || 'number'; - return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype; - - if ( $rtype eq 'text' ) { - return "$ra.$rc LIKE CAST($la.$lc AS text)"; - } - elsif ( $ltype eq 'text' ) { - return "$la.$lc LIKE CAST($ra.$rc AS text)"; - } - else { die "don't know how to cast" } -} - -sub check_uniqueness { - my $on = shift; - my %args = @_; - - my @columns = @{ $args{'columns'} }; - - print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n" - if $opt{'versbose'}; - - my ($scond, $tcond); - if ( $scond = $tcond = $args{'condition'} ) { - $scond =~ s/(\s|^)\./$1s./g; - $tcond =~ s/(\s|^)\./$1t./g; - } - - my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns) - ." FROM $on s LEFT JOIN $on t " - ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns) - . ($tcond? " AND ( $tcond )": "") - ." WHERE t.id IS NOT NULL " - ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns); - $query .= " AND ( $scond )" if $scond; - - my $sth = execute_query( - $query, - $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): () - ); - while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) { - print STDERR "Record #$tid in $on has the same set of values as $sid\n"; - for ( my $i = 0; $i < @columns; $i++ ) { - print STDERR "\t$columns[$i] => '$set[$i]'\n"; - } - } -} - -sub load_record { - my ($table, $id) = @_; - my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id ); - return $sth->fetchrow_hashref('NAME_lc'); -} - -sub delete_record { - my ($table, $id) = (@_); - print "Deleting record #$id in $table\n" if $opt{'verbose'}; - my $query = "DELETE FROM $table WHERE id = ?"; - $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] }; - return execute_query( $query, $id ); -} - -sub create_record { - print "Creating a record in $_[0]\n" if $opt{'verbose'}; - $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] }; - return $RT::Handle->Insert( @_ ); -} - -sub update_records { - my $table = shift; - my $where = shift; - my $what = shift; - - my (@where_cols, @where_binds); - while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; } - - my (@what_cols, @what_binds); - while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; } - - print "Updating record(s) in $table\n" if $opt{'verbose'}; - my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols) - ." WHERE ". join(' AND ', map "$_ = ?", @where_cols); - $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] }; - return execute_query( $query, @what_binds, @where_binds ); -} - -sub execute_query { - my ($query, @binds) = @_; - - print "Executing query: $query\n\n" if $opt{'verbose'}; - - my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr; - $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr; - return $sth; -} - -{ my %cached_answer; -sub prompt { - my $action = shift; - my $msg = shift; - my $token = shift || join ':', caller; - - return 0 unless $opt{'resolve'}; - return 1 if $opt{'force'}; - - return $cached_answer{ $token } if exists $cached_answer{ $token }; - - print $msg, "\n"; - print "$action ALL records with the same defect? [N]: "; - my $a = <STDIN>; - return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i; - return $cached_answer{ $token } = 0; -} } - -{ my %cached_answer; -sub prompt_action { - my $actions = shift; - my $msg = shift; - my $token = shift || join ':', caller; - - return '' unless $opt{'resolve'}; - return '' if $opt{'force'}; - return $cached_answer{ $token } if exists $cached_answer{ $token }; - - print $msg, "\n"; - print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: "; - my $a = <STDIN>; - chomp $a; - return $cached_answer{ $token } = '' unless $a; - foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) { - return $cached_answer{ $token } = lc substr $a, 0, 1; - } - return $cached_answer{ $token } = ''; -} } - -{ my %cached_answer; -sub prompt_integer { - my $action = shift; - my $msg = shift; - my $token = shift || join ':', caller; - - return 0 unless $opt{'resolve'}; - return 0 if $opt{'force'}; - - return $cached_answer{ $token } if exists $cached_answer{ $token }; - - print $msg, "\n"; - print "$action ALL records with the same defect? [0]: "; - my $a = <STDIN>; chomp $a; $a = int($a); - return $cached_answer{ $token } = $a; -} } - -1; diff --git a/rt/sbin/rt-validator.in b/rt/sbin/rt-validator.in index 9f8ff2927..331d5f379 100644 --- a/rt/sbin/rt-validator.in +++ b/rt/sbin/rt-validator.in @@ -3,7 +3,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC # <sales@bestpractical.com> # # (Except where explicitly superseded by other copyright notices) @@ -82,35 +82,17 @@ GetOptions( 'resolve', 'force', 'verbose|v', + 'help|h', ); -usage() unless $opt{'check'}; -usage_warning() if $opt{'resolve'} && !$opt{'force'}; - -sub usage { - print STDERR <<END; -Usage: $0 options - -Options: - - $0 --check - $0 --check --verbose - $0 --check --verbose --resolve - $0 --check --verbose --resolve --force - ---check - is mandatory argument, you can use -c, as well. ---verbose - print additional info to STDOUT ---resolve - enable resolver that can delete or create some records ---force - resolve without asking questions - -Description: +if ( $opt{help} || !$opt{check} ) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} -This script checks integrity of records in RT's DB. May delete some invalid -records or ressurect accidentally deleted. +usage_warning() if $opt{'resolve'} && !$opt{'force'}; -END - exit 1; -} sub usage_warning { print <<END; @@ -198,6 +180,9 @@ $redo_on{'Create'} = { GroupMembers => [ 'CGM vs. GM' ], CachedGroupMembers => [ 'CGM vs. GM' ], }; +$redo_on{'Update'} = { + Groups => ['User Defined Group Name uniqueness'], +}; my %describe_cb; %describe_cb = ( @@ -218,7 +203,7 @@ sub m2t($) { my $model = shift; return $cache{$model} if $cache{$model}; my $class = "RT::$model"; - my $object = $class->new( $RT::SystemUser ); + my $object = $class->new( RT->SystemUser ); return $cache{$model} = $object->Table; } } @@ -227,9 +212,9 @@ my (@do_check, %redo_check); my @CHECKS; foreach my $table ( qw(Users Groups) ) { push @CHECKS, "$table -> Principals" => sub { - my $msg = "A record in $table refers not existing record in Principals." - ." The script can either create missing record in Principals" - ." or delete record in $table."; + my $msg = "A record in $table refers to a nonexistent record in Principals." + ." The script can either create the missing record in Principals" + ." or delete the record in $table."; my ($type) = ($table =~ /^(.*)s$/); check_integrity( $table, 'id' => 'Principals', 'id', @@ -255,9 +240,9 @@ foreach my $table ( qw(Users Groups) ) { }; push @CHECKS, "Principals -> $table" => sub { - my $msg = "A record in Principals refers not existing record in $table." - ." In some cases it's possible to resurrect manually such records," - ." but this utility can only delete"; + my $msg = "A record in Principals refers to a nonexistent record in $table." + ." In some cases it's possible to manually resurrect such records," + ." but this utility can only delete records."; check_integrity( 'Principals', 'id' => $table, 'id', @@ -330,7 +315,7 @@ push @CHECKS, 'Queues <-> Role Groups' => sub { action => sub { my $id = shift; return unless prompt( - 'Delete', "Found role group of not existant queue." + 'Delete', "Found a role group of a nonexistent queue." ); delete_record( 'Groups', $id ); @@ -355,7 +340,7 @@ push @CHECKS, 'Tickets <-> Role Groups' => sub { action => sub { my $id = shift; return unless prompt( - 'Delete', "Found a role group of not existant ticket." + 'Delete', "Found a role group of a nonexistent ticket." ); delete_record( 'Groups', $id ); @@ -374,11 +359,41 @@ push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub { ); }; +push @CHECKS, 'System internal group uniqueness' => sub { + check_uniqueness( + 'Groups', + columns => ['Instance', 'Type'], + condition => '.Domain = ?', + bind_values => [ 'SystemInternal' ], + ); +}; + +# CHECK that user defined group names are unique +push @CHECKS, 'User Defined Group Name uniqueness' => sub { + check_uniqueness( + 'Groups', + columns => ['Name'], + condition => '.Domain = ?', + bind_values => [ 'UserDefined' ], + extra_tables => ['Principals sp', 'Principals tp'], + extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)), + extra_values => ['Group', 'Group'], + action => sub { + return unless prompt( + 'Rename', "Found a user defined group with a non-unique Name." + ); + + my $id = shift; + my %cols = @_; + update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) }); + }, + ); +}; push @CHECKS, 'GMs -> Groups, Members' => sub { my $msg = "A record in GroupMembers references an object that doesn't exist." - ." May be you deleted a group or principal directly from DB?" - ." Usually it's ok to delete such records."; + ." Maybe you deleted a group or principal directly from the database?" + ." Usually it's OK to delete such records."; check_integrity( 'GroupMembers', 'GroupId' => 'Groups', 'id', action => sub { @@ -413,7 +428,7 @@ push @CHECKS, 'CGM vs. GM' => sub { "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table." ); - my $gm = RT::GroupMember->new( $RT::SystemUser ); + my $gm = RT::GroupMember->new( RT->SystemUser ); $gm->Load( $id ); die "Couldn't load GM record #$id" unless $gm->id; my $cgm = create_record( 'CachedGroupMembers', @@ -434,7 +449,7 @@ push @CHECKS, 'CGM vs. GM' => sub { return unless prompt( 'Delete', "Found a record in CachedGroupMembers for a (Group, Member) pair" - ." that doesn't exist in GroupMembers table." + ." that doesn't exist in the GroupMembers table." ); delete_record( 'CachedGroupMembers', $id ); @@ -453,7 +468,7 @@ push @CHECKS, 'CGM vs. GM' => sub { ." duplicate in CachedGroupMembers table." ); - my $g = RT::Group->new( $RT::SystemUser ); + my $g = RT::Group->new( RT->SystemUser ); $g->Load( $id ); die "Couldn't load group #$id" unless $g->id; die "Loaded group by $id has id ". $g->id unless $g->id == $id; @@ -490,7 +505,7 @@ push @CHECKS, 'CGM vs. GM' => sub { my $id = shift; return unless prompt( 'Delete', - "Found a record in CachedGroupMembers with Via referencing not existing record." + "Found a record in CachedGroupMembers with Via that references a nonexistent record." ); delete_record( 'CachedGroupMembers', $id ); @@ -508,7 +523,7 @@ push @CHECKS, 'CGM vs. GM' => sub { my $id = shift; return unless prompt( 'Delete', - "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table." + "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table." ); delete_record( 'CachedGroupMembers', $id ); @@ -525,7 +540,7 @@ push @CHECKS, 'CGM vs. GM' => sub { my $id = shift; return unless prompt( 'Delete', - "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table." + "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table." ); delete_record( 'CachedGroupMembers', $id ); @@ -581,7 +596,7 @@ push @CHECKS, 'Tickets -> other' => sub { my $id = shift; return unless prompt( 'Delete', - "Found a ticket that's been merged into a ticket that don't exist anymore." + "Found a ticket that's been merged into a ticket that no longer exists." ); delete_record( 'Tickets', $id ); @@ -627,8 +642,8 @@ push @CHECKS, 'Transactions -> other' => sub { action => sub { my $id = shift; return unless prompt( - 'Delete', "Found a transaction regarding changes of Owner," - ." but User with id stored in OldValue column doesn't exist anymore." + 'Delete', "Found a transaction regarding Owner changes," + ." but the User with id stored in OldValue column doesn't exist anymore." ); delete_record( 'Transactions', $id ); @@ -641,8 +656,8 @@ push @CHECKS, 'Transactions -> other' => sub { action => sub { my $id = shift; return unless prompt( - 'Delete', "Found a transaction regarding changes of Owner," - ." but User with id stored in NewValue column doesn't exist anymore." + 'Delete', "Found a transaction regarding Owner changes," + ." but the User with id stored in NewValue column doesn't exist anymore." ); delete_record( 'Transactions', $id ); @@ -656,8 +671,8 @@ push @CHECKS, 'Transactions -> other' => sub { action => sub { my $id = shift; return unless prompt( - 'Delete', "Found a transaction describing watchers change," - ." but User with id stored in OldValue column doesn't exist anymore." + 'Delete', "Found a transaction describing watcher changes," + ." but the User with id stored in OldValue column doesn't exist anymore." ); delete_record( 'Transactions', $id ); @@ -671,8 +686,8 @@ push @CHECKS, 'Transactions -> other' => sub { action => sub { my $id = shift; return unless prompt( - 'Delete', "Found a transaction describing watchers change," - ." but User with id stored in NewValue column doesn't exist anymore." + 'Delete', "Found a transaction describing watcher changes," + ." but the User with id stored in NewValue column doesn't exist anymore." ); delete_record( 'Transactions', $id ); @@ -701,8 +716,8 @@ push @CHECKS, 'Transactions -> other' => sub { action => sub { my $id = shift; return unless prompt( - 'Delete', "Found a transaction describing queue change," - ." but Queue with id stored in NewValue column doesn't exist anymore." + 'Delete', "Found a transaction describing a queue change," + ." but the Queue with id stored in the NewValue column doesn't exist anymore." ); delete_record( 'Transactions', $id ); @@ -715,8 +730,8 @@ push @CHECKS, 'Transactions -> other' => sub { action => sub { my $id = shift; return unless prompt( - 'Delete', "Found a transaction describing queue change," - ." but Queue with id stored in OldValue column doesn't exist anymore." + 'Delete', "Found a transaction describing a queue change," + ." but the Queue with id stored in the OldValue column doesn't exist anymore." ); delete_record( 'Transactions', $id ); @@ -814,7 +829,7 @@ push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub { my %fix = (); foreach my $model ( @models ) { my $class = "RT::$model"; - my $object = $class->new( $RT::SystemUser ); + my $object = $class->new( RT->SystemUser ); foreach my $column ( qw(LastUpdatedBy Creator) ) { next unless $object->_Accessible( $column, 'auto' ); @@ -867,7 +882,7 @@ END push @CHECKS, 'LastUpdatedBy and Creator' => sub { foreach my $model ( @models ) { my $class = "RT::$model"; - my $object = $class->new( $RT::SystemUser ); + my $object = $class->new( RT->SystemUser ); my $table = $object->Table; foreach my $column ( qw(LastUpdatedBy Creator) ) { next unless $object->_Accessible( $column, 'auto' ); @@ -941,7 +956,7 @@ sub check_integrity { my $sth = execute_query( $query, @binds ); while ( my ($sid, @set) = $sth->fetchrow_array ) { - print STDERR "Record #$sid in $stable references not existent record in $ttable\n"; + 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"; } @@ -984,7 +999,7 @@ sub check_uniqueness { my @columns = @{ $args{'columns'} }; print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n" - if $opt{'versbose'}; + if $opt{'verbose'}; my ($scond, $tcond); if ( $scond = $tcond = $args{'condition'} ) { @@ -996,19 +1011,23 @@ sub check_uniqueness { ." FROM $on s LEFT JOIN $on t " ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns) . ($tcond? " AND ( $tcond )": "") + . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "") ." WHERE t.id IS NOT NULL " ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns); $query .= " AND ( $scond )" if $scond; + $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'}; my $sth = execute_query( $query, - $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): () + $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (), + $args{'extra_values'}? (@{ $args{'extra_values'} }): () ); while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) { print STDERR "Record #$tid in $on has the same set of values as $sid\n"; for ( my $i = 0; $i < @columns; $i++ ) { print STDERR "\t$columns[$i] => '$set[$i]'\n"; } + $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'}; } } @@ -1117,3 +1136,47 @@ sub prompt_integer { } } 1; + +__END__ + +=head1 NAME + +rt-validator - check and correct validity of records in RT's database + +=head1 SYNOPSIS + + rt-validator --check + rt-validator --check --verbose + rt-validator --check --verbose --resolve + rt-validator --check --verbose --resolve --force + +=head1 DESCRIPTION + +This script checks integrity of records in RT's DB. May delete some invalid +records or ressurect accidentally deleted. + +=head1 OPTIONS + +=over + +=item check + + mandatory. + + it's equall to -c + +=item verbose + + print additional info to STDOUT + it's equall to -v + +=item resolve + + enable resolver that can delete or create some records + +=item force + + resolve without asking questions + +=back + diff --git a/rt/sbin/standalone_httpd b/rt/sbin/standalone_httpd new file mode 100755 index 000000000..3386cd1fe --- /dev/null +++ b/rt/sbin/standalone_httpd @@ -0,0 +1,283 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use warnings; +use strict; + +# fix lib paths, some may be relative +BEGIN { + die <<EOT if ${^TAINT}; +RT does not run under Perl's "taint mode". Remove -T from the command +line, or remove the PerlTaintCheck parameter from your mod_perl +configuration. +EOT + + require File::Spec; + my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib"); + my $bin_path; + + for my $lib (@libs) { + unless ( File::Spec->file_name_is_absolute($lib) ) { + unless ($bin_path) { + if ( File::Spec->file_name_is_absolute(__FILE__) ) { + $bin_path = ( File::Spec->splitpath(__FILE__) )[1]; + } + else { + require FindBin; + no warnings "once"; + $bin_path = $FindBin::Bin; + } + } + $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); + } + unshift @INC, $lib; + } + +} + +use Getopt::Long; +no warnings 'once'; + +if (grep { m/help/ } @ARGV) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +require RT; +RT->LoadConfig(); +RT->InitLogging(); +require Module::Refresh if RT->Config->Get('DevelMode'); + +require RT::Handle; +my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + +unless ( $integrity ) { + print STDERR <<EOF; + +RT couldn't connect to the database where tickets are stored. +If this is a new installation of RT, you should visit the URL below +to configure RT and initialize your database. + +If this is an existing RT installation, this may indicate a database +connectivity problem. + +The error RT got back when trying to connect to your database was: + +$msg + +EOF + + require RT::Installer; + # don't enter install mode if the file exists but is unwritable + if (-e RT::Installer->ConfigFile && !-w _) { + die 'Since your configuration exists (' + . RT::Installer->ConfigFile + . ") but is not writable, I'm refusing to do anything.\n"; + } + + RT->Config->Set( 'LexiconLanguages' => '*' ); + RT::I18N->Init; + + RT->InstallMode(1); +} else { + RT->Init(); + + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post'); + unless ( $status ) { + print STDERR $msg, "\n\n"; + exit -1; + } +} + +# we must disconnect DB before fork +if ($RT::Handle) { + $RT::Handle->dbh(undef); + undef $RT::Handle; +} + +require RT::Interface::Web::Handler; +my $app = RT::Interface::Web::Handler->PSGIApp; + +if ($ENV{RT_TESTING}) { + my $screen_logger = $RT::Logger->remove('screen'); + require Log::Dispatch::Perl; + $RT::Logger->add( + Log::Dispatch::Perl->new( + name => 'rttest', + min_level => $screen_logger->min_level, + action => { + error => 'warn', + critical => 'warn' + } + ) + ); + require Plack::Middleware::Test::StashWarnings; + $app = Plack::Middleware::Test::StashWarnings->wrap($app); +} + +# when used as a psgi file +if (caller) { + return $app; +} + + +# load appropriate server + +require Plack::Runner; + +my $is_fastcgi = $0 =~ m/fcgi$/; +my $r = Plack::Runner->new( $0 =~ 'standalone' ? ( server => 'Standalone' ) : + $is_fastcgi ? ( server => 'FCGI' ) + : (), + env => 'deployment' ); + +# figure out the port +my $port; + +# handle "rt-server 8888" for back-compat, but complain about it +if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) { + warn "Deprecated: please run $0 --port $ARGV[0] instead\n"; + unshift @ARGV, '--port'; +} + +my @args = @ARGV; + +use List::MoreUtils 'last_index'; +my $last_index = last_index { $_ eq '--port' } @args; + +my $explicit_port; + +if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) { + $explicit_port = $args[$last_index+1]; + $port = $explicit_port; + + # inform the rest of the system what port we manually chose + my $old_app = $app; + $app = sub { + my $env = shift; + + $env->{'rt.explicit_port'} = $port; + + $old_app->($env, @_); + }; +} +else { + # default to the configured WebPort and inform Plack::Runner + $port = RT->Config->Get('WebPort') || '8080'; + push @args, '--port', $port; +} + +push @args, '--server', 'Standalone' if RT->InstallMode; +push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args; + +$r->parse_options(@args); + +delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything + +unless ($r->{env} eq 'development') { + push @{$r->{options}}, server_ready => sub { + my($args) = @_; + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }; +} +eval { $r->run($app) }; +if (my $err = $@) { + handle_startup_error($err); +} + +exit 0; + +sub handle_startup_error { + my $err = shift; + if ( $err =~ /listen/ ) { + handle_bind_error(); + } else { + die + "Something went wrong while trying to run RT's standalone web server:\n\t" + . $err; + } +} + + +sub handle_bind_error { + + print STDERR <<EOF; +WARNING: RT couldn't start up a web server on port @{[$port]}. +This is often the case if the port is already in use or you're running @{[$0]} +as someone other than your system's "root" user. You may also specify a +temporary port with: $0 --port <port> +EOF + + if ($explicit_port) { + print STDERR + "Please check your system configuration or choose another port\n\n"; + } +} + +__END__ + +=head1 NAME + +rt-server - RT standalone server + +=head1 SYNOPSIS + + # runs prefork server listening on port 8080, requires Starlet + rt-server --port 8080 + + # runs server listening on port 8080 + rt-server --server Standalone --port 8080 + # or + standalone_httpd --port 8080 + + # runs other PSGI server on port 8080 + rt-server --server Starman --port 8080 diff --git a/rt/sbin/standalone_httpd.in b/rt/sbin/standalone_httpd.in new file mode 100644 index 000000000..45c377088 --- /dev/null +++ b/rt/sbin/standalone_httpd.in @@ -0,0 +1,283 @@ +#!@PERL@ -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} +use warnings; +use strict; + +# fix lib paths, some may be relative +BEGIN { + die <<EOT if ${^TAINT}; +RT does not run under Perl's "taint mode". Remove -T from the command +line, or remove the PerlTaintCheck parameter from your mod_perl +configuration. +EOT + + require File::Spec; + my @libs = ("@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 Getopt::Long; +no warnings 'once'; + +if (grep { m/help/ } @ARGV) { + require Pod::Usage; + print Pod::Usage::pod2usage( { verbose => 2 } ); + exit; +} + +require RT; +RT->LoadConfig(); +RT->InitLogging(); +require Module::Refresh if RT->Config->Get('DevelMode'); + +require RT::Handle; +my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity; + +unless ( $integrity ) { + print STDERR <<EOF; + +RT couldn't connect to the database where tickets are stored. +If this is a new installation of RT, you should visit the URL below +to configure RT and initialize your database. + +If this is an existing RT installation, this may indicate a database +connectivity problem. + +The error RT got back when trying to connect to your database was: + +$msg + +EOF + + require RT::Installer; + # don't enter install mode if the file exists but is unwritable + if (-e RT::Installer->ConfigFile && !-w _) { + die 'Since your configuration exists (' + . RT::Installer->ConfigFile + . ") but is not writable, I'm refusing to do anything.\n"; + } + + RT->Config->Set( 'LexiconLanguages' => '*' ); + RT::I18N->Init; + + RT->InstallMode(1); +} else { + RT->Init(); + + my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post'); + unless ( $status ) { + print STDERR $msg, "\n\n"; + exit -1; + } +} + +# we must disconnect DB before fork +if ($RT::Handle) { + $RT::Handle->dbh(undef); + undef $RT::Handle; +} + +require RT::Interface::Web::Handler; +my $app = RT::Interface::Web::Handler->PSGIApp; + +if ($ENV{RT_TESTING}) { + my $screen_logger = $RT::Logger->remove('screen'); + require Log::Dispatch::Perl; + $RT::Logger->add( + Log::Dispatch::Perl->new( + name => 'rttest', + min_level => $screen_logger->min_level, + action => { + error => 'warn', + critical => 'warn' + } + ) + ); + require Plack::Middleware::Test::StashWarnings; + $app = Plack::Middleware::Test::StashWarnings->wrap($app); +} + +# when used as a psgi file +if (caller) { + return $app; +} + + +# load appropriate server + +require Plack::Runner; + +my $is_fastcgi = $0 =~ m/fcgi$/; +my $r = Plack::Runner->new( $0 =~ 'standalone' ? ( server => 'Standalone' ) : + $is_fastcgi ? ( server => 'FCGI' ) + : (), + env => 'deployment' ); + +# figure out the port +my $port; + +# handle "rt-server 8888" for back-compat, but complain about it +if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) { + warn "Deprecated: please run $0 --port $ARGV[0] instead\n"; + unshift @ARGV, '--port'; +} + +my @args = @ARGV; + +use List::MoreUtils 'last_index'; +my $last_index = last_index { $_ eq '--port' } @args; + +my $explicit_port; + +if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) { + $explicit_port = $args[$last_index+1]; + $port = $explicit_port; + + # inform the rest of the system what port we manually chose + my $old_app = $app; + $app = sub { + my $env = shift; + + $env->{'rt.explicit_port'} = $port; + + $old_app->($env, @_); + }; +} +else { + # default to the configured WebPort and inform Plack::Runner + $port = RT->Config->Get('WebPort') || '8080'; + push @args, '--port', $port; +} + +push @args, '--server', 'Standalone' if RT->InstallMode; +push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args; + +$r->parse_options(@args); + +delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything + +unless ($r->{env} eq 'development') { + push @{$r->{options}}, server_ready => sub { + my($args) = @_; + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }; +} +eval { $r->run($app) }; +if (my $err = $@) { + handle_startup_error($err); +} + +exit 0; + +sub handle_startup_error { + my $err = shift; + if ( $err =~ /listen/ ) { + handle_bind_error(); + } else { + die + "Something went wrong while trying to run RT's standalone web server:\n\t" + . $err; + } +} + + +sub handle_bind_error { + + print STDERR <<EOF; +WARNING: RT couldn't start up a web server on port @{[$port]}. +This is often the case if the port is already in use or you're running @{[$0]} +as someone other than your system's "root" user. You may also specify a +temporary port with: $0 --port <port> +EOF + + if ($explicit_port) { + print STDERR + "Please check your system configuration or choose another port\n\n"; + } +} + +__END__ + +=head1 NAME + +rt-server - RT standalone server + +=head1 SYNOPSIS + + # runs prefork server listening on port 8080, requires Starlet + rt-server --port 8080 + + # runs server listening on port 8080 + rt-server --server Standalone --port 8080 + # or + standalone_httpd --port 8080 + + # runs other PSGI server on port 8080 + rt-server --server Starman --port 8080 diff --git a/rt/sbin/tweak-template-locstring b/rt/sbin/tweak-template-locstring deleted file mode 100644 index 457641986..000000000 --- a/rt/sbin/tweak-template-locstring +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -w -# BEGIN BPS TAGGED BLOCK {{{ -# -# COPYRIGHT: -# -# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC -# <sales@bestpractical.com> -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: -# -# This work is made available to you under the terms of Version 2 of -# the GNU General Public License. A copy of that license should have -# been provided with this software, but in any event can be snarfed -# from www.gnu.org. -# -# This work is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -# 02110-1301 or visit their web page on the internet at -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: -# -# (The following paragraph is not intended to limit the rights granted -# to you to modify and distribute this software under the terms of -# the GNU General Public License and is only of importance to you if -# you choose to contribute your changes and enhancements to the -# community by submitting them to Best Practical Solutions, LLC.) -# -# By intentionally submitting any modifications, corrections or -# derivatives to this work, or any other work intended for use with -# Request Tracker, to Best Practical Solutions, LLC, you confirm that -# you are the copyright holder for those contributions and you grant -# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, -# royalty-free, perpetual, license to use, copy, create derivative -# works based on those contributions, and sublicense and distribute -# those contributions and any derivatives thereof. -# -# END BPS TAGGED BLOCK }}} -use strict; -# run this script with: -# perl -0pi sbin/tweak-template-locstring `ack -f share/html -G 'html$'` -s!\<\&\|\/l([^&]*)\&\>[\n\s]+(.*?)[\n\s]*\<\/\&\>!;my ($arg, $x) = ($1, $2); $x =~ s/\s*\n\s*/ /g;"<&|/l$arg&>$x</&>"!smge; - - -1; |