#
# Copyright (c) 1990,1991,1992 The Ohio State University.
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted
# provided that: (1) source distributions retain this entire copyright
# notice and comment, and (2) distributions including binaries display
# the following acknowledgement:  ``This product includes software
# developed by The Ohio State University and its contributors''
# in the documentation or other materials provided with the distribution
# and in all advertising materials mentioning features or use of this
# software. Neither the name of the University nor the names of its
# contributors may be used to endorse or promote products derived
# from this software without specific prior written permission.
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#

#
# clean-db
#
# Removes "old entries" from the backup and run databases and
# maintains the free tape pool.  
#
# Basic algorithm: consider the databases as a tree - at the root, you
# have tapes.  Each tape has a run entry in the run-db , each run has
# per-host run entries in the per-host run-db's, each of these has one
# or more backup entries in the per-host backup db's.
#
# Each backup is only "good" for KEEP days, where KEEP is the KEEP
# value for that level (defined in the backup.config file).  So we
# start at the leaves of the tree - the backup entries in the
# per-host backup DBs.  Nuke any that are older than KEEP days
# (ideally, we'd want to NOT nuke any that are current (those which
# haven't been superceded by more recent backups - these are the most
# recent backups for that file system, and really shouldn't be
# destroyed).  We can also nuke backups which were done on tapes that
# have been reused since then, since the data has been overwritten or 
# isn't accessible (past EOT).
#
# After cleaning the backup DBs, we can remove all entries from the
# per-host run DBs whose backups are all pruned.  Then we can remove
# all entries from the master run DB whose runs have been pruned, and
# finally we can free all tapes whose runs have been pruned.
#
# We also deal with tape expiration in there, and with KEPT tapes and
# backups. 
#

#
# Options:
#    d level	enable debugging - print verbose messages, don't do
#		file locking.
#
#    y		assume YES answers for all questions (delete this, 
#		free that, etc.) 
#
#    n		assume NO answers... 
#
#
#    v		verbose
#
#    s		sanitize databases - remove keywords and values that 
#		aren't "supposed" to be there.
#

$options = "hd:ynvs";
$usage = 
"usage: clean-db [-d debuglevel] [-y] [-n] [-v] [-s] [-h]
    -d debuglevel	print debugging messages
    -y			assume a YES answer for all questions
    -n			assume a NO answer for all questions
    -v			verbose mode
    -s			sanity check - nuke DB fields that don't exist
			anymore
    -h			display this message\n";

require 'global.defs';
require 'local.defs';
require $yagrip_perl;
require $backuplib_perl;

    #
    # Make sure that we clean up after ourselves if someone wants to kill us.
    #
$SIG{'INT'} = 'handle_interrupts';
$SIG{'HUP'} = 'handle_interrupts';
$SIG{'TERM'} = 'handle_interrupts';
$SIG{'QUIT'} = 'handle_interrupts';

    # 
    # Deal with args...we define *_string things to use as args for progs 
    # called from here so that we can pass on the right values (eg, -d
    # or "", etc). 
    #
die $usage if ! &getopt($options);
die $usage if defined($opt_h);
die $usage if $#ARGV != -1;
&sigh("error: make up your mind, you can't give both -y and -n!\n")
  if defined($opt_y) && defined($opt_n);

if (defined($opt_y) && defined($opt_s)) {
    undef $opt_y;
    if (! &query("It's risky to run clean-db with -y and -s.\nAre you sure that you want to do this? ")) {
	exit(0);
    }
    $opt_y = 1;
}

    #
    # Read the backup config file...
    #
&read_config();

&make_log_entry("clean-db started [$$]");

    #
    # Get to work...if you consider the DB info to be a tree, we've
    # got the run's at the bottom, and the backups at the top.  So we
    # start at the top and clean per-host backup entries that have
    # expired.  Then we can nuke any per-host run entries that no
    # longer have existing backups.  Then we can nuke runs from the
    # global run database that have no per-host run entries.  Then we
    # can recycle tapes whose runs have disappeared.  Orf.
    #

&sigh("error: can't lock '$run_db_file', timed out\n")
  if &lock($run_db_file) != $LOCK_OK;

&open_db(*RUNDB, $run_db_file, $db_mode) ||
  &sigh("error: can't open the dbm file '$run_db_file'\n");

&sigh("error: can't lock '$tape_db_file', timed out\n")
  if &lock($tape_db_file) != $LOCK_OK;

