sbin/rt-validator

   1 #!/usr/bin/perl
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2013 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 {
  54     require File::Spec;
  55     my @libs = ("lib", "local/lib");
  56     my $bin_path;
  57
  58     for my $lib (@libs) {
  59         unless ( File::Spec->file_name_is_absolute($lib) ) {
  60             unless ($bin_path) {
  61                 if ( File::Spec->file_name_is_absolute(__FILE__) ) {
  62                     $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
  63                 }
  64                 else {
  65                     require FindBin;
  66                     no warnings "once";
  67                     $bin_path = $FindBin::Bin;
  68                 }
  69             }
  70             $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
  71         }
  72         unshift @INC, $lib;
  73     }
  74
  75 }
  76
  77 use Getopt::Long;
  78 my %opt = ();
  79 GetOptions(
  80     \%opt,
  81     'check|c',
  82     'resolve',
  83     'force',
  84     'verbose|v',
  85     'help|h',
  86 );
  87
  88 if ( $opt{help} || !$opt{check} ) {
  89     require Pod::Usage;
  90     print Pod::Usage::pod2usage( { verbose => 2 } );
  91     exit;
  92 }
  93
  94 usage_warning() if $opt{'resolve'} && !$opt{'force'};
  95
  96
  97 sub usage_warning {
  98     print <<END;
  99 This utility can fix some issues with DB by creating or updating. In some
 100 cases there is no enough data to resurect a missing record, but records which
 101 refers to a missing can be deleted. It's up to you to decide what to do.
 102
 103 In any case it's highly recommended to have a backup before resolving anything.
 104
 105 Press enter to continue.
 106 END
 107 # Read a line of text, any line of text
 108     <STDIN>;
 109 }
 110
 111 use RT;
 112 RT::LoadConfig();
 113 RT::Init();
 114
 115 my $dbh = $RT::Handle->dbh;
 116 my $db_type = RT->Config->Get('DatabaseType');
 117
 118 my %TYPE = (
 119     'Transactions.Field'    => 'text',
 120     'Transactions.OldValue' => 'text',
 121     'Transactions.NewValue' => 'text',
 122 );
 123
 124 my @models = qw(
 125     ACE
 126     Attachment
 127     Attribute
 128     CachedGroupMember
 129     CustomField
 130     CustomFieldValue
 131     GroupMember
 132     Group
 133     Link
 134     ObjectCustomField
 135     ObjectCustomFieldValue
 136     Principal
 137     Queue
 138     ScripAction
 139     ScripCondition
 140     Scrip
 141     Template
 142     Ticket
 143     Transaction
 144     User
 145 );
 146
 147 my %redo_on;
 148 $redo_on{'Delete'} = {
 149     ACL => [],
 150
 151     Attributes => [],
 152
 153     Links => [],
 154
 155     CustomFields => [],
 156     CustomFieldValues => [],
 157     ObjectCustomFields => [],
 158     ObjectCustomFieldValues => [],
 159
 160     Queues => [],
 161
 162     Scrips => [],
 163     ScripActions => [],
 164     ScripConditions => [],
 165     Templates => [],
 166
 167     Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
 168     Transactions => [ 'Attachments -> other' ],
 169
 170     Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
 171     Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
 172     Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],
 173
 174     GroupMembers => [ 'CGM vs. GM' ],
 175     CachedGroupMembers => [ 'CGM vs. GM' ],
 176 };
 177 $redo_on{'Create'} = {
 178     Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
 179     Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
 180     GroupMembers => [ 'CGM vs. GM' ],
 181     CachedGroupMembers => [ 'CGM vs. GM' ],
 182 };
 183 $redo_on{'Update'} = {
 184     Groups => ['User Defined Group Name uniqueness'],
 185 };
 186
 187 my %describe_cb;
 188 %describe_cb = (
 189     Attachments => sub {
 190         my $row = shift;
 191         my $txn_id = $row->{transactionid};
 192         my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
 193         return $res .', '. describe( 'Transactions', $txn_id );
 194     },
 195     Transactions => sub {
 196         my $row = shift;
 197         return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
 198     },
 199 );
 200
 201 { my %cache = ();
 202 sub m2t($) {
 203     my $model = shift;
 204     return $cache{$model} if $cache{$model};
 205     my $class = "RT::$model";
 206     my $object = $class->new( RT->SystemUser );
 207     return $cache{$model} = $object->Table;
 208 } }
 209
 210 my (@do_check, %redo_check);
 211
 212 my @CHECKS;
 213 foreach my $table ( qw(Users Groups) ) {
 214     push @CHECKS, "$table -> Principals" => sub {
 215         my $msg = "A record in $table refers to a nonexistent record in Principals."
 216             ." The script can either create the missing record in Principals"
 217             ." or delete the record in $table.";
 218         my ($type) = ($table =~ /^(.*)s$/);
 219         check_integrity(
 220             $table, 'id' => 'Principals', 'id',
 221             join_condition => 't.PrincipalType = ?',
 222             bind_values => [ $type ],
 223             action => sub {
 224                 my $id = shift;
 225                 return unless my $a = prompt_action( ['Delete', 'create'], $msg );
 226
 227                 if ( $a eq 'd' ) {
 228                     delete_record( $table, $id );
 229                 }
 230                 elsif ( $a eq 'c' ) {
 231                     my $principal_id = create_record( 'Principals',
 232                         id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
 233                     );
 234                 }
 235                 else {
 236                     die "Unknown action '$a'";
 237                 }
 238             },
 239         );
 240     };
 241
 242     push @CHECKS, "Principals -> $table" => sub {
 243         my $msg = "A record in Principals refers to a nonexistent record in $table."
 244             ." In some cases it's possible to manually resurrect such records,"
 245             ." but this utility can only delete records.";
 246
 247         check_integrity(
 248             'Principals', 'id' => $table, 'id',
 249             condition   => 's.PrincipalType = ?',
 250             bind_values => [ $table =~ /^(.*)s$/ ],
 251             action => sub {
 252                 my $id = shift;
 253                 return unless prompt( 'Delete', $msg );
 254
 255                 delete_record( 'Principals', $id );
 256             },
 257         );
 258     };
 259 }
 260
 261 push @CHECKS, 'User <-> ACL equivalence group' => sub {
 262     # from user to group
 263     check_integrity(
 264         'Users', 'id' => 'Groups', 'Instance',
 265         join_condition   => 't.Domain = ? AND t.Type = ?',
 266         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
 267         action => sub {
 268             my $id = shift;
 269             return unless prompt(
 270                 'Create', "Found an user that has no ACL equivalence group."
 271             );
 272
 273             my $gid = create_record( 'Groups',
 274                 Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
 275             );
 276         },
 277     );
 278     # from group to user
 279     check_integrity(
 280         'Groups', 'Instance' => 'Users', 'id',
 281         condition   => 's.Domain = ? AND s.Type = ?',
 282         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
 283         action => sub {
 284             my $id = shift;
 285             return unless prompt(
 286                 'Delete', "Found an user ACL equivalence group, but there is no user."
 287             );
 288
 289             delete_record( 'Groups', $id );
 290         },
 291     );
 292     # one ACL equiv group for each user
 293     check_uniqueness(
 294         'Groups',
 295         columns     => ['Instance'],
 296         condition   => '.Domain = ? AND .Type = ?',
 297         bind_values => [ 'ACLEquivalence',  'UserEquiv' ],
 298     );
 299 };
 300
 301 # check integrity of Queue role groups
 302 push @CHECKS, 'Queues <-> Role Groups' => sub {
 303     # XXX: we check only that there is at least one group for a queue
 304     # from queue to group
 305     check_integrity(
 306         'Queues', 'id' => 'Groups', 'Instance',
 307         join_condition   => 't.Domain = ?',
 308         bind_values => [ 'RT::Queue-Role' ],
 309     );
 310     # from group to queue
 311     check_integrity(
 312         'Groups', 'Instance' => 'Queues', 'id',
 313         condition   => 's.Domain = ?',
 314         bind_values => [ 'RT::Queue-Role' ],
 315         action => sub {
 316             my $id = shift;
 317             return unless prompt(
 318                 'Delete', "Found a role group of a nonexistent queue."
 319             );
 320
 321             delete_record( 'Groups', $id );
 322         },
 323     );
 324 };
 325
 326 # check integrity of Ticket role groups
 327 push @CHECKS, 'Tickets <-> Role Groups' => sub {
 328     # XXX: we check only that there is at least one group for a queue
 329     # from queue to group
 330     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     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 };
 350
 351 # additional CHECKS on groups
 352 push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
 353     # Check that Domain, Instance and Type are unique
 354     check_uniqueness(
 355         'Groups',
 356         columns     => ['Domain', 'Instance', 'Type'],
 357         condition   => '.Domain LIKE ?',
 358         bind_values => [ '%-Role' ],
 359     );
 360 };
 361
 362 push @CHECKS, 'System internal group uniqueness' => sub {
 363     check_uniqueness(
 364         'Groups',
 365         columns     => ['Instance', 'Type'],
 366         condition   => '.Domain = ?',
 367         bind_values => [ 'SystemInternal' ],
 368     );
 369 };
 370
 371 # CHECK that user defined group names are unique
 372 push @CHECKS, 'User Defined Group Name uniqueness' => sub {
 373     check_uniqueness(
 374         'Groups',
 375         columns         => ['Name'],
 376         condition       => '.Domain = ?',
 377         bind_values     => [ 'UserDefined' ],
 378         extra_tables    => ['Principals sp', 'Principals tp'],
 379         extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)),
 380         extra_values    => ['Group', 'Group'],
 381         action          => sub {
 382             return unless prompt(
 383                 'Rename', "Found a user defined group with a non-unique Name."
 384             );
 385
 386             my $id = shift;
 387             my %cols = @_;
 388             update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) });
 389         },
 390     );
 391 };
 392
 393 push @CHECKS, 'GMs -> Groups, Members' => sub {
 394     my $msg = "A record in GroupMembers references an object that doesn't exist."
 395         ." Maybe you deleted a group or principal directly from the database?"
 396         ." Usually it's OK to delete such records.";
 397     check_integrity(
 398         'GroupMembers', 'GroupId' => 'Groups', 'id',
 399         action => sub {
 400             my $id = shift;
 401             return unless prompt( 'Delete', $msg );
 402
 403             delete_record( 'GroupMembers', $id );
 404         },
 405     );
 406     check_integrity(
 407         'GroupMembers', 'MemberId' => 'Principals', 'id',
 408         action => sub {
 409             my $id = shift;
 410             return unless prompt( 'Delete', $msg );
 411
 412             delete_record( 'GroupMembers', $id );
 413         },
 414     );
 415 };
 416
 417 # CGM and GM
 418 push @CHECKS, 'CGM vs. GM' => sub {
 419     # all GM record should be duplicated in CGM
 420     check_integrity(
 421         GroupMembers       => ['GroupId', 'MemberId'],
 422         CachedGroupMembers => ['GroupId', 'MemberId'],
 423         join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
 424         action => sub {
 425             my $id = shift;
 426             return unless prompt(
 427                 'Create',
 428                 "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
 429             );
 430
 431             my $gm = RT::GroupMember->new( RT->SystemUser );
 432             $gm->Load( $id );
 433             die "Couldn't load GM record #$id" unless $gm->id;
 434             my $cgm = create_record( 'CachedGroupMembers',
 435                 GroupId => $gm->GroupId, MemberId => $gm->MemberId,
 436                 ImmediateParentId => $gm->GroupId, Via => undef,
 437                 Disabled => 0, # XXX: we should check integrity of Disabled field
 438             );
 439             update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
 440         },
 441     );
 442     # all first level CGM records should have a GM record
 443     check_integrity(
 444         CachedGroupMembers => ['GroupId', 'MemberId'],
 445         GroupMembers       => ['GroupId', 'MemberId'],
 446         condition     => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
 447         action => sub {
 448             my $id = shift;
 449             return unless prompt(
 450                 'Delete',
 451                 "Found a record in CachedGroupMembers for a (Group, Member) pair"
 452                 ." that doesn't exist in the GroupMembers table."
 453             );
 454
 455             delete_record( 'CachedGroupMembers', $id );
 456         },
 457     );
 458     # each group should have a CGM record where MemberId == GroupId
 459     check_integrity(
 460         Groups => ['id', 'id'],
 461         CachedGroupMembers => ['GroupId', 'MemberId'],
 462         join_condition     => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
 463         action => sub {
 464             my $id = shift;
 465             return unless prompt(
 466                 'Create',
 467                 "Found a record in Groups that has no direct"
 468                 ." duplicate in CachedGroupMembers table."
 469             );
 470
 471             my $g = RT::Group->new( RT->SystemUser );
 472             $g->Load( $id );
 473             die "Couldn't load group #$id" unless $g->id;
 474             die "Loaded group by $id has id ". $g->id  unless $g->id == $id;
 475             my $cgm = create_record( 'CachedGroupMembers',
 476                 GroupId => $id, MemberId => $id,
 477                 ImmediateParentId => $id, Via => undef,
 478                 Disabled => $g->Disabled,
 479             );
 480             update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
 481         },
 482     );
 483
 484     # and back, each record in CGM with MemberId == GroupId without exceptions
 485     # should reference a group
 486     check_integrity(
 487         CachedGroupMembers => ['GroupId', 'MemberId'],
 488         Groups => ['id', 'id'],
 489         condition => "s.GroupId = s.MemberId",
 490         action => sub {
 491             my $id = shift;
 492             return unless prompt(
 493                 'Delete',
 494                 "Found a record in CachedGroupMembers for a group that doesn't exist."
 495             );
 496
 497             delete_record( 'CachedGroupMembers', $id );
 498         },
 499     );
 500     # Via
 501     check_integrity(
 502         CachedGroupMembers => 'Via',
 503         CachedGroupMembers => 'id',
 504         action => sub {
 505             my $id = shift;
 506             return unless prompt(
 507                 'Delete',
 508                 "Found a record in CachedGroupMembers with Via that references a nonexistent record."
 509             );
 510
 511             delete_record( 'CachedGroupMembers', $id );
 512         },
 513     );
 514
 515     # for every CGM where ImmediateParentId != GroupId there should be
 516     # matching parent record (first level)
 517     check_integrity(
 518         CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
 519         CachedGroupMembers => ['GroupId', 'MemberId'],
 520         join_condition => 't.Via = t.id',
 521         condition => 's.ImmediateParentId != s.GroupId',
 522         action => sub {
 523             my $id = shift;
 524             return unless prompt(
 525                 'Delete',
 526                 "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
 527             );
 528
 529             delete_record( 'CachedGroupMembers', $id );
 530         },
 531     );
 532
 533     # for every CGM where ImmediateParentId != GroupId there should be
 534     # matching "grand" parent record
 535     check_integrity(
 536         CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
 537         CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
 538         condition => 's.ImmediateParentId != s.GroupId',
 539         action => sub {
 540             my $id = shift;
 541             return unless prompt(
 542                 'Delete',
 543                 "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
 544             );
 545
 546             delete_record( 'CachedGroupMembers', $id );
 547         },
 548     );
 549
 550     # CHECK recursive records:
 551     # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
 552     # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
 553     {
 554         my $query = <<END;
 555 SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
 556     cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
 557 FROM
 558     CachedGroupMembers cgm1
 559     CROSS JOIN GroupMembers gm2
 560     LEFT JOIN CachedGroupMembers cgm3 ON (
 561             cgm3.GroupId           = cgm1.GroupId
 562         AND cgm3.MemberId          = gm2.MemberId
 563         AND cgm3.Via               = cgm1.id
 564         AND cgm3.ImmediateParentId = cgm1.MemberId )
 565 WHERE cgm1.GroupId != cgm1.MemberId
 566 AND gm2.GroupId = cgm1.MemberId
 567 AND cgm3.id IS NULL
 568 END
 569
 570         my $action = sub {
 571             my %props = @_;
 572             return unless prompt(
 573                 'Create',
 574                 "Found records in CachedGroupMembers table without recursive duplicates."
 575             );
 576             my $cgm = create_record( 'CachedGroupMembers', %props );
 577         };
 578
 579         my $sth = execute_query( $query );
 580         while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
 581             print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
 582             print STDERR " but there is no cached GM record that $m is member of #$g.\n";
 583             $action->(
 584                 GroupId => $g, MemberId => $m, Via => $via,
 585                 ImmediateParentId => $ip, Disabled => $dis,
 586             );
 587         }
 588     }
 589 };
 590
 591 # Tickets
 592 push @CHECKS, 'Tickets -> other' => sub {
 593     check_integrity(
 594         'Tickets', 'EffectiveId' => 'Tickets', 'id',
 595         action => sub {
 596             my $id = shift;
 597             return unless prompt(
 598                 'Delete',
 599                 "Found a ticket that's been merged into a ticket that no longer exists."
 600             );
 601
 602             delete_record( 'Tickets', $id );
 603         },
 604     );
 605     check_integrity(
 606         'Tickets', 'Queue' => 'Queues', 'id',
 607     );
 608     check_integrity(
 609         'Tickets', 'Owner' => 'Users', 'id',
 610     );
 611     # XXX: check that owner is only member of owner role group
 612 };
 613
 614
 615 push @CHECKS, 'Transactions -> other' => sub {
 616     foreach my $model ( @models ) {
 617         check_integrity(
 618             'Transactions', 'ObjectId' => m2t($model), 'id',
 619             condition   => 's.ObjectType = ?',
 620             bind_values => [ "RT::$model" ],
 621             action => sub {
 622                 my $id = shift;
 623                 return unless prompt(
 624                     'Delete', "Found a transaction without object."
 625                 );
 626
 627                 delete_record( 'Transactions', $id );
 628             },
 629         );
 630     }
 631     # type = CustomField
 632     check_integrity(
 633         'Transactions', 'Field' => 'CustomFields', 'id',
 634         condition   => 's.Type = ?',
 635         bind_values => [ 'CustomField' ],
 636     );
 637     # type = Take, Untake, Force, Steal or Give
 638     check_integrity(
 639         'Transactions', 'OldValue' => 'Users', 'id',
 640         condition   => 's.Type IN (?, ?, ?, ?, ?)',
 641         bind_values => [ qw(Take Untake Force Steal Give) ],
 642         action => sub {
 643             my $id = shift;
 644             return unless prompt(
 645                 'Delete', "Found a transaction regarding Owner changes,"
 646                 ." but the User with id stored in OldValue column doesn't exist anymore."
 647             );
 648
 649             delete_record( 'Transactions', $id );
 650         },
 651     );
 652     check_integrity(
 653         'Transactions', 'NewValue' => '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 NewValue column doesn't exist anymore."
 661             );
 662
 663             delete_record( 'Transactions', $id );
 664         },
 665     );
 666     # type = DelWatcher
 667     check_integrity(
 668         'Transactions', 'OldValue' => 'Principals', 'id',
 669         condition   => 's.Type = ?',
 670         bind_values => [ 'DelWatcher' ],
 671         action => sub {
 672             my $id = shift;
 673             return unless prompt(
 674                 'Delete', "Found a transaction describing watcher changes,"
 675                 ." but the User with id stored in OldValue column doesn't exist anymore."
 676             );
 677
 678             delete_record( 'Transactions', $id );
 679         },
 680     );
 681     # type = AddWatcher
 682     check_integrity(
 683         'Transactions', 'NewValue' => 'Principals', 'id',
 684         condition   => 's.Type = ?',
 685         bind_values => [ 'AddWatcher' ],
 686         action => sub {
 687             my $id = shift;
 688             return unless prompt(
 689                 'Delete', "Found a transaction describing watcher changes,"
 690                 ." but the User with id stored in NewValue column doesn't exist anymore."
 691             );
 692
 693             delete_record( 'Transactions', $id );
 694         },
 695     );
 696
 697 # XXX: Links need more love, uri is stored instead of id
 698 #    # type = DeleteLink
 699 #    check_integrity(
 700 #        'Transactions', 'OldValue' => 'Links', 'id',
 701 #        condition   => 's.Type = ?',
 702 #        bind_values => [ 'DeleteLink' ],
 703 #    );
 704 #    # type = AddLink
 705 #    check_integrity(
 706 #        'Transactions', 'NewValue' => 'Links', 'id',
 707 #        condition   => 's.Type = ?',
 708 #        bind_values => [ 'AddLink' ],
 709 #    );
 710
 711     # type = Set, Field = Queue
 712     check_integrity(
 713         'Transactions', 'NewValue' => 'Queues', 'id',
 714         condition   => 's.Type = ? AND s.Field = ?',
 715         bind_values => [ 'Set', 'Queue' ],
 716         action => sub {
 717             my $id = shift;
 718             return unless prompt(
 719                 'Delete', "Found a transaction describing a queue change,"
 720                 ." but the Queue with id stored in the NewValue column doesn't exist anymore."
 721             );
 722
 723             delete_record( 'Transactions', $id );
 724         },
 725     );
 726     check_integrity(
 727         'Transactions', 'OldValue' => 'Queues', 'id',
 728         condition   => 's.Type = ? AND s.Field = ?',
 729         bind_values => [ 'Set', 'Queue' ],
 730         action => sub {
 731             my $id = shift;
 732             return unless prompt(
 733                 'Delete', "Found a transaction describing a queue change,"
 734                 ." but the Queue with id stored in the OldValue column doesn't exist anymore."
 735             );
 736
 737             delete_record( 'Transactions', $id );
 738         },
 739     );
 740     # Reminders
 741     check_integrity(
 742         'Transactions', 'NewValue' => 'Tickets', 'id',
 743         join_condition => 't.Type = ?',
 744         condition      => 's.Type IN (?, ?, ?)',
 745         bind_values    => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
 746     );
 747 };
 748
 749 # Attachments
 750 push @CHECKS, 'Attachments -> other' => sub {
 751     check_integrity(
 752         Attachments  => 'TransactionId', Transactions => 'id',
 753         action => sub {
 754             my $id = shift;
 755             return unless prompt(
 756                 'Delete', "Found an attachment without a transaction."
 757             );
 758             delete_record( 'Attachments', $id );
 759         },
 760     );
 761     check_integrity(
 762         Attachments => 'Parent', Attachments => 'id',
 763         action => sub {
 764             my $id = shift;
 765             return unless prompt(
 766                 'Delete', "Found an sub-attachment without its parent attachment."
 767             );
 768             delete_record( 'Attachments', $id );
 769         },
 770     );
 771     check_integrity(
 772         Attachments => 'Parent',
 773         Attachments => 'id',
 774         join_condition => 's.TransactionId = t.TransactionId',
 775     );
 776 };
 777
 778 push @CHECKS, 'CustomFields and friends' => sub {
 779     #XXX: ObjectCustomFields needs more love
 780     check_integrity(
 781         'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
 782     );
 783     check_integrity(
 784         'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
 785     );
 786     foreach my $model ( @models ) {
 787         check_integrity(
 788             'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
 789             condition   => 's.ObjectType = ?',
 790             bind_values => [ "RT::$model" ],
 791         );
 792     }
 793 };
 794
 795 push @CHECKS, Templates => sub {
 796     check_integrity(
 797         'Templates', 'Queue' => 'Queues', 'id',
 798     );
 799 };
 800
 801 push @CHECKS, Scrips => sub {
 802     check_integrity(
 803         'Scrips', 'Queue' => 'Queues', 'id',
 804     );
 805     check_integrity(
 806         'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
 807     );
 808     check_integrity(
 809         'Scrips', 'ScripAction' => 'ScripActions', 'id',
 810     );
 811     check_integrity(
 812         'Scrips', 'Template' => 'Templates', 'id',
 813     );
 814 };
 815
 816 push @CHECKS, Attributes => sub {
 817     foreach my $model ( @models ) {
 818         check_integrity(
 819             'Attributes', 'ObjectId' => m2t($model), 'id',
 820             condition   => 's.ObjectType = ?',
 821             bind_values => [ "RT::$model" ],
 822         );
 823     }
 824 };
 825
 826 # Fix situations when Creator or LastUpdatedBy references ACL equivalence
 827 # group of a user instead of user
 828 push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
 829     my %fix = ();
 830     foreach my $model ( @models ) {
 831         my $class = "RT::$model";
 832         my $object = $class->new( RT->SystemUser );
 833         foreach my $column ( qw(LastUpdatedBy Creator) ) {
 834             next unless $object->_Accessible( $column, 'auto' );
 835
 836             my $table = m2t($model);
 837             my $query = <<END;
 838 SELECT m.id, g.id, g.Instance
 839 FROM
 840     Groups g JOIN $table m ON g.id = m.$column
 841 WHERE
 842     g.Domain = ?
 843     AND g.Type = ?
 844 END
 845             my $action = sub {
 846                 my ($gid, $uid) = @_;
 847                 return unless prompt(
 848                     'Update',
 849                     "Looks like there were a bug in old versions of RT back in 2006\n"
 850                     ."that has been fixed. If other checks are ok then it's ok to update\n"
 851                     ."these records to point them to users instead of groups"
 852                 );
 853                 $fix{ $table }{ $column }{ $gid } = $uid;
 854             };
 855
 856             my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
 857             while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
 858                 print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
 859                 print STDERR " when must reference user.\n";
 860                 $action->( $gid, $uid );
 861                 if ( keys( %fix ) > 1000 ) {
 862                     $sth->finish;
 863                     last;
 864                 }
 865             }
 866         }
 867     }
 868
 869     if ( keys %fix ) {
 870         foreach my $table ( keys %fix ) {
 871             foreach my $column ( keys %{ $fix{ $table } } ) {
 872                 my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
 873                 while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
 874                     update_records( $table, { $column => $gid }, { $column => $uid } );
 875                 }
 876             }
 877         }
 878         $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
 879     }
 880 };
 881
 882 push @CHECKS, 'LastUpdatedBy and Creator' => sub {
 883     foreach my $model ( @models ) {
 884         my $class = "RT::$model";
 885         my $object = $class->new( RT->SystemUser );
 886         my $table = $object->Table;
 887         foreach my $column ( qw(LastUpdatedBy Creator) ) {
 888             next unless $object->_Accessible( $column, 'auto' );
 889             check_integrity(
 890                 $table, $column => 'Users', 'id',
 891                 action => sub {
 892                     my ($id, %prop) = @_;
 893                     return unless my $replace_with = prompt_integer(
 894                         'Replace',
 895                         "Column $column should point to a user, but there is record #$id in table $table\n"
 896                         ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
 897                         ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
 898                         ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
 899                         ."or something like that.",
 900                         "$table.$column -> user #$prop{$column}"
 901                     );
 902                     update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
 903                 },
 904             );
 905         }
 906     }
 907 };
 908 my %CHECKS = @CHECKS;
 909
 910 @do_check = do { my $i = 1; grep $i++%2, @CHECKS };
 911
 912 while ( my $check = shift @do_check ) {
 913     $CHECKS{ $check }->();
 914
 915     foreach my $redo ( keys %redo_check ) {
 916         die "check $redo doesn't exist" unless $CHECKS{ $redo };
 917         delete $redo_check{ $redo };
 918         next if grep $_ eq $redo, @do_check; # don't do twice
 919         push @do_check, $redo;
 920     }
 921 }
 922
 923 sub check_integrity {
 924     my ($stable, @scols) = (shift, shift);
 925     my ($ttable, @tcols) = (shift, shift);
 926     my %args = @_;
 927
 928     @scols = @{ $scols[0] } if ref $scols[0];
 929     @tcols = @{ $tcols[0] } if ref $tcols[0];
 930
 931     print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
 932         if $opt{'verbose'};
 933
 934     my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
 935         ." FROM $stable s LEFT JOIN $ttable t"
 936         ." ON (". join(
 937             ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
 938         ) .")"
 939         . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
 940         ." WHERE t.id IS NULL"
 941         ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);
 942
 943     $query .= " AND ( $args{'condition'} )" if $args{'condition'};
 944
 945     my @binds = @{ $args{'bind_values'} || [] };
 946     if ( $tcols[0] eq 'id' && @tcols == 1 ) {
 947         my $type = $TYPE{"$stable.$scols[0]"} || 'number';
 948         if ( $type eq 'number' ) {
 949             $query .= " AND s.$scols[0] != ?"
 950         }
 951         elsif ( $type eq 'text' ) {
 952             $query .= " AND s.$scols[0] NOT LIKE ?"
 953         }
 954         push @binds, 0;
 955     }
 956
 957     my $sth = execute_query( $query, @binds );
 958     while ( my ($sid, @set) = $sth->fetchrow_array ) {
 959         print STDERR "Record #$sid in $stable references a nonexistent record in $ttable\n";
 960         for ( my $i = 0; $i < @scols; $i++ ) {
 961             print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
 962         }
 963         print STDERR "\t". describe( $stable, $sid ) ."\n";
 964         $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'};
 965     }
 966 }
 967
 968 sub describe {
 969     my ($table, $id) = @_;
 970     return '' unless my $cb = $describe_cb{ $table };
 971
 972     my $row = load_record( $table, $id );
 973     unless ( $row->{id} ) {
 974         $table =~ s/s$//;
 975         return "$table doesn't exist";
 976     }
 977     return $cb->( $row );
 978 }
 979
 980 sub columns_eq_cond {
 981     my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
 982     my $ltype = $TYPE{"$lt.$lc"} || 'number';
 983     my $rtype = $TYPE{"$rt.$rc"} || 'number';
 984     return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;
 985
 986     if ( $rtype eq 'text' ) {
 987         return "$ra.$rc LIKE CAST($la.$lc AS text)";
 988     }
 989     elsif ( $ltype eq 'text' ) {
 990         return "$la.$lc LIKE CAST($ra.$rc AS text)";
 991     }
 992     else { die "don't know how to cast" }
 993 }
 994
 995 sub check_uniqueness {
 996     my $on = shift;
 997     my %args = @_;
 998
 999     my @columns = @{ $args{'columns'} };
1000
1001     print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
1002         if $opt{'verbose'};
1003
1004     my ($scond, $tcond);
1005     if ( $scond = $tcond = $args{'condition'} ) {
1006         $scond =~ s/(\s|^)\./$1s./g;
1007         $tcond =~ s/(\s|^)\./$1t./g;
1008     }
1009
1010     my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
1011         ." FROM $on s LEFT JOIN $on t "
1012         ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
1013         . ($tcond? " AND ( $tcond )": "")
1014         . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "")
1015         ." WHERE t.id IS NOT NULL "
1016         ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
1017     $query .= " AND ( $scond )" if $scond;
1018     $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'};
1019
1020     my $sth = execute_query(
1021         $query,
1022         $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (),
1023         $args{'extra_values'}? (@{ $args{'extra_values'} }): ()
1024     );
1025     while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
1026         print STDERR "Record #$tid in $on has the same set of values as $sid\n";
1027         for ( my $i = 0; $i < @columns; $i++ ) {
1028             print STDERR "\t$columns[$i] => '$set[$i]'\n";
1029         }
1030         $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'};
1031     }
1032 }
1033
1034 sub load_record {
1035     my ($table, $id) = @_;
1036     my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
1037     return $sth->fetchrow_hashref('NAME_lc');
1038 }
1039
1040 sub delete_record {
1041     my ($table, $id) = (@_);
1042     print "Deleting record #$id in $table\n" if $opt{'verbose'};
1043     my $query = "DELETE FROM $table WHERE id = ?";
1044     $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
1045     return execute_query( $query, $id );
1046 }
1047
1048 sub create_record {
1049     print "Creating a record in $_[0]\n" if $opt{'verbose'};
1050     $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
1051     return $RT::Handle->Insert( @_ );
1052 }
1053
1054 sub update_records {
1055     my $table = shift;
1056     my $where = shift;
1057     my $what = shift;
1058
1059     my (@where_cols, @where_binds);
1060     while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }
1061
1062     my (@what_cols, @what_binds);
1063     while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }
1064
1065     print "Updating record(s) in $table\n" if $opt{'verbose'};
1066     my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
1067         ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
1068     $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
1069     return execute_query( $query, @what_binds, @where_binds );
1070 }
1071
1072 sub execute_query {
1073     my ($query, @binds) = @_;
1074
1075     print "Executing query: $query\n\n" if $opt{'verbose'};
1076
1077     my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
1078     $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
1079     return $sth;
1080 }
1081
1082 { my %cached_answer;
1083 sub prompt {
1084     my $action = shift;
1085     my $msg = shift;
1086     my $token = shift || join ':', caller;
1087
1088     return 0 unless $opt{'resolve'};
1089     return 1 if $opt{'force'};
1090
1091     return $cached_answer{ $token } if exists $cached_answer{ $token };
1092
1093     print $msg, "\n";
1094     print "$action ALL records with the same defect? [N]: ";
1095     my $a = <STDIN>;
1096     return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
1097     return $cached_answer{ $token } = 0;
1098 } }
1099
1100 { my %cached_answer;
1101 sub prompt_action {
1102     my $actions = shift;
1103     my $msg = shift;
1104     my $token = shift || join ':', caller;
1105
1106     return '' unless $opt{'resolve'};
1107     return '' if $opt{'force'};
1108     return $cached_answer{ $token } if exists $cached_answer{ $token };
1109
1110     print $msg, "\n";
1111     print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
1112     my $a = <STDIN>;
1113     chomp $a;
1114     return $cached_answer{ $token } = '' unless $a;
1115     foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
1116         return $cached_answer{ $token } = lc substr $a, 0, 1;
1117     }
1118     return $cached_answer{ $token } = '';
1119 } }
1120
1121 { my %cached_answer;
1122 sub prompt_integer {
1123     my $action = shift;
1124     my $msg = shift;
1125     my $token = shift || join ':', caller;
1126
1127     return 0 unless $opt{'resolve'};
1128     return 0 if $opt{'force'};
1129
1130     return $cached_answer{ $token } if exists $cached_answer{ $token };
1131
1132     print $msg, "\n";
1133     print "$action ALL records with the same defect? [0]: ";
1134     my $a = <STDIN>; chomp $a; $a = int($a);
1135     return $cached_answer{ $token } = $a;
1136 } }
1137
1138 1;
1139
1140 __END__
1141
1142 =head1 NAME
1143
1144 rt-validator - check and correct validity of records in RT's database
1145
1146 =head1 SYNOPSIS
1147
1148     rt-validator --check
1149     rt-validator --check --verbose
1150     rt-validator --check --verbose --resolve
1151     rt-validator --check --verbose --resolve --force
1152
1153 =head1 DESCRIPTION
1154
1155 This script checks integrity of records in RT's DB. May delete some invalid
1156 records or ressurect accidentally deleted.
1157
1158 =head1 OPTIONS
1159
1160 =over
1161
1162 =item check
1163
1164     mandatory.
1165
1166     it's equal to -c
1167
1168 =item verbose
1169
1170     print additional info to STDOUT
1171     it's equal to -v
1172
1173 =item resolve
1174
1175     enable resolver that can delete or create some records
1176
1177 =item force
1178
1179     resolve without asking questions
1180
1181 =back
1182