[freeside-commits] branch FREESIDE_2_3_BRANCH updated. 4fe5186a914e6dd00c31c61c44c4026a12f4634a
Ivan
ivan at 420.am
Fri Jun 1 19:44:56 PDT 2012
The branch, FREESIDE_2_3_BRANCH has been updated
via 4fe5186a914e6dd00c31c61c44c4026a12f4634a (commit)
from b87e9dfa32b9457a546732baca58642a36be3d28 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 4fe5186a914e6dd00c31c61c44c4026a12f4634a
Author: Ivan Kohler <ivan at freeside.biz>
Date: Fri Jun 1 19:44:53 2012 -0700
remove autogenerated files entirely to avoid git merge conflicts
diff --git a/rt/etc/upgrade/3.8-ical-extension b/rt/etc/upgrade/3.8-ical-extension
deleted file mode 100755
index 7e3b877..0000000
--- a/rt/etc/upgrade/3.8-ical-extension
+++ /dev/null
@@ -1,96 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-use lib "/opt/rt3/local/lib";
-use lib "/opt/rt3/lib";
-
-
-use RT;
-RT::LoadConfig();
-RT::Init();
-
-use RT::Attributes;
-my $attrs = RT::Attributes->new( $RT::SystemUser );
-$attrs->Limit(FIELD => 'ObjectType', OPERATOR=> '=', VALUE => 'RT::User');
-$attrs->Limit(FIELD => 'Name', OPERATOR=> '=', VALUE => 'ical-auth-token');
-while ( my $attr = $attrs->Next ) {
- my $uid = $attr->ObjectId;
- print "Processing auth token of user #". $uid ."...\n";
-
- my $user = RT::User->new( $RT::SystemUser );
- $user->Load( $uid );
- unless ( $user->id ) {
- print STDERR "\tERROR. Couldn't load user record\n";
- next;
- }
-
- my ($status, $msg);
-
- ($status, $msg) = $user->DeleteAttribute('AuthToken')
- if $user->FirstAttribute('AuthToken');
- unless ( $status ) {
- print STDERR "\tERROR. Couldn't delete duplicated attribute: $msg\n";
- next;
- } else {
- print "\tdeleted duplicate attribute\n";
- }
-
- ($status, $msg) = $attr->SetName('AuthToken');
- unless ( $status ) {
- print STDERR "\tERROR. Couldn't rename attribute: $msg\n";
- next;
- } else {
- print "\trenamed attribute\n";
- }
- print "\tDONE\n";
-}
-
-exit 0;
diff --git a/rt/etc/upgrade/generate-rtaddressregexp b/rt/etc/upgrade/generate-rtaddressregexp
deleted file mode 100755
index cac0872..0000000
--- a/rt/etc/upgrade/generate-rtaddressregexp
+++ /dev/null
@@ -1,87 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-use lib "/opt/rt3/local/lib";
-use lib "/opt/rt3/lib";
-
-use RT;
-RT::LoadConfig();
-RT->Config->Set('LogToScreen' => 'debug');
-RT::Init();
-
-$| = 1;
-
-if (my $re = RT->Config->Get('RTAddressRegexp')) {
- print "No need to use this script, you already have RTAddressRegexp set to $re\n";
- exit;
-}
-
-use RT::Queues;
-my $queues = RT::Queues->new( $RT::SystemUser );
-$queues->UnLimit;
-$queues->RowsPerPage(100);
-
-my @addresses = (RT->Config->Get('CorrespondAddress'), RT->Config->Get('CommentAddress'));
-while ( my $queue = $queues->Next ) {
- push @addresses, $queue->CorrespondAddress, $queue->CommentAddress;
-}
-
-my %seen;
-my $re = join '|', map "\Q$_\E",
- grep defined && length && !$seen{ lc $_ }++,
- @addresses;
-
-print <<ENDDESCRIPTION;
-You can add the following to RT_SiteConfig.pm, but may want to collapse it into a more efficient regexp.
-Keep in mind that this only contains the email addresses that RT knows about, you should also examine
-your mail system for aliases that reach RT but which RT doesn't know about.
-ENDDESCRIPTION
-print "Set(\$RTAddressRegexp,'^(?:${re})\$');\n";
diff --git a/rt/etc/upgrade/split-out-cf-categories b/rt/etc/upgrade/split-out-cf-categories
deleted file mode 100755
index b1012ec..0000000
--- a/rt/etc/upgrade/split-out-cf-categories
+++ /dev/null
@@ -1,171 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-use lib "/opt/rt3/local/lib";
-use lib "/opt/rt3/lib";
-
-use RT;
-RT::LoadConfig();
-RT->Config->Set('LogToScreen' => 'debug');
-RT::Init();
-
-$| = 1;
-
-$RT::Handle->BeginTransaction();
-
-use RT::CustomFields;
-my $CFs = RT::CustomFields->new( $RT::SystemUser );
-$CFs->UnLimit;
-$CFs->Limit( FIELD => 'Type', VALUE => 'Select' );
-
-my $seen;
-while (my $cf = $CFs->Next ) {
- next if $cf->BasedOnObj->Id;
- my @categories;
- my %mapping;
- my $values = $cf->Values;
- while (my $value = $values->Next) {
- next unless defined $value->Category and length $value->Category;
- push @categories, $value->Category unless grep {$_ eq $value->Category} @categories;
- $mapping{$value->Name} = $value->Category;
- }
- next unless @categories;
-
- $seen++;
- print "Found CF '@{[$cf->Name]}' with categories:\n";
- print " $_\n" for @categories;
-
- print "Split this CF's categories into a hierarchical custom field (Y/n)? ";
- my $dothis = <>;
- next if $dothis =~ /n/i;
-
- print "Enter name of CF to create as category ('@{[$cf->Name]} category'): ";
- my $newname = <>;
- chomp $newname;
- $newname = $cf->Name . " category" unless length $newname;
-
- # bump the CF's sort oder up by one
- $cf->SetSortOrder( ($cf->SortOrder || 0) + 1 );
-
- # ..and add a new CF before it
- my $new = RT::CustomField->new( $RT::SystemUser );
- my ($id, $msg) = $new->Create(
- Name => $newname,
- Type => 'Select',
- MaxValues => 1,
- LookupType => $cf->LookupType,
- SortOrder => $cf->SortOrder - 1,
- );
- die "Can't create custom field '$newname': $msg" unless $id;
-
- # Set the CF to be based on what we just made
- $cf->SetBasedOn( $new->Id );
-
- # Apply it to all of the same things
- {
- my $ocfs = RT::ObjectCustomFields->new( $RT::SystemUser );
- $ocfs->LimitToCustomField( $cf->Id );
- while (my $ocf = $ocfs->Next) {
- my $newocf = RT::ObjectCustomField->new( $RT::SystemUser );
- ($id, $msg) = $newocf->Create(
- SortOrder => $ocf->SortOrder,
- CustomField => $new->Id,
- ObjectId => $ocf->ObjectId,
- );
- die "Can't create ObjectCustomField: $msg" unless $id;
- }
- }
-
- # Copy over all of the rights
- {
- my $acl = RT::ACL->new( $RT::SystemUser );
- $acl->LimitToObject( $cf );
- while (my $ace = $acl->Next) {
- my $newace = RT::ACE->new( $RT::SystemUser );
- ($id, $msg) = $newace->Create(
- PrincipalId => $ace->PrincipalId,
- PrincipalType => $ace->PrincipalType,
- RightName => $ace->RightName,
- Object => $new,
- );
- die "Can't assign rights: $msg" unless $id;
- }
- }
-
- # Add values for all of the categories
- for my $i (0..$#categories) {
- ($id, $msg) = $new->AddValue(
- Name => $categories[$i],
- SortOrder => $i + 1,
- );
- die "Can't create custom field value: $msg" unless $id;
- }
-
- # Grovel through all ObjectCustomFieldValues, and add the
- # appropriate category
- {
- my $ocfvs = RT::ObjectCustomFieldValues->new( $RT::SystemUser );
- $ocfvs->LimitToCustomField( $cf->Id );
- while (my $ocfv = $ocfvs->Next) {
- next unless exists $mapping{$ocfv->Content};
- my $newocfv = RT::ObjectCustomFieldValue->new( $RT::SystemUser );
- ($id, $msg) = $newocfv->Create(
- CustomField => $new->Id,
- ObjectType => $ocfv->ObjectType,
- ObjectId => $ocfv->ObjectId,
- Content => $mapping{$ocfv->Content},
- );
- }
- }
-}
-
-$RT::Handle->Commit;
-print "No custom fields with categories found\n" unless $seen;
diff --git a/rt/etc/upgrade/vulnerable-passwords b/rt/etc/upgrade/vulnerable-passwords
deleted file mode 100755
index 0272e01..0000000
--- a/rt/etc/upgrade/vulnerable-passwords
+++ /dev/null
@@ -1,142 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-use lib "/opt/rt3/local/lib";
-use lib "/opt/rt3/lib";
-
-use RT;
-RT::LoadConfig;
-RT::Init;
-
-$| = 1;
-
-use Getopt::Long;
-use Digest::SHA;
-my $fix;
-GetOptions("fix!" => \$fix);
-
-use RT::Users;
-my $users = RT::Users->new( $RT::SystemUser );
-$users->Limit(
- FIELD => 'Password',
- OPERATOR => 'IS NOT',
- VALUE => 'NULL',
- ENTRYAGGREGATOR => 'AND',
-);
-$users->Limit(
- FIELD => 'Password',
- OPERATOR => '!=',
- VALUE => '*NO-PASSWORD*',
- ENTRYAGGREGATOR => 'AND',
-);
-$users->Limit(
- FIELD => 'Password',
- OPERATOR => 'NOT STARTSWITH',
- VALUE => '!',
- ENTRYAGGREGATOR => 'AND',
-);
-push @{$users->{'restrictions'}{ "main.Password" }}, "AND", {
- field => 'LENGTH(main.Password)',
- op => '<',
- value => '40',
-};
-
-# we want to update passwords on disabled users
-$users->{'find_disabled_rows'} = 1;
-
-my $count = $users->Count;
-if ($count == 0) {
- print "No users with unsalted or weak cryptography found.\n";
- exit 0;
-}
-
-if ($fix) {
- print "Upgrading $count users...\n";
- while (my $u = $users->Next) {
- my $stored = $u->__Value("Password");
- my $raw;
- if (length $stored == 32) {
- $raw = pack("H*",$stored);
- } elsif (length $stored == 22) {
- $raw = MIME::Base64::decode_base64($stored);
- } elsif (length $stored == 13) {
- printf "%20s => Old crypt() format, cannot upgrade\n", $u->Name;
- } else {
- printf "%20s => Unknown password format!\n", $u->Name;
- }
- next unless $raw;
-
- my $salt = pack("C4",map{int rand(256)} 1..4);
- my $sha = Digest::SHA::sha256(
- $salt . $raw
- );
- $u->_Set(
- Field => "Password",
- Value => MIME::Base64::encode_base64(
- $salt . substr($sha,0,26), ""),
- );
- }
- print "Done.\n";
- exit 0;
-} else {
- if ($count < 20) {
- print "$count users found with unsalted or weak-cryptography passwords:\n";
- print " Id | Name\n", "-"x9, "+", "-"x9, "\n";
- while (my $u = $users->Next) {
- printf "%8d | %s\n", $u->Id, $u->Name;
- }
- } else {
- print "$count users found with unsalted or weak-cryptography passwords\n";
- }
-
- print "\n", "Run again with --fix to upgrade.\n";
- exit 1;
-}
diff --git a/rt/sbin/rt-attributes-viewer b/rt/sbin/rt-attributes-viewer
deleted file mode 100755
index e141b83..0000000
--- a/rt/sbin/rt-attributes-viewer
+++ /dev/null
@@ -1,110 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-my $id = shift;
-usage() unless $id;
-
-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;
-}
-
-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;
-}
-
-my %res = ();
-$res{$_} = $attr->$_() foreach qw(ObjectType ObjectId Name Description Content ContentType);
-
-use Data::Dumper;
-print "Content of attribute #$id: ". Dumper( \%res );
-
diff --git a/rt/sbin/rt-clean-sessions b/rt/sbin/rt-clean-sessions
deleted file mode 100755
index 1649b34..0000000
--- 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 at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, "older=s", "debug", "help", "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-dump-database b/rt/sbin/rt-dump-database
deleted file mode 100755
index 2cdcc92..0000000
--- 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 at 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 = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use RT;
-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-email-dashboards b/rt/sbin/rt-email-dashboards
deleted file mode 100755
index 7cdb9c4..0000000
--- a/rt/sbin/rt-email-dashboards
+++ /dev/null
@@ -1,571 +0,0 @@
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use 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,
- );
- $mason->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
- $mason->interp->set_escape( u => \&RT::Interface::Web::EscapeURI );
- $mason->interp->set_escape( j => \&RT::Interface::Web::EscapeJS );
- }
- 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-digest b/rt/sbin/rt-email-digest
deleted file mode 100755
index 466ac04..0000000
--- 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 at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use warnings;
-use strict;
-
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Date::Format qw( strftime );
-use Getopt::Long;
-use RT;
-use RT::Interface::CLI qw( CleanEnv loc );
-use RT::Interface::Email;
-
-CleanEnv();
-RT::LoadConfig();
-RT::Init();
-
-sub usage {
- my ($error) = @_;
- print loc("Usage: ") . "$0 -m (daily|weekly) [--print] [--help]\n";
- print loc(
- "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.",
- $0
- ) . "\n";
- print "\n\t-m, --mode\t"
- . loc("Specify whether this is a daily or weekly run.") . "\n";
- print "\t-p, --print\t"
- . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent")
- . "\n";
- print "\t-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-group-admin b/rt/sbin/rt-email-group-admin
deleted file mode 100755
index 2025a24..0000000
--- 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 at 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 at bar.com' --user foo at bar.com
- rt-email-group-admin --create 'Notify VIPs' --user vip1 at bar.com
- rt-email-group-admin --add 'Notify VIPs' --user vip2 at bar.com --group vip1 --user vip3 at 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 at bar.com'
-
-=head1 DESCRIPTION
-
-This script list, create, modify or delete scrip actions in the RT DB. Once
-you've created an action you can use it in a scrip.
-
-For example you can create the following action using this script:
-
- rt-email-group-admin --create 'Notify developers' --group 'Development Team'
-
-Then you can add the followoing scrip to your Bugs queue:
-
- Condition: On Create
- Action: Notify developers
- Template: Transaction
- Stage: TransactionCreate
-
-Your development team will be notified on every new ticket in the queue.
-
-=cut
-
-use warnings;
-use strict;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use 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 at bestpractical.comE<gt>
-
-=head1 SEE ALSO
-
-L<RT::Action::NotifyGroup>, L<RT::Action::NotifyGroupAsComment>
-
-=cut
diff --git a/rt/sbin/rt-server b/rt/sbin/rt-server
deleted file mode 100755
index 28370ae..0000000
--- 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 at 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 = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use RT;
-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-shredder b/rt/sbin/rt-shredder
deleted file mode 100755
index 8cc0c00..0000000
--- 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 at 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 = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use RT::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-validator b/rt/sbin/rt-validator
deleted file mode 100755
index 4bf84af..0000000
--- 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 at bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Getopt::Long;
-my %opt = ();
-GetOptions(
- \%opt,
- 'check|c',
- 'resolve',
- 'force',
- 'verbose|v',
-);
-
-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;
-
- at 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/t/data/configs/apache2.2+fastcgi.conf b/rt/t/data/configs/apache2.2+fastcgi.conf
deleted file mode 100644
index 0a69450..0000000
--- a/rt/t/data/configs/apache2.2+fastcgi.conf
+++ /dev/null
@@ -1,44 +0,0 @@
-ServerRoot %%SERVER_ROOT%%
-PidFile %%PID_FILE%%
-LockFile %%LOCK_FILE%%
-ServerAdmin root at localhost
-
-%%LOAD_MODULES%%
-
-FastCgiIpcDir %%TMP_DIR%%
-
-<IfModule !mpm_netware_module>
-<IfModule !mpm_winnt_module>
-User freeside
-Group freeside
-</IfModule>
-</IfModule>
-
-Listen %%LISTEN%%
-
-ErrorLog "%%LOG_FILE%%"
-LogLevel debug
-
-<Directory />
- Options FollowSymLinks
- AllowOverride None
- Order deny,allow
- Deny from all
-</Directory>
-
-AddDefaultCharset UTF-8
-
-FastCgiServer %%RT_BIN_PATH%%/mason_handler.fcgi -processes 1 -idle-timeout 180 -initial-env RT_SITE_CONFIG=%%RT_SITE_CONFIG%%
-
-Alias /NoAuth/images/ %%DOCUMENT_ROOT%%/NoAuth/images/
-ScriptAlias / %%RT_BIN_PATH%%/mason_handler.fcgi/
-
-DocumentRoot "%%DOCUMENT_ROOT%%"
-<Location />
- Order allow,deny
- Allow from all
-
- Options +ExecCGI
- AddHandler fastcgi-script fcgi
-</Location>
-
diff --git a/rt/t/data/configs/apache2.2+mod_perl.conf b/rt/t/data/configs/apache2.2+mod_perl.conf
deleted file mode 100644
index 17761c5..0000000
--- a/rt/t/data/configs/apache2.2+mod_perl.conf
+++ /dev/null
@@ -1,41 +0,0 @@
-ServerRoot %%SERVER_ROOT%%
-PidFile %%PID_FILE%%
-LockFile %%LOCK_FILE%%
-ServerAdmin root at localhost
-
-%%LOAD_MODULES%%
-
-<IfModule !mpm_netware_module>
-<IfModule !mpm_winnt_module>
-User freeside
-Group freeside
-</IfModule>
-</IfModule>
-
-Listen %%LISTEN%%
-
-ErrorLog "%%LOG_FILE%%"
-LogLevel debug
-
-<Directory />
- Options FollowSymLinks
- AllowOverride None
- Order deny,allow
- Deny from all
-</Directory>
-
-AddDefaultCharset UTF-8
-PerlSetEnv RT_SITE_CONFIG %%RT_SITE_CONFIG%%
-PerlRequire %%RT_BIN_PATH%%/webmux.pl
-
-RedirectMatch permanent (.*)/$ $1/index.html
-
-DocumentRoot "%%DOCUMENT_ROOT%%"
-<Directory "%%DOCUMENT_ROOT%%">
- Order allow,deny
- Allow from all
-
- SetHandler perl-script
- PerlResponseHandler RT::Mason
-</Directory>
-
-----------------------------------------------------------------------
Summary of changes:
rt/etc/upgrade/3.8-ical-extension | 96 ---
rt/etc/upgrade/generate-rtaddressregexp | 87 ---
rt/etc/upgrade/split-out-cf-categories | 171 -----
rt/etc/upgrade/vulnerable-passwords | 142 ----
rt/sbin/rt-attributes-viewer | 110 ---
rt/sbin/rt-clean-sessions | 190 -----
rt/sbin/rt-dump-database | 199 -----
rt/sbin/rt-email-dashboards | 571 ---------------
rt/sbin/rt-email-digest | 337 ---------
rt/sbin/rt-email-group-admin | 508 -------------
rt/sbin/rt-server | 129 ----
rt/sbin/rt-shredder | 323 ---------
rt/sbin/rt-validator | 1119 -----------------------------
rt/t/data/configs/apache2.2+fastcgi.conf | 44 --
rt/t/data/configs/apache2.2+mod_perl.conf | 41 --
15 files changed, 0 insertions(+), 4067 deletions(-)
delete mode 100755 rt/etc/upgrade/3.8-ical-extension
delete mode 100755 rt/etc/upgrade/generate-rtaddressregexp
delete mode 100755 rt/etc/upgrade/split-out-cf-categories
delete mode 100755 rt/etc/upgrade/vulnerable-passwords
delete mode 100755 rt/sbin/rt-attributes-viewer
delete mode 100755 rt/sbin/rt-clean-sessions
delete mode 100755 rt/sbin/rt-dump-database
delete mode 100755 rt/sbin/rt-email-dashboards
delete mode 100755 rt/sbin/rt-email-digest
delete mode 100755 rt/sbin/rt-email-group-admin
delete mode 100755 rt/sbin/rt-server
delete mode 100755 rt/sbin/rt-shredder
delete mode 100755 rt/sbin/rt-validator
delete mode 100644 rt/t/data/configs/apache2.2+fastcgi.conf
delete mode 100644 rt/t/data/configs/apache2.2+mod_perl.conf
More information about the freeside-commits
mailing list