Annotation of /trunk/script/wait_admin

#!/usr/bin/perl -w

=head1 NAME

wait_admin - perform administrative tasks on WAIT catalog and meta files

=head1 SYNOPSIS

B<wait_admin>
[B<-database> I<dbname>]
[B<-dir> I<directory>]
[B<-table> I<table name>]
[B<-verbose>]
[B<-debug>]

=head1 OPTIONS

=over 5

=item B<-database> I<dbname>

Specify database name. Default is F<DB>.

=item B<-dir> I<directory>

Alternate directory where databases are located. Default is the
directory specified during configuration of WAIT.

=item B<-table> I<table name>

Specify just one table to check. By default, all tables are checked.

=item B<-quiet>

Supress C<ok:> messages from output.

=item B<-verbose>

Output also informational messages prefixed by C<info:>.

=item B<-debug>

Very chatty output (mostly for debugging) to STDERR. Includes verbose
messages which will go to STDOUT.

=back

=head1 DESCRIPTION

This script will check your database catalog and meta files and interactivly
try to recover from following cases:

=over 5

=item * removing database directory without droping tables first

=item * out of sync catalog and meta file data

=item * corrupted table data in catalog/meta (remove only!)

=back

This will be done performing following steps:

=over 5

=cut

BEGIN {require WAIT::Config;}

use strict;
use Getopt::Long;
use Data::Dumper;
use Storable qw(store retrieve dclone); # freeze thaw
use Text::Diff;
use Acme::Damn qw(unbless);
use Scalar::Util qw(blessed);   # Acme::Holly?
use IO::File;

my %OPT = (
        database => 'DB',
        dir => $WAIT::Config->{WAIT_home} || '/tmp',
        verbose => 0,
        debug => 0,     ## TODO change to 0 before release!
        quiet => 0,
        );

GetOptions(\%OPT,
           'database=s',
           'dir=s',
           'verbose!',
           'debug!',
           'quiet!',
);

my $catalog_file = "$OPT{dir}/$OPT{database}/catalog";
my $meta_file    = "$OPT{dir}/$OPT{database}/meta";

# logging functions
sub log_info {
        print "info: ",join("",@_),"\n" if ($OPT{'verbose'} || $OPT{'debug'});
}
sub log_ok {
        print "ok: ",join("",@_),"\n" if (!$OPT{'quiet'} || $OPT{'verbose'} || $OPT{'debug'});
}
sub log_warning {
        print "WARNING: ",join("",@_),"\n";
}
sub log_error {
        print "ERROR: ",join("",@_),"\n";
}
sub log_die {
        die "FATAL: ",join("",@_),"\n";
}
sub log_debug {
        print STDERR "debug: ",join("",@_),"\n" if ($OPT{'debug'});
}
# user interaction
sub ask {
        print join("",@_);
        my $ans = <STDIN>;
        chomp($ans);
        return $ans;
}
sub do_fix {
        my $ans = ask(( @_ , " [Y/n]: "));
        $ans ||= 'y';   # default
        if (lc($ans) =~ m/^y/) {
                return 1;
        }
        return 0;
}

# compress tabs to single space
sub compress_tabs {
        my ($p,$t) = @_;
        return $p.(" " x (length($t)/8));
}

sub compDumper {
        my $d = Dumper(shift);
        $d =~ s/^()(\s+)/compress_tabs($1,$2)/gem;
        return $d;
}
        

=item * check existence of catalog and meta files

=cut

if (-r $catalog_file) {
        log_info "using catalog '$catalog_file'";
} else {
        log_die "can't find catalog '$catalog_file': $!";
}

if (-r $meta_file) {
        log_info "using meta '$meta_file'";
} else {
        log_die "can't find meta '$meta_file': $!";
}

=item * read catalog and meta files

=cut

my ($catalog,$meta);

if ($catalog = retrieve($catalog_file)) {
        log_ok "catalog opened with Storable";
} else {
        log_die "catalog unreadable by Storable!";
}

if ($meta = do $meta_file) {
        log_ok "meta read with do";
} else {
        log_warning "do meta failed... trying with cat...";
        $meta = eval `cat $meta_file`;
        if ($meta) {
                log_ok "meta read with cat (why did do failed?)";
        } else {
                log_die "can't cat or do meta file!";
        }
}

=item * compare content of meta and catalog files

