#!/usr/bin/perl -w
######################################################################
#
# Edwin Huffstutler, <edwinh@computer.org>
# $Id: flexbackup,v 1.61 1999/11/03 03:13:41 edwinh Exp $
# $Name: v0_9_8 $
#
#         >>>> Also see the README file <<<<
#
# USAGE:
#
#  flexbackup -help                : this message
#  flexbackup -fs all              : backup all filesystems, level 0
#  flexbackup -fs <x>              : backup filesystem <x>, level 0
#  flexbackup -fs all -level <n>   : backup all filesystems, level n
#  flexbackup -fs <x> -level <n>   : backup filesystem <x>, level n
#  flexbackup -list                : list files in archive at current
#                                    tape position
#  flexbackup -extract             : extract all files from current tape
#                                    position into your current working directory
#  flexbackup -extract -files <f>  : restore the files listed in file <f>
#                                    from current tape position into your
#                                    current working directory
#  flexbackup -compare             : compare archive at current tape position
#                                    with the files in your current directory
#  flexbackup -restore             : as above, but interactive restore
#                                    (dump type only for now)
#  flexbackup [operation] file     : if archiving to files rather than a device,
#                                    list/extract/compare/restore options take
#                                    a filename argument
#  flexbackup [operation] -num <n> : read file number n from tape
#  flexbackup -toc                 : list this tape's table of contents
#  flexbackup -toc all             : list all known table of contents
#  flexbackup -toc <key>           : list table of contents for tape key
#  flexbackup -toc <key> -delete   : force deletion of entire specified tape index
#  flexbackup -toc <key> -dfile n  : force deletion of specified tape/filenumber
#  flexbackup [opt] -c <file>      : use <file> instead of /etc/flexbackup.conf
#                                    for configuration
#  flexbackup [opt] -type <x>      : override $type from config file
#  flexbackup [opt] -compress <x>  : override $compress from config file
#  flexbackup -fs all -noreten     : don't retension for level 0 "all" backups
#  flexbackup -fs all -noerase     : don't rewind/erase for level 0 "all" backups
#  flexbackup -fs <x> -erase       : force a rewind/erase before backup
#  flexbackup -fs <x> -norewind    : don't rewind tape after a single backup
#  flexbackup [operation] -reten   : force a retension before read
#  flexbackup -newtape             : erase & create new index key (but no backup)
#  flexbackup [opt] -n             : don't run actual dump or mt commands
#  flexbackup [opt] -d 'var=val'   : override config file setting of $var
#  flexbackup -version             : show version
#
######################################################################
#
#  flexbackup is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2, or (at your option)
#  any later version.
#
#  flexbackup is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with flexbackup; see the file COPYING.  If not, write to
#  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#
######################################################################

use POSIX;
use AnyDBM_File;
use Getopt::Long;
use English;
use strict;

# No output buffering
$OUTPUT_AUTOFLUSH = 1;

package main;

# See if afio is calling us as a control script
if ($ARGV[0] =~ /flexbackup.volume_header_info/) {
    &print_afio_volume_header();
    exit(0);
}

# This is changed during "make install"
$main::CONFFILE="/etc/flexbackup.conf";

%main::opt = ();
if (! &main::GetOptions(\%main::opt,
                        "help",
                        "c=s",
                        "level=i",
                        "fs=s",
                        "extract:s",
                        "files=s",
                        "restore:s",
                        "list:s",
                        "compare:s",
                        "num:i",
                        "toc:s",
                        "delete",
                        "dfile=i",
                        "type=s",
                        "compress=s",
                        "erase!",
                        "rewind!",
                        "reten!",
                        "newtape",
                        "version",
                        "n",
                        "d=s%"
		  )) {
    &usage();
    exit(0);
}

# Give usage message
if (defined($main::opt{'help'})) {
    &usage();
    exit(0);
}

# Version
if (defined($main::opt{'version'})) {
    print "flexbackup version " . &versionstring() . "\n";
    print '$Id: flexbackup,v 1.61 1999/11/03 03:13:41 edwinh Exp $ ' . "\n";
    exit(0);
}


# Get/read config file
print "\nflexbackup version " . &versionstring() . "\n";
&readconfigfile();
print "\n";

# Set OS type
chomp($main::uname = `uname -s`);

# Sanity check
&optioncheck();

# See about rewind/erse/reten flags
&set_tape_operation_defaults();

# Get current date string
$main::date = &current_time("short");

# Decide what to do
if (defined($main::opt{'restore'})) {
    &restore_routine();

} elsif (defined($main::opt{'extract'})) {
    &extract_routine();

} elsif (defined($main::opt{'compare'})) {
    &compare_routine();

} elsif (defined($main::opt{'list'})) {
    &list_routine();

} elsif (defined($main::opt{'fs'})) {
    &backup_routine();

} elsif (defined($main::opt{'toc'})) {

    &line();
    &mt("generic-blocksize $main::mt_blksize");
    &toc_routine();

} elsif (defined($main::opt{'newtape'})) {

    &line();
    &mt("generic-blocksize $main::mt_blksize");
    &log('| Rewinding & erasing tape...');
    &mt('rewind');
    &maybe_delete_old_index();
    &mt('generic-erase');
    &new_tape_key();
    &line();

}

untie(%main::index);

exit(0);

######################################################################
# Backup
######################################################################
sub backup_routine {

    my @files;
    my $label;
    my $list;
    my $tapecounter = 0;
    my %oldlogs;
    my %oldstamps;
    my $fs;
    my $logfile;
    my $symlink;
    my $logext = '';
    my $comp_cmd;
    my $tape_key;

    # Get rid of trailing /
    $main::opt{'fs'} = &nuke_trailing_slash($main::opt{'fs'});

    # Figure out log file name & empty log file
    $label = &get_label($main::opt{'fs'});
    $logfile = "$cfg::prefix$label.$main::level.$main::date";
    $symlink = "$cfg::prefix$label.latest";
    $main::log = "$cfg::logdir/$logfile";
    if (! open(LOG,">$main::log")) {
        die "Can't write to $main::log: $OS_ERROR";
    }
    close(LOG);

    &line();
    &mt("generic-blocksize $main::mt_blksize");

    # Remember old stamp files (will remove at end of job)
    # ("old" = any higher-numbered stamps for this label)
    opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR");
    @files = readdir(DIR);
    foreach (reverse sort @files) {
        next if (! m/^$cfg::sprefix$label\.([0-9])$/);
        if ($1 > $main::level) {
            $oldstamps{"$cfg::stampdir/$_"} = $1
        }
    }
    close(DIR);

    # Remember old log files (will remove at end of job)
    # ("old" = any higher-numbered logs for this label)
    opendir(DIR,"$cfg::logdir") or die("Can't open cfg::logdir: $OS_ERROR");
    @files = readdir(DIR);
    foreach (reverse sort @files) {
        next if (! m/^$cfg::prefix$label\.([0-9])\.([0-9]+)(\.gz|\.bz2|\.Z)?$/);
        if ($1 > $main::level) {
            $oldlogs{"$cfg::logdir/$_"} = $1 . "|" . $2;
        }
    }
    close(DIR);


    ##########################
    #
    # Main backup routine
    #
    ##########################
    # Spew some info
    &log("| Doing level $main::level backup of $main::opt{fs} using $cfg::type");

    if ($main::opt{'fs'} eq 'all') {

        foreach $list (@cfg::filesystems) {

            # Maybe retension
            if ($main::do_reten == 1) {
                &log('| Retensioning tape...');
                &mt('retension');
            }

            # Maybe rewind/erase
            if ($main::do_erase == 1) {
                &log('| Rewinding & erasing tape...');
                &mt('rewind');
                &maybe_delete_old_index();
                &mt('generic-erase');
                $tape_key = &new_tape_key();
            } else {
                &mt('rewind');
                $tape_key = &get_tape_key();
                &log('| Making sure tape is at end of data...');
                &mt('generic-eod');
            }

            # Multiple tapes are only for level 0
            if ($main::level == 0) {
                &log("| Tape \#$tapecounter");
            }

            # Print what "all" means
            &log("| Filesystems = $list");

            # Show tape position
            &line();
            &mt('generic-query');

            # Iterate over the filesystems and back 'em up
            foreach $fs (split(/\s+/,$list)) {

                # Get rid of trailing /
                $fs = &nuke_trailing_slash($fs);

                &backup($fs,$tape_key);
                if ($cfg::indexes eq "true") {
                    $main::nextfile++;
                }
            }

            # Prompt for new tape if more than one set in list & level 0
            if ($main::level == 0) {
                if ($tapecounter < $main::num_tapes) {

                    # Maybe rewind (usually true)
                    if ($main::do_rewind_after == 1) {
                        &log("| Rewinding...");
                        &mt('rewind');
                        &line();
                    }

                    if (!defined($main::use_file)) {
                        &toc_routine($tape_key);
                    }

                    $tapecounter++;
                    if (!defined($main::use_file)) {
                        print "\n";
                        while(1) {
                            print "---> Insert tape \#$tapecounter (enter y to continue) ";
                            chomp($_ = <STDIN>);
                            last if ($_ =~ m/^y/i);
                        }
                        print "\n";
                        &line();
                    }
                }               # end not at last tape
            }                   # end level == 0 (inside foreach fs, inside all)
        }                       # end foreach fs (inside all)

    } else {

        # Just one filesystem

        # Maybe retension
        if ($main::do_reten == 1) {
            &log('| Retensioning tape...');
            &mt('retension');
        }

        # Maybe rewind/erase
        if ($main::do_erase == 1) {
            &log('| Rewinding & erasing tape...');
            &mt('rewind');
            &maybe_delete_old_index();
            &mt('generic-erase');
            $tape_key = &new_tape_key();
        } else {
            &mt('rewind');
            $tape_key = &get_tape_key();
            &log('| Making sure tape is at end of data...');
            &mt('generic-eod');
        }

        &line();
        &mt('generic-query');

        &backup($main::opt{'fs'},$tape_key);

    } # end all or single fs

    &line();

    # Maybe rewind (usually true)
    if ($main::do_rewind_after == 1) {
        &log("| Rewinding...");
        &mt('rewind');
    }

    # Actually remove the old log and stamp files now that we are done
    foreach (sort keys %oldstamps) {
        print "| Removing out of date level $oldstamps{$_} timestamp of $main::opt{fs}\n";
        unlink("$_") or warn("Can't remove $_: $OS_ERROR\n");
    }
    foreach (sort keys %oldlogs) {
        my ($lev,$d) = split(/\|/,$oldlogs{$_});
        print "| Removing old level $lev log of $main::opt{fs} (dated $d)\n";
        unlink("$_") or warn("Can't remove $_: $OS_ERROR\n");
    }

    # Compress log file
    if ($cfg::comp_log ne 'false') {
        if ($cfg::comp_log eq "gzip") {
            $logext = ".gz";
            $comp_cmd = "gzip -f $main::log";
        } elsif ($cfg::comp_log eq "bzip2") {
            $logext = ".bz2";
            $comp_cmd = "bzip2 -f $main::log";
        } elsif ($cfg::comp_log eq "compress") {
            $logext = ".Z";
            $comp_cmd = "compress -f $main::log";
        }
        &line("logonly");
        print "| Compressing log ($logfile" . "$logext)\n";
        system("$comp_cmd");
        if ($CHILD_ERROR) {
            warn("Error compressing log file\n");
        }
        undef $main::log;
    }

    # Symlink the "latest" log file for this level
    &log("| Linking $symlink" . "$logext -> $logfile" . $logext);
    unlink("$cfg::logdir/$symlink" . $logext);
    symlink("$logfile" . $logext,"$cfg::logdir/$symlink" . $logext);

    &line();

    &toc_routine($tape_key);

    exit(0);

}

