default to a session cookie instead of setting an explicit timeout, weird timezone...
[freeside.git] / rt / sbin / rt-validator.in
index ba2686e..080a05a 100644 (file)
@@ -1,41 +1,41 @@
 #!@PERL@
 # BEGIN BPS TAGGED BLOCK {{{
-# 
+#
 # COPYRIGHT:
-# 
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-#                                          <jesse@bestpractical.com>
-# 
+#
+# This software is Copyright (c) 1996-2019 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
 # (Except where explicitly superseded by other copyright notices)
-# 
-# 
+#
+#
 # LICENSE:
-# 
+#
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
-# 
+#
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 # 02110-1301 or visit their web page on the internet at
 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-# 
-# 
+#
+#
 # CONTRIBUTION SUBMISSION POLICY:
-# 
+#
 # (The following paragraph is not intended to limit the rights granted
 # to you to modify and distribute this software under the terms of
 # the GNU General Public License and is only of importance to you if
 # you choose to contribute your changes and enhancements to the
 # community by submitting them to Best Practical Solutions, LLC.)
-# 
+#
 # By intentionally submitting any modifications, corrections or
 # derivatives to this work, or any other work intended for use with
 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
 # 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 {
+BEGIN { # BEGIN RT CMD BOILERPLATE
     require File::Spec;
+    require Cwd;
     my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
     my $bin_path;
 
     for my $lib (@libs) {
         unless ( File::Spec->file_name_is_absolute($lib) ) {
-            unless ($bin_path) {
-                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
-                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
-                }
-                else {
-                    require FindBin;
-                    no warnings "once";
-                    $bin_path = $FindBin::Bin;
-                }
-            }
+            $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
             $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
         }
         unshift @INC, $lib;
@@ -74,61 +66,35 @@ BEGIN {
 
 }
 
-use Getopt::Long;
+use RT::Interface::CLI qw(Init);
 my %opt = ();
-GetOptions(
+Init(
     \%opt,
     'check|c',
     'resolve',
     'force',
     'verbose|v',
+    'links-only',
 );
 
-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
+Pod::Usage::pod2usage( { verbose => 2 } ) unless $opt{check};
 
---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;
-}
+usage_warning() if $opt{'resolve'} && !$opt{'force'};
 
 sub usage_warning {
     print <<END;
 This utility can fix some issues with DB by creating or updating. In some
-cases there is no enough data to resurect a missing record, but records which
-refers to a missing can be deleted. It's up to you to decide what to do.
+cases there is not enough data to resurect a missing record, but records which
+refer to a missing record can be deleted. It's up to you to decide what to do.
 
 In any case it's highly recommended to have a backup before resolving anything.
 
 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');
 
@@ -140,6 +106,7 @@ my %TYPE = (
 
 my @models = qw(
     ACE
+    Article
     Attachment
     Attribute
     CachedGroupMember
@@ -155,6 +122,7 @@ my @models = qw(
     ScripAction
     ScripCondition
     Scrip
+    ObjectScrip
     Template
     Ticket
     Transaction
@@ -177,6 +145,7 @@ $redo_on{'Delete'} = {
     Queues => [],
 
     Scrips => [],
+    ObjectScrips => [],
     ScripActions => [],
     ScripConditions => [],
     Templates => [],
@@ -197,6 +166,9 @@ $redo_on{'Create'} = {
     GroupMembers => [ 'CGM vs. GM' ],
     CachedGroupMembers => [ 'CGM vs. GM' ],
 };
+$redo_on{'Update'} = {
+    Groups => ['User Defined Group Name uniqueness'],
+};
 
 my %describe_cb;
 %describe_cb = (
@@ -217,7 +189,7 @@ sub m2t($) {
     my $model = shift;
     return $cache{$model} if $cache{$model};
     my $class = "RT::$model";
-    my $object = $class->new( $RT::SystemUser );
+    my $object = $class->new( RT->SystemUser );
     return $cache{$model} = $object->Table;
 } }
 
@@ -226,17 +198,17 @@ my (@do_check, %redo_check);
 my @CHECKS;
 foreach my $table ( qw(Users Groups) ) {
     push @CHECKS, "$table -> Principals" => sub {
-        my $msg = "A record in $table refers not existing record in Principals."
-            ." The script can either create missing record in Principals"
-            ." or delete record in $table.";
+        my $msg = "A record in $table refers to a nonexistent record in Principals."
+            ." The script can either create the missing record in Principals"
+            ." or delete the record in $table.";
         my ($type) = ($table =~ /^(.*)s$/);
-        check_integrity(
+        return 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 );
+                return unless my $a = prompt_action( ['Create', 'delete'], $msg );
 
                 if ( $a eq 'd' ) {
                     delete_record( $table, $id );
@@ -254,11 +226,11 @@ foreach my $table ( qw(Users Groups) ) {
     };
 
     push @CHECKS, "Principals -> $table" => sub {
-        my $msg = "A record in Principals refers not existing record in $table."
-            ." In some cases it's possible to resurrect manually such records,"
-            ." but this utility can only delete";
+        my $msg = "A record in Principals refers to a nonexistent record in $table."
+            ." In some cases it's possible to manually resurrect such records,"
+            ." but this utility can only delete records.";
 
-        check_integrity(
+        return check_integrity(
             'Principals', 'id' => $table, 'id',
             condition   => 's.PrincipalType = ?',
             bind_values => [ $table =~ /^(.*)s$/ ],
@@ -273,15 +245,16 @@ foreach my $table ( qw(Users Groups) ) {
 }
 
 push @CHECKS, 'User <-> ACL equivalence group' => sub {
+    my $res = 1;
     # from user to group
-    check_integrity(
+    $res *= check_integrity(
         'Users', 'id' => 'Groups', 'Instance',
         join_condition   => 't.Domain = ? AND t.Type = ?',
         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
         action => sub {
             my $id = shift;
             return unless prompt(
-                'Create', "Found an user that has no ACL equivalence group."
+                'Create', "Found a user that has no ACL equivalence group."
             );
 
             my $gid = create_record( 'Groups',
@@ -290,82 +263,87 @@ push @CHECKS, 'User <-> ACL equivalence group' => sub {
         },
     );
     # from group to user
-    check_integrity(
+    $res *= check_integrity(
         'Groups', 'Instance' => 'Users', 'id',
         condition   => 's.Domain = ? AND s.Type = ?',
         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
         action => sub {
             my $id = shift;
             return unless prompt(
-                'Delete', "Found an user ACL equivalence group, but there is no user."
+                'Delete', "Found a user ACL equivalence group, but there is no user."
             );
 
             delete_record( 'Groups', $id );
         },
     );
     # one ACL equiv group for each user
-    check_uniqueness(
+    $res *= check_uniqueness(
         'Groups',
         columns     => ['Instance'],
         condition   => '.Domain = ? AND .Type = ?',
         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
     );
+    return $res;
 };
 
 # check integrity of Queue role groups
 push @CHECKS, 'Queues <-> Role Groups' => sub {
     # XXX: we check only that there is at least one group for a queue
     # from queue to group
-    check_integrity(
+    my $res = 1;
+    $res *= check_integrity(
         'Queues', 'id' => 'Groups', 'Instance',
         join_condition   => 't.Domain = ?',
         bind_values => [ 'RT::Queue-Role' ],
     );
     # from group to queue
-    check_integrity(
+    $res *= check_integrity(
         'Groups', 'Instance' => 'Queues', 'id',
         condition   => 's.Domain = ?',
         bind_values => [ 'RT::Queue-Role' ],
         action => sub {
             my $id = shift;
             return unless prompt(
-                'Delete', "Found role group of not existant queue."
+                'Delete', "Found a role group of a nonexistent queue."
             );
 
             delete_record( 'Groups', $id );
         },
     );
+    return $res;
 };
 
 # check integrity of Ticket role groups
 push @CHECKS, 'Tickets <-> Role Groups' => sub {
     # XXX: we check only that there is at least one group for a queue
     # from queue to group
-    check_integrity(
+    my $res = 1;
+    $res *= check_integrity(
         'Tickets', 'id' => 'Groups', 'Instance',
         join_condition   => 't.Domain = ?',
         bind_values => [ 'RT::Ticket-Role' ],
     );
     # from group to ticket
-    check_integrity(
+    $res *= check_integrity(
         'Groups', 'Instance' => 'Tickets', 'id',
         condition   => 's.Domain = ?',
         bind_values => [ 'RT::Ticket-Role' ],
         action => sub {
             my $id = shift;
             return unless prompt(
-                'Delete', "Found a role group of not existant ticket."
+                'Delete', "Found a role group of a nonexistent ticket."
             );
 
             delete_record( 'Groups', $id );
         },
     );
+    return $res;
 };
 
 # additional CHECKS on groups
 push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
     # Check that Domain, Instance and Type are unique
-    check_uniqueness(
+    return check_uniqueness(
         'Groups',
         columns     => ['Domain', 'Instance', 'Type'],
         condition   => '.Domain LIKE ?',
@@ -373,12 +351,43 @@ push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
     );
 };
 
+push @CHECKS, 'System internal group uniqueness' => sub {
+    return check_uniqueness(
+        'Groups',
+        columns     => ['Instance', 'Type'],
+        condition   => '.Domain = ?',
+        bind_values => [ 'SystemInternal' ],
+    );
+};
+
+# CHECK that user defined group names are unique
+push @CHECKS, 'User Defined Group Name uniqueness' => sub {
+    return check_uniqueness(
+        'Groups',
+        columns         => ['Name'],
+        condition       => '.Domain = ?',
+        bind_values     => [ 'UserDefined' ],
+        extra_tables    => ['Principals sp', 'Principals tp'],
+        extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)),
+        extra_values    => ['Group', 'Group'],
+        action          => sub {
+            return unless prompt(
+                'Rename', "Found a user defined group with a non-unique Name."
+            );
+
+            my $id = shift;
+            my %cols = @_;
+            update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) });
+        },
+    );
+};
 
 push @CHECKS, 'GMs -> Groups, Members' => sub {
     my $msg = "A record in GroupMembers references an object that doesn't exist."
-        ." May be you deleted a group or principal directly from DB?"
-        ." Usually it's ok to delete such records.";
-    check_integrity(
+        ." Maybe you deleted a group or principal directly from the database?"
+        ." Usually it's OK to delete such records.";
+    my $res = 1;
+    $res *= check_integrity(
         'GroupMembers', 'GroupId' => 'Groups', 'id',
         action => sub {
             my $id = shift;
@@ -387,7 +396,7 @@ push @CHECKS, 'GMs -> Groups, Members' => sub {
             delete_record( 'GroupMembers', $id );
         },
     );
-    check_integrity(
+    $res *= check_integrity(
         'GroupMembers', 'MemberId' => 'Principals', 'id',
         action => sub {
             my $id = shift;
@@ -396,12 +405,14 @@ push @CHECKS, 'GMs -> Groups, Members' => sub {
             delete_record( 'GroupMembers', $id );
         },
     );
+    return $res;
 };
 
 # CGM and GM
 push @CHECKS, 'CGM vs. GM' => sub {
+    my $res = 1;
     # all GM record should be duplicated in CGM
-    check_integrity(
+    $res *= check_integrity(
         GroupMembers       => ['GroupId', 'MemberId'],
         CachedGroupMembers => ['GroupId', 'MemberId'],
         join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
@@ -412,7 +423,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
                 "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
             );
 
-            my $gm = RT::GroupMember->new( $RT::SystemUser );
+            my $gm = RT::GroupMember->new( RT->SystemUser );
             $gm->Load( $id );
             die "Couldn't load GM record #$id" unless $gm->id;
             my $cgm = create_record( 'CachedGroupMembers',
@@ -424,7 +435,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
         },
     );
     # all first level CGM records should have a GM record
-    check_integrity(
+    $res *= check_integrity(
         CachedGroupMembers => ['GroupId', 'MemberId'],
         GroupMembers       => ['GroupId', 'MemberId'],
         condition     => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
@@ -433,14 +444,14 @@ push @CHECKS, 'CGM vs. GM' => sub {
             return unless prompt(
                 'Delete',
                 "Found a record in CachedGroupMembers for a (Group, Member) pair"
-                ." that doesn't exist in GroupMembers table."
+                ." that doesn't exist in the GroupMembers table."
             );
 
             delete_record( 'CachedGroupMembers', $id );
         },
     );
     # each group should have a CGM record where MemberId == GroupId
-    check_integrity(
+    $res *= check_integrity(
         Groups => ['id', 'id'],
         CachedGroupMembers => ['GroupId', 'MemberId'],
         join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
@@ -452,7 +463,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
                 ." duplicate in CachedGroupMembers table."
             );
 
-            my $g = RT::Group->new( $RT::SystemUser );
+            my $g = RT::Group->new( RT->SystemUser );
             $g->Load( $id );
             die "Couldn't load group #$id" unless $g->id;
             die "Loaded group by $id has id ". $g->id  unless $g->id == $id;
@@ -467,7 +478,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
 
     # and back, each record in CGM with MemberId == GroupId without exceptions
     # should reference a group
-    check_integrity(
+    $res *= check_integrity(
         CachedGroupMembers => ['GroupId', 'MemberId'],
         Groups => ['id', 'id'],
         condition => "s.GroupId = s.MemberId",
@@ -482,14 +493,14 @@ push @CHECKS, 'CGM vs. GM' => sub {
         },
     );
     # Via
-    check_integrity(
+    $res *= 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."
+                "Found a record in CachedGroupMembers with Via that references a nonexistent record."
             );
 
             delete_record( 'CachedGroupMembers', $id );
@@ -498,7 +509,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
 
     # for every CGM where ImmediateParentId != GroupId there should be
     # matching parent record (first level) 
-    check_integrity(
+    $res *= check_integrity(
         CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
         CachedGroupMembers => ['GroupId', 'MemberId'],
         join_condition => 't.Via = t.id',
@@ -507,7 +518,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
             my $id = shift;
             return unless prompt(
                 'Delete',
-                "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table."
+                "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
             );
 
             delete_record( 'CachedGroupMembers', $id );
@@ -516,7 +527,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
 
     # for every CGM where ImmediateParentId != GroupId there should be
     # matching "grand" parent record
-    check_integrity(
+    $res *= check_integrity(
         CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
         CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
         condition => 's.ImmediateParentId != s.GroupId',
@@ -524,7 +535,7 @@ push @CHECKS, 'CGM vs. GM' => sub {
             my $id = shift;
             return unless prompt(
                 'Delete',
-                "Found a record in CachedGroupMembers that referencing not existant record in CachedGroupMembers table."
+                "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
             );
 
             delete_record( 'CachedGroupMembers', $id );
@@ -562,6 +573,7 @@ END
 
         my $sth = execute_query( $query );
         while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
+            $res = 0;
             print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
             print STDERR " but there is no cached GM record that $m is member of #$g.\n";
             $action->(
@@ -570,35 +582,53 @@ END
             );
         }
     }
+
+    return $res;
 };
 
 # Tickets
 push @CHECKS, 'Tickets -> other' => sub {
-    check_integrity(
+    my $res = 1;
+    $res *= check_integrity(
         'Tickets', 'EffectiveId' => 'Tickets', 'id',
         action => sub {
             my $id = shift;
             return unless prompt(
                 'Delete',
-                "Found a ticket that's been merged into a ticket that don't exist anymore."
+                "Found a ticket that's been merged into a ticket that no longer exists."
             );
 
             delete_record( 'Tickets', $id );
         },
     );
-    check_integrity(
+    $res *= check_integrity(
         'Tickets', 'Queue' => 'Queues', 'id',
     );
-    check_integrity(
+    $res *= check_integrity(
         'Tickets', 'Owner' => 'Users', 'id',
+         action => sub {
+             my ($id, %prop) = @_;
+             return unless my $replace_with = prompt_integer(
+                 'Replace',
+                 "Column Owner should point to a user, but there is record #$id in Tickets\n"
+                 ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
+                 ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
+                 ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
+                 ."or something like that.",
+                 "Tickets.Owner -> user #$prop{Owner}"
+             );
+             update_records( 'Tickets', { id => $id, Owner => $prop{Owner} }, { Owner => $replace_with } );
+         },
     );
     # XXX: check that owner is only member of owner role group
+    return $res;
 };
 
 
 push @CHECKS, 'Transactions -> other' => sub {
+    my $res = 1;
     foreach my $model ( @models ) {
-        check_integrity(
+        $res *= check_integrity(
             'Transactions', 'ObjectId' => m2t($model), 'id',
             condition   => 's.ObjectType = ?',
             bind_values => [ "RT::$model" ],
@@ -613,126 +643,117 @@ push @CHECKS, 'Transactions -> other' => sub {
         );
     }
     # type = CustomField
-    check_integrity(
+    $res *= check_integrity(
         'Transactions', 'Field' => 'CustomFields', 'id',
         condition   => 's.Type = ?',
         bind_values => [ 'CustomField' ],
     );
     # type = Take, Untake, Force, Steal or Give
-    check_integrity(
+    $res *= check_integrity(
         'Transactions', 'OldValue' => 'Users', 'id',
         condition   => 's.Type IN (?, ?, ?, ?, ?)',
         bind_values => [ qw(Take Untake Force Steal Give) ],
         action => sub {
             my $id = shift;
             return unless prompt(
-                'Delete', "Found a transaction regarding changes of Owner,"
-                ." but User with id stored in OldValue column doesn't exist anymore."
+                'Delete', "Found a transaction regarding Owner changes,"
+                ." but the User with id stored in OldValue column doesn't exist anymore."
             );
 
             delete_record( 'Transactions', $id );
         },
     );
-    check_integrity(
+    $res *= 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', "Found a transaction regarding Owner changes,"
+                ." but the User with id stored in NewValue column doesn't exist anymore."
             );
 
             delete_record( 'Transactions', $id );
         },
     );
     # type = DelWatcher
-    check_integrity(
+    $res *= 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', "Found a transaction describing watcher changes,"
+                ." but the User with id stored in OldValue column doesn't exist anymore."
             );
 
             delete_record( 'Transactions', $id );
         },
     );
     # type = AddWatcher
-    check_integrity(
+    $res *= 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', "Found a transaction describing watcher changes,"
+                ." but the User with id stored in NewValue column doesn't exist anymore."
             );
 
             delete_record( 'Transactions', $id );
         },
     );
 
-# XXX: Links need more love, uri is stored instead of id
-#    # type = DeleteLink
-#    check_integrity(
-#        'Transactions', 'OldValue' => 'Links', 'id',
-#        condition   => 's.Type = ?',
-#        bind_values => [ 'DeleteLink' ],
-#    );
-#    # type = AddLink
-#    check_integrity(
-#        'Transactions', 'NewValue' => 'Links', 'id',
-#        condition   => 's.Type = ?',
-#        bind_values => [ 'AddLink' ],
-#    );
+#   type = DeleteLink or AddLink
+#   handled in 'Links: *' checks as {New,Old}Value store URIs
 
     # type = Set, Field = Queue
-    check_integrity(
+    $res *= check_integrity(
         'Transactions', 'NewValue' => 'Queues', 'id',
         condition   => 's.Type = ? AND s.Field = ?',
         bind_values => [ 'Set', 'Queue' ],
         action => sub {
             my $id = shift;
             return unless prompt(
-                'Delete', "Found a transaction describing queue change,"
-                ." but Queue with id stored in NewValue column doesn't exist anymore."
+                'Delete', "Found a transaction describing queue change,"
+                ." but the Queue with id stored in the NewValue column doesn't exist anymore."
             );
 
             delete_record( 'Transactions', $id );
         },
     );
-    check_integrity(
+    $res *= 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', "Found a transaction describing queue change,"
+                ." but the Queue with id stored in the OldValue column doesn't exist anymore."
             );
 
             delete_record( 'Transactions', $id );
         },
     );
     # Reminders
-    check_integrity(
+    $res *= check_integrity(
         'Transactions', 'NewValue' => 'Tickets', 'id',
         join_condition => 't.Type = ?',
         condition      => 's.Type IN (?, ?, ?)',
         bind_values    => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
     );
+    return $res;
 };
 
 # Attachments
 push @CHECKS, 'Attachments -> other' => sub {
-    check_integrity(
+    my $res = 1;
+    $res *= check_integrity(
         Attachments  => 'TransactionId', Transactions => 'id',
         action => sub {
             my $id = shift;
@@ -742,7 +763,7 @@ push @CHECKS, 'Attachments -> other' => sub {
             delete_record( 'Attachments', $id );
         },
     );
-    check_integrity(
+    $res *= check_integrity(
         Attachments => 'Parent', Attachments => 'id',
         action => sub {
             my $id = shift;
@@ -752,68 +773,79 @@ push @CHECKS, 'Attachments -> other' => sub {
             delete_record( 'Attachments', $id );
         },
     );
-    check_integrity(
+    $res *= check_integrity(
         Attachments => 'Parent',
         Attachments => 'id',
         join_condition => 's.TransactionId = t.TransactionId',
     );
+    return $res;
 };
 
 push @CHECKS, 'CustomFields and friends' => sub {
+    my $res = 1;
     #XXX: ObjectCustomFields needs more love
-    check_integrity(
+    $res *= check_integrity(
         'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
     );
-    check_integrity(
+    $res *= check_integrity(
         'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
     );
     foreach my $model ( @models ) {
-        check_integrity(
+        $res *= check_integrity(
             'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
             condition   => 's.ObjectType = ?',
             bind_values => [ "RT::$model" ],
         );
     }
+    return $res;
 };
 
 push @CHECKS, Templates => sub {
-    check_integrity(
+    return check_integrity(
         'Templates', 'Queue' => 'Queues', 'id',
     );
 };
 
 push @CHECKS, Scrips => sub {
-    check_integrity(
-        'Scrips', 'Queue' => 'Queues', 'id',
-    );
-    check_integrity(
+    my $res = 1;
+    $res *= check_integrity(
         'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
     );
-    check_integrity(
+    $res *= check_integrity(
         'Scrips', 'ScripAction' => 'ScripActions', 'id',
     );
-    check_integrity(
-        'Scrips', 'Template' => 'Templates', 'id',
+    $res *= check_integrity(
+        'Scrips', 'Template' => 'Templates', 'Name',
+    );
+    $res *= check_integrity(
+        'ObjectScrips', 'Scrip' => 'Scrips', 'id',
     );
+    $res *= check_integrity(
+        'ObjectScrips', 'ObjectId' => 'Queues', 'id',
+    );
+    return $res;
 };
 
 push @CHECKS, Attributes => sub {
+    my $res = 1;
     foreach my $model ( @models ) {
-        check_integrity(
+        $res *= check_integrity(
             'Attributes', 'ObjectId' => m2t($model), 'id',
             condition   => 's.ObjectType = ?',
             bind_values => [ "RT::$model" ],
         );
     }
+    return $res;
 };
 
 # Fix situations when Creator or LastUpdatedBy references ACL equivalence
 # group of a user instead of user
 push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
+    my $res = 1;
     my %fix = ();
     foreach my $model ( @models ) {
         my $class = "RT::$model";
-        my $object = $class->new( $RT::SystemUser );
+        my $object = $class->new( RT->SystemUser );
         foreach my $column ( qw(LastUpdatedBy Creator) ) {
             next unless $object->_Accessible( $column, 'auto' );
 
@@ -839,6 +871,7 @@ END
 
             my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
             while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
+                $res = 0;
                 print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
                 print STDERR " when must reference user.\n";
                 $action->( $gid, $uid );
@@ -861,16 +894,18 @@ END
         }
         $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
     }
+    return $res;
 };
 
 push @CHECKS, 'LastUpdatedBy and Creator' => sub {
+    my $res = 1;
     foreach my $model ( @models ) {
         my $class = "RT::$model";
-        my $object = $class->new( $RT::SystemUser );
+        my $object = $class->new( RT->SystemUser );
         my $table = $object->Table;
         foreach my $column ( qw(LastUpdatedBy Creator) ) {
             next unless $object->_Accessible( $column, 'auto' );
-            check_integrity(
+            $res *= check_integrity(
                 $table, $column => 'Users', 'id',
                 action => sub {
                     my ($id, %prop) = @_;
@@ -878,7 +913,7 @@ push @CHECKS, 'LastUpdatedBy and Creator' => sub {
                         '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"
+                        ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
                         ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
                         ."or something like that.",
                         "$table.$column -> user #$prop{$column}"
@@ -888,13 +923,210 @@ push @CHECKS, 'LastUpdatedBy and Creator' => sub {
             );
         }
     }
+    return $res;
+};
+
+push @CHECKS, 'Links: wrong organization' => sub {
+    my $res = 1;
+    my @URI_USES = (
+        { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
+        { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
+        { model => 'Link', column => 'Target' },
+        { model => 'Link', column => 'Base' },
+    );
+
+    my $right_org = RT->Config->Get('Organization');
+    my @rt_uris = rt_uri_modules();
+    foreach my $package (@rt_uris) {
+
+        my $rt_uri = $package->new( $RT::SystemUser );
+        my $scheme = $rt_uri->Scheme;
+        my $prefix = $rt_uri->LocalURIPrefix;
+
+        foreach my $use ( @URI_USES ) {
+            my $table = m2t( $use->{'model'} );
+            my $column = $use->{'column'};
+
+            my $query = "SELECT id, $column FROM $table WHERE"
+              . " $column LIKE ? AND $column NOT LIKE ?";
+            my @binds = (sql_escape_like($scheme) ."://%", sql_escape_like($prefix) ."%");
+
+            while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
+                $query .= " AND $k = ?";
+                push @binds, $v;
+            }
+            my $sth = execute_query( $query, @binds );
+            while ( my ($id, $value) = $sth->fetchrow_array ) {
+                $res = 0;
+                print STDERR "Record #$id in $table. Value of $column column most probably is an incorrect link\n";
+                my ($wrong_org) = ( $value =~ m{^\Q$scheme\E://(.+)/[^/]+/[0-9]*$} );
+                next unless my $replace_with = prompt(
+                    'Replace',
+                    "Column $column in $table is a link.  There is record #$id that has a"
+                    ." local scheme of '$scheme', but its organization is '$wrong_org'"
+                    ." instead of '$right_org'.  Most probably the Organization was"
+                    ." changed from '$wrong_org' to '$right_org' at some point.  It is"
+                    ." generally a good idea to replace these wrong links.\n",
+                    "Links: wrong organization $wrong_org"
+                                                     );
+
+                print "Updating record(s) in $table\n" if $opt{'verbose'};
+                my $wrong_prefix = $scheme . '://'. $wrong_org;
+                my $query = "UPDATE $table SET $column = ". sql_concat('?', "SUBSTR($column, ?)")
+                  ." WHERE $column LIKE ?";
+                execute_query( $query, $prefix, length($wrong_prefix)+1, sql_escape_like($wrong_prefix) .'/%' );
+
+                $redo_check{'Links: wrong organization'} = 1;
+                $redo_check{'Links: LocalX for non-ticket'} = 1;
+                last; # plenty of chances we covered all cases with one update
+            }
+        }
+    } # end foreach my $package (@rt_uris)
+    return $res;
+};
+
+push @CHECKS, 'Links: LocalX for non-ticket' => sub {
+    my $res = 1;
+    my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
+    my $scheme = $rt_uri->Scheme;
+    my $prefix = $rt_uri->LocalURIPrefix;
+    my $table = m2t('Link');
+
+    foreach my $dir ( 'Target', 'Base' ) {
+        # we look only at links with correct organization, previouse check deals
+        # with incorrect orgs
+        my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir NOT LIKE ?";
+        my @binds = (sql_escape_like($prefix) ."/%", sql_escape_like($prefix) ."/ticket/%");
+
+        my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
+        while ( my ($id, $value) = $sth->fetchrow_array ) {
+            $res = 0;
+            print STDERR "Record #$id in $table. Value of Local$dir is not 0\n";
+            next unless my $replace_with = prompt(
+                'Replace',
+                "Column Local$dir in $table should be 0 if $dir column is not link"
+                ." to a ticket. It's ok to replace with 0.\n",
+            );
+
+            print "Updating record(s) in $table\n" if $opt{'verbose'};
+            execute_query( "UPDATE $table SET Local$dir = 0 WHERE $where", @binds );
+            $redo_check{'Links: wrong organization'} = 1;
+
+            last; # we covered all cases with one update
+        }
+    }
+    return $res;
+};
+
+push @CHECKS, 'Links: LocalX != X' => sub {
+    my $res = 1;
+    my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
+    my $scheme = $rt_uri->Scheme;
+    my $prefix = $rt_uri->LocalURIPrefix .'/ticket/';
+    my $table = m2t('Link');
+
+    foreach my $dir ( 'Target', 'Base' ) {
+        # we limit to $dir = */ticket/* so it doesn't conflict with previouse check
+        # previouse check is more important as there was a bug in RT when Local$dir
+        # was set for not tickets
+        # XXX: we have issue with MergedInto links - "LocalX !~ X"
+        my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir != ". sql_concat('?', "Local$dir")
+            ." AND Type != ?";
+        my @binds = (sql_escape_like($prefix) ."%", $prefix, 'MergedInto');
+
+        my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
+        while ( my ($id, $value) = $sth->fetchrow_array ) {
+            $res = 0;
+            print STDERR "Record #$id in $table. Value of $dir doesn't match ticket id in Local$dir\n";
+            next unless my $replace_with = prompt(
+                'Replace',
+                "For ticket links column $dir in $table table should end with"
+                ." ticket id from Local$dir. It's probably ok to fix $dir column.\n",
+            );
+
+            print "Updating record(s) in $table\n" if $opt{'verbose'};
+            execute_query(
+                "UPDATE $table SET $dir = ". sql_concat('?', "Local$dir") ." WHERE $where",
+                $prefix, @binds
+            );
+
+            last; # we covered all cases with one update
+        }
+    }
+    return $res;
+};
+
+push @CHECKS, 'Links: missing object' => sub {
+    my $res = 1;
+    my @URI_USES = (
+        { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
+        { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
+        { model => 'Link', column => 'Target' },
+        { model => 'Link', column => 'Base' },
+    );
+
+    my @rt_uris = rt_uri_modules();
+    foreach my $package (@rt_uris) {
+
+        my $rt_uri = $package->new( $RT::SystemUser );
+        my $scheme = $rt_uri->Scheme;
+        my $prefix = $rt_uri->LocalURIPrefix;
+
+        foreach my $use ( @URI_USES ) {
+            my $stable = m2t( $use->{'model'} );
+            my $scolumn = $use->{'column'};
+
+            foreach my $tmodel ( @models ) {
+                my $tclass = 'RT::'. $tmodel;
+                my $ttable = m2t($tmodel);
+
+                my $tprefix = $prefix .'/'. ($tclass eq 'RT::Ticket'? 'ticket' : $tclass) .'/';
+
+                $tprefix = $prefix . '/article/' if $tclass eq 'RT::Article';
+
+                my $query = "SELECT s.id FROM $stable s LEFT JOIN $ttable t "
+                  ." ON t.id = ". sql_str2int("SUBSTR(s.$scolumn, ?)")
+                    ." WHERE s.$scolumn LIKE ? AND t.id IS NULL";
+                my @binds = (length($tprefix) + 1, sql_escape_like($tprefix).'%');
+
+                while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
+                    $query .= " AND s.$k = ?";
+                    push @binds, $v;
+                }
+
+                my $sth = execute_query( $query, @binds );
+                while ( my ($sid) = $sth->fetchrow_array ) {
+                    $res = 0;
+                    print STDERR "Link in $scolumn column in record #$sid in $stable table points"
+                      ." to not existing object.\n";
+                    next unless prompt(
+                        'Delete',
+                        "Column $scolumn in $stable table is a link to an object that doesn't exist."
+                        ." You can delete such records, however make sure there is no other"
+                        ." errors with links.\n",
+                        'Link to a missing object in $ttable'
+                                      );
+
+                    delete_record($stable, $sid);
+                }
+            }
+        }
+    } # end foreach my $package (@rt_uris)
+    return $res;
 };
+
+
 my %CHECKS = @CHECKS;
 
 @do_check = do { my $i = 1; grep $i++%2, @CHECKS };
 
+if ($opt{'links-only'}) {
+    @do_check = grep { /^Links:/ } @do_check;
+}
+
+my $status = 1;
 while ( my $check = shift @do_check ) {
-    $CHECKS{ $check }->();
+    $status *= $CHECKS{ $check }->();
 
     foreach my $redo ( keys %redo_check ) {
         die "check $redo doesn't exist" unless $CHECKS{ $redo };
@@ -903,6 +1135,19 @@ while ( my $check = shift @do_check ) {
         push @do_check, $redo;
     }
 }
+exit 1 unless $status;
+exit 0;
+
+=head2 check_integrity
+
+Takes two (table name, column(s)) pairs. First pair
+is reference we check and second is destination that
+must exist. Array reference can be used for multiple
+columns.
+
+Returns 0 if a record is missing or 1 otherwise.
+
+=cut
 
 sub check_integrity {
     my ($stable, @scols) = (shift, shift);
@@ -938,15 +1183,21 @@ sub check_integrity {
         push @binds, 0;
     }
 
+    my $res = 1;
+
     my $sth = execute_query( $query, @binds );
     while ( my ($sid, @set) = $sth->fetchrow_array ) {
-        print STDERR "Record #$sid in $stable references not existent record in $ttable\n";
+        $res = 0;
+
+        print STDERR "Record #$sid in $stable references a nonexistent record in $ttable\n";
         for ( my $i = 0; $i < @scols; $i++ ) {
             print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
         }
         print STDERR "\t". describe( $stable, $sid ) ."\n";
-        $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'};
+        $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) )
+            if $args{'action'};
     }
+    return $res;
 }
 
 sub describe {
@@ -983,7 +1234,7 @@ sub check_uniqueness {
     my @columns = @{ $args{'columns'} };
 
     print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
-        if $opt{'versbose'};
+        if $opt{'verbose'};
 
     my ($scond, $tcond);
     if ( $scond = $tcond = $args{'condition'} ) {
@@ -995,20 +1246,27 @@ sub check_uniqueness {
         ." FROM $on s LEFT JOIN $on t "
         ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
         . ($tcond? " AND ( $tcond )": "")
+        . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "")
         ." WHERE t.id IS NOT NULL "
         ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
     $query .= " AND ( $scond )" if $scond;
+    $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'};
 
     my $sth = execute_query(
         $query,
-        $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): ()
+        $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (),
+        $args{'extra_values'}? (@{ $args{'extra_values'} }): ()
     );
+    my $res = 1;
     while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
+        $res = 0;
         print STDERR "Record #$tid in $on has the same set of values as $sid\n";
         for ( my $i = 0; $i < @columns; $i++ ) {
             print STDERR "\t$columns[$i] => '$set[$i]'\n";
         }
+        $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'};
     }
+    return $res;
 }
 
 sub load_record {
@@ -1059,6 +1317,30 @@ sub execute_query {
     return $sth;
 }
 
+sub sql_concat {
+    return $_[0] if @_ <= 1;
+
+    my $db_type = RT->Config->Get('DatabaseType');
+    if ( $db_type eq 'Pg' || $db_type eq 'SQLite' ) {
+        return '('. join( ' || ', @_ ) .')';
+    }
+    return sql_concat('CONCAT('. join( ', ', splice @_, 0, 2 ).')', @_);
+}
+
+sub sql_str2int {
+    my $db_type = RT->Config->Get('DatabaseType');
+    if ( $db_type eq 'Pg' ) {
+        return "($_[0])::integer";
+    }
+    return $_[0];
+}
+
+sub sql_escape_like {
+    my ($string) = @_;
+    $string =~ s/([%_\\])/\\$1/g;
+    return $string;
+}
+
 { my %cached_answer;
 sub prompt {
     my $action = shift;
@@ -1084,7 +1366,7 @@ sub prompt_action {
     my $token = shift || join ':', caller;
 
     return '' unless $opt{'resolve'};
-    return '' if $opt{'force'};
+    return lc substr $actions->[0], 0, 1 if $opt{'force'};
     return $cached_answer{ $token } if exists $cached_answer{ $token };
 
     print $msg, "\n";
@@ -1115,4 +1397,66 @@ sub prompt_integer {
     return $cached_answer{ $token } = $a;
 } }
 
+# Find all RT::URI modules RT has loaded
+
+sub rt_uri_modules {
+    my @uris = grep /^RT\/URI\/.+\.pm$/, keys %INC;
+    my @uri_modules;
+    foreach my $uri_path (@uris){
+        next if $uri_path =~ /base\.pm$/; # Skip base RT::URI object
+        $uri_path = substr $uri_path, 0, -3; # chop off .pm
+        push @uri_modules, join '::', split '/', $uri_path;
+    }
+
+    return @uri_modules;
+}
+
 1;
+
+__END__
+
+=head1 NAME
+
+rt-validator - check and correct validity of records in RT's database
+
+=head1 SYNOPSIS
+
+    rt-validator --check 
+    rt-validator --check --verbose
+    rt-validator --check --verbose --resolve
+    rt-validator --check --verbose --resolve --force
+
+=head1 DESCRIPTION
+
+This script checks integrity of records in RT's DB. May delete some invalid
+records or ressurect accidentally deleted.
+
+=head1 OPTIONS
+
+=over
+
+=item check
+
+    mandatory.
+    
+    it's equal to -c
+
+=item verbose
+
+    print additional info to STDOUT
+    it's equal to -v
+
+=item resolve
+
+    enable resolver that can delete or create some records
+
+=item force
+
+    resolve without asking questions
+
+=item links-only 
+
+    only run the Link validation routines, useful if you changed your Organization
+
+=back
+