&open_db(*TAPEDB, $tape_db_file, $db_mode) ||
  &sigh("error: can't open the dbm file '$tape_db_file'\n");

    #
    # Make a list of all the tapes and their corresponding run numbers.
    # If the tape is free or expired, use a run number of -1.  This is 
    # used to help clear out backups.
    #

foreach $tape_id (&keys_db(*TAPEDB)) {
    if (! &read_db(*TAPEDB, $tape_id, *tape_value, *tape_array) || $tape_value eq "") {
	print  
"warning: tape DB entry for $tape_id has no value!\n";
	$tape_list{$tape_id} = -2;
    } elsif ($tape_array{"flags"} eq "free") { # fixme: or expired
	$tape_list{$tape_id} = -1;
    } else {
	$tape_list{$tape_id} = $tape_array{"run_id"};
    }
}

    #
    # Make a list of the runs and cache their keep values and ages.
    #
foreach $run_id (&keys_db(*RUNDB)) {
    if (! &read_db(*RUNDB, $run_id, *run_value, *run_array) || $run_value eq "") {
	print 
"warning: run DB entry $run_id has no value!\n";
    } else {
	&get_keep_and_age($run_id, *run_array);
    }
}

    #
    # Find all the per-host backup databases.  For each one, clean it
    # via the following stuff...
    #
    # We'll maintain two lists - %bu_keep_list is an array indexed by
    # $host.$buid, which are the host/buid pairs that are not being
    # cleaned (they're being kept).  @nuke_list is an array of buid's
    # to delete at the end of each run through the loop.
    #
    # %bu_run_list is a mapping between $host.$buid and the run that 
    # it claims to be in.  When we read the buid lists in the per-host
    # run databases we will use this to make sure that the runs that 
    # include this buid are mentioned by those buid's.  This shouldn't 
    # be necessary, but a little anal-rententive cross checking doesn't
    # hurt, especially when its cheap.
    #
%bu_keep_list = ();
%bu_run_list = ();