Data might differ, depending on ordering of variables in Storable and
Data::Dumper structures and ability to store structure correctly (it seems that there is always difference in 'attr' variable). If you select
B<-verbose> flag, you will also see diff between catalog and meta file, so
you can decide do you want to re-sync them or not.

If differences are found, you will be offered to select master copy (catalog
or meta). You can also accept default none which will skip synchronization
because of differences.

=cut

print STDERR compDumper($catalog,$meta) if ($OPT{'debug'});

my $cc = 0;     # number of changes in catalog

if (Dumper($catalog) ne Dumper($meta)) {
        log_warning "catalog and meta are different!";
        my $diff = diff(\Dumper($catalog),\Dumper($meta), { STYLE => "Unified" });
        $diff =~ s/^([\s\+\-])(\s+)/compress_tabs($1,$2)/gem;

        print STDERR "diff -u catalog meta\n$diff" if ($OPT{'debug'});

        foreach my $d (split(/@@ [+-]\d+,\d+ [+-]\d+,\d+ @@/, $diff)) {

                if ($d =~ m/^\-(.+)$/m && $d =~ m/^\+\Q$1\E/m) {
                        log_debug("false alarm! structure ordering different");
                } elsif ($d) {
                        log_info("here is diff between catalog and meta:\n",$d);
                }
        }

        if ($diff) {
                my $ans=ask("Select master repository to sync to [meta/catalog/NONE]: ");
                if ($ans =~ m/^c/i) {
                        $meta = $catalog;
                        log_info("copied catalog to meta");
                        $cc++;
                } elsif ($ans =~ m/^m/i) {
                        $catalog = $meta;
                        log_info("copied meta to catalog");
                        $cc++;
                } else {
                        log_info("meta and catalog still out of sync!");
                }
        }
} else {
        log_ok "meta and catalog are same\n";
}

# catalog and meta unblessed
my $c = dclone($catalog);
my $m = dclone($meta);

if (my $class = blessed $c) {
        if ($class eq "WAIT::Database") {
                log_ok "top class $class";
                unbless($c);
        } else {
                log_die "unknown top class $class";
        }
}

=item * check for existence of database directory

=cut

my $db_dir = $c->{'file'} ||
        log_die("no database directory in c!");
if (-d $db_dir) {
        log_ok("database directory: '$db_dir' (exists)");
} else {
        log_die("database directory '$db_dir' doesn't exist!");
}

=item * print info about database

This will check if database name and mode is defined, and
report if unique attributes restrction is in effect.

=cut

if ($c->{'name'}) {
        log_info("database name: ",$c->{'name'});
} else {
        log_error("database name is not defined");
}

if ($db_dir =~ m/\/$c->{'name'}$/) {
        log_ok("database directory contains database name");
}

if ($c->{'mode'}) {
        log_info("catalog mode: ",$c->{'mode'});
} else {
        log_error("catalog mode is not defined");
}

my $unique_att = $c->{'uniqueatt'} &&
        log_info("using unique attributes restriction");

=item * list tables in database and check them

If option B<-table> is used, just one table will be checked.

Varous tests on tables will be performed, including correct class blessing,
and testing for table directories.

=cut

sub remove_table {
        my $t = shift;

        if (do_fix("Do you want to remove table '$t' from database?")) {
                delete $catalog->{'tables'}->{$t} || warn "can't delete table $t from catalog!";
                $cc++;
                log_info("table '$t' removed from database $OPT{database}");
        }
}

my @tables = keys %{$c->{'tables'}};
@tables = qw/$OPT{table}/ if ($OPT{table});

foreach my $t (@tables) {
        log_info "checking table '$t'";
        if (! $c->{'tables'}->{$t}) {
                log_warning("table $t key exists, but no data!");
                remove_table($t);
                next;
        }
        my $tc = blessed $c->{'tables'}->{$t};
        if ($tc) {
                if ($tc eq "WAIT::Table") {
                        log_ok("table '$t' is $tc");

                        if (-d "$db_dir/$t") {
                                log_info("table directory exists");
                        } else {
                                log_error("can't find directory for table '$t', it should be '$db_dir/$t'");
                                remove_table($t);
                        }

                } else {
                        log_error("table '$t' should be blessed to WAIT::Table and not to $tc!");
                        remove_table($t);
                }
        } else {
                log_error("table '$t' isn't blessed");
                remove_table($t);
        }
}

