sbin/rt-validator

   1 #!/usr/bin/perl
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
   7 #                                          <sales@bestpractical.com>
   8 #
   9 # (Except where explicitly superseded by other copyright notices)
  10 #
  11 #
  12 # LICENSE:
  13 #
  14 # This work is made available to you under the terms of Version 2 of
  15 # the GNU General Public License. A copy of that license should have
  16 # been provided with this software, but in any event can be snarfed
  17 # from www.gnu.org.
  18 #
  19 # This work is distributed in the hope that it will be useful, but
  20 # WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 # General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with this program; if not, write to the Free Software
  26 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  27 # 02110-1301 or visit their web page on the internet at
  28 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  29 #
  30 #
  31 # CONTRIBUTION SUBMISSION POLICY:
  32 #
  33 # (The following paragraph is not intended to limit the rights granted
  34 # to you to modify and distribute this software under the terms of
  35 # the GNU General Public License and is only of importance to you if
  36 # you choose to contribute your changes and enhancements to the
  37 # community by submitting them to Best Practical Solutions, LLC.)
  38 #
  39 # By intentionally submitting any modifications, corrections or
  40 # derivatives to this work, or any other work intended for use with
  41 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  42 # you are the copyright holder for those contributions and you grant
  43 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  44 # royalty-free, perpetual, license to use, copy, create derivative
  45 # works based on those contributions, and sublicense and distribute
  46 # those contributions and any derivatives thereof.
  47 #
  48 # END BPS TAGGED BLOCK }}}
  49 use strict;
  50 use warnings;
  51
  52 # fix lib paths, some may be relative
  53 BEGIN { # BEGIN RT CMD BOILERPLATE
  54     require File::Spec;
  55     require Cwd;
  56     my @libs = ("lib", "local/lib");
  57     my $bin_path;
  58
  59     for my $lib (@libs) {
  60         unless ( File::Spec->file_name_is_absolute($lib) ) {
  61             $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
  62             $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
  63         }
  64         unshift @INC, $lib;
  65     }
  66
  67 }
  68
  69 use Getopt::Long;
  70 my %opt = ();
  71 GetOptions(
  72     \%opt,
  73     'check|c',
  74     'resolve',
  75     'force',
  76     'verbose|v',
  77     'help|h',
  78     'links-only',
  79 );
  80
  81 if ( $opt{help} || !$opt{check} ) {
  82     require Pod::Usage;
  83     print Pod::Usage::pod2usage( { verbose => 2 } );
  84     exit 2;
  85 }
  86
  87 usage_warning() if $opt{'resolve'} && !$opt{'force'};
  88
  89 sub usage_warning {
  90     print <<END;
  91 This utility can fix some issues with DB by creating or updating. In some
  92 cases there is not enough data to resurect a missing record, but records which
  93 refer to a missing record can be deleted. It's up to you to decide what to do.
  94
  95 In any case it's highly recommended to have a backup before resolving anything.
  96
  97 Press enter to continue.
  98 END
  99 # Read a line of text, any line of text
 100     <STDIN>;
 101 }
 102
 103 use RT;
 104 RT::LoadConfig();
 105 RT::Init();
 106
 107 my $dbh = $RT::Handle->dbh;
 108 my $db_type = RT->Config->Get('DatabaseType');
 109
 110 my %TYPE = (
 111     'Transactions.Field'    => 'text',
 112     'Transactions.OldValue' => 'text',
 113     'Transactions.NewValue' => 'text',
 114 );
 115
 116 my @models = qw(
 117     ACE
 118     Article
 119     Attachment
 120     Attribute
 121     CachedGroupMember
 122     CustomField
 123     CustomFieldValue
 124     GroupMember
 125     Group
 126     Link
 127     ObjectCustomField
 128     ObjectCustomFieldValue
 129     Principal
 130     Queue
 131     ScripAction
 132     ScripCondition
 133     Scrip
 134     ObjectScrip
 135     Template
 136     Ticket
 137     Transaction
 138     User
 139 );
 140
 141 my %redo_on;
 142 $redo_on{'Delete'} = {
 143     ACL => [],
 144
 145     Attributes => [],
 146
 147     Links => [],
 148
 149     CustomFields => [],
 150     CustomFieldValues => [],
 151     ObjectCustomFields => [],
 152     ObjectCustomFieldValues => [],
 153
 154     Queues => [],
 155
 156     Scrips => [],
 157     ObjectScrips => [],
 158     ScripActions => [],
 159     ScripConditions => [],
 160     Templates => [],
 161
 162     Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
 163     Transactions => [ 'Attachments -> other' ],
 164
 165     Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
 166     Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
 167     Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],
 168
 169     GroupMembers => [ 'CGM vs. GM' ],
 170     CachedGroupMembers => [ 'CGM vs. GM' ],
 171 };
 172 $redo_on{'Create'} = {
 173     Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
 174     Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
 175     GroupMembers => [ 'CGM vs. GM' ],
 176     CachedGroupMembers => [ 'CGM vs. GM' ],
 177 };
 178 $redo_on{'Update'} = {
 179     Groups => ['User Defined Group Name uniqueness'],
 180 };
 181
 182 my %describe_cb;
 183 %describe_cb = (
 184     Attachments => sub {
 185         my $row = shift;
 186         my $txn_id = $row->{transactionid};
 187         my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
 188         return $res .', '. describe( 'Transactions', $txn_id );
 189     },
 190     Transactions => sub {
 191         my $row = shift;
 192         return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
 193     },
 194 );
 195
 196 { my %cache = ();
 197 sub m2t($) {
 198     my $model = shift;
 199     return $cache{$model} if $cache{$model};
 200     my $class = "RT::$model";
 201     my $object = $class->new( RT->SystemUser );
 202     return $cache{$model} = $object->Table;
 203 } }
 204
 205 my (@do_check, %redo_check);
 206
 207 my @CHECKS;
 208 foreach my $table ( qw(Users Groups) ) {
 209     push @CHECKS, "$table -> Principals" => sub {
 210         my $msg = "A record in $table refers to a nonexistent record in Principals."
 211             ." The script can either create the missing record in Principals"
 212             ." or delete the record in $table.";
 213         my ($type) = ($table =~ /^(.*)s$/);
 214         return check_integrity(
 215             $table, 'id' => 'Principals', 'id',
 216             join_condition => 't.PrincipalType = ?',
 217             bind_values => [ $type ],
 218             action => sub {
 219                 my $id = shift;
 220                 return unless my $a = prompt_action( ['Create', 'delete'], $msg );
 221
 222                 if ( $a eq 'd' ) {
 223                     delete_record( $table, $id );
 224                 }
 225                 elsif ( $a eq 'c' ) {
 226                     my $principal_id = create_record( 'Principals',
 227                         id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
 228                     );
 229                 }
 230                 else {
 231                     die "Unknown action '$a'";
 232                 }
 233             },
 234         );
 235     };
 236
 237     push @CHECKS, "Principals -> $table" => sub {
 238         my $msg = "A record in Principals refers to a nonexistent record in $table."
 239             ." In some cases it's possible to manually resurrect such records,"
 240             ." but this utility can only delete records.";
 241
 242         return check_integrity(
 243             'Principals', 'id' => $table, 'id',
 244             condition   => 's.PrincipalType = ?',
 245             bind_values => [ $table =~ /^(.*)s$/ ],
 246             action => sub {
 247                 my $id = shift;
 248                 return unless prompt( 'Delete', $msg );
 249
 250                 delete_record( 'Principals', $id );
 251             },
 252         );
 253     };
 254 }
 255
 256 push @CHECKS, 'User <-> ACL equivalence group' => sub {
 257     my $res = 1;
 258     # from user to group
 259     $res *= check_integrity(
 260         'Users', 'id' => 'Groups', 'Instance',
 261         join_condition   => 't.Domain = ? AND t.Type = ?',
 262         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
 263         action => sub {
 264             my $id = shift;
 265             return unless prompt(
 266                 'Create', "Found an user that has no ACL equivalence group."
 267             );
 268
 269             my $gid = create_record( 'Groups',
 270                 Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
 271             );
 272         },
 273     );
 274     # from group to user
 275     $res *= check_integrity(
 276         'Groups', 'Instance' => 'Users', 'id',
 277         condition   => 's.Domain = ? AND s.Type = ?',
 278         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
 279         action => sub {
 280             my $id = shift;
 281             return unless prompt(
 282                 'Delete', "Found an user ACL equivalence group, but there is no user."
 283             );
 284
 285             delete_record( 'Groups', $id );
 286         },
 287     );
 288     # one ACL equiv group for each user
 289     $res *= check_uniqueness(
 290         'Groups',
 291         columns     => ['Instance'],
 292         condition   => '.Domain = ? AND .Type = ?',
 293         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
 294     );
 295     return $res;
 296 };
 297
 298 # check integrity of Queue role groups
 299 push @CHECKS, 'Queues <-> Role Groups' => sub {
 300     # XXX: we check only that there is at least one group for a queue
 301     # from queue to group
 302     my $res = 1;
 303     $res *= check_integrity(
 304         'Queues', 'id' => 'Groups', 'Instance',
 305         join_condition   => 't.Domain = ?',
 306         bind_values => [ 'RT::Queue-Role' ],
 307     );
 308     # from group to queue
 309     $res *= check_integrity(
 310         'Groups', 'Instance' => 'Queues', 'id',
 311         condition   => 's.Domain = ?',
 312         bind_values => [ 'RT::Queue-Role' ],
 313         action => sub {
 314             my $id = shift;
 315             return unless prompt(
 316                 'Delete', "Found a role group of a nonexistent queue."
 317             );
 318
 319             delete_record( 'Groups', $id );
 320         },
 321     );
 322     return $res;
 323 };
 324
 325 # check integrity of Ticket role groups
 326 push @CHECKS, 'Tickets <-> Role Groups' => sub {
 327     # XXX: we check only that there is at least one group for a queue
 328     # from queue to group
 329     my $res = 1;
 330     $res *= check_integrity(
 331         'Tickets', 'id' => 'Groups', 'Instance',
 332         join_condition   => 't.Domain = ?',
 333         bind_values => [ 'RT::Ticket-Role' ],
 334     );
 335     # from group to ticket
 336     $res *= check_integrity(
 337         'Groups', 'Instance' => 'Tickets', 'id',
 338         condition   => 's.Domain = ?',
 339         bind_values => [ 'RT::Ticket-Role' ],
 340         action => sub {
 341             my $id = shift;
 342             return unless prompt(
 343                 'Delete', "Found a role group of a nonexistent ticket."
 344             );
 345
 346             delete_record( 'Groups', $id );
 347         },
 348     );
 349     return $res;
 350 };
 351
 352 # additional CHECKS on groups
 353 push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
 354     # Check that Domain, Instance and Type are unique
 355     return check_uniqueness(
 356         'Groups',
 357         columns     => ['Domain', 'Instance', 'Type'],
 358         condition   => '.Domain LIKE ?',
 359         bind_values => [ '%-Role' ],
 360     );
 361 };
 362
 363 push @CHECKS, 'System internal group uniqueness' => sub {
 364     return check_uniqueness(
 365         'Groups',
 366         columns     => ['Instance', 'Type'],
 367         condition   => '.Domain = ?',
 368         bind_values => [ 'SystemInternal' ],
 369     );
 370 };
 371
 372 # CHECK that user defined group names are unique
 373 push @CHECKS, 'User Defined Group Name uniqueness' => sub {
 374     return check_uniqueness(
 375         'Groups',
 376         columns         => ['Name'],
 377         condition       => '.Domain = ?',
 378         bind_values     => [ 'UserDefined' ],
 379         extra_tables    => ['Principals sp', 'Principals tp'],
 380         extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)),
 381         extra_values    => ['Group', 'Group'],
 382         action          => sub {
 383             return unless prompt(
 384                 'Rename', "Found a user defined group with a non-unique Name."
 385             );
 386
 387             my $id = shift;
 388             my %cols = @_;
 389             update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) });
 390         },
 391     );
 392 };
 393
 394 push @CHECKS, 'GMs -> Groups, Members' => sub {
 395     my $msg = "A record in GroupMembers references an object that doesn't exist."
 396         ." Maybe you deleted a group or principal directly from the database?"
 397         ." Usually it's OK to delete such records.";
 398     my $res = 1;
 399     $res *= check_integrity(
 400         'GroupMembers', 'GroupId' => 'Groups', 'id',
 401         action => sub {
 402             my $id = shift;
 403             return unless prompt( 'Delete', $msg );
 404
 405             delete_record( 'GroupMembers', $id );
 406         },
 407     );
 408     $res *= check_integrity(
 409         'GroupMembers', 'MemberId' => 'Principals', 'id',
 410         action => sub {
 411             my $id = shift;
 412             return unless prompt( 'Delete', $msg );
 413
 414             delete_record( 'GroupMembers', $id );
 415         },
 416     );
 417     return $res;
 418 };
 419
 420 # CGM and GM
 421 push @CHECKS, 'CGM vs. GM' => sub {
 422     my $res = 1;
 423     # all GM record should be duplicated in CGM
 424     $res *= check_integrity(
 425         GroupMembers       => ['GroupId', 'MemberId'],
 426         CachedGroupMembers => ['GroupId', 'MemberId'],
 427         join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
 428         action => sub {
 429             my $id = shift;
 430             return unless prompt(
 431                 'Create',
 432                 "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
 433             );
 434
 435             my $gm = RT::GroupMember->new( RT->SystemUser );
 436             $gm->Load( $id );
 437             die "Couldn't load GM record #$id" unless $gm->id;
 438             my $cgm = create_record( 'CachedGroupMembers',
 439                 GroupId => $gm->GroupId, MemberId => $gm->MemberId,
 440                 ImmediateParentId => $gm->GroupId, Via => undef,
 441                 Disabled => 0, # XXX: we should check integrity of Disabled field
 442             );
 443             update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
 444         },
 445     );
 446     # all first level CGM records should have a GM record
 447     $res *= check_integrity(
 448         CachedGroupMembers => ['GroupId', 'MemberId'],
 449         GroupMembers       => ['GroupId', 'MemberId'],
 450         condition     => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
 451         action => sub {
 452             my $id = shift;
 453             return unless prompt(
 454                 'Delete',
 455                 "Found a record in CachedGroupMembers for a (Group, Member) pair"
 456                 ." that doesn't exist in the GroupMembers table."
 457             );
 458
 459             delete_record( 'CachedGroupMembers', $id );
 460         },
 461     );
 462     # each group should have a CGM record where MemberId == GroupId
 463     $res *= check_integrity(
 464         Groups => ['id', 'id'],
 465         CachedGroupMembers => ['GroupId', 'MemberId'],
 466         join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
 467         action => sub {
 468             my $id = shift;
 469             return unless prompt(
 470                 'Create',
 471                 "Found a record in Groups that has no direct"
 472                 ." duplicate in CachedGroupMembers table."
 473             );
 474
 475             my $g = RT::Group->new( RT->SystemUser );
 476             $g->Load( $id );
 477             die "Couldn't load group #$id" unless $g->id;
 478             die "Loaded group by $id has id ". $g->id  unless $g->id == $id;
 479             my $cgm = create_record( 'CachedGroupMembers',
 480                 GroupId => $id, MemberId => $id,
 481                 ImmediateParentId => $id, Via => undef,
 482                 Disabled => $g->Disabled,
 483             );
 484             update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
 485         },
 486     );
 487
 488     # and back, each record in CGM with MemberId == GroupId without exceptions
 489     # should reference a group
 490     $res *= check_integrity(
 491         CachedGroupMembers => ['GroupId', 'MemberId'],
 492         Groups => ['id', 'id'],
 493         condition => "s.GroupId = s.MemberId",
 494         action => sub {
 495             my $id = shift;
 496             return unless prompt(
 497                 'Delete',
 498                 "Found a record in CachedGroupMembers for a group that doesn't exist."
 499             );
 500
 501             delete_record( 'CachedGroupMembers', $id );
 502         },
 503     );
 504     # Via
 505     $res *= check_integrity(
 506         CachedGroupMembers => 'Via',
 507         CachedGroupMembers => 'id',
 508         action => sub {
 509             my $id = shift;
 510             return unless prompt(
 511                 'Delete',
 512                 "Found a record in CachedGroupMembers with Via that references a nonexistent record."
 513             );
 514
 515             delete_record( 'CachedGroupMembers', $id );
 516         },
 517     );
 518
 519     # for every CGM where ImmediateParentId != GroupId there should be
 520     # matching parent record (first level)
 521     $res *= check_integrity(
 522         CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
 523         CachedGroupMembers => ['GroupId', 'MemberId'],
 524         join_condition => 't.Via = t.id',
 525         condition => 's.ImmediateParentId != s.GroupId',
 526         action => sub {
 527             my $id = shift;
 528             return unless prompt(
 529                 'Delete',
 530                 "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
 531             );
 532
 533             delete_record( 'CachedGroupMembers', $id );
 534         },
 535     );
 536
 537     # for every CGM where ImmediateParentId != GroupId there should be
 538     # matching "grand" parent record
 539     $res *= check_integrity(
 540         CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
 541         CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
 542         condition => 's.ImmediateParentId != s.GroupId',
 543         action => sub {
 544             my $id = shift;
 545             return unless prompt(
 546                 'Delete',
 547                 "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
 548             );
 549
 550             delete_record( 'CachedGroupMembers', $id );
 551         },
 552     );
 553
 554     # CHECK recursive records:
 555     # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
 556     # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
 557     {
 558         my $query = <<END;
 559 SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
 560     cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
 561 FROM
 562     CachedGroupMembers cgm1
 563     CROSS JOIN GroupMembers gm2
 564     LEFT JOIN CachedGroupMembers cgm3 ON (
 565             cgm3.GroupId           = cgm1.GroupId
 566         AND cgm3.MemberId          = gm2.MemberId
 567         AND cgm3.Via               = cgm1.id
 568         AND cgm3.ImmediateParentId = cgm1.MemberId )
 569 WHERE cgm1.GroupId != cgm1.MemberId
 570 AND gm2.GroupId = cgm1.MemberId
 571 AND cgm3.id IS NULL
 572 END
 573
 574         my $action = sub {
 575             my %props = @_;
 576             return unless prompt(
 577                 'Create',
 578                 "Found records in CachedGroupMembers table without recursive duplicates."
 579             );
 580             my $cgm = create_record( 'CachedGroupMembers', %props );
 581         };
 582
 583         my $sth = execute_query( $query );
 584         while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
 585             $res = 0;
 586             print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
 587             print STDERR " but there is no cached GM record that $m is member of #$g.\n";
 588             $action->(
 589                 GroupId => $g, MemberId => $m, Via => $via,
 590                 ImmediateParentId => $ip, Disabled => $dis,
 591             );
 592         }
 593     }
 594
 595     return $res;
 596 };
 597
 598 # Tickets
 599 push @CHECKS, 'Tickets -> other' => sub {
 600     my $res = 1;
 601     $res *= check_integrity(
 602         'Tickets', 'EffectiveId' => 'Tickets', 'id',
 603         action => sub {
 604             my $id = shift;
 605             return unless prompt(
 606                 'Delete',
 607                 "Found a ticket that's been merged into a ticket that no longer exists."
 608             );
 609
 610             delete_record( 'Tickets', $id );
 611         },
 612     );
 613     $res *= check_integrity(
 614         'Tickets', 'Queue' => 'Queues', 'id',
 615     );
 616     $res *= check_integrity(
 617         'Tickets', 'Owner' => 'Users', 'id',
 618          action => sub {
 619              my ($id, %prop) = @_;
 620              return unless my $replace_with = prompt_integer(
 621                  'Replace',
 622                  "Column Owner should point to a user, but there is record #$id in Tickets\n"
 623                  ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
 624                  ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
 625                  ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
 626                  ."or something like that.",
 627                  "Tickets.Owner -> user #$prop{Owner}"
 628              );
 629              update_records( 'Tickets', { id => $id, Owner => $prop{Owner} }, { Owner => $replace_with } );
 630          },
 631     );
 632     # XXX: check that owner is only member of owner role group
 633     return $res;
 634 };
 635
 636
 637 push @CHECKS, 'Transactions -> other' => sub {
 638     my $res = 1;
 639     foreach my $model ( @models ) {
 640         $res *= check_integrity(
 641             'Transactions', 'ObjectId' => m2t($model), 'id',
 642             condition   => 's.ObjectType = ?',
 643             bind_values => [ "RT::$model" ],
 644             action => sub {
 645                 my $id = shift;
 646                 return unless prompt(
 647                     'Delete', "Found a transaction without object."
 648                 );
 649
 650                 delete_record( 'Transactions', $id );
 651             },
 652         );
 653     }
 654     # type = CustomField
 655     $res *= check_integrity(
 656         'Transactions', 'Field' => 'CustomFields', 'id',
 657         condition   => 's.Type = ?',
 658         bind_values => [ 'CustomField' ],
 659     );
 660     # type = Take, Untake, Force, Steal or Give
 661     $res *= check_integrity(
 662         'Transactions', 'OldValue' => 'Users', 'id',
 663         condition   => 's.Type IN (?, ?, ?, ?, ?)',
 664         bind_values => [ qw(Take Untake Force Steal Give) ],
 665         action => sub {
 666             my $id = shift;
 667             return unless prompt(
 668                 'Delete', "Found a transaction regarding Owner changes,"
 669                 ." but the User with id stored in OldValue column doesn't exist anymore."
 670             );
 671
 672             delete_record( 'Transactions', $id );
 673         },
 674     );
 675     $res *= check_integrity(
 676         'Transactions', 'NewValue' => 'Users', 'id',
 677         condition   => 's.Type IN (?, ?, ?, ?, ?)',
 678         bind_values => [ qw(Take Untake Force Steal Give) ],
 679         action => sub {
 680             my $id = shift;
 681             return unless prompt(
 682                 'Delete', "Found a transaction regarding Owner changes,"
 683                 ." but the User with id stored in NewValue column doesn't exist anymore."
 684             );
 685
 686             delete_record( 'Transactions', $id );
 687         },
 688     );
 689     # type = DelWatcher
 690     $res *= check_integrity(
 691         'Transactions', 'OldValue' => 'Principals', 'id',
 692         condition   => 's.Type = ?',
 693         bind_values => [ 'DelWatcher' ],
 694         action => sub {
 695             my $id = shift;
 696             return unless prompt(
 697                 'Delete', "Found a transaction describing watcher changes,"
 698                 ." but the User with id stored in OldValue column doesn't exist anymore."
 699             );
 700
 701             delete_record( 'Transactions', $id );
 702         },
 703     );
 704     # type = AddWatcher
 705     $res *= check_integrity(
 706         'Transactions', 'NewValue' => 'Principals', 'id',
 707         condition   => 's.Type = ?',
 708         bind_values => [ 'AddWatcher' ],
 709         action => sub {
 710             my $id = shift;
 711             return unless prompt(
 712                 'Delete', "Found a transaction describing watcher changes,"
 713                 ." but the User with id stored in NewValue column doesn't exist anymore."
 714             );
 715
 716             delete_record( 'Transactions', $id );
 717         },
 718     );
 719
 720 #   type = DeleteLink or AddLink
 721 #   handled in 'Links: *' checks as {New,Old}Value store URIs
 722
 723     # type = Set, Field = Queue
 724     $res *= check_integrity(
 725         'Transactions', 'NewValue' => 'Queues', 'id',
 726         condition   => 's.Type = ? AND s.Field = ?',
 727         bind_values => [ 'Set', 'Queue' ],
 728         action => sub {
 729             my $id = shift;
 730             return unless prompt(
 731                 'Delete', "Found a transaction describing a queue change,"
 732                 ." but the Queue with id stored in the NewValue column doesn't exist anymore."
 733             );
 734
 735             delete_record( 'Transactions', $id );
 736         },
 737     );
 738     $res *= check_integrity(
 739         'Transactions', 'OldValue' => 'Queues', 'id',
 740         condition   => 's.Type = ? AND s.Field = ?',
 741         bind_values => [ 'Set', 'Queue' ],
 742         action => sub {
 743             my $id = shift;
 744             return unless prompt(
 745                 'Delete', "Found a transaction describing a queue change,"
 746                 ." but the Queue with id stored in the OldValue column doesn't exist anymore."
 747             );
 748
 749             delete_record( 'Transactions', $id );
 750         },
 751     );
 752     # Reminders
 753     $res *= check_integrity(
 754         'Transactions', 'NewValue' => 'Tickets', 'id',
 755         join_condition => 't.Type = ?',
 756         condition      => 's.Type IN (?, ?, ?)',
 757         bind_values    => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
 758     );
 759     return $res;
 760 };
 761
 762 # Attachments
 763 push @CHECKS, 'Attachments -> other' => sub {
 764     my $res = 1;
 765     $res *= check_integrity(
 766         Attachments  => 'TransactionId', Transactions => 'id',
 767         action => sub {
 768             my $id = shift;
 769             return unless prompt(
 770                 'Delete', "Found an attachment without a transaction."
 771             );
 772             delete_record( 'Attachments', $id );
 773         },
 774     );
 775     $res *= check_integrity(
 776         Attachments => 'Parent', Attachments => 'id',
 777         action => sub {
 778             my $id = shift;
 779             return unless prompt(
 780                 'Delete', "Found an sub-attachment without its parent attachment."
 781             );
 782             delete_record( 'Attachments', $id );
 783         },
 784     );
 785     $res *= check_integrity(
 786         Attachments => 'Parent',
 787         Attachments => 'id',
 788         join_condition => 's.TransactionId = t.TransactionId',
 789     );
 790     return $res;
 791 };
 792
 793 push @CHECKS, 'CustomFields and friends' => sub {
 794     my $res = 1;
 795     #XXX: ObjectCustomFields needs more love
 796     $res *= check_integrity(
 797         'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
 798     );
 799     $res *= check_integrity(
 800         'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
 801     );
 802     foreach my $model ( @models ) {
 803         $res *= check_integrity(
 804             'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
 805             condition   => 's.ObjectType = ?',
 806             bind_values => [ "RT::$model" ],
 807         );
 808     }
 809     return $res;
 810 };
 811
 812 push @CHECKS, Templates => sub {
 813     return check_integrity(
 814         'Templates', 'Queue' => 'Queues', 'id',
 815     );
 816 };
 817
 818 push @CHECKS, Scrips => sub {
 819     my $res = 1;
 820     $res *= check_integrity(
 821         'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
 822     );
 823     $res *= check_integrity(
 824         'Scrips', 'ScripAction' => 'ScripActions', 'id',
 825     );
 826     $res *= check_integrity(
 827         'Scrips', 'Template' => 'Templates', 'Name',
 828     );
 829     $res *= check_integrity(
 830         'ObjectScrips', 'Scrip' => 'Scrips', 'id',
 831     );
 832     $res *= check_integrity(
 833         'ObjectScrips', 'ObjectId' => 'Queues', 'id',
 834     );
 835     return $res;
 836 };
 837
 838 push @CHECKS, Attributes => sub {
 839     my $res = 1;
 840     foreach my $model ( @models ) {
 841         $res *= check_integrity(
 842             'Attributes', 'ObjectId' => m2t($model), 'id',
 843             condition   => 's.ObjectType = ?',
 844             bind_values => [ "RT::$model" ],
 845         );
 846     }
 847     return $res;
 848 };
 849
 850 # Fix situations when Creator or LastUpdatedBy references ACL equivalence
 851 # group of a user instead of user
 852 push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
 853     my $res = 1;
 854     my %fix = ();
 855     foreach my $model ( @models ) {
 856         my $class = "RT::$model";
 857         my $object = $class->new( RT->SystemUser );
 858         foreach my $column ( qw(LastUpdatedBy Creator) ) {
 859             next unless $object->_Accessible( $column, 'auto' );
 860
 861             my $table = m2t($model);
 862             my $query = <<END;
 863 SELECT m.id, g.id, g.Instance
 864 FROM
 865     Groups g JOIN $table m ON g.id = m.$column
 866 WHERE
 867     g.Domain = ?
 868     AND g.Type = ?
 869 END
 870             my $action = sub {
 871                 my ($gid, $uid) = @_;
 872                 return unless prompt(
 873                     'Update',
 874                     "Looks like there were a bug in old versions of RT back in 2006\n"
 875                     ."that has been fixed. If other checks are ok then it's ok to update\n"
 876                     ."these records to point them to users instead of groups"
 877                 );
 878                 $fix{ $table }{ $column }{ $gid } = $uid;
 879             };
 880
 881             my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
 882             while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
 883                 $res = 0;
 884                 print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
 885                 print STDERR " when must reference user.\n";
 886                 $action->( $gid, $uid );
 887                 if ( keys( %fix ) > 1000 ) {
 888                     $sth->finish;
 889                     last;
 890                 }
 891             }
 892         }
 893     }
 894
 895     if ( keys %fix ) {
 896         foreach my $table ( keys %fix ) {
 897             foreach my $column ( keys %{ $fix{ $table } } ) {
 898                 my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
 899                 while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
 900                     update_records( $table, { $column => $gid }, { $column => $uid } );
 901                 }
 902             }
 903         }
 904         $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
 905     }
 906     return $res;
 907 };
 908
 909 push @CHECKS, 'LastUpdatedBy and Creator' => sub {
 910     my $res = 1;
 911     foreach my $model ( @models ) {
 912         my $class = "RT::$model";
 913         my $object = $class->new( RT->SystemUser );
 914         my $table = $object->Table;
 915         foreach my $column ( qw(LastUpdatedBy Creator) ) {
 916             next unless $object->_Accessible( $column, 'auto' );
 917             $res *= check_integrity(
 918                 $table, $column => 'Users', 'id',
 919                 action => sub {
 920                     my ($id, %prop) = @_;
 921                     return unless my $replace_with = prompt_integer(
 922                         'Replace',
 923                         "Column $column should point to a user, but there is record #$id in table $table\n"
 924                         ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
 925                         ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
 926                         ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
 927                         ."or something like that.",
 928                         "$table.$column -> user #$prop{$column}"
 929                     );
 930                     update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
 931                 },
 932             );
 933         }
 934     }
 935     return $res;
 936 };
 937
 938 push @CHECKS, 'Links: wrong organization' => sub {
 939     my $res = 1;
 940     my @URI_USES = (
 941         { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
 942         { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
 943         { model => 'Link', column => 'Target' },
 944         { model => 'Link', column => 'Base' },
 945     );
 946
 947     my @rt_uris = rt_uri_modules();
 948     foreach my $package (@rt_uris) {
 949
 950         my $rt_uri = $package->new( $RT::SystemUser );
 951         my $scheme = $rt_uri->Scheme;
 952         my $prefix = $rt_uri->LocalURIPrefix;
 953
 954         foreach my $use ( @URI_USES ) {
 955             my $table = m2t( $use->{'model'} );
 956             my $column = $use->{'column'};
 957
 958             my $query = "SELECT id, $column FROM $table WHERE"
 959               . " $column LIKE ? AND $column NOT LIKE ?";
 960             my @binds = ($scheme ."://%", $prefix ."%");
 961
 962             while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
 963                 $query .= " AND $k = ?";
 964                 push @binds, $v;
 965             }
 966             my $sth = execute_query( $query, @binds );
 967             while ( my ($id, $value) = $sth->fetchrow_array ) {
 968                 $res = 0;
 969                 print STDERR "Record #$id in $table. Value of $column column most probably is an incorrect link\n";
 970                 my ($wrong_org) = ( $value =~ m{^\Q$scheme\E://(.+)/[^/]+/[0-9]*$} );
 971                 next unless my $replace_with = prompt(
 972                     'Replace',
 973                     "Column $column in $table is a link. Local links has scheme '$scheme'"
 974                     ." followed by organization name from the config file. There is record"
 975                     ." #$id that has scheme '$scheme', but organization is '$wrong_org'."
 976                     ." Most probably you changed organization, but didn't update links."
 977                     ." It's ok to replace these wrong links.\n",
 978                     "Links: wrong organization $wrong_org"
 979                                                      );
 980
 981                 print "Updating record(s) in $table\n" if $opt{'verbose'};
 982                 my $wrong_prefix = $scheme . '://'. $wrong_org;
 983                 my $query = "UPDATE $table SET $column = ". sql_concat('?', "SUBSTR($column, ?)")
 984                   ." WHERE $column LIKE ?";
 985                 execute_query( $query, $prefix, length($wrong_prefix)+1, $wrong_prefix .'/%' );
 986
 987                 $redo_check{'Links: wrong organization'} = 1;
 988                 $redo_check{'Links: LocalX for non-ticket'} = 1;
 989                 last; # plenty of chances we covered all cases with one update
 990             }
 991         }
 992     } # end foreach my $package (@rt_uris)
 993     return $res;
 994 };
 995
 996 push @CHECKS, 'Links: LocalX for non-ticket' => sub {
 997     my $res = 1;
 998     my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
 999     my $scheme = $rt_uri->Scheme;
1000     my $prefix = $rt_uri->LocalURIPrefix;
1001     my $table = m2t('Link');
1002
1003     foreach my $dir ( 'Target', 'Base' ) {
1004         # we look only at links with correct organization, previouse check deals
1005         # with incorrect orgs
1006         my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir NOT LIKE ?";
1007         my @binds = ($prefix ."/%", $prefix ."/ticket/%");
1008
1009         my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
1010         while ( my ($id, $value) = $sth->fetchrow_array ) {
1011             $res = 0;
1012             print STDERR "Record #$id in $table. Value of Local$dir is not 0\n";
1013             next unless my $replace_with = prompt(
1014                 'Replace',
1015                 "Column Local$dir in $table should be 0 if $dir column is not link"
1016                 ." to a ticket. It's ok to replace with 0.\n",
1017             );
1018
1019             print "Updating record(s) in $table\n" if $opt{'verbose'};
1020             execute_query( "UPDATE $table SET Local$dir = 0 WHERE $where", @binds );
1021             $redo_check{'Links: wrong organization'} = 1;
1022
1023             last; # we covered all cases with one update
1024         }
1025     }
1026     return $res;
1027 };
1028
1029 push @CHECKS, 'Links: LocalX != X' => sub {
1030     my $res = 1;
1031     my $rt_uri = RT::URI::fsck_com_rt->new( $RT::SystemUser );
1032     my $scheme = $rt_uri->Scheme;
1033     my $prefix = $rt_uri->LocalURIPrefix .'/ticket/';
1034     my $table = m2t('Link');
1035
1036     foreach my $dir ( 'Target', 'Base' ) {
1037         # we limit to $dir = */ticket/* so it doesn't conflict with previouse check
1038         # previouse check is more important as there was a bug in RT when Local$dir
1039         # was set for not tickets
1040         # XXX: we have issue with MergedInto links - "LocalX !~ X"
1041         my $where = "Local$dir > 0 AND $dir LIKE ? AND $dir != ". sql_concat('?', "Local$dir")
1042             ." AND Type != ?";
1043         my @binds = ($prefix ."%", $prefix, 'MergedInto');
1044
1045         my $sth = execute_query( "SELECT id FROM $table WHERE $where", @binds );
1046         while ( my ($id, $value) = $sth->fetchrow_array ) {
1047             $res = 0;
1048             print STDERR "Record #$id in $table. Value of $dir doesn't match ticket id in Local$dir\n";
1049             next unless my $replace_with = prompt(
1050                 'Replace',
1051                 "For ticket links column $dir in $table table should end with"
1052                 ." ticket id from Local$dir. It's probably ok to fix $dir column.\n",
1053             );
1054
1055             print "Updating record(s) in $table\n" if $opt{'verbose'};
1056             execute_query(
1057                 "UPDATE $table SET $dir = ". sql_concat('?', "Local$dir") ." WHERE $where",
1058                 $prefix, @binds
1059             );
1060
1061             last; # we covered all cases with one update
1062         }
1063     }
1064     return $res;
1065 };
1066
1067 push @CHECKS, 'Links: missing object' => sub {
1068     my $res = 1;
1069     my @URI_USES = (
1070         { model => 'Transaction', column => 'OldValue', Additional => { Type => 'DeleteLink' } },
1071         { model => 'Transaction', column => 'NewValue', Additional => { Type => 'AddLink' } },
1072         { model => 'Link', column => 'Target' },
1073         { model => 'Link', column => 'Base' },
1074     );
1075
1076     my @rt_uris = rt_uri_modules();
1077     foreach my $package (@rt_uris) {
1078
1079         my $rt_uri = $package->new( $RT::SystemUser );
1080         my $scheme = $rt_uri->Scheme;
1081         my $prefix = $rt_uri->LocalURIPrefix;
1082
1083         foreach my $use ( @URI_USES ) {
1084             my $stable = m2t( $use->{'model'} );
1085             my $scolumn = $use->{'column'};
1086
1087             foreach my $tmodel ( @models ) {
1088                 my $tclass = 'RT::'. $tmodel;
1089                 my $ttable = m2t($tmodel);
1090
1091                 my $tprefix = $prefix .'/'. ($tclass eq 'RT::Ticket'? 'ticket' : $tclass) .'/';
1092
1093                 $tprefix = $prefix . '/article/' if $tclass eq 'RT::Article';
1094
1095                 my $query = "SELECT s.id FROM $stable s LEFT JOIN $ttable t "
1096                   ." ON t.id = ". sql_str2int("SUBSTR(s.$scolumn, ?)")
1097                     ." WHERE s.$scolumn LIKE ? AND t.id IS NULL";
1098                 my @binds = (length($tprefix) + 1, $tprefix.'%');
1099
1100                 while ( my ($k, $v) = each %{ $use->{'Additional'} || {} } ) {
1101                     $query .= " AND s.$k = ?";
1102                     push @binds, $v;
1103                 }
1104
1105                 my $sth = execute_query( $query, @binds );
1106                 while ( my ($sid) = $sth->fetchrow_array ) {
1107                     $res = 0;
1108                     print STDERR "Link in $scolumn column in record #$sid in $stable table points"
1109                       ." to not existing object.\n";
1110                     next unless prompt(
1111                         'Delete',
1112                         "Column $scolumn in $stable table is a link to an object that doesn't exist."
1113                         ." You can delete such records, however make sure there is no other"
1114                         ." errors with links.\n",
1115                         'Link to a missing object in $ttable'
1116                                       );
1117
1118                     delete_record($stable, $sid);
1119                 }
1120             }
1121         }
1122     } # end foreach my $package (@rt_uris)
1123     return $res;
1124 };
1125
1126
1127 my %CHECKS = @CHECKS;
1128
1129 @do_check = do { my $i = 1; grep $i++%2, @CHECKS };
1130
1131 if ($opt{'links-only'}) {
1132     @do_check = grep { /^Links:/ } @do_check;
1133 }
1134
1135 my $status = 1;
1136 while ( my $check = shift @do_check ) {
1137     $status *= $CHECKS{ $check }->();
1138
1139     foreach my $redo ( keys %redo_check ) {
1140         die "check $redo doesn't exist" unless $CHECKS{ $redo };
1141         delete $redo_check{ $redo };
1142         next if grep $_ eq $redo, @do_check; # don't do twice
1143         push @do_check, $redo;
1144     }
1145 }
1146 exit 1 unless $status;
1147 exit 0;
1148
1149 =head2 check_integrity
1150
1151 Takes two (table name, column(s)) pairs. First pair
1152 is reference we check and second is destination that
1153 must exist. Array reference can be used for multiple
1154 columns.
1155
1156 Returns 0 if a record is missing or 1 otherwise.
1157
1158 =cut
1159
1160 sub check_integrity {
1161     my ($stable, @scols) = (shift, shift);
1162     my ($ttable, @tcols) = (shift, shift);
1163     my %args = @_;
1164
1165     @scols = @{ $scols[0] } if ref $scols[0];
1166     @tcols = @{ $tcols[0] } if ref $tcols[0];
1167
1168     print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
1169         if $opt{'verbose'};
1170
1171     my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
1172         ." FROM $stable s LEFT JOIN $ttable t"
1173         ." ON (". join(
1174             ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
1175         ) .")"
1176         . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
1177         ." WHERE t.id IS NULL"
1178         ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);
1179
1180     $query .= " AND ( $args{'condition'} )" if $args{'condition'};
1181
1182     my @binds = @{ $args{'bind_values'} || [] };
1183     if ( $tcols[0] eq 'id' && @tcols == 1 ) {
1184         my $type = $TYPE{"$stable.$scols[0]"} || 'number';
1185         if ( $type eq 'number' ) {
1186             $query .= " AND s.$scols[0] != ?"
1187         }
1188         elsif ( $type eq 'text' ) {
1189             $query .= " AND s.$scols[0] NOT LIKE ?"
1190         }
1191         push @binds, 0;
1192     }
1193
1194     my $res = 1;
1195
1196     my $sth = execute_query( $query, @binds );
1197     while ( my ($sid, @set) = $sth->fetchrow_array ) {
1198         $res = 0;
1199
1200         print STDERR "Record #$sid in $stable references a nonexistent record in $ttable\n";
1201         for ( my $i = 0; $i < @scols; $i++ ) {
1202             print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
1203         }
1204         print STDERR "\t". describe( $stable, $sid ) ."\n";
1205         $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) )
1206             if $args{'action'};
1207     }
1208     return $res;
1209 }
1210
1211 sub describe {
1212     my ($table, $id) = @_;
1213     return '' unless my $cb = $describe_cb{ $table };
1214
1215     my $row = load_record( $table, $id );
1216     unless ( $row->{id} ) {
1217         $table =~ s/s$//;
1218         return "$table doesn't exist";
1219     }
1220     return $cb->( $row );
1221 }
1222
1223 sub columns_eq_cond {
1224     my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
1225     my $ltype = $TYPE{"$lt.$lc"} || 'number';
1226     my $rtype = $TYPE{"$rt.$rc"} || 'number';
1227     return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;
1228
1229     if ( $rtype eq 'text' ) {
1230         return "$ra.$rc LIKE CAST($la.$lc AS text)";
1231     }
1232     elsif ( $ltype eq 'text' ) {
1233         return "$la.$lc LIKE CAST($ra.$rc AS text)";
1234     }
1235     else { die "don't know how to cast" }
1236 }
1237
1238 sub check_uniqueness {
1239     my $on = shift;
1240     my %args = @_;
1241
1242     my @columns = @{ $args{'columns'} };
1243
1244     print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
1245         if $opt{'verbose'};
1246
1247     my ($scond, $tcond);
1248     if ( $scond = $tcond = $args{'condition'} ) {
1249         $scond =~ s/(\s|^)\./$1s./g;
1250         $tcond =~ s/(\s|^)\./$1t./g;
1251     }
1252
1253     my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
1254         ." FROM $on s LEFT JOIN $on t "
1255         ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
1256         . ($tcond? " AND ( $tcond )": "")
1257         . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "")
1258         ." WHERE t.id IS NOT NULL "
1259         ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
1260     $query .= " AND ( $scond )" if $scond;
1261     $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'};
1262
1263     my $sth = execute_query(
1264         $query,
1265         $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (),
1266         $args{'extra_values'}? (@{ $args{'extra_values'} }): ()
1267     );
1268     my $res = 1;
1269     while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
1270         $res = 0;
1271         print STDERR "Record #$tid in $on has the same set of values as $sid\n";
1272         for ( my $i = 0; $i < @columns; $i++ ) {
1273             print STDERR "\t$columns[$i] => '$set[$i]'\n";
1274         }
1275         $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'};
1276     }
1277     return $res;
1278 }
1279
1280 sub load_record {
1281     my ($table, $id) = @_;
1282     my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
1283     return $sth->fetchrow_hashref('NAME_lc');
1284 }
1285
1286 sub delete_record {
1287     my ($table, $id) = (@_);
1288     print "Deleting record #$id in $table\n" if $opt{'verbose'};
1289     my $query = "DELETE FROM $table WHERE id = ?";
1290     $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
1291     return execute_query( $query, $id );
1292 }
1293
1294 sub create_record {
1295     print "Creating a record in $_[0]\n" if $opt{'verbose'};
1296     $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
1297     return $RT::Handle->Insert( @_ );
1298 }
1299
1300 sub update_records {
1301     my $table = shift;
1302     my $where = shift;
1303     my $what = shift;
1304
1305     my (@where_cols, @where_binds);
1306     while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }
1307
1308     my (@what_cols, @what_binds);
1309     while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }
1310
1311     print "Updating record(s) in $table\n" if $opt{'verbose'};
1312     my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
1313         ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
1314     $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
1315     return execute_query( $query, @what_binds, @where_binds );
1316 }
1317
1318 sub execute_query {
1319     my ($query, @binds) = @_;
1320
1321     print "Executing query: $query\n\n" if $opt{'verbose'};
1322
1323     my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
1324     $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
1325     return $sth;
1326 }
1327
1328 sub sql_concat {
1329     return $_[0] if @_ <= 1;
1330
1331     my $db_type = RT->Config->Get('DatabaseType');
1332     if ( $db_type eq 'Pg' || $db_type eq 'SQLite' ) {
1333         return '('. join( ' || ', @_ ) .')';
1334     }
1335     return sql_concat('CONCAT('. join( ', ', splice @_, 0, 2 ).')', @_);
1336 }
1337
1338 sub sql_str2int {
1339     my $db_type = RT->Config->Get('DatabaseType');
1340     if ( $db_type eq 'Pg' ) {
1341         return "($_[0])::integer";
1342     }
1343     return $_[0];
1344 }
1345
1346 { my %cached_answer;
1347 sub prompt {
1348     my $action = shift;
1349     my $msg = shift;
1350     my $token = shift || join ':', caller;
1351
1352     return 0 unless $opt{'resolve'};
1353     return 1 if $opt{'force'};
1354
1355     return $cached_answer{ $token } if exists $cached_answer{ $token };
1356
1357     print $msg, "\n";
1358     print "$action ALL records with the same defect? [N]: ";
1359     my $a = <STDIN>;
1360     return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
1361     return $cached_answer{ $token } = 0;
1362 } }
1363
1364 { my %cached_answer;
1365 sub prompt_action {
1366     my $actions = shift;
1367     my $msg = shift;
1368     my $token = shift || join ':', caller;
1369
1370     return '' unless $opt{'resolve'};
1371     return lc substr $actions->[0], 0, 1 if $opt{'force'};
1372     return $cached_answer{ $token } if exists $cached_answer{ $token };
1373
1374     print $msg, "\n";
1375     print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
1376     my $a = <STDIN>;
1377     chomp $a;
1378     return $cached_answer{ $token } = '' unless $a;
1379     foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
1380         return $cached_answer{ $token } = lc substr $a, 0, 1;
1381     }
1382     return $cached_answer{ $token } = '';
1383 } }
1384
1385 { my %cached_answer;
1386 sub prompt_integer {
1387     my $action = shift;
1388     my $msg = shift;
1389     my $token = shift || join ':', caller;
1390
1391     return 0 unless $opt{'resolve'};
1392     return 0 if $opt{'force'};
1393
1394     return $cached_answer{ $token } if exists $cached_answer{ $token };
1395
1396     print $msg, "\n";
1397     print "$action ALL records with the same defect? [0]: ";
1398     my $a = <STDIN>; chomp $a; $a = int($a);
1399     return $cached_answer{ $token } = $a;
1400 } }
1401
1402 # Find all RT::URI modules RT has loaded
1403
1404 sub rt_uri_modules {
1405     my @uris = grep /^RT\/URI\/.+\.pm$/, keys %INC;
1406     my @uri_modules;
1407     foreach my $uri_path (@uris){
1408         next if $uri_path =~ /base\.pm$/; # Skip base RT::URI object
1409         $uri_path = substr $uri_path, 0, -3; # chop off .pm
1410         push @uri_modules, join '::', split '/', $uri_path;
1411     }
1412
1413     return @uri_modules;
1414 }
1415
1416 1;
1417
1418 __END__
1419
1420 =head1 NAME
1421
1422 rt-validator - check and correct validity of records in RT's database
1423
1424 =head1 SYNOPSIS
1425
1426     rt-validator --check
1427     rt-validator --check --verbose
1428     rt-validator --check --verbose --resolve
1429     rt-validator --check --verbose --resolve --force
1430
1431 =head1 DESCRIPTION
1432
1433 This script checks integrity of records in RT's DB. May delete some invalid
1434 records or ressurect accidentally deleted.
1435
1436 =head1 OPTIONS
1437
1438 =over
1439
1440 =item check
1441
1442     mandatory.
1443
1444     it's equal to -c
1445
1446 =item verbose
1447
1448     print additional info to STDOUT
1449     it's equal to -v
1450
1451 =item resolve
1452
1453     enable resolver that can delete or create some records
1454
1455 =item force
1456
1457     resolve without asking questions
1458
1459 =item links-only
1460
1461     only run the Link validation routines, useful if you changed your Organization
1462
1463 =back
1464