$pattern = "$backup_host_file*.$dbext";
foreach $budb_name (<${pattern}>) {
    #
    # Need to nuke the trailing .$dbext to get the base DB name,
    # and get the host name for other uses.
    #
    @tmp = split(/\./, $budb_name);
    pop(@tmp);			# nuke trailing .$dbext
    $host = $tmp[$#tmp];	# host name is last before .$dbext
    $budb_name = join('.', @tmp);

    @tmp = split(m-/-, $budb_name);
    $only_name = @tmp[$#tmp];

    print "working on per-host backup DB $only_name\n" if defined($opt_v);

    &sigh("error: can't lock '$budb_name', timed out\n")
	if &lock($budb_name) != $LOCK_OK;
    
    &open_db(*DB, $budb_name, $db_mode) ||
       &sigh("error: can't open the dbm file '$budb_name'\n");

    @nuke_list = ();
    $max_buid = -1;

    @backup_keys = &keys_db(*DB);
    push(@db_nuke_list, $budb_name) if $#backup_keys == -1;

  bu_entry_loop:
    foreach $bu_id (@backup_keys) {
	$max_buid = $bu_id+0 if $bu_id+0 > $max_buid; # find max BUID

	# no value - bogus entry, nuke it.
	if (! &read_db(*DB, $bu_id, *budb_value, *budb_array) || $budb_value eq "") {
	    if (defined($opt_s) && 
		&query("  $budb_name entry $bu_id has no value - nuke it? ")) {
	        push(@nuke_list, $bu_id);
		next bu_entry_loop;
	    } else {
		print  
"warning: $budb_name entry $bu_id has no value!\n";
	    }
	}

	if (defined($opt_s)) {
	    $bad_keys = &sanitize("backup_host", $budb_name, $bu_id, *budb_array);

	    if ($bad_keys ne "" &&
		&query("  sanitize BUDB $only_name, entry $bu_id (bad keys: $bad_keys)? ")) {
	        &write_db(*DB, $bu_id, *budb_array, $budb_name, "backup_host");
	    }
	}

	$run_id = $budb_array{"run"};			# Get the Run ID

	$bu_run_list{"$host.$bu_id"} = $run_id;

        if (! &read_db(*RUNDB, $run_id, *run_value, *run_array) || $run_value eq "") {
	    if (defined($opt_s) && &query("  $budb_name entry $bu_id belongs to run $run_id, which doesn't exist.\nDelete this backup? ")) {
		push(@nuke_list, $bu_id);
	    } else {
		print  
"warning: run database entry $run_id isn't defined or has no value, so I can't
warning: - process $budb_name entry $bu_id.  Run clean-db -s.\n";
	    }
	    next bu_entry_loop;
	}

	if (defined($cached_run_keep{$run_id})) {
	    $keep = $cached_run_keep{$run_id};
	    $age = $cached_run_age{$run_id};
	} else {
	    print
"warning: there's no cached value for run $run_id, but I escaped from the previous test (while checking $only_name)!\n";
	    next bu_entry_loop;
	}

	#
	# Check the tapes that this backups is supposed to be on.  
	# If the tape is free or expired, or if it claims to hold a
	# different run, then the tape has been reused or something,
	# so set $tape_is_reused or $tape_is_free.
	#
	$tape_is_free = 0;
	$tape_is_reused = 0;

	@tapes_used = ();
      screwy_loop:
	foreach $tapefile (split(/,/, $budb_array{"tflist"})) {
	    ($tape, $file) = split(/\./, $tapefile);

	    push(@tapes_used, $tape);

	    if ($tape_list{$tape} == -2) {
		print  
"warning: backup $bu_id in $budb_name claims to use tape $tape, which has no value.
warning: - Run clean-db -s.\n";
		next screwy_loop;
	    }

	    if ($tape_list{$tape} == -1) {
		$tape_is_free = 1;
		last screwy_loop;
	    }

	    if ($tape_list{$tape} ne $run_id) {
	        $tape_is_reused = 1;
		last screwy_loop;
	    }
	}

	#
        # If the tape was freed or reused, then nuke the tflist entry.
	#
	if (($tape_is_free || $tape_is_reused) &&
	    &query(sprintf("  remove tflist from $bu_id in $only_name? (since tape $tape has been %s)",
			   ($tape_is_freed) ? "freed" : "reused"))) {
	    delete $budb_array{"tflist"};
	    $budb_array{"flags"} = "reused";
	    &write_db(*DB, $bu_id, *budb_array, $budb_name, "backup_host");
	}

	#
	# If the online database is gone, then mark it as deleted.
	#
	if ($budb_array{"d-flags"} eq "done" && 
	    $budb_array{"afile"} ne "") {
	    ($tmp, $path_name) = &get_archive_host_and_file($budb_array{"afile"});
	    if (! -f $path_name) {
		if (defined($opt_s)) {
		    if (&query(sprintf("  mark %s in $bu_id as deleted? (looks like it is missing)", 
				       $budb_array{"afile"}))) {
		        $budb_array{"d-flags"} = "deleted";
			&write_db(*DB, $bu_id, *budb_array, $budb_name, "backup_host");
		    }
		} else {
		    printf  
"warning: online archive %s in backup $bu_id in $budb_name seems to be missing.
warning: check it, and run clean-db -s to delete it if this isn't a temporary 
warning: condition.\n",
			  $budb_array{"afile"};
		}
	    }
	}

	#
	# fixme - deal with 'current' backups.
	#
	if (($budb_array{"saved"} ne "yes") && 
	    ($age > $keep) && 
	    &query(sprintf("  delete $bu_id from $only_name? (run %s age %.2f keep %.2f)",
			   $budb_array{"run"},
			   $age / $DAYS,
			   $keep / $DAYS))) {
    	    push(@nuke_list, $bu_id);
	} else {
	    $bu_keep_list{"$host.$bu_id"} = 1;

	    foreach $tape (@tapes_used) {     # keep track of the tapes that 
		$tape_has_backups{$tape} = 1; # have backups on them.
	    }
	}
    }

    foreach $bu_id (@nuke_list) {
	&delete_db(*DB, $bu_id, $budb_name);
    }

    &close_db(*DB);

    &unlock($budb_name);

    &check_sequence_file($budb_name, $max_buid);
}

    #
    # Clean out the per-host run database...if the BU's mentioned
    # don't exist in the bu_keep_list (indexed as host.buid) and 
    # its expired then nuke the entry.  
    #
    # Maintains ph_run_keep_list as a list of host.runid pairs that 
    # are still around.  Maintains nuke_list as array of keys to delete
    # at end of each loop.
    #
%ph_run_keep_list = ();
$max_run_id = -1;

$pattern = "$run_host_file*.$dbext";
foreach $run_name (<${pattern}>) {
    @tmp = split(/\./, $run_name); # nuke trailing .$dbext
    pop(@tmp);
    $host = $tmp[$#tmp];	# host name is last before .$dbext
    $run_name = join('.', @tmp);

    @tmp = split(m-/-, $run_name);
    $only_name = $tmp[$#tmp];

    print "working on per-host run DB $only_name\n" if defined($opt_v);
    
    &sigh("error: can't lock $run_name, timed out\n")
	if &lock($run_name) != $LOCK_OK;


    if (-z "$run_name.$dbext") {
       print "warning: database $run_name.$dbext is zero size - deleting!\n";
       unlink("$run_name.$dbext");
    }

    if (! &open_db(*DB, $run_name, $db_mode)) {
       &sigh("error: can't open the dbm file '$run_name'\n");
    }

    @nuke_list = ();

    @run_keys = &keys_db(*DB);
    # delete empty database...
    push(@db_nuke_list, $run_name) if $#run_keys == -1;

  run_entry_loop:
    foreach $run_id (@run_keys) {
        $max_run_id = $run_id+0 if $run_id+0 > $max_run_id;

	# Might not have a value, that's ok.
        &read_db(*DB, $run_id, *run_host_value, *run_host_array);

        if (! &defined_db(*RUNDB, $run_id)) {
	    if (defined($opt_s) &&
		&query("  $run_name entry $run_id doesn't have a matching run in the main run DB - nuke it? ")) {
	        push(@nuke_list, $run_id);
		next run_entry_loop;
	    } else {
		print
"warning: $run_name entry $run_id doesn't have a matching run in the main run DB.
warning: - run clean-db -s to delete this entry if it persists.\n";
	    }
	}

	if (defined($opt_s)) {
	    $bad_keys = &sanitize("run_host", $run_name, $run_id, *run_host_array);

	    if ($bad_keys ne "" &&
		&query("  sanitize per-host run DB $only_name, entry $run_id (bad keys: $bad_keys)? ")) {
	        &write_db(*DB, $run_id, *run_host_array, $run_name, "run_host");
	    }
	}

        #
        # Check the BUIDs for this run out - if they are all missing, 
        # then this run gets the ax...
        #
	$found = 0;
        $buid_list = $run_host_array{"buid_list"};
search_loop:
	foreach $buid (split(/,/, $buid_list)) {
	    $claimed = $bu_run_list{"$host.$buid"};
	    if ($claimed ne "" && $claimed ne $run_id) {
		print  
"warning: Run $run_id claims backup $host $buid, which claims to be in run $claimed!\n";
	    }

	    if (defined($bu_keep_list{"$host.$buid"})) {
		$found = 1;
	    }
	}

        #
        # Get the keep and age for this run...
        #
	if (defined($cached_run_keep{$run_id})) {
	    $keep = $cached_run_keep{$run_id};
	    $age = $cached_run_age{$run_id};
	} else {
	    print
"warning: there's no cached value for run $run_id, but I escaped from the previous test for its existence (while checking $only_name)!\n";
	    next run_entry_loop;
	}

	if ($found == 0 && 
	    ($age > $keep) &&
	    &query("  delete $run_id from $only_name? (backups $buid_list are all gone and run is expired) ")) {
	    push(@nuke_list, $run_id);
	} else {
	    $ph_run_keep_list{"$host.$run_id"} = 1;
	}
    }

    foreach $run_id (@nuke_list) {
        &delete_db(*DB, $run_id, $run_host);
    }

    &close_db(*DB);

    &unlock($run_name);
}

    #
    # Clean out the run database...if the hosts mentioned for a run
    # entry don't have corresponding run entries in their per-host run
    # DB's and its expired, nuke this entry.
    #
@nuke_list = ();

print "working on main run DB\n" if defined($opt_v);

@run_keys = &keys_db(*RUNDB);
#don't bother to nuke the main run db
#push(@db_nuke_list, $run_db_file) if $#run_keys == -1;

run_loop:
foreach $run_id (@run_keys) {
    $max_run_id = $run_id+0 if $run_id+0 > $max_run_id;

    if (! &read_db(*RUNDB, $run_id, *run_value, *run_array) || $run_value eq "") {
       if (defined($opt_s) && 
	   &query("  $run_db_file entry $run_id has no value - nuke it? ")) {
	    push(@nuke_list, $run_id);
	    next run_loop;
	} else {
	    print  
"warning: $run_db_file entry $run_id has no value!\n";
	}
    }

    if (defined($opt_s)) {
        $bad_keys = &sanitize("run_db", $run_db_file, $run_id, *run_array);

        if ($bad_keys ne "" &&
	    &query("  sanitize run DB, entry $run_id (bad keys: $bad_keys)? ")) {
	    &write_db(*RUNDB, $run_id, *run_array, $run_db_file, "run_db");
	}
    }

    #
    # If we don't find this run ID in any of the per-host run databases, 
    # nuke it...
    #
    $found = 0;

search_loop2:
    foreach $host (split(',', $run_array{"hosts"})) {
	if (defined($ph_run_keep_list{"$host.$run_id"})) {
	    $found = 1;
	    last search_loop2;
	}
    }

    #
    # Get the keep and age for this run...
    #
    if (defined($cached_run_keep{$run_id})) {
	$keep = $cached_run_keep{$run_id};
	$age = $cached_run_age{$run_id};
    } else {
	print
"warning: there's no cached value for run $run_id, but I escaped from the previous test for its existence (while checking the run DB)!\n";
	next run_loop;
    }

    if ($found == 0 &&
        ($age > $keep) &&
        &query("  delete $run_id from the run DB? (no entries in per-host run DBs) ")) {

        chop($start = &ctime($run_array{"start_date"}));
        $nuked_run_cache{$run_id} = 
          sprintf("%d %d,%d %s\ninfo:\t\t\t%s",
		  $run_id,
		  $run_array{"chain"},
		  $run_array{"level"},
		  $run_array{"hosts"},
		  $start);
	push(@nuke_list, $run_id);
    } else {
	$run_keep_list{$run_id} = 1;
    }
}

foreach $run_id (@nuke_list) {
    &delete_db(*RUNDB, $run_id, $run_db_file);
}

&close_db(*RUNDB);

&unlock($run_db_file);

&check_sequence_file($run_db_file, $max_run_id);

%ph_run_keep_list = ();		# not needed now

    #
    # Finally, red up the tape database.  We don't want to nuke
    # entries, just change the state from used to free (or expired).  
    # A tape is free if the run on it has been nuked from the
    # database. 
    #

print "working on tape DB\n" if defined($opt_v);

@tape_keys = &keys_db(*TAPEDB);
#don't bother to nuke the tape db
#push(@db_nuke_list, $tape_db_file) if $#tape_keys == -1;

tape_loop:
foreach $tape_id (@tape_keys) {
    if (! &read_db(*TAPEDB, $tape_id, *tape_value, *tape_array) || $tape_value eq "") {
       if (defined($opt_s) && 
	   &query("  $tape_db_file entry $tape_id has no value - nuke it? ")) {
	    push(@nuke_list, $key);
	    next tape_loop;
	} else {
	    print  
"warning: $tape_db_file entry $key has no value!\n";
	}
    }

    $was_changed = 0;
    $this_tape_type = $tape_array{"type"};
    if ($this_tape_type eq "") {
        print  
"warning: no tape type set for tape $tape_id.\n";
    }

    $age_limit = $expire_age{$this_tape_type};
    $uses_limit = $expire_uses{$this_tape_type};

    if ($age_limit == 0 || $uses_limit == 0) {
        print 
"warning: no age limit or uses limit for tape type '$this_tape_type'.
warning: - Tape ID $tape_id will need to be freed by hand.\n";
    }

    #
    # If (the tape is used, or was promised more than $promised_timeout ago)
    # AND the run it belongs to is gone, then clean it up...
    #
    if (($tape_array{"flags"} eq "used" &&                 # if it is used and the 
	     ! $tape_has_backups{$tape_id}) ||             #   run has no backups
	($tape_array{"flags"} eq "promised" &&             # or promised and timed out
	     $tape_array{"used_date"}+0 < time - $promised_timeout)) {

        $uses = $tape_array{"uses"} + 0;
        if ($tape_array{"add_date"} eq "") {
	    print  
"warning: tape $tape_id is missing the add_date field in the database.\n";
	    $age = 0; 
	} else {
	    $age = time - $tape_array{"add_date"};
	}

        if ($uses_limit > 0 &&
	    $uses > $uses_limit &&
	    &query("  Expire tape $tape_id (used $uses, max $uses_limit)? ")) {
	    $flags = "expired";
	    print 
"info: Tape $tape_id has been expired - too many uses ($uses, max $uses_limit)\n";
	} elsif ($age_limit > 0 &&
		 $age > $age_limit &&
		 &query("  Expire tape $tape_id (too old)? ")) {
	    $flags = "expired";
	    print  
"info: Tape $tape_id has been expired - too old\n";
	} else {
	    if (&query("  Free tape $tape_id? ")) {
		$flags = "free";
		if (defined($nuked_run_cache{$tape_array{"run_id"}})) {
		    printf  "info: freed $tape_id\t[was %s]\n",
		        $nuked_run_cache{$tape_array{"run_id"}};
		} elsif ($tape_array{"flags"} eq "promised") {
		    print  "info: freed $tape_id\t[was promised]\n";
		} else {
		    printf "info: freed $tape_id\t[was run %s]\n",
		        $tape_array{"run_id"};
		}
	    } else {
		next tape_loop;
	    }
	}

	$tape_array{"flags"} = $flags;
        $was_changed = 1;
    }

    #
    # If the -s option was given, then sanitize the database...
    #
    if (defined($opt_s)) {
        %tmp_array = %tape_array;
	$bad_keys = &sanitize("tape_db", $tape_db_file, $tape_id, *tmp_array);

	if ($bad_keys ne "" &&
	    &query("  sanitize tape DB, entry $tape_id (bad keys: $bad_keys)? ")) {
	    %tape_array = %tmp_array;
	    $was_changed = 1;
	}

	if ($tape_array{"type"} eq "") {
	    $tape_array{"type"} = $default_tape_type;
	    $tape_array{"format"} = $default_tape_format;
	    $was_changed = 1;
	}
    }

    if ($was_changed) {
        &write_db(*TAPEDB, $tape_id, *tape_array, $tape_db_name, "tape_db");
    }
}

&close_db(*TAPEDB);

&unlock($tape_db_file);

    #
    # Nuke old databases that don't contain anything.
    #
print "deleting empty database files\n" if defined($opt_v);

foreach $db_name (@db_nuke_list) {
    if (&query("  delete $db_name (empty database)? ")) {
        if (unlink("$db_name.$dbext")) {
	    print
"info: deleted empty database $db_name.\n";
	} else {
	    print
"warning: couldn't delete empty database $db_name.\n";
        }

        if ($dbext2 ne "" && ! unlink("$db_name.$dbext2")) {
	    print
	      "warning: couldn't delete empty database $db_name.$dbext2.\n";
	}
    }
}

    #
    # Nuke old sequence files that don't have a corresponding database.
    #
print "cleaning sequence files\n" if defined($opt_v);

$pattern = "$db_dir/*.$sequence_ext";
foreach $sequence_name (<${pattern}>) {
    #
    # Need to nuke the trailing .$sequence to get the base DB name,
    # and get the host name for other uses.
    #
    $db_name = $sequence_name;
    $db_name =~ s/\.$sequence_ext$/\.$dbext/;

    if (! -f $db_name) {
	if (&query("  delete $sequence_name (corresponding database $db_name is gone)? ")) {
	    if (unlink($sequence_name)) {
	        print
"info: deleted useless sequence file $sequence_name.\n";
	    } else {
	        print
"warning: couldn't delete useless sequence file $sequence_name.\n";
            }
        }
    }
}

    #
    # Clean out the output directory if it exists...
    #
foreach $directory ($output_dir) {
    if (! chdir($directory)) {
        next;
    }

    print "cleaning $directory\n" if defined($opt_v);

    open(DIR, "/bin/ls |");
    while (<DIR>) {
        chop;
        $file = $_;

	next if ($file eq "lost+found");
        $plain_name = $file;
        $plain_name =~ s/.Z$//;

        if ($run_keep_list{$plain_name} != 1) {
	    if (&query("  delete $directory/$file (run expired)? ")) {
	        if (unlink($file) != 1) {
	            print  
"warning: cannot delete $directory/$file\n";
	        }
	    }
	}
    }
}

    #
    # Finally, clean out the file and error directories...
    #
foreach $directory ($file_dir, $error_dir, $tar_db_dir, @online_repositories) {
    if (! chdir($directory)) {
        next;
    }

    print "cleaning $directory\n" if defined($opt_v);

    open(DIR, "/bin/ls |");
    while (<DIR>) {
        chop;
        $file = $_;

        $plain_name = $file;
        $plain_name =~ s/.Z$//;

        if ($bu_keep_list{$plain_name} != 1) {
	    if (&query("  delete $directory/$file (backup expired)? ")) {
	        if (unlink($file) != 1) {
	            print  
"warning: cannot delete $directory/$file\n";
	        }
	    }
	}
    }
}

&make_log_entry("clean-db done [$$]");

exit 0;


#
# Simple minded routine to ask a question and get an answer.  Default 
# answer is no, must type y, Y, yes or YES for yes.  Returns 1 for yes, 
# 0 for no.  
#
# -y option forces query to return 1 (yes) - all questions using query 
# should be phrased (and used) so that the default answer of yes is 
# acceptable!
#
sub query {
    local($question) = @_;
    local($answer);

    if (defined($opt_y)) {
	printf "%sYES\n", $question;
	return(1);
    } elsif (defined($opt_n)) {
	printf "%sNO\n", $question;
	return(0);
    } else {
	$| = 1;
	print $question;
	$answer = <>;
	chop($answer);
	if ($answer eq "y" ||
	    $answer eq "Y" ||
	    $answer eq "yes" ||
	    $answer eq "YES") {
            return(1);
	}

	return(0);
    }
}

#
# Fun stuff.  Takes an associative array of key/value pairs 
# (%entries) and removes any entries whose keys aren't in 
# the list of known keys for the named database type.
#
# The array %entries is modified in place, and we return a space 
# separated list of the keywords that we nuked.  %entries should be 
# used with pack_em_up to update the database if that is what you 
# want to do.
#
# Use with care.
#
sub sanitize {
    local($type, $db, $name, *entries) = @_;
    local($key, $thing, $foo);
    local(@key_list, @bad_keys);

    @key_list = keys %entries;
    foreach $key (@key_list) {
	if (! defined($ok_keys{"$type $key"})) {
	    delete $entries{$key};
	    push(@bad_keys, $key);
	}
    }

    #
    # check the required keys for this type of database
    #
    foreach $thing (keys %ok_keys) {
	if ($thing =~ /^$type/ && $ok_keys{$thing} == 1) {
	    ($foo, $key) = split(/ /, $thing);
	    if (! defined($entries{$key})) {
		print  
"warning: $db entry $name (type $type) is missing a value for $key\n";
	    }
	}
    }

    return(join(' ', @bad_keys));
}
    
#
# Check that the named sequence file contains a number that's at least 
# as great as $id.  If the file doesn't exist, or has a lower sequence number,
# then bitch about it and recreate the file.
#
sub check_sequence_file {
    local($file, $id) = @_;

    $file = $file . ".$sequence_ext";

    if (! open(SEQ, $file)) {
	print  
"warning: sequence file $file doesn't exist!
warning: - New sequence starts at $id\n";
	&make_sequence_file($file, $id);
    } else {
	$sequence = <SEQ>+0;
	close(SEQ);

	if ($id > $sequence) {
	    print  
"warning: max id for sequence $file is $id,
warning: - but sequence file is at $sequence!  Resetting...\n";
	    &make_sequence_file($file, $id);
	}
    }
}

#
# Create a sequence file with the given name and ID.
#
sub make_sequence_file {
    local($file, $id) = @_;

    if (&lock($file) != $LOCK_OK) {
        print 
"warning: cannot lock sequence file $file to create it.\n";
        return;
    }

    if (! open(SEQ, ">$file")) {
        print  
"warning: couldn't recreate the sequence file $file.\n";
	return;
    }

    print SEQ $id;

    close(SEQ);

    &unlock($file);
}

#
# Get the keep value for this run and calculate its age.  Cache the results.
#

sub get_keep_and_age {
    local($run_id, *run_array) = @_;
    local($keep, $age);

    if (defined($level_keep{$run_array{"chain"},$run_array{"level"}})) {
        $keep = $level_keep{$run_array{"chain"},$run_array{"level"}} + 0;
    } elsif (defined($default_keep{$run_array{"level"}})) {
	$keep = $default_keep{$run_array{"level"}};
    } else {
	printf 
"warning: chain %d level %d isn't defined, and there's no default 'keep' 
warning: - for that level.\n",
  	       $run_array{"chain"},
	       $run_array{"level"};
	$keep = $default_keep{"default"};
    }

    $age = time - ($run_array{"start_date"} + 0);

    $cached_run_keep{$run_id} = $keep;
    $cached_run_age{$run_id} = $age;

    return($keep, $age);
}