Initial commit 4.0.5-3
[usit-rt.git] / sbin / rt-validator
1 #!/usr/bin/perl
2 # BEGIN BPS TAGGED BLOCK {{{
3 #
4 # COPYRIGHT:
5 #
6 # This software is Copyright (c) 1996-2012 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 peak 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 equall to -c
1167
1168 =item verbose
1169
1170     print additional info to STDOUT
1171     it's equall 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