rt/sbin/rt-validator.in

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