######################################################################
# Backup a filesystem
######################################################################
sub backup {

    my $dir = shift(@_);
    my $tape_key = shift(@_);
    my $title;
    my $notagtitle;
    my @cmds;
    my @echo_cmds;
    my $cmd;
    my $localdir = $dir;
    my $label = &get_label($dir);
    my $host;

    &line();

    if ($localdir =~ s/^(.+):(.+)$/$2/) {
	$main::remote = $1;
	chomp($main::tapehost = `hostname`);
        if ($main::tapehost eq $main::remote) {
            die("Remote host and this host are the same! no banana for you!");
        }

    } else {
        $main::remote = '';
    }

    # Create file name if writing to a file
    # (config file's $device points to a dir in this case)
    if (defined($main::use_file)) {
        $_ = $main::level . "." . $main::date . "." . $cfg::type;
        if ($cfg::type =~ m/^(tar|dump|cpio)$/) {
            if ($cfg::compress eq "gzip") {
                $_ .= ".gz";
            } elsif ($cfg::compress eq "bzip2") {
                $_ .= ".bz2";
            } elsif ($cfg::compress eq "compress") {
                $_ .= ".Z";
            }
        } elsif ($cfg::type eq "afio") {
            # tag these a little different, the archive file itself isn't a
            # .gz or .bz2, but the files in it are....
            if ($cfg::compress eq "gzip") {
                $_ .= "-gz";
            } elsif ($cfg::compress eq "bzip2") {
                $_ .= "-bz2";
            } elsif ($cfg::compress eq "compress") {
                $_ .= "-Z";
            }
        }
        $main::device = $cfg::device . "/" . $label . "." . $_;
    }

    # Just get the date for now; don't write the timestamp
    # Until after the backup has run
    $main::date_at_start = &current_time();

    # Label for this archive
    chomp($host = `hostname`);
    $_ = $cfg::type . "+" . $cfg::compress;
    $_ =~ s/\+false//;
    $title = "level $main::level $dir $main::date_at_start $_ from $host";
    $notagtitle = "level $main::level $dir $main::date_at_start from $host";

    # Modify table of contents
    if (($tape_key ne '')
        and
        ($cfg::indexes eq "true")) {
        # If writing to files, store the filename
        if (defined($main::use_file)) {
            @_ = split(/\//,$main::device);
            $_ = pop(@_);
            if (defined($main::opt{'n'})) {
                &log("| (debug) \$main::index{$tape_key|$main::nextfile} = $notagtitle ($_)");
            } else {
                $main::index{"$tape_key|$main::nextfile"} = "$notagtitle ($_)";
            }
        } else {
            if (defined($main::opt{'n'})) {
                &log("| (debug) \$main::index{$tape_key|$main::nextfile} = $title");
            } else {
                $main::index{"$tape_key|$main::nextfile"} = $title;
            }
        }
        &log("| File number $main::nextfile, index key $tape_key");
    }

    &log("| Backup of: $dir");
    if ($cfg::type eq 'dump') {
	@cmds = &backup_dump($label,$localdir);
    } elsif ($cfg::type eq 'afio') {
	@cmds = &backup_afio($label,$localdir,$title);
    } elsif ($cfg::type eq 'tar') {
	@cmds = &backup_tar($label,$localdir,$title);
    } elsif ($cfg::type eq 'cpio') {
	@cmds = &backup_cpio($label,$localdir,$title);
    } elsif ($cfg::type eq 'zip') {
	@cmds = &backup_zip($label,$localdir,$title);
    }

    # Strip multiple spaces
    foreach (@cmds) {
        s/\s+/ /g;
    }

    # Format commands for nice printing
    @echo_cmds = @cmds;
    foreach (@echo_cmds) {
        &split_and_echo($_);
    }
    &line();

    # Enough fooling around... run it.
    if (!defined($main::opt{'n'})) {
        foreach $cmd (@cmds) {
            system("($cmd) 2>&1 | tee -a $main::log");
            if ($CHILD_ERROR) {
                &log("$cfg::type: error from backup, exiting");
                &log("offending command: $cmd");
                exit(1);
            }
        }
    } else {
        &log("(debug) command output would be here");
    }
    &line();

    # Create timestamp file, but use date from before the backup started
    # so next time we will catch files that might have been toucehd during the run
    $_ = &current_time();
    &log("| Backup start: $main::date_at_start");
    &log("| Backup end:   $_");
    system("touch $main::touch_flag \"$main::date_at_start\" $cfg::stampdir/$cfg::sprefix$label.$main::level");

    # Got errors unless I paused before trying to access the tape right way...
    if ((!defined($main::opt{'n'})) and (!defined($main::use_file))) {
        sleep 10;
    }
    &line();

    # Show where we are on the tape
    &mt('generic-query');

}

######################################################################
# Return command to backup a filesystem using dump
######################################################################
sub backup_dump {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $cmd = '';
    my $tmpstamp = "$cfg::tmpdir/refdate.$$";
    my $date_flag;

    # Warnings
    if (defined($cfg::exclude_expr[0])) {
        &log("| Note: \$exclude_expr is ignored for dump");
    }
    if ($cfg::traverse_fs eq "true") {
        &log("| Note: \$traverse_fs is always false for dump");
    }

    # With this one we don't have to put a stampfile on the remote system
    # since we only need the date string
    if ($main::level == 0) {
        &get_last_date($label); # Just to print dates, don't need result
        $date_flag = "";
    } else {
        $_ = &get_last_date($label);
        $date_flag = "-T \"$_\" ";
    }

    $cmd .= "dump -$main::level ";
    $cmd .= "$main::dump_blk_flag ";
    if ($cfg::dump_use_dumpdates eq "true") {
        $cmd .= "-u ";
    } else {
        $cmd .= $date_flag;
    }
    $cmd .= "$main::dump_len_flag ";
    $cmd .= "-f - ";
    $cmd .= "$dir $main::z";
    if ($main::remote and ($cfg::buffer eq "true")) {
        $cmd .= "$main::buffer_cmd";
    }

    # Wrap all that together
    $cmd = &maybe_remote_cmd($cmd);

    # Append writer stuff
    $cmd .= "$main::buffer_cmd $main::buffer_write_flags" . "$main::device";

    return($cmd);


}

######################################################################
# Return command to backup a filesystem using afio
######################################################################
sub backup_afio {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $cmd = '';
    my $tmpstamp = "$cfg::tmpdir/refdate.$$";
    my $tmplabel = "$cfg::tmpdir/label.$$";
    my $tmpnocompress = "$cfg::tmpdir/nocompress.$$";
    my $remove;
    my $no_compress = '';

    $_ = &get_last_date($label);

    $cmd .= "touch $main::touch_flag \"$_\" $tmpstamp ; ";

    # list of file exenstions to not compress
    if (($cfg::compress !~ /^(false|hardware)$/) and ($cfg::nocompress_types ne "")) {
        $cmd .= "echo \"$cfg::nocompress_types\" > $tmpnocompress ; ";
        $no_compress = "-E $tmpnocompress";
    }

    $cmd .= "printf \"\\nVolume Label:\\n$title\\n\\n\" > $tmplabel ; ";

    $cmd .= "cd $dir ; ";
    $cmd .= "(echo //--$tmplabel flexbackup.volume_header_info && ";
    $cmd .= "find . $main::mountpoint_flag ";
    $cmd .= "-newer $tmpstamp ";
    $cmd .= "-print | ";
    $cmd .= "sed -e \"s%^\./%%\" ";
    $cmd .= "$main::exclude_cmd ";
    $cmd .= ") | ";
    $cmd .= "afio -o ";
    $cmd .= "$no_compress ";
    $cmd .= "-z ";
    $cmd .= "$main::afio_z_flag ";
    $cmd .= "$main::afio_verb_flag ";
    $cmd .= "$main::afio_sparse_flag ";
    $cmd .= "$main::afio_bnum_flag ";
    $cmd .= "$main::afio_blk_flag ";
    $cmd .= "-";
    if ($main::remote and ($cfg::buffer eq "true")) {
        $cmd .= "$main::buffer_cmd";
    }
    $remove = "$tmpstamp $tmplabel";
    if ($no_compress ne '') {
        $remove .= " $tmpnocompress";
    }
    $cmd .= " ; rm -f $remove";

    # Wrap all that together
    $cmd = &maybe_remote_cmd($cmd);

    # Append writer stuff
    $cmd .= "$main::buffer_cmd $main::buffer_write_flags" . "$main::device";

    return($cmd);

}

######################################################################
# Return command to backup a filesystem using cpio
######################################################################
sub backup_cpio {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $cmd = '';
    my $tmpstamp = "$cfg::tmpdir/refdate.$$";

    $_ = &get_last_date($label);

    $cmd .= "touch $main::touch_flag \"$_\" $tmpstamp ; ";

    # Kludge a title for by replacing / with - in the title
    # then touch a file in the dir we are going to back up.
    $title =~ s%/%-%g;
    $title =~ s% %_%g;
    $cmd .= "touch \"$dir/$title\" ; ";

    $cmd .= "cd $dir ; ";
    $cmd .= "find . $main::mountpoint_flag ";
    $cmd .= "-newer $tmpstamp ";
    $cmd .= "-print | ";
    $cmd .= "sed -e \"s%^\./%%\" ";
    $cmd .= "$main::exclude_cmd ";
    $cmd .= "| ";
    $cmd .= "cpio --create ";
    $cmd .= "--format $cfg::cpio_format ";
    $cmd .= "$main::cpio_verb_flag ";
    $cmd .= "$main::cpio_sparse_flag ";
    $cmd .= "$main::cpio_blk_flag ";
    $cmd .= "$main::z";
    if ($main::remote and ($cfg::buffer eq "true")) {
        $cmd .= "$main::buffer_cmd";
    }
    $cmd .= " ; rm -f $tmpstamp \"$dir/$title\"";

    # Wrap all that together
    $cmd = &maybe_remote_cmd($cmd);

    # Append writer stuff
    $cmd .= "$main::buffer_cmd $main::buffer_write_flags" . "$main::device";

    return($cmd);

}

######################################################################
# Return command to backup a filesystem using tar
######################################################################
sub backup_tar {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $cmd = '';
    my $tmpstamp = "$cfg::tmpdir/refdate.$$";

    $_ = &get_last_date($label);

    $cmd .= "touch $main::touch_flag \"$_\" $tmpstamp ; ";

    $cmd .= "cd $dir ; ";
    $cmd .= "find . $main::mountpoint_flag ";
    $cmd .= "! -type d ";
    $cmd .= "-newer $tmpstamp ";
    $cmd .= "-print | ";
    $cmd .= "sed -e \"s%^\./%%\" ";
    $cmd .= "$main::exclude_cmd ";
    $cmd .= "| ";
    $cmd .= "tar --create ";
    $cmd .= "--files-from=- ";
    $cmd .= "--same-permissions ";
    $cmd .= "--same-order ";
    $cmd .= "--no-recursion ";
    $cmd .= "--totals ";
    $cmd .= "--label \"$title\" ";
    $cmd .= "$main::tar_atime_flag ";
    $cmd .= "$main::tar_verb_flag ";
    $cmd .= "$main::tar_sparse_flag ";
    $cmd .= "$main::tar_recnum_flag ";
    $cmd .= "$main::tar_blk_flag ";
    $cmd .= "--file - ";
    $cmd .= "$main::z";
    if ($main::remote and ($cfg::buffer eq "true")) {
        $cmd .= "$main::buffer_cmd";
    }
    $cmd .= " ; rm -f $tmpstamp";

    # Wrap all that together
    $cmd = &maybe_remote_cmd($cmd);

    # Append writer stuff
    $cmd .= "$main::buffer_cmd $main::buffer_write_flags" . "$main::device";

    return($cmd);

}

######################################################################
# Return command to backup a filesystem using zip
######################################################################
sub backup_zip {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $cmd = '';
    my @cmds;
    my $tmpstamp = "$cfg::tmpdir/refdate.$$";
    my $tmp = "$cfg::tmpdir/tmp$$.zip";

    $_ = &get_last_date($label);

    # Kludge a title by replacing / with - in the title
    # then touch a file in the dir we are going to back up.
    $title =~ s%/%-%g;
    $title =~ s% %_%g;
    $cmd .= "touch \"$dir/$title\" ; ";

    $cmd .= "touch $main::touch_flag \"$_\" $tmpstamp ; ";

    $cmd .= "cd $dir ; ";
    $cmd .= "find . $main::mountpoint_flag ";
    $cmd .= "-newer $tmpstamp ";
    $cmd .= "-print | ";
    $cmd .= "sed -e \"s%^\./%%\" ";
    $cmd .= "$main::exclude_cmd ";
    $cmd .= "| ";
    $cmd .= "zip -@ ";
    $cmd .= "-b $cfg::tmpdir "; # temp file path
    $cmd .= "-y "; # store symlinks
    $cmd .= "$main::zip_compr_flag ";
    $cmd .= "$main::zip_noz_flag "; # nocompress list
    $cmd .= "$main::zip_verb_flag "; # verbose flag
    $cmd .= "$tmp";

    # Wrap all that together
    $cmd = &maybe_remote_cmd($cmd);
    push(@cmds,$cmd);

    $cmd = "cat $tmp ";
    if ($main::remote and ($cfg::buffer eq "true")) {
        $cmd .= "$main::buffer_cmd";
    }
    $cmd .= " ; rm -f $tmpstamp \"$dir/$title\" $tmp";

    # Wrap all that together
    $cmd = &maybe_remote_cmd($cmd);

    # Append writer stuff
    $cmd .= "$main::buffer_cmd $main::buffer_write_flags" . "$main::device";

    push(@cmds,$cmd);

    return(@cmds);

}

######################################################################
# List the files in an archive
######################################################################
sub list_routine {

    my $cmd;

    $main::log = "flexbackup.list.log";
    if (! open(LOG,">$main::log")) {
        $main::log = "/tmp/flexbackup.list.log";
        if (! open(LOG,">$main::log")) {
            die "Can't write to $main::log: $OS_ERROR";
        }
    }
    close(LOG);

    $cmd = &setup_before_read();

    if ($cfg::type eq 'dump') {
	$cmd .= "restore -t ";
        $cmd .= "$main::dump_verb_flag ";
        $cmd .= "$main::dump_blk_flag ";
        $cmd .= "-f -";

    } elsif ($cfg::type eq 'afio') {
        $cmd .= "afio -t ";
        $cmd .= "-z ";
        $cmd .= "-D $0 ";
        $cmd .= "$main::afio_unz_flag ";
        $cmd .= "$main::afio_verb_flag ";
        $cmd .= "$main::afio_sparse_flag ";
        $cmd .= "$main::afio_bnum_flag ";
        $cmd .= "$main::afio_blk_flag ";
        $cmd .= "-";

    } elsif ($cfg::type eq 'tar') {
        $cmd .= "tar --list ";
        $cmd .= "--totals ";
        $cmd .= "$main::tar_verb_flag ";
        $cmd .= "$main::tar_sparse_flag ";
        $cmd .= "$main::tar_recnum_flag ";
        $cmd .= "$main::tar_blk_flag ";
        $cmd .= "-B ";
        $cmd .= "--file -";

    } elsif ($cfg::type eq 'cpio') {
        $cmd .= "cpio --list ";
        $cmd .= "$main::cpio_verb_flag ";
        $cmd .= "$main::cpio_blk_flag";

    } elsif ($cfg::type eq 'zip') {
        my $tmpfile = "$cfg::tmpdir/zip.$$";
        $cmd .= "cat > $tmpfile ; ";
        $cmd .= "unzip -l ";
        $cmd .= "$main::zip_verb_flag ";
        $cmd .= "$tmpfile ; ";
        $cmd .= "rm -f $tmpfile";

    }

    &run_or_echo_then_query($cmd);

}

######################################################################
# Extract files (maybe a list) to current directory
######################################################################
sub extract_routine {

    my $restore_files = '';
    my $newlist = "$cfg::tmpdir/extract.$$";
    my $cmd;

    $main::log = "flexbackup.extract.log";
    if (! open(LOG,">$main::log")) {
        $main::log = "/tmp/flexbackup.extract.log";
        if (! open(LOG,">$main::log")) {
            die "Can't write to $main::log: $OS_ERROR";
        }
    }
    close(LOG);

    $cmd = &setup_before_read();

    if (defined($main::opt{'files'})) {
        # Have to get a list of the files for restore to use
        open(LIST,"$main::opt{files}") or die ("Can't open $main::opt{files}: $OS_ERROR");
        open(NEWLIST,">$newlist") or die ("Can't open $newlist: $OS_ERROR");
        while(<LIST>) {
            chomp;
            $_ =~ s%^/%%;
            $_ =~ s%^\./%%;
            print NEWLIST "$_\n";
            $restore_files .= " $_";
        }
        close(LIST);
        close(NEWLIST);
        &log("| Extracting files listed in $main::opt{files}");
    }

    if ($cfg::type eq 'dump') {
	$cmd .= "restore -x ";
        $cmd .= "$main::dump_verb_flag ";
        $cmd .= "$main::dump_blk_flag ";
        $cmd .= "-f -";
        if (defined($main::opt{'files'})) {
            $cmd .= "$restore_files";
        }

    } elsif ($cfg::type eq 'afio') {
        $cmd .= "afio -i ";
        if (defined($main::opt{'files'})) {
            $cmd .= "-w $newlist ";
        }
        $cmd .= "-z ";
        $cmd .= "-x ";
        $cmd .= "-D $0 ";
        $cmd .= "$main::afio_unz_flag ";
        $cmd .= "$main::afio_verb_flag ";
        $cmd .= "$main::afio_sparse_flag ";
        $cmd .= "$main::afio_bnum_flag ";
        $cmd .= "$main::afio_blk_flag ";
        $cmd .= "-";

    } elsif ($cfg::type eq 'tar') {
        $cmd .= "tar --extract ";
        if (defined($main::opt{'files'})) {
            $cmd .= "--files-from $newlist ";
        }
        $cmd .= "--totals ";
        $cmd .= "--same-permissions ";
        $cmd .= "--same-order ";
        $cmd .= "$main::tar_verb_flag ";
        $cmd .= "$main::tar_sparse_flag ";
        $cmd .= "$main::tar_recnum_flag ";
        $cmd .= "$main::tar_blk_flag ";
        $cmd .= "-B ";
        $cmd .= "--file -";

    } elsif ($cfg::type eq 'cpio') {
        $cmd .= "cpio --extract ";
        if (defined($main::opt{'files'})) {
            $cmd .= "--pattern-file $newlist ";
        }
        $cmd .= "--preserve-modification-time ";
        $cmd .= "--make-directories ";
        $cmd .= "$main::cpio_verb_flag ";
        $cmd .= "$main::cpio_blk_flag";

    } elsif ($cfg::type eq 'zip') {
        my $tmpfile = "$cfg::tmpdir/zip.$$";
        $cmd .= "cat > $tmpfile ; ";
        $cmd .= "unzip ";
        $cmd .= "$main::zip_verb_flag ";
        $cmd .= "$tmpfile ";
        if (defined($main::opt{'files'})) {
            $cmd .= "$restore_files ";
        }
        $cmd .= "; ";
        $cmd .= "rm -f $tmpfile";

    }

    &run_or_echo_then_query($cmd);

    if (defined($main::opt{'files'})) {
        unlink("$newlist") or die ("Can't remove $newlist: $OS_ERROR");
    }
}

######################################################################
# Compare an archive to current directory
######################################################################
sub compare_routine {

    my $cmd;

    $main::log = "flexbackup.compare.log";
    if (! open(LOG,">$main::log")) {
        $main::log = "/tmp/flexbackup.compare.log";
        if (! open(LOG,">$main::log")) {
            die "Can't write to $main::log: $OS_ERROR";
        }
    }
    close(LOG);

    $cmd = &setup_before_read();
    if ($cfg::type eq 'dump') {
	$cmd .= "restore -C ";
        $cmd .= "$main::dump_blk_flag ";
        $cmd .= "-f -";

    } elsif ($cfg::type eq 'afio') {
        $cmd .= "afio -r ";
        $cmd .= "-z ";
        $cmd .= "-D $0 ";
        $cmd .= "$main::afio_unz_flag ";
        $cmd .= "$main::afio_sparse_flag ";
        $cmd .= "$main::afio_blk_flag ";
        $cmd .= "-";

    } elsif ($cfg::type eq 'tar') {
        $cmd .= "tar --diff ";
        $cmd .= "--totals ";
        $cmd .= "$main::tar_blk_flag ";
        $cmd .= "$main::tar_sparse_flag ";
        $cmd .= "$main::tar_recnum_flag ";
        $cmd .= "-B ";
        $cmd .= "--file -";

    } elsif ($cfg::type eq 'cpio') {
        die("cpio not capable of comparing files");

    } elsif ($cfg::type eq 'zip') {
        die("zip not capable of comparing files");

    }

    &run_or_echo_then_query($cmd);

}

######################################################################
# Interactive restore
######################################################################
sub restore_routine {

    my $cmd = &setup_before_read();

    if ($cfg::type eq 'dump') {
	$cmd .= "restore -i ";
        $cmd .= "$main::dump_verb_flag ";
        $cmd .= "$main::dump_blk_flag ";
        $cmd .= "-f -";

    } elsif ($cfg::type eq 'afio') {
        die("Interactive restore for $cfg::type not implemented yet");

    } elsif ($cfg::type eq 'cpio') {
        die("Interactive restore for $cfg::type not implemented yet");

    } elsif ($cfg::type eq 'tar') {
        die("Interactive restore for $cfg::type not implemented yet");

    } elsif ($cfg::type eq 'zip') {
        die("Interactive restore for $cfg::type not implemented yet");

    }

    &run_or_echo_then_query($cmd);

}

######################################################################
# Return the "label" name of the filesystem/dir
######################################################################
sub get_label {

    my $path = shift(@_);
    my $host = '';
    my $label;

    if ($path =~ m/(\S+):(\S+)/) {
        $host = $1 . "-";
        $label = $2;
    } else {
        $label = $path;
    }

    $label =~ s%^/%%; # nuke leading slash
    $label =~ s%/%-%g; # turn / into -
    $label = 'root' if ($label eq '');

    return($host . $label);

}

######################################################################
# Return a date string of the timestamp file
# from the last dump of this level or lower
#   in ctime format normally
#   in YYYYMMDDhhmm.ss format if touch_flag is set to -t
#   or unconditionally in ctime format if 2nd argument is given
######################################################################
sub get_last_date {

    my $label = shift(@_);
    my $readable = shift(@_);
    my $file;
    my $numeric_val;
    my $string_val;
    my $return_val;
    my $lastlevel = 0;
    my $targetfile = '';
    my $mtime;

    # Find last stamp file
    opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR");
    my @files = readdir(DIR);
    foreach $file (reverse sort @files) {
        next if ($file !~ m/^$cfg::sprefix$label\.([0-9])$/);
        if ($1 <= $main::level) {
            $targetfile = "$cfg::stampdir/$file";
            $lastlevel = $1;
            last;
        }
    }
    close(DIR);

    # get date from targetfile
    # or complain if level > 0 and no timestamp
    # or use the epoch for level 0
    if ($main::level == 0) {
        $numeric_val = '197001010000.00';
        $string_val = "Thu Jan 01 00:00:00 1970";

    } elsif ($targetfile ne '') {
        $mtime = (stat($targetfile))[9];
        $string_val = strftime("%a %b %d %H:%M:%S %Y", localtime($mtime));
        $numeric_val = strftime("%Y%m%d%H%M.%S", localtime($mtime));

    } else {
        die("Can't do a level $main::level backup - no level 0 timestamp found");

    }

    # what kind of touch flag we are using determines the return type
    # dump -T always expects the string type though
    if (($main::touch_flag eq "-d")
        or
        (($cfg::type eq "dump") and ($cfg::dump_use_dumpdates eq "false"))) {
        $return_val = $string_val;
    } else {
        $return_val = $numeric_val;
    }

    &log("| Date of this level $main::level backup: $main::date_at_start");
    if ($main::level == 0) {
        &log("| Date of last level $lastlevel backup: the epoch");
    } else {
        &log("| Date of last level $lastlevel backup: $return_val");
    }
    &line();

    if (defined($readable)) {
        return($string_val);
    } else {
        return($return_val);
    }
}

######################################################################
# Echo message to screen and log
######################################################################
sub log {

    my $msg = shift(@_);

    print "$msg\n";
    if (defined($main::log)) {
        open(LOG,">>$main::log");
        print LOG "$msg\n";
        close(LOG);
    }

}

######################################################################
# Echo a line to both screen and log
######################################################################
sub line {

    my $logonly = shift(@_);

    if (!defined($logonly)) {
        print "|------------------------------------------------\n";
    }
    if (defined($main::log)) {
        open(LOG,">>$main::log");
        print LOG "|------------------------------------------------\n";
        close(LOG);
    }

}

######################################################################
# Read configuration file
######################################################################
sub readconfigfile {

    my $configfile;
    my $var;
    my $value;
    my $defines = $main::opt{'d'};

    if (defined($main::opt{'c'})) {
        $configfile = $main::opt{'c'};
    } else {
        $configfile = $main::CONFFILE;
    }
    if (! -r $configfile) {
        die("config file $configfile: $OS_ERROR");
    }
    system("perl -c $configfile 2>&1");
    if ($CHILD_ERROR) {
        die("syntax error in config file $configfile");
    }

    package cfg;
    require "$configfile";
    package main;

    # Overrides
    foreach $var (keys %$defines) {
        $value = $$defines{$var};
        &log("(override) $var = $value");
        eval("\$cfg::$var=\"$value\"");
    }

}

######################################################################
# Do a tape operation
######################################################################
sub mt {

    my (@operations) = (@_);
    my $operation;
    my $oldoperation;
    my $out;

    # Set hardware compression when we do the blocksize
    # Can someone who has a drive that does this tell me if this works???
    if ($cfg::compress eq "hardware") {
        foreach (@operations) {
            if ($_ =~ m/generic-blocksize/) {
                push(@operations,'compression 1');
            }
        }
    }

    foreach $operation (@operations) {

        # mt flavors for block number
        if ($operation eq 'generic-query') {
            if ($main::uname =~ /Linux/) {
                $operation = 'tell';
                if ($main::ftape == 1) {
                    $operation = 'getsize';
                }
            } elsif ($main::uname =~ /BSD/) {
                $operation = 'rdhpos';
            } elsif ($main::uname =~ /OSF1/) {
                $operation = 'status';
            } elsif ($main::uname =~ /AIX/) {
                $operation = 'status';
            } elsif ($main::uname =~ /HP-UX/) {
                next;
            } elsif ($main::uname =~ /SunOS/) {
                $operation = 'status';
            } elsif ($main::uname =~ /IRIX/) {
                $operation = 'status';
            } else {
                $operation = 'status';
            }
        }

        # mt flavors for eod
        if ($operation eq 'generic-eod') {
            if ($main::uname =~ /Linux/) {
                $operation = 'eod';
                if ($main::ftape == 1) {
                    $operation = 'eom';
                }
            } elsif ($main::uname =~ /BSD/) {
                $operation = 'eod';
            } elsif ($main::uname =~ /OSF1/) {
                $operation = 'seod';
            } elsif ($main::uname =~ /AIX/) {
                $operation = 'fsf 1000';
            } elsif ($main::uname =~ /HP-UX/) {
                $operation = 'eod';
            } elsif ($main::uname =~ /SunOS/) {
                $operation = 'eom';
            } elsif ($main::uname =~ /IRIX/) {
                $operation = 'eod';
            } else {
                $operation = 'eod';
            }
        }

        # mt flavors for erase
        # (some mt's have no "erase", just rewind before starting...)
        if ($operation eq 'generic-erase') {
            if ($cfg::erase_rewind_only eq "true") {
                next;
            } elsif ($main::uname =~ /Linux/) {
                $operation = 'erase';
            } elsif ($main::uname =~ /BSD/) {
                $operation = 'erase';
            } elsif ($main::uname =~ /OSF1/) {
                next;
            } elsif ($main::uname =~ /AIX/) {
                next;
            } elsif ($main::uname =~ /HP-UX/) {
                next;
            } elsif ($main::uname =~ /SunOS/) {
                $operation = 'erase';
            } elsif ($main::uname =~ /IRIX/) {
                $operation = 'erase';
            } else {
                $operation = 'erase';
            }
        }

        # mt flavors for setblk
        if ($operation =~ /generic-blocksize/) {
            if ($main::uname =~ /Linux/) {
                $operation =~ s/generic-blocksize/setblk/;
            } elsif ($main::uname =~ /BSD/) {
                $operation =~ s/generic-blocksize/blocksize/;
            } elsif ($main::uname =~ /OSF1/) {
                next;
            } elsif ($main::uname =~ /AIX/) {
                next;
            } elsif ($main::uname =~ /HP-UX/) {
                next;
            } elsif ($main::uname =~ /SunOS/) {
                next;
            } elsif ($main::uname =~ /IRIX/) {
                $operation =~ s/generic-blocksize/setblksz/;
            } else {
                $operation =~ s/generic-blocksize/setblk/;
            }
        }

        if (defined($main::use_file)) {
            if (defined($main::opt{'fs'})) {
                &log("| Archiving to file; \"mt $operation\" skipped");
            } else {
                &log("| Reading from file; \"mt $operation\" skipped");
            }

        } elsif (defined($main::opt{'n'})) {
            &log("| (debug) $main::mt -f $main::device $operation");

        } else {

            if ($operation =~ /setblk/) {
                # Try and see which of setblk/defblksize will work
                # This is kludgy, but doable
                chomp($out = `$main::mt -f $main::device $operation 2>&1`);
                if ($CHILD_ERROR) {
                    &log("| Trying \"mt defblksize\" instead of \"mt setblk\"");
                    $oldoperation = $operation;
                    $operation =~ s/setblk/defblksize/;
                    chomp($out = `$main::mt -f $main::device $operation 2>&1`);
                    if ($CHILD_ERROR) {
                        &log("Error setting block size");
                        &log("Neither of these commands worked:");
                        &log("  $main::mt -f $main::device $oldoperation");
                        &log("  $main::mt -f $main::device $operation");
                        exit(1);
                    } # error on second guess
                } # error on first guess
            } # operation = setblk

            if (defined($main::log)) {
                system("$main::mt -f $main::device $operation 2>&1 | tee -a $main::log");
            } else {
                system("$main::mt -f $main::device $operation 2>&1");
            }

            if ($CHILD_ERROR) {
                &log("Error from $main::mt $operation\n");
                exit(1);
            }

        } # not a file

    } # foreach operation

}

######################################################################
# Option error checking & init stuff
######################################################################
sub optioncheck {

    my $realdev;

    # Archive type on commandline
    if (defined($main::opt{'type'})) {
        $cfg::type = $main::opt{'type'};
    }

    # Compress flag on commandline
    if (defined($main::opt{'compress'})) {
        $cfg::compress = $main::opt{'compress'};
    }

    # First check if things are defined in the config file
    # Checks exist, true/false, or one of options
    &check(\$cfg::type,'type','dump afio tar cpio zip');
    &check(\$cfg::compress,'compress','gzip bzip2 compress false hardware');
    &check(\$cfg::compr_level,'compr_level','exist');
    &check(\$cfg::verbose,'verbose');
    &check(\$cfg::sparse,'sparse');
    &check(\$cfg::indexes,'indexes');
    &check(\$cfg::buffer,'buffer');
    &check(\$cfg::buffer_megs,'buffer_megs','exist');
    &check(\$cfg::pad_blocks,'pad_blocks');
    &check(\$cfg::device,'device','exist');
    &check(\$cfg::blksize,'blksize','exist');
    &check(\$cfg::mt_var_blksize,'mt_var_blksize');
    &check(\$cfg::traverse_fs,'traverse_fs','false local all');
    &check(\$cfg::nocompress_types,'nocompress_types','exist');
    &check(\$cfg::remoteshell,'remoteshell','ssh ssh2 ssh1 rsh');
    &check(\$cfg::erase_tape_all_level_zero,'erase_tape_all_level_zero');
    &check(\$cfg::erase_rewind_only,'erase_rewind_only');
    &check(\$cfg::logdir,'logdir','exist');
    &check(\$cfg::tmpdir,'tmpdir','exist');
    &check(\$cfg::comp_log,'comp_log','gzip bzip2 compress false');
    &check(\$cfg::stampdir,'stampdir','exist');
    &check(\$cfg::index,'index','exist');
    &check(\$cfg::prefix,'prefix','exist');
    &check(\$cfg::sprefix,'sprefix','exist');
    &check(\$cfg::afio_echo_block,'afio_echo_block');
    &check(\$cfg::afio_compress_cache_size,'afio_compress_cache_size','exist');
    &check(\$cfg::afio_compress_threshold,'afio_compress_threshold','exist');
    &check(\$cfg::tar_echo_record_num,'tar_echo_record_num');
    &check(\$cfg::tar_atime_preserve,'tar_atime_preserve');
    &check(\$cfg::dump_length,'dump_length','exist');
    &check(\$cfg::dump_use_dumpdates,'dump_use_dumpdates');
    &check(\$cfg::cpio_format,'cpio_format','bin odc newc crc tar ustar hpbin hpodc');
    if (@main::errors) {
        print "\nErrors:\n";
        while(@main::errors) {
            print " " . pop(@main::errors) . "\n";
        }
        exit(1);
    }

    # Chase links
    $realdev = $cfg::device;
    while (-l $realdev) {
        $realdev = readlink($realdev);
    }

    # Check device (or dir)
    $main::ftape = 0 ;
    if (-c $realdev) {

        # Check for ftape driver
        if ($realdev =~ /n?z?[qr]ft(\d+)/) {
            $main::ftape = 1;
        }

    } elsif (-d $cfg::device) {
        if ($cfg::device !~ m:^/:) {
            push(@main::errors,"Please give full path, not relative (\$device=$cfg::device)");
        } else {
            $main::use_file = 1;
            $cfg::device =~ s:/$::; # nuke trailing slash if any
        }
    } else {
        push(@main::errors,"\$device must be set to a directory or a device");
    }
    $main::device = $cfg::device;

    # Can we write to it?
    if (! -w $main::device) {
        push(@main::errors,"Can't write to $main::device");
    }

    # Set mt type
    if ($main::ftape == 1) {
        &checkinpath('ftmt');
        $main::mt = 'ftmt';
    } else {
        &checkinpath('mt');
        $main::mt = 'mt';
    }

    # Exclude regexp for find
    $main::exclude_cmd = '';
    # Deal with the old non-array setting that may be in the config file
    if (!defined($cfg::exclude_expr[0]) and defined($cfg::exclude_expr)) {
        $cfg::exclude_expr[0] = $cfg::exclude_expr;
    }
    if (defined($cfg::exclude_expr[0])) {
        &checkinpath("egrep");
        my @excl_array;
        my $expr;
        foreach $expr (@cfg::exclude_expr) {

            # People just don't grok regex's.
            #
            # If the first character is a *, they obviously got it wrong,
            # we can try to assume what they meant.
            #
            # If the user put "*.whatever" as an expression, turn this
            # "glob" into a regex for them
            # If the user put "*whatever" as an expression, turn this
            # "glob" into a regex for them
            if ($expr =~ m/^\*\./) {
                $expr =~ s/^\*\./.\*\\./;
            }
            if ($expr =~ m/^\*/) {
                $expr =~ s/^\*/.*/;
            }

            # AAAH! Csh should be banned from the face of the earth!
            #
            # If an expression contains $ at the end we need to be careful
            # and leave it out of the quotes, or csh will yack if doing a
            # remote backup. This happens only if the user's shell is
            # csh/tcsh.  Then the string is doublequoted inside single
            # quotes and there is _no way_ for csh do deal with $ in that
            # situation.  This took a LONG time to figure out.
            if ($expr =~ m/^(.+)\$$/) {
                $expr = '"' . $1 . '"' . '$'; #'# quote to keep font-lock happy
            } else {
                $expr = '"' . $expr . '"';
            }

            push(@excl_array, "egrep -v $expr");
        }
        $main::exclude_cmd = "| " . join(" | ", @excl_array);
    }

    # Traverse mountpoints?
    if ($cfg::traverse_fs eq "local") {
        $main::mountpoint_flag = "! -fstype nfs";
    } elsif ($cfg::traverse_fs eq "all") {
        $main::mountpoint_flag = "";
    } else {
        $main::mountpoint_flag = "-xdev";
    }

    # Block size
    if ($cfg::blksize !~ m/^\d+$/) {
        push(@main::errors,"\$blksize must be set to an integer");
    }

    # mt uses blocksize of bytes not k.  Also check for variable size
    if ($cfg::mt_var_blksize eq "true") {
        $main::mt_blksize = 0;
    } else {
        $main::mt_blksize = $cfg::blksize * 1024;
    }
    # buffer blocksize needs k appended
    $main::buffer_blk_flag = "-s " . $cfg::blksize . "k";
    # dd blocksize needs k appended
    $main::dd_blk_flag = "ibs=" . $cfg::blksize . "k obs=" . $cfg::blksize . "k";
    # afio blocksize needs k appended
    $main::afio_blk_flag = "-b " . $cfg::blksize . "k";
    # dump blocksize just in k like the config file
    $main::dump_blk_flag = "-b $cfg::blksize";
    # tar blocks are in 512-byte units
    # long name is really --blocking-factor but changed from --block-size
    # only in recent versions.  just use the short flag.
    $main::tar_blk_flag =  $cfg::blksize * 2;
    $main::tar_blk_flag = "-b $main::tar_blk_flag";
    # cpio blocks are in bytes
    $main::cpio_blk_flag = $cfg::blksize * 1024;
    $main::cpio_blk_flag = "--io-size $main::cpio_blk_flag";

    # Generic compression (afio/zip archives will do their own flags)
    if ($cfg::compress eq "gzip") {
        &checkinpath($cfg::compress);
        if ($cfg::compr_level !~ m/^[123456789]$/) {
            push(@main::errors,"\$compr_level must be set to 1-9");
        } else {
            $main::z = " | $cfg::compress -$cfg::compr_level";
        }
        $main::unz = "$cfg::compress -dq | ";

    } elsif ($cfg::compress eq "bzip2") {
        &checkinpath($cfg::compress);
        if ($cfg::compr_level !~ m/^[123456789]$/) {
            push(@main::errors,"\$compr_level must be set to 1-9");
        } else {
            $main::z = " | $cfg::compress -$cfg::compr_level";
        }
        $main::unz = "$cfg::compress -d | ";

    } elsif ($cfg::compress eq "compress") {
        &checkinpath($cfg::compress);
        $main::z = " | $cfg::compress -c";
        $main::unz = "$cfg::compress -dc | ";

    } else {
        $main::z = "";
        $main::unz = "";
    }

    # Block padding
    if ($cfg::pad_blocks eq "true") {
        $main::dd_pad_flag = "conv=noerror,sync";
        $main::buffer_pad_flag = "-B";
    } else {
        $main::dd_pad_flag = '';
        $main::buffer_pad_flag = '';
    }


    # Buffer stuff
    # Just use dd if buffer is disabled
    if ($cfg::buffer eq "true") {
        &checkinpath('buffer');
        if ($cfg::buffer_megs =~ m/^\d+$/) {
            $main::buffer_megs = $cfg::buffer_megs . "m";
            $main::buffer_cmd = " | buffer -m $main::buffer_megs $main::buffer_blk_flag";
            if (!defined($main::use_file)) {
                $main::buffer_write_flags = "-u 100 -t -p 75 $main::buffer_pad_flag -o ";
                $main::buffer_read_flags = "-u 100 -t -p 75 $main::buffer_pad_flag -i ";
            } else {
                $main::buffer_write_flags = "-t -p 75 $main::buffer_pad_flag -o ";
                $main::buffer_read_flags = "-t -p 75 $main::buffer_pad_flag -i ";
            }
            $main::read_cmd = "buffer -m $main::buffer_megs $main::buffer_blk_flag $main::buffer_read_flags";
        } else {
            push(@main::errors,"\$buffer_megs must be set to integer number of megabytes");
        }
    } else {
        &checkinpath('dd');
        $main::buffer_cmd = " | dd $main::dd_blk_flag $main::dd_pad_flag";
        $main::buffer_write_flags = "of=";
        $main::read_cmd = "dd $main::dd_blk_flag $main::dd_pad_flag if=";
    }

    # Check for type of touch flag
    # Only GNU fileutils has the touch -d flag
    if ($main::uname =~ /Linux/) {
        $main::touch_flag = "-d";
    } else {
        $main::touch_flag = "-t";
    }

    # Check we can find rsh or ssh
    &checkinpath($cfg::remoteshell);

    # Check we can find common stuff
    &checkinpath('touch');
    &checkinpath('hostname');
    &checkinpath('tee');
    &checkinpath('rm');
    &checkinpath('find');
    &checkinpath('sed');

    # Filesystems
    $main::num_tapes = -1;
    foreach (@cfg::filesystems) {
        $main::num_tapes++;
    }
    if ($main::num_tapes == -1) {
        push(@main::errors,"no filesystem spec for \"all\" backups (\$filesystem[0] not defined)");
    }

    # Verbose flag
    if ($cfg::verbose eq "true") {
        $main::afio_verb_flag = "-v";
        $main::dump_verb_flag = "-v";
        $main::tar_verb_flag = "--verbose";
        $main::cpio_verb_flag = "--verbose";
        $main::zip_verb_flag = "-v";
    } else {
        $main::afio_verb_flag = "";
        $main::dump_verb_flag = "";
        $main::tar_verb_flag = "";
        $main::cpio_verb_flag = "--dot";
        $main::zip_verb_flag = "-q";
    }

    # Sparse flag
    if ($cfg::sparse eq "true") {
        $main::afio_sparse_flag = "";
        $main::tar_sparse_flag = "--sparse";
        $main::cpio_sparse_flag = "--sparse";
    } else {
        $main::afio_sparse_flag = "-j";
        $main::tar_sparse_flag = "";
        $main::cpio_sparse_flag = "";
    }

    # Type-specific setup
    if ($cfg::type eq 'afio') {

        &checkinpath('afio');
        &checkinpath('printf');

        # Compress flag for afio must be handled differently
        if ($cfg::compress =~ m/^(gzip|bzip2|compress)$/) {

            if ($cfg::compress eq "gzip") {
                $main::afio_z_flag = "-P $cfg::compress -Q -$cfg::compr_level -Z";
                $main::afio_unz_flag = "-P $cfg::compress -Q -d -Q -q -Z";

            } elsif ($cfg::compress eq "bzip2") {
                $main::afio_z_flag = "-P $cfg::compress -Q -$cfg::compr_level -Z";
                $main::afio_unz_flag = "-P $cfg::compress -Q -d -Z";

            } elsif ($cfg::compress eq "compress") {
                $main::afio_z_flag = "-P $cfg::compress -Q -c -Z";
                $main::afio_unz_flag = "-P $cfg::compress -Q -d -Q -c -Z";

            }
            $main::unz = ""; # Reset & just use this for reading the archive file.

            # Compression cache size
            if ($cfg::afio_compress_cache_size !~ m/^\d+$/) {
                push(@main::errors,"\$afio_compress_cache_size must be set to an integer");
            } else {
                if ($cfg::afio_compress_cache_size != 0) {
                    $main::afio_z_flag .= " -M " . $cfg::afio_compress_cache_size . "m";
                }
            }

            # Compression threshold
            if ($cfg::afio_compress_threshold !~ m/^\d+$/) {
                push(@main::errors,"\$afio_compress_threshold must be set to an integer");
            } else {
                if ($cfg::afio_compress_threshold != 0) {
                    $main::afio_z_flag .= " -T " . $cfg::afio_compress_threshold . "k";
                }
            }

        } else {
            $main::afio_z_flag = "";
            $main::afio_unz_flag = "";
        }

        # Echo block number
        $main::afio_bnum_flag = "";
        if ($cfg::verbose eq "true") {
            if ($cfg::afio_echo_block eq "true") {
                $main::afio_bnum_flag = "-B";
            }
        }

    } elsif ($cfg::type eq 'dump') {

        &checkinpath('dump');
        &checkinpath('restore');

        # Length of tape
        if ($cfg::dump_length !~ m/^\d+$/) {
            push(@main::errors,"\$dump_length must be set to integer number of kilobytes");
        }

        # If length set to 0 will will try autosize
        if ($cfg::dump_length == 0) {
            $main::dump_len_flag = "-a";
        } else {
            $main::dump_len_flag = "-B $cfg::dump_length";
        }

    } elsif ($cfg::type eq 'tar') {

        &checkinpath('tar');

        # Echo record number
        $main::tar_recnum_flag = "";
        if ($cfg::verbose eq "true") {
            if ($cfg::tar_echo_record_num eq "true") {
                $main::tar_recnum_flag = "-R";
            }
        }

        # Set atime preserve
        if ($cfg::tar_atime_preserve eq "true") {
            $main::tar_atime_flag = "--atime-preserve";
        } else {
            $main::tar_atime_flag = "";
        }

    } elsif ($cfg::type eq 'cpio') {

        &checkinpath('cpio');

    } elsif ($cfg::type eq 'zip') {

        &checkinpath('zip');
        &checkinpath('unzip');
        &checkinpath('sed');

        $main::zip_compr_flag = "-$cfg::compr_level";

       if ($cfg::compress =~ /^(gzip|bzip2|compress)$/) {
            warn("Using type \"zip\" with compress=$cfg::compress makes no sense");
            warn("Setting compression to false");
	    $main::unz = "";
	    $main::z = "";
	    $cfg::compress = "false";
        }

        $main::zip_noz_flag = "";
        if ($cfg::nocompress_types ne "") {
            # Add dots to file extensions, make -n flag
            @_ =  split(" ",$cfg::nocompress_types);
            foreach (@_) {
                $_ = "." . $_;
            }
            $main::zip_noz_flag = " -n " . join(":",@_);
        }

    }

    # Paths: tmp, log/stamp files, open index
    &checkinpath($cfg::comp_log) if ($cfg::comp_log ne "false");

    $cfg::tmpdir = &nuke_trailing_slash($cfg::tmpdir);
    $cfg::logdir = &nuke_trailing_slash($cfg::logdir);
    $cfg::stampdir = &nuke_trailing_slash($cfg::stampdir);

    if ($cfg::tmpdir !~ m:^/:) {
        push(@main::errors,"\$tmpdir must be absolute path: $cfg::tmpdir");
    }
    if ($cfg::logdir !~ m:^/:) {
        push(@main::errors,"\$logdir must be absolute path: $cfg::logdir");
    }
    if ($cfg::stampdir !~ m:^/:) {
        push(@main::errors,"\$stampdir must be absolute path: $cfg::stampdir");
    }
    if (! -d $cfg::tmpdir) {
        push(@main::errors,"\$tmpdir $cfg::tmpdir is not a directory");
    }
    if (! -d $cfg::logdir) {
        mkdir("$cfg::logdir",0755) or push(@main::errors,"Can't mkdir $cfg::logdir: $OS_ERROR");
    }
    if (! -w $cfg::logdir) {
        push(@main::errors,"Can't write to $cfg::logdir: $OS_ERROR");
    }
    if (! -d $cfg::stampdir) {
        mkdir("$cfg::stampdir",0755) or push(@main::errors,"Can't mkdir $cfg::stampdir: $OS_ERROR");
    }
    if (! -w $cfg::stampdir) {
        push(@main::errors,"Can't write to $cfg::stampdir: $OS_ERROR");
    }

    # Index database
    if ($cfg::indexes eq "true") {
        tie(%main::index,"AnyDBM_File",$cfg::index,O_CREAT|O_RDWR,0640) or
            push(@main::errors,"Can't tie DB $cfg::index: $OS_ERROR");
    }

    # Levels
    if (defined($main::opt{'level'})) {
        if ($main::opt{'level'} !~ m/^\d$/) {
            push(@main::errors,"-level must be 0 through 9 only");
        }
    }

    # Check delete/toc flags
    if (!defined($main::opt{'toc'})) {
        if (defined($main::opt{'dfile'})) {
            push(@main::errors,"-dfile useless without -toc <key>");
        }
        if (defined($main::opt{'delete'})) {
            push(@main::errors,"-delete useless without -toc <key>");
        }
    } else {
        if ($cfg::indexes eq "false") {
            push(@main::errors,"Can't do -toc with \$indexes set to false");
        }
    }

    # Mode
    my (@modelist) = qw(fs list extract compare restore toc newtape);
    my @modes;
    my $modecount = 0;
    foreach (@modelist) {
        if (defined($main::opt{$_})) {
            $modecount++;
            push(@modes,$_);
        }
    }
    if ($modecount > 1) {
        $_ = join(" -",@modes);
        push(@main::errors,"Can't specify more than one mode (given \"-$_\")");
    }
    if ($modecount == 0) {
        push(@main::errors,"Nothing to do (see -help)");
    }

    # Test
    if (defined($main::opt{'n'})) {
        &log('(debug) no backup or mt commands will be executed');
    }

    # Check extract list
    if (defined($main::opt{'files'})) {
        if (defined($main::opt{'extract'})) {
            if (! -r $main::opt{'files'}) {
                push(@main::errors,"list of files $main::opt{files} not readable: $OS_ERROR");
            }
        } else {
            push(@main::errors,"-files can only be used with -extract");
        }
    }

    if (@main::errors) {
        print "\nErrors:\n";
        while(@main::errors) {
            print " " . pop(@main::errors) . "\n";
        }
        exit(1);
    }

}

######################################################################
# Print usage summary from the header
######################################################################
sub usage {

    open(FILE,"$0") or die "Can't open $0: $OS_ERROR";
    while(<FILE>) {
        last if (m/^\#\s+USAGE:/);
    }
    while(<FILE>) {
        last if (m/^\#\#\#\#\#\#\#/);
        s/^\#//;
        print;
    }
    close(FILE);

}

######################################################################
# Return version string from CVS tag
######################################################################
sub versionstring {

    my $ver = ' $Name: v0_9_8 $ ';
    $ver =~ s/Name//g;
    $ver =~ s/[:\$]//g;
    $ver =~ s/\s+//g;
    $ver =~ s/^v//g;
    $ver =~ s/_/\./g;
    if ($ver eq '') {
        $ver = "devel";
    }
    return($ver . " <flexbackup\@home.com>");

}

######################################################################
# Return current time in ctime format if normal
# in YYYYMMDDHHMM.SS format if on BSD or arg "numeric" is given
# just YYYYMMMDD if argument "short" is given
######################################################################
sub current_time {

    my $format = shift(@_);
    my $string;
    my $current_time = time;

    if (defined($format)) {
	if ($format eq "short") {
	    $string = strftime("%Y%m%d", localtime($current_time));
	} elsif ($format eq "numeric") {
	    $string = strftime("%Y%m%d%H%M.%S", localtime($current_time));
	}
    } elsif ($main::touch_flag eq "-t") {
        $string = strftime("%Y%m%d%H%M.%S", localtime($current_time));
    } else {
        $string = strftime("%a %b %d %H:%M:%S %Y", localtime($current_time));
    }

    return($string);

}

######################################################################
# Possibly return a filename to use
# if running list/extract/compare/restore
######################################################################
sub maybe_get_filename {

    my @modes = qw(list extract compare restore);
    my $arg;
    my $file;
    my $ftype;

    # grab filename from option argument
    # optionscheck already guarantees only one is set
    foreach (@modes) {
        if (defined($main::opt{$_})) {
            $arg = $main::opt{$_};
        }
    }

    # if the flag given but null, and $device was not set to a dir, just return
    if (($arg eq '') and (!defined($main::use_file))) {
        return($main::device);
    }

    # Look for file in current dir first (or full path given)
    # Then in $device dir (if conf file set to backup to files)
    if (-f "$arg") {
        $file = $arg;
        $main::use_file = 1;

    } elsif (defined($main::use_file) and (-f "$cfg::device/$arg")) {
        $file = $cfg::device . "/" . $arg;

    } else {
        if (defined($main::use_file)) {
            print STDERR "Error: file \"$arg\" or \"$cfg::device/$arg\" not found\n";
            print STDERR "When extracting from a backup file, you must specify file name.\n";
            print STDERR "(like \"-list file.tar.bz2\")\n";
            die();
        } else {
            die("Error: file \"$arg\" not found");
        }
    }

    # Try and guess file types and commpression scheme
    # might as well since we are reading from a file in this case
    if ($file =~ m/\.(dump|cpio|tar)\.(gz|bz2|Z)$/) {
        $cfg::type = $1;
        $cfg::compress = $2;
        $cfg::compress =~ s/gz/gzip/;
        $cfg::compress =~ s/bz2/bzip2/;
        $cfg::compress =~ s/Z/compress/;
        &log("| Auto-set to type=$cfg::type compress=$cfg::compress");
        &optioncheck(); # redo to set a few variables over

    } elsif ($file =~ m/\.afio-(gz|bz2|Z)$/) {
        $cfg::type = "afio";
        $cfg::compress = $1;
        $cfg::compress =~ s/gz/gzip/;
        $cfg::compress =~ s/bz2/bzip2/;
        $cfg::compress =~ s/Z/compress/;
        &log("| Auto-set to type=$cfg::type compress=$cfg::compress");
        &optioncheck(); # redo to set a few variables over

    } elsif ($file =~ m/\.(afio|dump|cpio|tar|zip)$/) {
        $cfg::type = $1;
        $cfg::compress = "false";
        &log("| Auto-set to type=$cfg::type compress=$cfg::compress");
        &optioncheck(); # redo to set a few variables over

    } elsif ($file =~ m/\.tgz$/) {
        $cfg::type = "tar";
        $cfg::compress = "gzip";
        &log("| Auto-set to type=$cfg::type compress=$cfg::compress");
        &optioncheck(); # redo to set a few variables over

    } elsif ($file =~ m/\.taz$/) {
        $cfg::type = "tar";
        $cfg::compress = "compress";
        &log("| Auto-set to type=$cfg::type compress=$cfg::compress");
        &optioncheck(); # redo to set a few variables over

    } elsif ($file =~ m/\.rpm$/) {
        $cfg::type = "cpio";
        $cfg::compress = "false";
        &log("| Auto-set to type=$cfg::type compress=$cfg::compress");

    }

    return($file);

}

######################################################################
# Check validity of a config option
######################################################################
sub check {

    my $ref = shift(@_);
    my $varname = shift(@_);
    my $ok = shift(@_);         # list of ok values, or empty for t/f, or "exists"
    my @ok;
    my $found = 0;
    my $realvarname;

    if (!defined($ok)) {
        @ok = ('true','false');
    } else {
        @ok = split(" ",$ok);
    }

    if (!defined($$ref)) {
        push(@main::errors,"\$$varname not defined");
    } else {
        if ($ok[0] ne "exist") {
            foreach (@ok) {
                if ($_ eq $$ref) {
                    $found = 1;
                }
            }
            if ($found == 0 ) {
                $_ = join(", ",@ok);
                push(@main::errors,"\$$varname must be one of $_");
            }
        }
    }

}

######################################################################
# Check to see if a program is found in $PATH
######################################################################
sub checkinpath {
    my ($file) = @_;
    my ($dir, @path);

    @path = split(/:/,$ENV{'PATH'});

    foreach $dir (@path) {
        if (-e "${dir}/$file" && -x _) {
            return "${dir}/$file";
        }
    }
    push(@main::errors,"$file not found in \$PATH");
    return(0);

}

######################################################################
# Run  a command, or echo it depending on the -n flag
# Then show tape drive position
######################################################################
sub run_or_echo_then_query {

    my $cmd = shift(@_);

    &split_and_echo($cmd);
    &line();

    if (!defined($main::opt{'n'})) {
        system("($cmd) 2>&1 | tee -a $main::log");
    } else {
        &log("(debug) command output would be here");
    }

    &line();
    &mt('generic-query');
    &line();

    # Maybe rewind (usually false for reads)
    if ($main::do_rewind_after == 1) {
        &log("| Rewinding...");
        &mt('rewind');
        &line();
    }


}

######################################################################
# Return a command possibly wrapped in ssh/rsh, or else just ()
######################################################################
sub maybe_remote_cmd {

    my $cmd = shift(@_);
    my $quote = shift(@_);

    if (!defined($quote)) {
        $quote = "'";
    }

    if ($main::remote) {
	$cmd  = "$cfg::remoteshell $main::remote " . $quote . $cmd . $quote;
    } else {
	$cmd  = "($cmd)";
    }
    return($cmd);

}

######################################################################
# Stuff to do before list/restore/extract/compare
# return command to get archive on stdout
######################################################################
sub setup_before_read {

    my $cmd;

    &line();

    $main::device = &maybe_get_filename();

    &mt("generic-blocksize $main::mt_blksize");

    # Maybe retension
    if ($main::do_reten == 1) {
        &log('| Retensioning tape...');
        &mt('retension');
    }

    if (defined($main::opt{'num'})) {
        &log("| Positioning tape at file number $main::opt{num}");
        &mt("rewind","fsf $main::opt{num}");
    } else {
        if ($main::use_file == 1) {
            &log("| Reading from on-disk file $main::device");
        } else {
            &log("| Reading from current tape position");
        }
    }

    &line();
    &mt('generic-query');
    &line();

    $cmd .= $main::read_cmd . $main::device . " | ";
    $cmd .= "$main::unz ";

    if ($main::device =~ m/\.rpm$/) {
        $cmd .= "rpm2cpio | ";
    }

    $cmd =~ s/\s+/ /g;

    return($cmd);

}


######################################################################
# Get rid of trailing slash on path or host:/path specs
######################################################################
sub nuke_trailing_slash {

    my $spec = shift(@_);
    my $host;
    my $path;

    if ($spec =~ m/(\S+:)(\S+)/) {
        $host = $1;
        $path = $2;
    } else {
        $host = '';
        $path = $spec;
    }

    if ($path ne "/") {
        $path =~ s%/$%%;
    }

    return($host . $path);

}

######################################################################
# Print the volume label from an afio control file
######################################################################
sub print_afio_volume_header {
    # for now just echo our stdin
    print "\n";
    while(<STDIN>) {
        print;
    }
}

######################################################################
# Figure out which of rewind/erase/reten we are going to assume
######################################################################
sub set_tape_operation_defaults {

    # Get backup level...
    if (defined($main::opt{'level'})) {
        $main::level = $main::opt{'level'};
    } else {
        $main::level = 0;
    }

    # Assume stuff based on how we are called first
    if (defined($main::opt{'fs'})) {
        if ($main::opt{'fs'} eq 'all') {
            if ($main::level == 0) {
                # All level zero - retension, and erase a new tape
                # (config file may tell us not to erase)
                if ($cfg::erase_tape_all_level_zero eq "true") {
                    $main::do_reten = 1;
                    $main::do_erase = 1;
                } else {
                    $main::do_reten = 0;
                    $main::do_erase = 0;
                }
                $main::do_rewind_after = 1;
            } else {
                # All incremental backup - go to end of tape
                $main::do_reten = 0;
                $main::do_erase = 0;
                $main::do_rewind_after = 1;
            }
        } else {
            # Just one filesystem - assume we append to tape
            $main::do_reten = 0;
            $main::do_erase = 0;
            $main::do_rewind_after = 1;
        } # all or one filesystem

    } else {

        # We're doing a read of some sort
        $main::do_reten = 0;
        $main::do_erase = 0; # -erase has no effect anyway here
        $main::do_rewind_after = 0;
    }

    # Then see if commandline flags override anything
    if (defined($main::opt{'reten'})) {
        $main::do_reten = $main::opt{'reten'};
    }
    if (defined($main::opt{'erase'})) {
        $main::do_erase = $main::opt{'erase'};
    }
    if (defined($main::opt{'rewind'})) {
        $main::do_rewind_after = $main::opt{'rewind'};
    }
}

######################################################################
# Split long lines for echoing
######################################################################
sub split_and_echo {

    my $string = shift(@_);
    my @chunks;
    my $line = "";
    my $linelimit = 76;

    # This looks convolved but it auto-wraps the
    # command lines down to a nice width for printing...

    @chunks = split(" ",$string);
    while (@chunks) {
        while ($_ = shift(@chunks)) {
            if (length($_) < $linelimit ) {
                # Item is less than $linelimit -
                # check to see if total line length is over, if so
                # save it for next line
                if ((length($line) + length($_)) > $linelimit) {
                    unshift(@chunks,$_);
                    last;
                }
            } else {
                # Single item longer than $linelimit -
                # wait till we have a blank line
                if ($line !~ /^ ?$/) {
                    unshift(@chunks,$_);
                    last;
                }
            }
            # Add this item to the line
            $line .= $_ . " ";
        }

        # Print backslash at end unless the last line
        if (@chunks) {
            $_ = '\\';
        } else {
            $_ = "";
        }

        # What a mess we went through above, just to print it...
        &log("| $line" . $_);

        # Indent next line(s) by one space
        $line = " ";
    }
}


######################################################################
# Create new tape "key" and return it
# Also sets main::nextfile
######################################################################
sub new_tape_key {

    my $key;
    my $dev = $main::device;
    my $old;
    my $string;

    return('') if $cfg::indexes eq "false";

    $key = &current_time("numeric");

    # If writing to a file see if there is already an index key and use it
    if (defined($main::use_file)) {
	$dev .= "/index-key";
	if (-r $dev) {
	    open(KEY,$dev) or die("Can't open existing key $dev: $OS_ERROR");
	    chomp($key = <KEY>);
	    close(KEY);

            &log("| Directory's existing key is $key");

            # Figure out the existing files
            foreach (sort keys %main::index) {
                my ($tape,$filenum) = split(/\|/,$_);
                if ($tape eq $key) {
                    $main::nextfile = $filenum;
                }
            }
            # Set for the next file
            $main::nextfile++;
            return($key);
	}
    }

    &log("| Creating index key $key");
    $string = "printf \'$key\\nThis is a flexbackup index key\\n\' | ";
    $string .=  "dd $main::dd_blk_flag $main::dd_pad_flag of=$dev";

    if (defined($main::opt{'n'})) {
        &log("| (debug) $string");
    } else {
        `$string 2> /dev/null`;
    }

    $main::nextfile = 1;

    if (defined($main::use_file)) {
        $_ = "<tape index key, dir=$cfg::device>";
    } else {
        $_ = "<tape index key>";
    }

    if (defined($main::opt{'n'})) {
        &log("| (debug) \$main::index{$key|0} = $_");
    } else {
        $main::index{"$key|0"} = $_;
    }

    return($key);
}

######################################################################
# Get existing index key
# Also sets main::nextfile
######################################################################
sub get_tape_key {

    my $quiet = shift(@_);
    my $key;
    my $dev = $main::device;
    my $string;

    return('') if $cfg::indexes eq "false";

    # If writing to a file see if there is already an index key and use it
    if (defined($main::use_file)) {
	$dev .= "/index-key";
	if (-r $dev) {
	    open(KEY,$dev) or die("Can't open existing key $dev: $OS_ERROR");
	    chomp($key = <KEY>);
	    close(KEY);
        } else {
            return(&new_tape_key());
        }

    } else {

        $string = "dd $main::dd_blk_flag $main::dd_pad_flag count=1 if=$main::device";
        if (defined($main::opt{'n'})) {
            &log("| (debug) $string");
            $key = '';
        } else {
            $key = `$string 2> /dev/null`;
            @_ = split(/\n/,$key);
            $key = $_[0];
        }
        if (defined($key)) {
            chomp($key);
            if ($key !~ m/^\d+\.\d\d$/) {
                if (!defined($quiet)) {
                    &log("| ERROR: This tape doesn't have an index! (use -erase?)");
                }
                $main::nextfile = 0;
                return('');
            }
        } else {
            if (!defined($quiet)) {
                &log("| ERROR: This tape doesn't have an index! (use -erase?)");
            }
            $main::nextfile = 0;
            return('');
        }
    }

    # Find the number of existing files
    $main::nextfile = 0;
    foreach (sort keys %main::index) {
        my ($tape,$filenum) = split(/\|/,$_);
        if ($tape eq $key) {
            if ($filenum > $main::nextfile) {
                $main::nextfile = $filenum;
            }
        }
    }
    # Set for the next file
    $main::nextfile++;
    &log("| Found index key $key, next file is $main::nextfile");

    return($key);

}

######################################################################
# Print table of contents
# Can give a specific key as argument
# Or uses command flag (specific key, current tape/dir, or "all")
# Alss handles deletion of tape index records
######################################################################
sub toc_routine {

    my $arg = shift(@_);
    my $key;
    my %keys;
    my $file;
    my $tape;
    my $filenum;
    return if $cfg::indexes eq "false";

    if (defined($arg)) {

        return if ($arg eq '');
        $keys{$arg} = 1;

    } elsif ($main::opt{'toc'} =~ m/^\d+\.\d\d$/) {

        if (!defined($main::opt{'delete'})) {

            &log("| Listing specific index");

            # Print toc for a specific tape
            $keys{"$main::opt{toc}"} = 1;

        } else {

            # This section deletes a whole index record, or maybe just
            # individual file records
            foreach (sort keys %main::index) {
                ($tape,$filenum) = split(/\|/,$_);
                if (defined($main::opt{'dfile'})) {
                    if (($tape eq $main::opt{'toc'})
                        and
                        ($filenum != 0)
                        and
                        ($filenum eq $main::opt{'dfile'})) {
                        &log("| Deleting record for tape $tape file $filenum");
                        if (defined($main::opt{'n'})) {
                            &log("| (debug) delete \$main::index{$tape|$filenum}");
                        } else {
                            delete $main::index{"$tape|$filenum"};
                        }
                    }
                } else {
                    if ($tape eq $main::opt{'toc'}) {
                        &log("| Deleting record for tape $tape file $filenum");
                        if (defined($main::opt{'n'})) {
                            &log("| (debug) delete \$main::index{$tape|$filenum}");
                        } else {
                            delete $main::index{"$tape|$filenum"};
                        }
                    }
                }

            }

            &line();
            return;

        }

        &line();

    } elsif ($main::opt{'toc'} eq '') {

        # Print toc for current tape/device
        &mt('rewind');
        $_ = &get_tape_key();
        &mt('rewind');
        if ($_ ne '') {
            $keys{$_} = 1;
        }
        &line();

    } elsif ($main::opt{'toc'} eq "all") {

        &log("| Listing all in database");

        # Print everything we know about
        foreach $file (sort keys %main::index) {
            ($tape,$filenum) = split(/\|/,$file);
            $keys{$tape} = 1;
        }
        &line();

    } else {
        die("Invalid key spec $main::opt{toc}");
    }


    # Print the toc of each tape in our list
    foreach $key (sort keys %keys) {

        my %contents;
        my @contents = ();
        my $found = 0;

        foreach $file (sort keys %main::index) {
            ($tape,$filenum) = split(/\|/,$file);
            if ($tape eq $key) {
                $filenum = sprintf("%-04d",$filenum);
                push(@contents,$filenum);
                $contents{$filenum} = $main::index{$file};
                $found = 1;
            }
        }

        &log('');
        if ($found == 0) {
            &log("Key $key not found in index");
        } else {
            &log("File  Contents    (tape index $key)");
            &log("-----------------------------------------------");
            foreach (sort bynumber @contents) {
                &log($_ . $contents{$_});
            }
        }
        &log('');
    }

}

######################################################################
# Remove index records for a tape we are about to erase
######################################################################
sub maybe_delete_old_index {

    my $key;
    my $tape;
    my $filenum;

    return if $cfg::indexes eq "false";

    return if defined($main::use_file);

    $key = &get_tape_key('quiet');
    if ($key ne '') {
        foreach (sort keys %main::index) {
            ($tape,$filenum) = split(/\|/,$_);
            if ($tape eq $key) {
                &log("| Deleting record for file $filenum");
                if (defined($main::opt{'n'})) {
                    &log("| (debug) delete \$main::index{$tape|$filenum}");
                } else {
                    delete $main::index{"$tape|$filenum"};
                }
            }
        }

    }

}

######################################################################
# Sort by number
######################################################################
sub bynumber {
    $a <=> $b;
}