print STDERR compDumper($catalog) if ($OPT{'debug'});

if ($cc && do_fix("Commit $cc ",($cc == 1 ? "change" : "changes")," to catalog and meta?")) {
        eval { store($catalog, $catalog_file) } ||
                log_die("can't store new catalog in '$catalog_file': $!");
        
        my $fh = new IO::File "> $meta_file";
        if (! $fh) {
                log_error("can't open meta file '$meta_file' for writing: $!");
                log_die("you should probably re-run this tool to make catalog and meta in-sync!");
        }
        my $dd = new Data::Dumper [$catalog],['self'];
        $fh->print('my ');
        $fh->print($dd->Dumpxs) || log_die("problem dumping meta file: $1 (re-run this tool)");
        $fh->close;
}

$WAIT::Config = $WAIT::Config; # make perl -w happy

=head1 WARNING

This script doesn't use locks. So you beter don't run it on live database or
expect that your data might get trashed (so, think again do you want to copy
database first before running this script on it!).

=head1 TODO

Check various conditions and improve recovery.

=head1 AUTHOR

Dobrica Pavlinusic E<lt>F<dpavlin@rot13.org>E<gt>

=cut
1	dpavlin	99	#!/usr/bin/perl -w
2
3			=head1 NAME
4
5			wait_admin - perform administrative tasks on WAIT catalog and meta files
6
7			=head1 SYNOPSIS
8
9			B<wait_admin>
10			[B<-database> I<dbname>]
11			[B<-dir> I<directory>]
12			[B<-table> I<table name>]
13			[B<-verbose>]
14			[B<-debug>]
15
16			=head1 OPTIONS
17
18			=over 5
19
20			=item B<-database> I<dbname>
21
22			Specify database name. Default is F<DB>.
23
24			=item B<-dir> I<directory>
25
26			Alternate directory where databases are located. Default is the
27			directory specified during configuration of WAIT.
28
29			=item B<-table> I<table name>
30
31			Specify just one table to check. By default, all tables are checked.
32
33			=item B<-quiet>
34
35			Supress C<ok:> messages from output.
36
37			=item B<-verbose>
38
39			Output also informational messages prefixed by C<info:>.
40
41			=item B<-debug>
42
43			Very chatty output (mostly for debugging) to STDERR. Includes verbose
44			messages which will go to STDOUT.
45
46			=back
47
48			=head1 DESCRIPTION
49
50			This script will check your database catalog and meta files and interactivly
51			try to recover from following cases:
52
53			=over 5
54
55			=item * removing database directory without droping tables first
56
57			=item * out of sync catalog and meta file data
58
59	dpavlin	101	=item * corrupted table data in catalog/meta (remove only!)
60
61	dpavlin	99	=back
62
63			This will be done performing following steps:
64
65			=over 5
66
67			=cut
68
69			BEGIN {require WAIT::Config;}
70
71			use strict;
72			use Getopt::Long;
73			use Data::Dumper;
74			use Storable qw(store retrieve dclone); # freeze thaw
75			use Text::Diff;
76			use Acme::Damn qw(unbless);
77			use Scalar::Util qw(blessed); # Acme::Holly?
78			use IO::File;
79
80			my %OPT = (
81			database => 'DB',
82			dir => $WAIT::Config->{WAIT_home} \|\| '/tmp',
83			verbose => 0,
84			debug => 0, ## TODO change to 0 before release!
85			quiet => 0,
86			);
87
88			GetOptions(\%OPT,
89			'database=s',
90			'dir=s',
91			'verbose!',
92			'debug!',
93			'quiet!',
94			);
95
96			my $catalog_file = "$OPT{dir}/$OPT{database}/catalog";
97			my $meta_file = "$OPT{dir}/$OPT{database}/meta";
98
99			# logging functions
100			sub log_info {
101			print "info: ",join("",@_),"\n" if ($OPT{'verbose'} \|\| $OPT{'debug'});
102			}
103			sub log_ok {
104			print "ok: ",join("",@_),"\n" if (!$OPT{'quiet'} \|\| $OPT{'verbose'} \|\| $OPT{'debug'});
105			}
106			sub log_warning {
107			print "WARNING: ",join("",@_),"\n";
108			}
109			sub log_error {
110			print "ERROR: ",join("",@_),"\n";
111			}
112			sub log_die {
113			die "FATAL: ",join("",@_),"\n";
114			}
115			sub log_debug {
116			print STDERR "debug: ",join("",@_),"\n" if ($OPT{'debug'});
117			}
118			# user interaction
119			sub ask {
120			print join("",@_);
121			my $ans = <STDIN>;
122			chomp($ans);
123			return $ans;
124			}
125			sub do_fix {
126			my $ans = ask(( @_ , " [Y/n]: "));
127			$ans \|\|= 'y'; # default
128			if (lc($ans) =~ m/^y/) {
129			return 1;
130			}
131			return 0;
132			}
133
134			# compress tabs to single space
135			sub compress_tabs {
136			my ($p,$t) = @_;
137			return $p.(" " x (length($t)/8));
138			}
139
140			sub compDumper {
141			my $d = Dumper(shift);
142			$d =~ s/^()(\s+)/compress_tabs($1,$2)/gem;
143			return $d;
144			}
145
146
147			=item * check existence of catalog and meta files
148
149			=cut
150
151			if (-r $catalog_file) {
152			log_info "using catalog '$catalog_file'";
153			} else {
154			log_die "can't find catalog '$catalog_file': $!";
155			}
156
157			if (-r $meta_file) {
158			log_info "using meta '$meta_file'";
159			} else {
160			log_die "can't find meta '$meta_file': $!";
161			}
162
163			=item * read catalog and meta files
164
165			=cut
166
167			my ($catalog,$meta);
168
169			if ($catalog = retrieve($catalog_file)) {
170			log_ok "catalog opened with Storable";
171			} else {
172			log_die "catalog unreadable by Storable!";
173			}
174
175			if ($meta = do $meta_file) {
176			log_ok "meta read with do";
177			} else {
178			log_warning "do meta failed... trying with cat...";
179			$meta = eval `cat $meta_file`;
180			if ($meta) {
181			log_ok "meta read with cat (why did do failed?)";
182			} else {
183			log_die "can't cat or do meta file!";
184			}
185			}
186
187			=item * compare content of meta and catalog files
188
189			Data might differ, depending on ordering of variables in Storable and
190	dpavlin	101	Data::Dumper structures and ability to store structure correctly (it seems that there is always difference in 'attr' variable). If you select
191			B<-verbose> flag, you will also see diff between catalog and meta file, so
192			you can decide do you want to re-sync them or not.
193	dpavlin	99
194			If differences are found, you will be offered to select master copy (catalog
195			or meta). You can also accept default none which will skip synchronization
196			because of differences.
197
198			=cut
199
200			print STDERR compDumper($catalog,$meta) if ($OPT{'debug'});
201
202			my $cc = 0; # number of changes in catalog
203
204			if (Dumper($catalog) ne Dumper($meta)) {
205			log_warning "catalog and meta are different!";
206			my $diff = diff(\Dumper($catalog),\Dumper($meta), { STYLE => "Unified" });
207			$diff =~ s/^([\s\+\-])(\s+)/compress_tabs($1,$2)/gem;
208
209			print STDERR "diff -u catalog meta\n$diff" if ($OPT{'debug'});
210
211			foreach my $d (split(/@@ [+-]\d+,\d+ [+-]\d+,\d+ @@/, $diff)) {
212
213			if ($d =~ m/^\-(.+)$/m && $d =~ m/^\+\Q$1\E/m) {
214			log_debug("false alarm! structure ordering different");
215			} elsif ($d) {
216			log_info("here is diff between catalog and meta:\n",$d);
217			}
218			}
219
220			if ($diff) {
221			my $ans=ask("Select master repository to sync to [meta/catalog/NONE]: ");
222			if ($ans =~ m/^c/i) {
223			$meta = $catalog;
224			log_info("copied catalog to meta");
225			$cc++;
226			} elsif ($ans =~ m/^m/i) {
227			$catalog = $meta;
228			log_info("copied meta to catalog");
229			$cc++;
230			} else {
231			log_info("meta and catalog still out of sync!");
232			}
233			}
234			} else {
235			log_ok "meta and catalog are same\n";
236			}
237
238			# catalog and meta unblessed
239			my $c = dclone($catalog);
240			my $m = dclone($meta);
241
242			if (my $class = blessed $c) {
243			if ($class eq "WAIT::Database") {
244			log_ok "top class $class";
245			unbless($c);
246			} else {
247			log_die "unknown top class $class";
248			}
249			}
250
251			=item * check for existence of database directory
252
253			=cut
254
255			my $db_dir = $c->{'file'} \|\|
256			log_die("no database directory in c!");
257			if (-d $db_dir) {
258			log_ok("database directory: '$db_dir' (exists)");
259			} else {
260			log_die("database directory '$db_dir' doesn't exist!");
261			}
262
263			=item * print info about database
264
265			This will check if database name and mode is defined, and
266			report if unique attributes restrction is in effect.
267
268			=cut
269
270			if ($c->{'name'}) {
271			log_info("database name: ",$c->{'name'});
272			} else {
273			log_error("database name is not defined");
274			}
275
276			if ($db_dir =~ m/\/$c->{'name'}$/) {
277			log_ok("database directory contains database name");
278			}
279
280			if ($c->{'mode'}) {
281			log_info("catalog mode: ",$c->{'mode'});
282			} else {
283			log_error("catalog mode is not defined");
284			}
285
286			my $unique_att = $c->{'uniqueatt'} &&
287			log_info("using unique attributes restriction");
288
289			=item * list tables in database and check them
290
291			If option B<-table> is used, just one table will be checked.
292
293			Varous tests on tables will be performed, including correct class blessing,
294			and testing for table directories.
295
296			=cut
297
298	dpavlin	101	sub remove_table {
299			my $t = shift;
300
301			if (do_fix("Do you want to remove table '$t' from database?")) {
302			delete $catalog->{'tables'}->{$t} \|\| warn "can't delete table $t from catalog!";
303			$cc++;
304			log_info("table '$t' removed from database $OPT{database}");
305			}
306			}
307
308	dpavlin	99	my @tables = keys %{$c->{'tables'}};
309			@tables = qw/$OPT{table}/ if ($OPT{table});
310
311			foreach my $t (@tables) {
312			log_info "checking table '$t'";
313	dpavlin	101	if (! $c->{'tables'}->{$t}) {
314			log_warning("table $t key exists, but no data!");
315			remove_table($t);
316			next;
317			}
318	dpavlin	99	my $tc = blessed $c->{'tables'}->{$t};
319			if ($tc) {
320			if ($tc eq "WAIT::Table") {
321			log_ok("table '$t' is $tc");
322
323			if (-d "$db_dir/$t") {
324			log_info("table directory exists");
325			} else {
326			log_error("can't find directory for table '$t', it should be '$db_dir/$t'");
327	dpavlin	101	remove_table($t);
328	dpavlin	99	}
329
330			} else {
331			log_error("table '$t' should be blessed to WAIT::Table and not to $tc!");
332	dpavlin	101	remove_table($t);
333	dpavlin	99	}
334			} else {
335			log_error("table '$t' isn't blessed");
336	dpavlin	101	remove_table($t);
337	dpavlin	99	}
338			}
339
340			print STDERR compDumper($catalog) if ($OPT{'debug'});
341
342			if ($cc && do_fix("Commit $cc ",($cc == 1 ? "change" : "changes")," to catalog and meta?")) {
343			eval { store($catalog, $catalog_file) } \|\|
344			log_die("can't store new catalog in '$catalog_file': $!");
345
346			my $fh = new IO::File "> $meta_file";
347			if (! $fh) {
348			log_error("can't open meta file '$meta_file' for writing: $!");
349			log_die("you should probably re-run this tool to make catalog and meta in-sync!");
350			}
351			my $dd = new Data::Dumper [$catalog],['self'];
352			$fh->print('my ');
353			$fh->print($dd->Dumpxs) \|\| log_die("problem dumping meta file: $1 (re-run this tool)");
354			$fh->close;
355			}
356
357			$WAIT::Config = $WAIT::Config; # make perl -w happy
358
359			=head1 WARNING
360
361			This script doesn't use locks. So you beter don't run it on live database or
362			expect that your data might get trashed (so, think again do you want to copy
363			database first before running this script on it!).
364
365			=head1 TODO
366
367			Check various conditions and improve recovery.
368
369			=head1 AUTHOR
370
371			Dobrica Pavlinusic E<lt>F<dpavlin@rot13.org>E<gt>
372
373			=cut