/usr/bin/flexbackup

#!/usr/bin/perl -w
######################################################################
#
# Edwin Huffstutler, <edwinh@computer.org>
# $Id: flexbackup,v 1.185 2003/10/10 14:12:09 edwinh Exp $
# $Name: v1_2_1 $
#
#   >>>> Also see the config file, README, manpages, & FAQ <<<<
#
# USAGE:
#  flexbackup -help                : this message
#
# BACKUP:
#  flexbackup -dir <dir>           : backup directory tree, level 0
#  flexbackup -set <tag>           : backup set "tag" (def. in config file), level 0
#  flexbackup -set all             : backup all sets, level 0
#  flexbackup [...] -level <n>     : backup level, can be integer or
#                                    full/differential/incremental
#  flexbackup [...] -pkgdelta <x>  : prune backup to files not part of a package
#                                    or changed from distributed version
#                                    <x> can be "rpm" or "freebsd" package systems
#  flexbackup [...] -wday <n>      : backup only if the week day matches
#                                    the input number.  Sunday is 0 or 7.
#  flexbackup [...] -pipe          : write to stdout rather than file/device
#  flexbackup [...] -ignore-errors : continue backups even if commands return error
#                                    status
# READING ARCHIVES:
#  flexbackup -list                : list files in archive
#  flexbackup -extract             : extract all files from archive into your
#                                    current working directory
#  flexbackup -extract -flist <f>  : restore the files listed in text file <f>
#                                    into your current working directory
#  flexbackup -extract -onefile <f>: restore the single file specified by <f>
#                                    into your current working directory
#  flexbackup -compare             : compare archive with the files in your
#                                    current directory
#  flexbackup -restore             : interactive restore (dump type only for now)
#  flexbackup [...] -num <n>       : read file number n from tape; if not given
#                                    uses current tape position
#  flexbackup [...] <file>         : if archiving to files rather than a device,
#                                    list/extract/compare/restore options take
#  flexbackup [...] -pipe          : read archive from stdin
#  flexbackup [...] -volumes <n>   : # of volumes in input
#                                    (EXPERIMENTAL mbuffer multivolume support)
# INDEX RELATED:
#  flexbackup -toc                 : list current device's table of contents
#  flexbackup -toc all             : list all known table of contents
#  flexbackup -toc <key>           : list table of contents for specific key
#  flexbackup -rmindex all         : force db delete of all index info
#  flexbackup -rmindex <key>       : force db delete of specified tape/dir index
#  flexbackup -rmindex <key>:<x>   : force db delete of specified tape:file
#
# TESTING/DEBUG:
#  flexbackup -test-tape-drive     : tries writing/reading files to make sure you
#                                    have tape driver & parameters set up right
#  flexbackup [...] -n             : don't run actual dump or mt commands, just echo
#  flexbackup [...] -type filelist : special backup type that just saves list of
#                                    files that would have been archived
# MISC:
#  flexbackup -newtape             : erase & create new index key (but no backup)
#  flexbackup -rmfile <file>       : if backups to disk, rm file & index info
#  flexbackup -rmfile all          : if backups to disk, rm all files/index for dir
#  flexbackup [...] -c <file>      : use <file> instead of /etc/flexbackup.conf
#                                    for configuration
#  flexbackup [...] -type <x>      : override $type from config file
#  flexbackup [...] -compress <x>  : override $compress from config file
#  flexbackup [...] -device <dev>  : override $device from config file
#  flexbackup [...] -d 'var=val'   : override config file setting of $var
#  flexbackup -dir <x> -erase      : force a rewind/erase before backup
#  flexbackup -dir <x> -norewind   : don't rewind tape after a single backup
#  flexbackup -set <x> -noreten    : don't retension for level 0 set backups
#  flexbackup -set <x> -noerase    : don't rewind/erase for level 0 set backups
#  flexbackup [...] -reten         : force a retension before read
#  flexbackup [...] -nodefaults    : don't use any default values for config variables
#  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 Text::Wrap;
use File::Basename;
use English;
use strict;

# No output buffering
$OUTPUT_AUTOFLUSH = 1;

# Set the traditional UNIX system locale behavior (touch doesn't read LANG)
my $loc = POSIX::setlocale( &POSIX::LC_ALL, "C" );

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

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

# This took awhile to figure out.  if the shell is capable of it, we use
# this on the end of any pipelines to see if any of the commands in the
# pipeline failed, rather than just the last one.
#
# If /bin/sh is really bash2 in disguise, or remote shell is bash2/zsh,
# we can use their status array variables
#
# With plain sh, we don't know if the non-last command in the pipe fails
# See exit-status collecting trick in the code.
#
# With tcsh/csh as a remote shell, you don't know which command, but
# $? is still set if anything in the pipeline failed
#
$::bash_pipe_exit = '; x=(${PIPESTATUS[@]}); i=0; while [ $i -lt ${#x[@]} ]; do [ ${x[$i]} -eq 0 ] || exit ${x[$i]}; i=$(($i+1)); done';
$::zsh_pipe_exit = '; x=(${pipestatus[@]}); i=1; while [ $i -le ${#x[@]} ]; do [ ${x[$i]} -eq 0 ] || exit ${x[$i]}; i=$(($i+1)); done';

# tar has a limit of this many chars in its volume label
$::tar_max_label = 99;

# Get commandline flags
%::opt = ();
if (! &::GetOptions(\%::opt,
			"c=s",
			"compare:s",
			"compress=s",
			"d=s%",
			"dir=s",
			"pipe",
			"pkgdelta=s",
			"device=s",
			"differential",
			"erase!",
			"extract:s",
			"flist=s",
			"full",
			"help",
			"incremental",
			"ignore-errors",
			"level=s",
			"list:s",
			"onefile=s",
			"n",
			"newtape",
			"nodefaults",
			"num:i",
			"restore:s",
			"reten!",
			"rewind!",
			"rmfile:s@",
			"rmindex:s@",
			"set=s",
			"test-tape-drive",
			"toc:s",
			"type=s",
			"version",
			"volumes:i",
			"wday=i"
			)) {
    exit(0);
}

# Default fd for messages (we might have stdout as archive output)
if (defined($::opt{'pipe'})) {
    $::msg = *STDERR;
} else {
    $::msg = *STDOUT;
}

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

# Version
if (defined($::opt{'version'})) {
    print $::msg "flexbackup version " . &versionstring() . "\n";
    print $::msg '$Id: flexbackup,v 1.185 2003/10/10 14:12:09 edwinh Exp $ ' . "\n";
    exit(0);
}

# Exit if -wday given and it isn't that day of the week (see FAQ)
&check_wday();

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

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

# Sanity check commandline flags and config file options
&optioncheck();
&line('screen');

# Check shells, buffer is runnable, remote progs...
&test_before_run();

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

# Get current date string
$::date = &current_time('numeric');

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

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

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

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

} elsif (defined($::opt{'dir'}) or defined($::opt{'set'})) {
    &backup_routine();

} elsif (defined($::opt{'toc'})) {
    &line();
    # Only do this if we're going to grab current tape index
    if ($::opt{'toc'} eq '') {
	&mt("generic-blocksize $::mt_blksize");
    }
    &toc_routine();

} elsif (defined($::opt{'rmindex'})) {
    &line();
    foreach my $arg (@{$::opt{'rmindex'}}) {
	&rmindex($arg);
    }

} elsif (defined($::opt{'newtape'})) {
    &line();
    &mt("generic-blocksize $::mt_blksize");
    &newtape();

} elsif (defined($::opt{'rmfile'})) {
    &line();
    &rmfile();

} elsif (defined($::opt{'test-tape-drive'})) {
    &line();
    &test_tape_drive();

}

if (($::mode !~ m/^(list|extract|restore|compare|test-tape-drive)$/) and
    ($cfg::indexes eq "true")) {
    untie(%::index);
}

system ('rm', '-rf', $cfg::tmpdir);
exit(0);

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

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

    # Figure out log file name & empty log file
    if (defined($::opt{'set'})) {
	$label = &get_label($::opt{'set'});
    } else {
	$label = &get_label($::opt{'dir'});
    }

    if ($cfg::staticlogs eq 'false' ) {
	$logsuffix = ".$::date";
    }

    if (!defined($::set_incremental)) {
	$logfile = "$cfg::prefix$label.$::level" . $logsuffix;
    } else {
	$logfile = "$cfg::prefix$label.incremental" . $logsuffix;
    }

    $symlink = "$cfg::prefix$label.latest";
    $::log = "$cfg::logdir/$logfile";
    if (! open(LOG,">$::log")) {
	die "Can't write to $::log: $OS_ERROR";
    }
    close(LOG);

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


    # Remember old log files (will remove at end of job)
    # ("old" = any higher- or equal-numbered logs for this label)
    if (!defined($::set_incremental)) {
	opendir(DIR,"$cfg::logdir") or die("Can't open cfg::logdir: $OS_ERROR");
	@files = readdir(DIR);
	foreach my $lf (reverse sort @files) {

	    # Skip our own log
	    next if ($lf =~ m/^$logfile(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/);

	    # Find normal old logs
	    if ($lf =~ m/^$cfg::prefix$label\.(\d+)(\.(\d+))?(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/) {
		if ($1 >= $::level) {
		    # Might be from $staticlogs=true or false
		    if (defined($3)) {
			$oldlogs{"$cfg::logdir/$lf"} = $1 . "|" . $3;
		    } else {
			$oldlogs{"$cfg::logdir/$lf"} = $1;
		    }
		}
	    }

	    # If this is a level 0, we can nuke incremental logs
	    if (($::level == 0) and ($lf =~ m/^$cfg::prefix$label\.(incremental)(\.(\d+))?(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/)) {
		# Might be from $staticlogs=true or false
		if (defined($3)) {
		    $oldlogs{"$cfg::logdir/$lf"} = $1 . "|" . $3;
		} else {
		    $oldlogs{"$cfg::logdir/$lf"} = $1;
		}
	    }
	}
	close(DIR);
    }


    # Possibly populate package-file hashes if we are using
    # -pkgdelta.  This is so we only have to run through these operations
    # once per machine if multiple fs's are being run
    if (defined($::pkgdelta)) {
	if (defined($::local)) {
	    &list_packages('localhost');
	    &find_packaged_files('localhost');
	    &find_changed_files('localhost');
	}
	foreach my $host (keys %::remotehosts) {
	    &list_packages($host);
	    &find_packaged_files($host);
	    &find_changed_files($host);
	}
	$::pkgdelta_filelist = "$cfg::tmpdir/pkgdelta.$PROCESS_ID";
	&line();
    }

    ##########################
    #
    # Main backup routine
    #
    ##########################
    if (defined($::opt{'set'})) {

	if (!defined($::set_incremental)) {
	    &log("| Doing level $::level backup of set $::opt{set} using $cfg::type");
	} else {
	    &log("| Doing incremental backup of $::opt{set} using $cfg::type");
	}

	# All sets or just one?
	my @do_sets;
	if ($::opt{'set'} eq 'all') {
	    @do_sets = keys(%cfg::set);
	    if (defined($::tapedevice)) {
		$_ = scalar(@do_sets);
		$_ = join(" ", @do_sets) . " ($_ tapes)";
	    } else {
		$_ = join(" ", @do_sets);
	    }
	    &log("| All sets = $_");
	} else {
	    @do_sets = ($::opt{'set'});
	}

	my $num_tapes = scalar(@do_sets) - 1;
	foreach my $this_set (@do_sets) {

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

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

	    # Print what this set contains
	    &log("| Backup set \"$this_set\" ($cfg::set{$this_set})");

	    # Show tape position
	    if (defined($::tapedevice)) {
		# Multiple tapes are only for level 0
		if (!defined($::set_incremental) and ($::level == 0)) {
		    &log("| Tape \#$tapecounter");
		}
		&line();
		&mt('generic-query');
	    }

	    # Iterate over the filesystems in the set and back 'em up
	    foreach my $dir (&split_list($cfg::set{$this_set})) {

		my $level;

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

		# If level is icremental for the set, each dir might
		# have a different numeric level
		if (!defined($::set_incremental)) {
		    $level = $::level;
		} else {
		    $level = &get_incremental_level($dir);
		}

		$error = &backup($dir, $tape_key, $level);
		last if ($error != 0);

		if ($cfg::indexes eq "true") {
		    $::nextfile++;
		}
	    }

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

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

		    if (defined($::tapedevice)) {
			&toc_routine($tape_key);
		    }

		    $tapecounter++;
		    if (defined($::tapedevice)) {
			print $::msg "\n";
			while(1) {
			    print $::msg "---> Insert tape \#$tapecounter (enter y to continue) ";
			    chomp($_ = <STDIN>);
			    last if ($_ =~ m/^y/i);
			}
			print $::msg "\n";
			&line();
		    }

		} # end not at last tape
	    } # end if level == 0

	}  # end foreach set

    } else {

	# Just one filesystem, -dir given
	&log("| Doing level $::level backup of $::opt{dir} using $cfg::type");

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

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

	if (defined($::tapedevice)) {
	    &line();
	    &mt('generic-query');
	}

	$error = &backup($::opt{'dir'}, $tape_key, $::level);

    } # end set or single fs

    if (defined($::tapedevice)) {
	&line();
    }

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

    # Remove old log files now that we are done
    if ($error == 0) {
	my $rmlogs = 0;
	foreach my $lf (sort keys %oldlogs) {
	    $rmlogs++;
	    my ($lev,$d) = split(/\|/,$oldlogs{$lf});
	    if (defined($d)) {
		&log("| Removing old level $lev log of $label (dated $d)");
	    } else{
		&log("| Removing old level $lev log of $label");
	    }
	    if (!defined($::debug)) {
		unlink("$lf") or warn("Can't remove $lf: $OS_ERROR\n");
	    }
	}
	&line('log') if ($rmlogs > 0);
    }

    # Compress log file
    if ($cfg::comp_log ne 'false') {
	if ($cfg::comp_log eq "gzip") {
	    $logext = ".gz";
	    $comp_cmd = "$::path{gzip} -f \"$::log\"";
	} elsif ($cfg::comp_log eq "bzip2") {
	    $logext = ".bz2";
	    $comp_cmd = "$::path{bzip2} -f \"$::log\"";
	} elsif ($cfg::comp_log eq "lzop") {
	    $logext = ".lzo";
	    $comp_cmd = "$::path{lzop} -U -f \"$::log\"";
	} elsif ($cfg::comp_log eq "zip") {
	    $logext = ".zip";
	    $comp_cmd = "$::path{cat} \"$::log\" | $::path{zip} -q - - > \"$::log" . $logext . "\"; $::path{rm} -f \"$::log\"";
	} elsif ($cfg::comp_log eq "compress") {
	    $logext = ".Z";
	    $comp_cmd = "$::path{compress} -f \"$::log\"";
	}
	undef $::log;
	&log("| Compressing log ($logfile" . "$logext)", 'screen');
	system("$comp_cmd");
	if ($CHILD_ERROR) {
	    warn("Error compressing log file\n");
	}
    }

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

    &line('screen');

    if ($error == 0) {
	&toc_routine($tape_key);
    }

    exit($error);

}

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

    my $dir = shift(@_);
    my $tape_key = shift(@_);
    my $level = shift(@_);
    my $title;
    my $title_without_type;
    my @cmds;
    my @echo_cmds;
    my $cmd;
    my $localdir = $dir;
    my $label = &get_label($dir);
    my $host;
    my @files;
    my %oldstamps;
    my $remote;
    my $tapehost;
    my $indexkey;
    my $catchexit;
    my $exitscript = "$cfg::tmpdir/collectexit.$PROCESS_ID.sh";
    my $result = "$cfg::tmpdir/exitstatus.$PROCESS_ID";
    my $pkglist;
    my $error = 0;

    &line();


    if ($localdir =~ s/^(.+)://) {
	$remote = $1;
	chomp($tapehost = `hostname`);
	if (($tapehost eq $remote)
	    or
	    ($remote =~ /^localhost/)) {
	    die("Remote host and this host are the same! No scooby snack for you!");
	}

    } else {
	undef $remote;
    }

    # Remember old stamp files (will remove at end of job)
    # "old" = any higher-numbered stamps for this label
    # (we will be touching the one of equal level, so don't mark for removal)
    opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR");
    @files = readdir(DIR);
    foreach my $f (reverse sort @files) {
	next if ($f !~ m/^$cfg::sprefix$label\.(\d+)$/);
	if ($1 > $level) {
	    $oldstamps{"$cfg::stampdir/$f"} = $1
	}
    }
    close(DIR);

    # Create file name if writing to a file
    # (config file's $device points to a dir in this case)
    if (defined($::use_file)) {

	my $filename = $level;

	if (defined($::pkgdelta)) {
	    $filename .= $::pkgdelta;
	}

	if ($cfg::staticfiles eq 'true') {
	    $filename .= "." . $cfg::type;
	} else {
	    $filename .= "." . $::date . "." . $cfg::type;
	}

	# Some types need the filename modified
	if ($cfg::type eq 'ar') {
	    $filename =~ s/ar$/a/;
	} elsif ($cfg::type eq 'copy') {
	    $filename =~ s/\.copy$//;
	} elsif ($cfg::type eq 'rsync') {
	    $filename =~ s/\.rsync$//;
	}

	# Note compression setting in filename
	if ($cfg::type =~ m/^(tar|dump|cpio|star|pax|ar|shar|filelist)$/) {
	    if ($cfg::compress eq "gzip") {
		$filename .= ".gz";
	    } elsif ($cfg::compress eq "bzip2") {
		$filename .= ".bz2";
	    } elsif ($cfg::compress eq "lzop") {
		$filename .= ".lzo";
	    } elsif ($cfg::compress eq "zip") {
		$filename .= ".zip";
	    } elsif ($cfg::compress eq "compress") {
		$filename .= ".Z";
	    } elsif ($cfg::compress eq "lzma") {
		$filename .= ".lzma";
	    }
	} 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") {
		$filename .= "-gz";
	    } elsif ($cfg::compress eq "bzip2") {
		$filename .= "-bz2";
	    } elsif ($cfg::compress eq "lzop") {
		$filename .= "-lzo";
	    } elsif ($cfg::compress eq "zip") {
		$filename .= "-zip";
	    } elsif ($cfg::compress eq "compress") {
		$filename .= "-Z";
	    } elsif ($cfg::compress eq "lzma") {
		$filename .= "-lzma";
	    }
	}

	# Overwrite device var to be the archive filename
	$::device = $cfg::device . "/" . $label . "." . $filename;

    }

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

    # Label for this archive
    chomp($host = `hostname`);
    $title = $cfg::type . "+" . $cfg::compress;
    $title =~ s/\+false//;
    if (!defined($::pkgdelta)) {
	$title = "level $level $dir $::date_at_start $title from $host";
	$title_without_type = "level $level $dir $::date_at_start from $host";
    } else {
	$pkglist = "flexbackup.$::pkgdelta.packagelist";
	$title = "level $level+$::pkgdelta $dir $::date_at_start $title from $host";
	$title_without_type = "level $level+$::pkgdelta $dir $::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($::use_file)) {
	    @_ = split(/\//,$::device);
	    $_ = pop(@_);
	    $indexkey = "$tape_key|$_";
	    if (defined($::debug)) {
		&log("(debug) \$::index{$indexkey} = $title_without_type");
	    } else {
		$::index{$indexkey} = "$title_without_type";
	    }
	} elsif (defined($::use_blockdevice)) {
	    # no indexes anyway
	} else {
	    $indexkey = "$tape_key|$::nextfile";
	    if (defined($::debug)) {
		&log("(debug) \$::index{$indexkey} = $title");
	    } else {
		$::index{$indexkey} = $title;
	    }
	    &log("| File number $::nextfile, tape index $tape_key");
	}
    }

    # Write list of packages
    if (defined($::pkgdelta) and
	(
	 ($cfg::pkgdelta_archive_list eq 'true') or
	 (($cfg::pkgdelta_archive_list eq 'rootonly') and ($localdir eq '/'))
	 )
	) {
	$pkglist = "$localdir/$pkglist";
	my $write = "> $pkglist";
	my $h;

	if(defined($remote)) {
	    $write = &maybe_remote_cmd("$::path{cat} $write", $remote);
	    $write = "| $write";
	    $h = $remote;
	} else {
	    $h = 'localhost';
	}
	if (!defined($::debug)) {
	    open(LIST,"$write") || die;
	    foreach my $pkg (sort keys %{$::package_list{$h}}) {
		print LIST "$pkg\n";
	    }
	    close(LIST);
	}
    }

    &log("| Backup of: $dir");
    my $remove = '';
    if ($cfg::type eq 'dump') {
	($remove, @cmds) = &backup_dump($label, $localdir, $level, $remote);
    } elsif ($cfg::type eq 'afio') {
	($remove, @cmds) = &backup_afio($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'cpio') {
	($remove, @cmds) = &backup_cpio($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'tar') {
	($remove, @cmds) = &backup_tar($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'star') {
	($remove, @cmds) = &backup_star($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'pax') {
	($remove, @cmds) = &backup_pax($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'zip') {
	($remove, @cmds) = &backup_zip($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'ar') {
	($remove, @cmds) = &backup_ar($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'shar') {
	($remove, @cmds) = &backup_shar($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'lha') {
	($remove, @cmds) = &backup_lha($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'copy') {
	($remove, @cmds) = &backup_copy_cpio($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'rsync') {
	($remove, @cmds) = &backup_copy_rsync($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'filelist') {
	($remove, @cmds) = &backup_filelist($label, $localdir, $title, $level, $remote);
    }

	if(defined($remote)) {
		# create our temporary directory as first remote command
		unshift(@cmds, &maybe_remote_cmd("$::path{mkdir} -p $cfg::tmpdir", $remote));
	}

    # Nuke any tmp files used in the above routines
    if ($remove ne '') {
	push(@cmds, &maybe_remote_cmd("$::path{rm} -f $remove", $remote));
    }

    # Create/nuke tmp file list if we did local package delta
    if (defined($::pkgdelta)) {
	if (
	    ($cfg::pkgdelta_archive_list eq 'true') or
	    (($cfg::pkgdelta_archive_list eq 'rootonly') and ($localdir eq '/'))
	    ) {
	    push(@cmds, &maybe_remote_cmd("$::path{rm} -f $::pkgdelta_filelist $pkglist", $remote));
	} else {
	    push(@cmds, &maybe_remote_cmd("$::path{rm} -f $pkglist", $remote));
	}
    }
	
	if(defined($remote)) {
		# remove temporary directory as our last remote command
		push(@cmds, &maybe_remote_cmd("$::path{rm} -rf $cfg::tmpdir", $remote));
	}

    # Strip multiple spaces
    foreach my $cmd (@cmds) {
	$cmd =~ s/\s+/ /g;
    }

   # Use pipeline exitcode hook if /bin/sh can't report pipeline status
    if ($::shelltype{'localhost'} =~ m/^(unknown|bash1|ksh)$/) {

	$catchexit = 1;

	unlink($result);
	open(SCR, "> $exitscript") || die;
	print SCR '#!/bin/sh' . "\n";
	print SCR '"$@"' . "\n";;
	print SCR '[ $? = 0 ] || echo $@ >> ' . $result . "\n";
	close(SCR);
	chmod(0755, $exitscript);

	push(@cmds, "[ ! -e $result ]");
    }

    # Replace piped commands with exit status collector if we need to
    foreach my $cmd (@cmds) {

	if (defined($catchexit)) {

	    # Save ssh commands temporarily so we don't replace pipes inside them
	    my $saveremote;
	    if ($cmd =~ s/($cfg::remoteshell .* \'.*\')/XXXflexbackupXXX/) {
		$saveremote = $1;
	    }

	    # Replace piped or anded commands with catch-script
	    #   -Not if the command started a subshell ( .. )
	    if ($cmd =~ s:\s+(\||&&)\s+([^\(]): $1 $exitscript $2:g) {

		# You would think we'd put it on the front of the pipe as
		# well.  Can't do this globally because the "cd <dir> &&"
		# at the front makes the cd happen in a subshell. If
		# its not "cd <something>, do it.
		if ($cmd !~ m:^\s*cd\s+\"[^\"]+\"\s*(;|&&):) {
		    $cmd = "$exitscript $cmd";
		}

		# Take care of subshell
		$cmd =~ s:\s+(\||&&)\s+(\()\s*: $1 \( $exitscript :g;

	    }

	    # Put any ssh stuff back
	    $cmd =~ s:XXXflexbackupXXX:$saveremote:;
	}
    }

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

    # Enough fooling around... run it.
    if (!defined($::debug)) {
	foreach $cmd (@cmds) {

	    if (defined($::use_pipe)) {
		system("$cmd");
	    } else {
		if ($::shelltype{'localhost'} eq 'bash2') {
		    # /bin/sh is really bash2 on this system
		    open(CMD,"($cmd " . $::bash_pipe_exit . ") 2>&1 |") || die;
		} elsif ($::shelltype{'localhost'} eq 'zsh') {
		    # Does anybody make /bin/sh be zsh? probably not...
		    open(CMD,"($cmd " . $::zsh_pipe_exit . ") 2>&1 |") || die;
		} else {
		    open(CMD,"($cmd) 2>&1 |") || die;
		}
		open(LOG,">>$::log") || die;
		while(<CMD>) {
		    print $::msg $_;
		    print LOG $_;
		}
		close(LOG);
		close(CMD);
	    }

	    if ($CHILD_ERROR) {
		&log('');

		# If using exit trick, cat the result file; otherwise use normal output
		if (defined($catchexit)) {
		    my $out = `cat $result`;
		    &log("ERROR: non-zero exit from:\n$out");
		} else {
		    &log("ERROR: non-zero exit from:\n$cmd");
		}

		if (defined($::opt{'ignore-errors'})) {

		    $error = 0;
		    &log('');
		    &log("ERROR: will continue anyway");

		} else {

		    $error++;
		    &log('');
		    &log("ERROR: exiting");

		    # Put ERROR in the index if tapedevice, or nuke index if file
		    if (defined($indexkey)) {
			if (defined($::use_file)) {
			    delete $::index{$indexkey};
			} elsif (defined($::use_blockdevice)) {
			    # no indexes anyway
			} else {
			    $::index{$indexkey} .= "\n\t---> ERROR during write, above may not be valid";
			}
		    }

		    # If file, rm botched file regardless of index
		    if (defined($::use_file)) {
			if ($cfg::type =~ m/^(copy|rsync)$/) {
			    system("rm -rf $::device");
			} else {
			    unlink($::device);
			}
		    }

		} # ignore error defined

	    } # CHILD_ERROR

	} # foreach cmd

    } else {
	&log("(debug) command output would be here");
    }
    &line();

    # Actually remove the old stamp files now that we are done
    if ($error == 0) {
	foreach my $ts (sort keys %oldstamps) {
	    print $::msg "| Removing out of date level $oldstamps{$ts} timestamp for $dir\n";
	    if (!defined($::debug)) {
		unlink("$ts") or warn("Can't remove $ts: $OS_ERROR\n");
	    }
	}
    }

    # Create timestamp file, but use date from before the backup started
    # so next time we will catch files that might have been touched during the run
    my $t = &current_time('ctime');
    &log("| Backup start: $::date_at_start");
    &log("| Backup end:   $t");
    if (($error == 0) and !defined($::debug)) {
	system("$::path{touch} -t \"$::stamp_at_start\" \"$cfg::stampdir/$cfg::sprefix$label.$level\"");
    }

    &line();

    # Got errors unless I paused before trying to access the tape right way...
    if ((!defined($::debug)) and defined($::tapedevice)) {
	sleep 10;
    }

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

    if (defined($catchexit)) {
	unlink($result);
	unlink($exitscript);
    }

    return($error);
}

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

    my $label = shift(@_);
    my $dir = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $date_flag;
    my $remove = '';

    # Need this check here in case fs=all, level=incremental, and we go beyond 9
    if ($level > 9) {
	die("Can't use level > 9 and type=dump");
    }

    # Warnings about stuff dump can't do
    if (defined($cfg::exclude_expr[0])) {
	&log("| NOTE: \$exclude_expr is ignored for type=dump");
    }

    my $prunekey;
    if (defined($remote)) {
	$prunekey = "$remote:$dir";
    } else {
	$prunekey = $dir;
    }
    if (defined(%{$::prune{$prunekey}})) {
	&log("| NOTE: \$prune is ignored for type=dump");
    }

    if ($cfg::traverse_fs ne 'false') {
	&log("| NOTE: \$traverse_fs is always false for type=dump");
    }

    if (defined($::pkgdelta)) {
	&log("| NOTE: packaging system delta ignored for for type=dump");
    }

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

    $cmd = '';
    $cmd .= "$::path{dump} -$level ";
    $cmd .= "$::dump_blk_flag ";
    if ($cfg::dump_use_dumpdates eq "true") {
	$cmd .= "-u ";
    } else {
	$cmd .= $date_flag;
    }
    $cmd .= "$::dump_len_flag ";
    $cmd .= "-f - ";
    $cmd .= "$dir $::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    return($remove, @cmds);


}

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

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

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    # list of file exenstions to not compress
    if (($cfg::compress !~ /^(false|hardware)$/) and ($cfg::afio_nocompress_types ne "")) {
	$cmd = "$::path{printf} \"$cfg::afio_nocompress_types\" > $tmpnocompress";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$no_compress = "-E +$tmpnocompress";
	$remove .= " $tmpnocompress";
    }

    if ($cfg::label ne 'false') {
	$cmd = "$::path{printf} \"Volume Label:\\n$title\\n\\n\" > $tmplabel";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $tmplabel";
    }

    $cmd = "cd \"$dir\" && ";
    if ($cfg::label ne 'false') {
	$cmd .= "($::path{printf} \"//--$tmplabel flexbackup.volume_header_info\\n\" && ";
    }
    $cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote);
    if ($cfg::label ne 'false') {
	$cmd .= ")";
    }
    $cmd .= " | ";

    $cmd .= "$::path{afio} -o ";
    $cmd .= "$no_compress ";
    $cmd .= "-z ";
    $cmd .= "-1 mc ";
    $cmd .= "$::afio_z_flag ";
    $cmd .= "$::afio_verb_flag ";
    $cmd .= "$::afio_sparse_flag ";
    $cmd .= "$::afio_atime_flag ";
    $cmd .= "$::afio_bnum_flag ";
    $cmd .= "$::afio_blk_flag ";
    $cmd .= "-";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    return($remove, @cmds);

}

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

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    if ($cfg::label ne 'false') {
	# 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;
	$cmd = "$::path{touch} \"$dir/$title\"";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " \"$dir/$title\"";
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote);
    $cmd .= "| ";

    $cmd .= "$::path{cpio} -o ";
    $cmd .= "-0 ";
    $cmd .= "-H $cfg::cpio_format ";
    $cmd .= "$::cpio_verb_flag ";
    $cmd .= "$::cpio_blk_flag ";
    $cmd .= "$::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    return($remove, @cmds);

}

######################################################################
# Return command to copy directory tree
######################################################################
sub backup_copy_cpio {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote);
    $cmd .= "| ";

    $cmd .= "$::path{cpio} -o ";
    $cmd .= "-0 ";
    $cmd .= "-H $cfg::cpio_format ";
    $cmd .= "$::cpio_verb_flag ";
    $cmd .= "$::cpio_blk_flag ";

    # Buffer both sides / compress if remote
    if (defined($remote)) {
	$cmd .= "$::z";
	$cmd .= $::buffer_cmd;
    }

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

    # Yell if destination exists
    if (-d "$::device") {
	&log("| Existing destination directory $::device found!");
	&log("| It will be *deleted*, unless you hit CTRL-C");
	&log("| and abort within 10 seconds...");
	&line();
	sleep(10);
	system("rm -rf $::device");
    }

    # Expand cpio archive on other side of pipe
    $cmd .= " | ";
    if (defined($remote)) {
	$cmd .= "$::unz";
    }
    $cmd .= "(";
    $cmd .= "mkdir -p $::device ; ";
    $cmd .= "cd $::device ; ";
    $cmd .= "$::path{cpio} -i ";
    $cmd .= "-m ";
    $cmd .= "-d ";
    $cmd .= "$::cpio_blk_flag";
    $cmd .= ")";

    push(@cmds, $cmd);

    return($remove, @cmds);

}

######################################################################
# Return command to copy directory tree via rsync
######################################################################
sub backup_copy_rsync {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $remove = '';

    if ($cfg::buffer ne 'false') {
	&log("| NOTE: \$buffer is ignored for type=rsync");
    }

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote);

    # Just the find may run on the remote - rsync call will always be local
    $cmd = &maybe_remote_cmd($cmd, $remote);

    # Have to take leading './' off to make rsync's include/exclude work right
    $cmd .= " | $::path{sed} -e \"s/\\.\\///g\" | ";

    $cmd .= "$::path{rsync} ";
    $cmd .= "--include-from=- --exclude=* ";
    $cmd .= "--archive ";
    $cmd .= "$::rsync_verb_flag ";
    $cmd .= "--delete --delete-excluded ";
    if ($cfg::compress ne 'false') {
	$cmd .= "--compress ";
    }
    if (defined($remote)) {
	$cmd .= "--rsh=$::path{$cfg::remoteshell} ";
	if ($cfg::remoteuser ne '') {
	    $cmd .= "$cfg::remoteuser" . '@' . "$remote:";
	} else {
	    $cmd .= "$remote:";
	}
    }
    $cmd .= "$dir/ $::device";

    push(@cmds, $cmd);

    return($remove, @cmds);

}

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

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote);
    $cmd .= "| ";

    $cmd .= "$::path{tar} --create ";
    $cmd .= "--null ";
    $cmd .= "--files-from=- ";
    $cmd .= "--ignore-failed-read ";
    $cmd .= "--same-permissions ";
    $cmd .= "--no-recursion ";
    $cmd .= "--totals ";
    if ($cfg::label ne 'false') {
	if (length($title) > $::tar_max_label) {
	    &log("| NOTE: truncating tar label (> $::tar_max_label chars)");
	    $title = substr($title, 0, $::tar_max_label);
	}
	$cmd .= "--label \"$title\" ";
    }
    $cmd .= "$::tar_verb_flag ";
    $cmd .= "$::tar_sparse_flag ";
    $cmd .= "$::tar_atime_flag ";
    $cmd .= "$::tar_recnum_flag ";
    $cmd .= "$::tar_blk_flag ";
    $cmd .= "--file - ";
    $cmd .= "$::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    return($remove, @cmds);

}

######################################################################
# Return command to backup a directory using star
######################################################################
sub backup_star {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote);
    $cmd .= "| ";

    $cmd .= "$::path{star} -c ";
    $cmd .= "list=- ";
    $cmd .= "-p ";
    $cmd .= "-l ";
    $cmd .= "-D ";
    $cmd .= "-B ";
    $cmd .= "-dirmode ";
    if ($cfg::label ne 'false') {
	$cmd .= "VOLHDR=\"$title\" ";
    }
    $cmd .= "H=$cfg::star_format ";
    $cmd .= "$::star_fifo_flag ";
    $cmd .= "$::star_acl_flag ";
    $cmd .= "$::star_verb_flag ";
    $cmd .= "$::star_sparse_flag ";
    $cmd .= "$::star_atime_flag ";
    $cmd .= "$::star_blocknum_flag ";
    $cmd .= "$::star_blk_flag ";
    $cmd .= "file=- ";
    $cmd .= "$::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    return($remove, @cmds);

}

######################################################################
# Return command to backup a directory using pax
######################################################################
sub backup_pax {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    if ($cfg::label ne 'false') {
	# 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;
	$cmd = "$::path{touch} \"$dir/$title\"";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " \"$dir/$title\"";
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote);
    $cmd .= "| ";

    $cmd .= "$::path{pax} -w ";
    $cmd .= "-d ";
    $cmd .= "-s %^./%% ";
    $cmd .= "-x $cfg::pax_format ";
    $cmd .= "$::pax_verb_flag ";
    $cmd .= "$::pax_blk_flag ";
    $cmd .= "$::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    return($remove, @cmds);

}

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

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $tmpzip = "$cfg::tmpdir/archive.$PROCESS_ID.zip";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    if ($cfg::label ne 'false') {
	# 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;
	$cmd = "$::path{touch} \"$dir/$title\"";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " \"$dir/$title\"";
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote);
    $cmd .= "| ";

    $cmd .= "$::path{zip} -@ ";
    $cmd .= "-b $cfg::tmpdir "; # temp file path
    $cmd .= "-y "; # store symlinks
    $cmd .= "$::zip_compr_flag ";
    $cmd .= "$::zip_noz_flag "; # nocompress list
    $cmd .= "$::zip_verb_flag "; # verbose flag
    $cmd .= "$tmpzip";

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

    $cmd = "$::path{cat} $tmpzip ";
    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }
    $cmd = &maybe_remote_cmd($cmd, $remote);

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    $remove .= " $tmpzip";

    return($remove, @cmds);

}



######################################################################
# Return command to backup a directory using ar
######################################################################
sub backup_ar {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $filelist = "$cfg::tmpdir/arlist.$PROCESS_ID";
    my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID";
    my $remove = '';

    &log("| NOTE: ar archives will not descend directories");

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    if ($cfg::label ne 'false') {
	# 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 = "$::path{touch} \"$dir/$title\"";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " \"$dir/$title\"";
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote, '-maxdepth 1 ! -type d');
    $cmd .= "> $filelist; ";

    $cmd .= "$::path{ar} rc";
    $cmd .= "$::ar_verb_flag ";
    $cmd .= "$tmpfile ";
    $cmd .= "`$::path{cat} $filelist`";
    $cmd .= "; $::path{cat} $tmpfile $::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    $remove .= " $filelist $tmpfile";

    return($remove, @cmds);

}

######################################################################
# Return command to backup a directory using shar
######################################################################
sub backup_shar {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote, '! -type d');
    $cmd .= " | ";

    $cmd .= "$::path{shar} ";
    $cmd .= "$::shar_verb_flag ";
    if ($cfg::label ne 'false') {
	$cmd .= "-n \"$title\" ";
    }
    $cmd .= "-S ";
    $cmd .= "$::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    return($remove, @cmds);

}


######################################################################
# Return command to backup a directory using lha
######################################################################
sub backup_lha {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $filelist = "$cfg::tmpdir/lhalist.$PROCESS_ID";
    my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    if ($cfg::label ne 'false') {
	# 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 = "echo \"$title\" > \"$dir/$title\"";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " \"$dir/$title\"";
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote);
    $cmd .= "> $filelist; ";

    $cmd .= "$::path{lha} a";
    $cmd .= "$::lha_verb_flag ";
    $cmd .= "$tmpfile ";
    $cmd .= "`$::path{cat} $filelist`";
    $cmd .= "; $::path{cat} $tmpfile $::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    $remove .= " $filelist $tmpfile";

    return($remove, @cmds);

}

######################################################################
# Just back up the file listing (useful for debugging)
######################################################################
sub backup_filelist {

    my $label = shift(@_);
    my $dir = shift(@_);
    my $title = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $cmd = '';
    my @cmds;
    my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
    my $filelist = "$cfg::tmpdir/filelist.$PROCESS_ID";
    my $remove = '';

    if (defined($remote) and ($level != 0)) {
	my $time = &get_last_date($label, $level, 'numeric');
	$cmd = "$::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    if (defined $::use_pipe) {
	&log("| NOTE: Writing list of files that would have been backed up to stdout");
    } else {
	&log("| NOTE: Writing list of files that would have been backed up to current directory");
    }

    $cmd = "cd \"$dir\" && ";
    $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote);
    $cmd .= "> $filelist; $::path{cat} $filelist 1>&2; $::path{cat} $filelist ";
    $cmd .= "$::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $::buffer_cmd;
    }

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

    # Append writer stuff
    $cmd = &append_writer_cmd($cmd);

    push(@cmds, $cmd);

    $remove .= " $filelist";

    return($remove, @cmds);

}

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

    my $cmd = &setup_before_read('list');

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

    } elsif ($cfg::type eq 'afio') {
	$cmd .= "$::path{afio} -t ";
	$cmd .= "-z ";
	# Don't use label reader if reading from pipe (needs stdin)
	if (!defined($::use_pipe)) {
	    $cmd .= "-D $0 ";
	}
	$cmd .= "$::afio_unz_flag ";
	$cmd .= "$::afio_verb_flag ";
	$cmd .= "$::afio_sparse_flag ";
	$cmd .= "$::afio_bnum_flag ";
	$cmd .= "$::afio_blk_flag ";
	$cmd .= "-";

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

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

    } elsif ($cfg::type eq 'star') {
	$cmd .= "$::path{star} -t ";
	$cmd .= "$::star_fifo_flag ";
	$cmd .= "$::star_verb_flag ";
	$cmd .= "$::star_sparse_flag ";
	$cmd .= "$::star_blocknum_flag ";
	$cmd .= "$::star_blk_flag ";
	$cmd .= "-B ";
	$cmd .= "file=-";

    } elsif ($cfg::type eq 'pax') {
	$cmd .= "$::path{pax} ";
	$cmd .= "$::pax_verb_flag ";

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

    } elsif ($cfg::type eq 'ar') {
	my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID";
	$cmd .= "$::path{cat} > $tmpfile; ";
	$cmd .= "$::path{ar} t";
	$cmd .= "$::ar_verb_flag ";
	$cmd .= "$tmpfile; ";
	$cmd .= "$::path{rm} -f $tmpfile";

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

	$cmd .= "perl -pe 'last if (! m/^#/)'";

    } elsif ($cfg::type =~ m/^(copy|rsync)$/) {

	if ($cfg::verbose eq "true") {
	    $cmd = "ls -laR $::device";
	} else {
	    $cmd = "ls -aR $::device";
	}

    } elsif ($cfg::type eq 'lha') {
	my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID";
	$cmd .= "$::path{cat} > $tmpfile ; ";
	$cmd .= "$::path{lha} l";
	$cmd .= "$::lha_verb_flag ";
	$cmd .= "$tmpfile ; ";
	$cmd .= "$::path{rm} -f $tmpfile";

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

	$cmd .= "$::path{cat}";

    }

    &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.$PROCESS_ID";

    my $cmd = &setup_before_read('extract');

    if (defined($::opt{'flist'})) {
	# Have to get a list of the files for restore to use
	open(LIST,"$::opt{flist}") or die ("Can't open $::opt{flist}: $OS_ERROR");
	open(NEWLIST,">$newlist") or die ("Can't open $newlist: $OS_ERROR");
	while(<LIST>) {
	    chomp;
	    $_ =~ s%^/%%;
	    $_ =~ s%^\./%%;

	    # Some types need the leading ./ to extract the file list,
	    # since its stored that way
	    if ($cfg::type =~ m/^(tar|lha)$/) {
		$_ = './' . $_;
	    }
	    print NEWLIST "$_\n";
	    $restore_files .= " $_";
	}
	close(LIST);
	close(NEWLIST);
	&log("| Extracting files listed in $::opt{flist}");
    }

    if (defined($::opt{'onefile'})) {
	open(NEWLIST,">$newlist") or die ("Can't open $newlist: $OS_ERROR");
	$_ = $::opt{'onefile'};
	$_ =~ s%^/%%;
	$_ =~ s%^\./%%;
	# Some types need the leading ./ to extract the file list,
	# since its stored that way
	if ($cfg::type =~ m/^(tar|lha)$/) {
	    $_ = './' . $_;
	}
	print NEWLIST "$_\n";
	$restore_files .= " $_";
	close(NEWLIST);
	&log("| Extracting single file" . $restore_files);
    }

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

    } elsif ($cfg::type eq 'afio') {
	$cmd .= "$::path{afio} -i ";
	if ($restore_files ne '') {
	    $cmd .= "-w $newlist ";
	}
	$cmd .= "-z ";
	$cmd .= "-x ";
	# Don't use label reader if reading from pipe (needs stdin)
	if (!defined($::use_pipe)) {
	    $cmd .= "-D $0 ";
	}
	$cmd .= "$::afio_unz_flag ";
	$cmd .= "$::afio_verb_flag ";
	$cmd .= "$::afio_sparse_flag ";
	$cmd .= "$::afio_bnum_flag ";
	$cmd .= "$::afio_blk_flag ";
	$cmd .= "-";

    } elsif ($cfg::type eq 'cpio') {
	$cmd .= "$::path{cpio} -i ";
	if ($restore_files ne '') {
	    $cmd .= "-E $newlist ";
	}
	$cmd .= "-m ";
	$cmd .= "-d ";
	$cmd .= "$::cpio_verb_flag ";
	$cmd .= "$::cpio_blk_flag";

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

    } elsif ($cfg::type eq 'star') {
	$cmd .= "$::path{star} -x ";
	if ($restore_files ne '') {
	    $cmd .= "list=$newlist ";
	}
	$cmd .= "-p ";
	$cmd .= "$::star_fifo_flag ";
	$cmd .= "$::star_verb_flag ";
	$cmd .= "$::star_sparse_flag ";
	$cmd .= "$::star_blocknum_flag ";
	$cmd .= "$::star_blk_flag ";
	$cmd .= "-B ";
	$cmd .= "file=-";

    } elsif ($cfg::type eq 'pax') {
	$cmd .= "$::path{pax} -r ";
	$cmd .= "$::pax_verb_flag ";
	$cmd .= $restore_files;

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

    } elsif ($cfg::type eq 'ar') {
	my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID";
	$cmd .= "$::path{cat} > $tmpfile; ";
	$cmd .= "$::path{ar} xo";
	$cmd .= "$::ar_verb_flag ";
	$cmd .= "$tmpfile ";
	$cmd .= $restore_files;
	$cmd .= "; ";
	$cmd .= "$::path{rm} -f $tmpfile";

    } elsif ($cfg::type eq 'shar') {
	$cmd .= "sh ";
	if ($restore_files ne '') {
	    &log("| NOTE: \"-flist/-onefile\" ignored for shar");
	}

    } elsif ($cfg::type =~ m/^(copy|rsync)$/) {

	die("Ummm... just copy your files, you have the whole tree...");

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

	die("You can't extract the 'filelist' type, it's just for testing...");

    } elsif ($cfg::type eq 'lha') {
	my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID";
	$cmd .= "$::path{cat} > $tmpfile ; ";
	$cmd .= "$::path{lha} x";
	$cmd .= "$::lha_verb_flag ";
	$cmd .= "$tmpfile ";
	$cmd .= $restore_files;
	$cmd .= "; ";
	$cmd .= "$::path{rm} -f $tmpfile";

    }

    &run_or_echo_then_query($cmd);

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

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

    my $cmd = &setup_before_read('compare');

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

    } elsif ($cfg::type eq 'afio') {
	$cmd .= "$::path{afio} -r ";
	$cmd .= "-z ";
	# Don't use label reader if reading from pipe (needs stdin)
	if (!defined($::use_pipe)) {
	    $cmd .= "-D $0 ";
	}
	$cmd .= "$::afio_unz_flag ";
	$cmd .= "$::afio_sparse_flag ";
	$cmd .= "$::afio_blk_flag ";
	$cmd .= "-";

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

    } elsif ($cfg::type eq 'star') {
	$cmd .= "$::path{star} -diff ";
	$cmd .= "$::star_fifo_flag ";
	$cmd .= "$::star_blk_flag ";
	$cmd .= "$::star_sparse_flag ";
	$cmd .= "$::star_blocknum_flag ";
	$cmd .= "-B ";
	$cmd .= "file=-";

    } elsif ($cfg::type =~ m/^(copy|rsync)$/) {

	$::path{'diff'} = &checkinpath('diff');

	$cmd = "$::path{diff} -r -q ";
	$cmd .= ". $::device";

    } else {
	die("$cfg::type not capable of comparing files");
    }

    &run_or_echo_then_query($cmd);

}

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

    my $cmd = &setup_before_read('restore');

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

    } else {
	die("Interactive restore for $cfg::type not implemented");
    }

    &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 =~ s/(\S+)://) {
	$host = $1 . "-";
	$label = $path;
    } 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 lower level
#   in YYYYMMDDhhmm.ss format if arg 'numeric'
#   in ctime format if if arg 'ctime'
#   timestamp reference file if arg 'filename'
######################################################################
sub get_last_date {

    my $label = shift(@_);
    my $thislevel = shift(@_);
    my $format = shift(@_);
    my $lastlevel;
    my $targetfile = '';
    my $numeric_val;
    my $string_val;
    my $mtime;


    # use the epoch for level 0
    if ($thislevel == 0) {
	$numeric_val = '197001010000.00';
	$string_val = "Thu Jan 01 00:00:00 1970";

    } else {

	# Find last stamp file
	opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR");
	close(DIR);
	my $tmp = $thislevel - 1;
	foreach my $lev (reverse (0..$tmp)) {
	    my $file = "$cfg::stampdir/$cfg::sprefix" . "$label.$lev";
	    if (-e "$file") {
		$lastlevel = $lev;
		$targetfile = $file;
		last;
	    }
	}

	# get date from targetfile
	# or complain if no timestamp
	if ($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 $thislevel backup - no level 0 timestamp found");
	}

    }

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

    if (!defined($format)) {
	$format = 'ctime';
    }

    if ($format eq 'numeric') {
	return($numeric_val);
    } elsif ($format eq 'ctime') {
	return($string_val);
    } elsif ($format eq 'filename') {
	return($targetfile);
    } else {
	return($string_val);
    }
}

######################################################################
# Echo message to screen and log
# optionally just one or the other
######################################################################
sub log {

    my $msg = shift(@_);
    my $only = shift(@_);
    my $do_screen = 1;
    my $do_log = 1;

    if (!defined($only)) {
	$do_screen = 1;
	$do_log = 1;
    } elsif ($only eq 'screen') {
	$do_screen = 1;
	$do_log = 0;
    } elsif ($only eq 'log') {
	$do_screen = 0;
	$do_log = 1;
    }

    if ($do_screen == 1) {
	print $::msg "$msg\n";
    }

    if (($do_log == 1) and defined($::log)) {
	open(LOG,">>$::log") || warn("can't open logfile");
	print LOG "$msg\n";
	close(LOG);
    }

}

######################################################################
# Echo a line to both screen and log
# optionally just one or the other
######################################################################
sub line {

    my $only = shift(@_);
    my $do_screen = 1;
    my $do_log = 1;

    my $length = 60;

    if (!defined($only)) {
	$do_screen = 1;
	$do_log = 1;
    } elsif ($only eq 'screen') {
	$do_screen = 1;
	$do_log = 0;
    } elsif ($only eq 'log') {
	$do_screen = 0;
	$do_log = 1;
    }

    if ($do_screen == 1) {
	print $::msg '|';
	print $::msg '-' x $length;
	print $::msg "\n";
    }

    if (($do_log == 1) and defined($::log)) {
	open(LOG,">>$::log") || warn("can't open logfile");
	print LOG '|';
	print LOG '-' x $length;
	print LOG "\n";
	close(LOG);
    }

}

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

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

    if (defined($::opt{'c'})) {
	$configfile = $::opt{'c'};
    } else {
	$configfile = $::CONFFILE;
    }
    if (! -r "$configfile") {
	die("config file $configfile: $OS_ERROR");
    }
    system("perl -c \"$configfile\"");
    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) = (@_);

    # Set hardware compression when we do the blocksize
    if ($cfg::compress eq "hardware") {
	foreach my $operation (@operations) {
	    if ($operation =~ m/generic-blocksize/) {
		if ($::uname =~ /Linux/) {
		    push(@operations,'compression 1');
		} elsif ($::uname =~ /FreeBSD/) {
		    push(@operations,'comp on');
		} else {
		    push(@operations,'compression 1');
		}
	    }
	}
    }

    # We want 1-filemark behavior always
    # Set if currently doing blocksize command
    foreach my $operation (@operations) {
	if ($operation =~ m/generic-blocksize/) {
	    if ($::uname =~ /FreeBSD/) {
		push(@operations,'seteotmodel 1');
	    }
	}
    }

    foreach my $operation (@operations) {

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

	# mt flavors for eod
	if ($operation eq 'generic-eod') {
	    if ($::uname =~ /Linux/) {
		$operation = 'eod';
		if ($::ftape == 1) {
		    $operation = 'eom';
		}
	    } elsif ($::uname =~ /OpenBSD/) {
		$operation = 'eod';
	    } elsif ($::uname =~ /FreeBSD/) {
		$operation = 'eod';
	    } elsif ($::uname =~ /OSF1/) {
		$operation = 'seod';
	    } elsif ($::uname =~ /AIX/) {
		$operation = 'fsf 1000';
	    } elsif ($::uname =~ /HP-UX/) {
		$operation = 'eod';
	    } elsif ($::uname =~ /SunOS/) {
		$operation = 'eom';
	    } elsif ($::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") {
		$operation = 'rewind';
	    } elsif ($::uname =~ /Linux/) {
		$operation = 'erase';
	    } elsif ($::uname =~ /OpenBSD/) {
		$operation = 'erase';
	    } elsif ($::uname =~ /FreeBSD/) {
		$operation = 'erase';
	    } elsif ($::uname =~ /OSF1/) {
		$operation = 'erase';
	    } elsif ($::uname =~ /AIX/) {
		$operation = 'erase';
	    } elsif ($::uname =~ /HP-UX/) {
		$operation = 'erase';
	    } elsif ($::uname =~ /SunOS/) {
		$operation = 'erase';
	    } elsif ($::uname =~ /IRIX/) {
		$operation = 'erase';
	    } else {
		$operation = 'erase';
	    }
	}

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

	if (defined($::use_file)) {
	    # mt ops skipped for files
	} elsif (defined($::use_blockdevice)) {
	    # mt ops skipped for block device
	} else {

	    my $command;

	    # Override mt operation so user can set for unknown flavors
	    # or for debugging info, like mt tell -> mt status
	    if(defined($cfg::mt{$operation})) {
		$operation = $cfg::mt{$operation};
		next if ($operation eq 'nop');
	    }

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

	    $command = "$::path{mt} -f $::device $operation 2>&1 ";

	    if (defined($::remotetapehost)) {
		$command = &maybe_remote_cmd($command, $::remotetapehost);
	    }

	    if (!defined($::debug)) {

		open(CMD,"($command) 2>&1 |") || die;
		if (defined($::log)) { open(LOG,">>$::log") || die; }
		while(<CMD>) {
		    print $_;
		    if (defined($::log)) { print LOG $_; }
		}
		close(CMD);
		if (defined($::log)) { close(LOG); }

	    } else {
		&log("(debug) $command");
	    }

	} # not a file

    } # foreach operation

}

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

    my $buffer_blk_flag;
    my $buffer_write_pad_flag;
    my $buffer_read_pad_flag;

    my $mbuffer_blk_flag;
    my $mbuffer_write_pad_flag;
    my $mbuffer_read_pad_flag;

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

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

    # Device flag on commandline
    if (defined($::opt{'device'})) {
	$cfg::device = $::opt{'device'};
	if (defined($::opt{'stdout'})) {
	    push(@::errors,"Can't use -device and -pipe at the same time");
	}
    }

    # Debug
    if (defined($::opt{'n'})) {
	$::debug = 1;
    }

    # Flag old config file
    if (defined(@cfg::filesystems) or defined($cfg::mt_var_blksize)) {
	# so strict shuts up
	my $junk = @cfg::filesystems;
	$junk = $cfg::mt_var_blksize;
	push(@::errors,"You've got an old 1.0.x configuration file, please update it!");
    }

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

    # First check if things are defined in the config file
    # Checks exist, true/false, or one of options
    &checkvar(\$cfg::type,'type','dump afio cpio tar star pax zip ar shar lha copy rsync filelist','tar');
    &checkvar(\$cfg::compress,'compress','gzip bzip2 lzop compress zip false hardware lzma','gzip');
    &checkvar(\$cfg::compr_level,'compr_level','exist','4');
    &checkvar(\$cfg::verbose,'verbose','bool','true');
    &checkvar(\$cfg::sparse,'sparse','bool','true');
    &checkvar(\$cfg::label,'label','bool','true');
    &checkvar(\$cfg::atime_preserve,'atime_preserve','bool','false');
    &checkvar(\$cfg::indexes,'indexes','bool','true');
    &checkvar(\$cfg::staticfiles,'staticfiles','bool','false');
    &checkvar(\$cfg::buffer,'buffer','false buffer mbuffer','false');
    &checkvar(\$cfg::pad_blocks,'pad_blocks','bool','true');
    &checkvar(\$cfg::device,'device','exist','/dev/tape');
    &checkvar(\$cfg::remoteshell,'remoteshell','ssh ssh2 ssh1 rsh','ssh');
    &checkvar(\$cfg::remoteuser,'remoteuser','exist','');
    &checkvar(\$cfg::erase_tape_set_level_zero,'erase_tape_set_level_zero','bool','true');
    &checkvar(\$cfg::erase_rewind_only,'erase_rewind_only','bool','false');
    &checkvar(\$cfg::logdir,'logdir','exist','/var/log/flexbackup');
    &checkvar(\$cfg::tmpdir,'tmpdir','exist','/tmp');
    &checkvar(\$cfg::comp_log,'comp_log','gzip bzip2 lzop compress zip false','gzip');
    &checkvar(\$cfg::stampdir,'stampdir','exist','/var/lib/flexbackup');
    &checkvar(\$cfg::index,'index','exist','/var/lib/flexbackup/index');
    &checkvar(\$cfg::keyfile,'keyfile','exist','00-index-key');
    &checkvar(\$cfg::staticlogs,'staticlogs','bool','false');
    &checkvar(\$cfg::prefix,'prefix','exist','');
    &checkvar(\$cfg::sprefix,'sprefix','exist','');

    if (@::errors) {
	print $::msg "Errors:\n";
	while(@::errors) {
	    print $::msg " " . shift(@::errors) . "\n";
	}
	exit(1);
    }

    # Check we can find rsh or ssh
    $::path{$cfg::remoteshell} = &checkinpath($cfg::remoteshell);
    if ($cfg::remoteuser ne '') {
	$::remoteshell = "$::path{$cfg::remoteshell} -l $cfg::remoteuser";
    } else {
	$::remoteshell = $::path{$cfg::remoteshell};
    }

    # Check we can find common stuff
    $::path{'touch'} = &checkinpath('touch');
    $::path{'hostname'} = &checkinpath('hostname');
    $::path{'cat'} = &checkinpath('cat');
    $::path{'rm'} = &checkinpath('rm');
    $::path{'tee'} = &checkinpath('tee');
    $::path{'find'} = &checkinpath('find');
    $::path{'dd'} = &checkinpath('dd');
    $::path{'printf'} = &checkinpath('printf');
    $::path{'mkdir'} = &checkinpath('mkdir');

    push(@::remoteprogs,($::path{'touch'},$::path{'rm'},$::path{'find'},$::path{'printf'},$::path{'mkdir'}));

    # Check device (or dir)
    $::ftape = 0;
    if (defined($::opt{'pipe'})) {

	# Dump to stdout.
	# Disable indexing, all messages to stderr
	$::use_file = 1;
	$::use_pipe = 1;
	$cfg::indexes = 'false';
	$cfg::device = '-';

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

	$::use_file = 1;
	chomp($cfg::device = `pwd`);
	$cfg::device =~ s:/$::;
	$cfg::indexes = 'false';

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

    } else {

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

	    my @pathname = split('/',$realdev);
	    $realdev = readlink("$realdev");

	    # If a relative link we'll need the dir from the link
	    if ($realdev !~ m:^/:) {
		pop(@pathname);
		$realdev = join('/',@pathname) . "/$realdev";
	    }
	}

	if (-c $realdev) {

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

	} elsif (-b $realdev) {

	    # In case of floppy or similar.
	    # Can't do multiple files this way; turn indexing off
	    $::use_blockdevice = 1;
	    $cfg::indexes = 'false';

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

	} elsif ($cfg::device =~ m%(\S+):(/dev/.*)%) {

	    $::remotetapehost = $1;
	    $cfg::device = $2;
	    $::tapedevice = 1;

	} else {
	    push(@::errors,"\$device must be set to a directory, a local device, or a remote device");
	}

	# Can we write to it?
	if ((! -w $cfg::device) and
	    !defined($::remotetapehost) and
	    ($::mode =~ m/^(set|dir|newtape)$/)) {
	    push(@::errors,"Can't write to $cfg::device");
	}

    }

    $::device = $cfg::device;


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

    # Exclude regexp for find
    $::exclude_expr = '';
    if (defined($cfg::exclude_expr[0])) {
	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 . '"' . '$'; #' (comment to fool emacs 20.7
	    } else {
		$expr = '"' . $expr . '"';
	    }

	    $::exclude_expr .= "! -regex $expr ";
	}
    }

    # Traverse mountpoints?
    &checkvar(\$cfg::traverse_fs,'traverse_fs','false local all','false');
    if ($cfg::traverse_fs eq "local") {
	$::mountpoint_flag = "! -fstype nfs ! -fstype smbfs ! -fstype bind ! -fstype proc ! -fstype devpts ! -fstype devfs ! -fstype tmpfs";
    } elsif ($cfg::traverse_fs eq "all") {
	$::mountpoint_flag = "! -fstype proc ! -fstype devpts ! -fstype devfs ! -fstype tmpfs";
    } else {
	$::mountpoint_flag = "-xdev";
    }

    # Block size
    &checkvar(\$cfg::blksize,'blksize','exist','10');
    # Isn't required; if commented out in config we use same as $blksize
    #&checkvar(\$cfg::mt_blksize,'mt_blksize','exist');
    if ($cfg::blksize !~ m/^\d+$/) {
	push(@::errors,"\$blksize must be set to an integer");
    }
    if ($cfg::blksize ne '0') {
	# buffer blocksize needs k appended
	$buffer_blk_flag = "-s " . $cfg::blksize . "k";
	# mbuffer blocksize in bytes
	$mbuffer_blk_flag = "-s " . $cfg::blksize * 1024;
	# dd blocksize needs k appended
	$::dd_blk_flag = "ibs=" . $cfg::blksize . "k obs=" . $cfg::blksize . "k";
	# dump blocksize just in k like the config file
	$::dump_blk_flag = "-b $cfg::blksize";
	# afio blocksize needs k appended
	$::afio_blk_flag = "-b " . $cfg::blksize . "k";
	# cpio blocks are in bytes
	$::cpio_blk_flag = "-C " . $cfg::blksize * 1024;
	# 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.
	$::tar_blk_flag = "-b " . $cfg::blksize * 2;
	# star blocks are in 512-byte units
	$::star_blk_flag = "blocks=" . $cfg::blksize * 2;
	# pax blocksize needs k appended
	$::pax_blk_flag = "-b " . $cfg::blksize . "k";
    } else {
	$buffer_blk_flag = "";
	$mbuffer_blk_flag = "";
	$::dd_blk_flag = "";
	$::dump_blk_flag = "";
	$::afio_blk_flag = "";
	$::cpio_blk_flag = "";
	$::tar_blk_flag =  "";
	$::star_blk_flag =  "";
	$::pax_blk_flag = "";
    }

    # mt block size (in bytes not k)
    if (!defined($cfg::mt_blksize)) {
	$cfg::mt_blksize = $cfg::blksize * 1024;
	$::mt_blksize = $cfg::mt_blksize;
    }
    if ($cfg::mt_blksize !~ m/^\d+$/) {
	push(@::errors,"\$mt_blksize must be set to an integer");
    } else {
	if ($cfg::mt_blksize != 0) {
	    my $tmp = $cfg::blksize * 1024;
	    if ($tmp%$cfg::mt_blksize != 0) {
		push(@::errors,"\$mt_blksize ($cfg::mt_blksize) should be a factor of \$blksize ($tmp)");
	    }
	}
	$::mt_blksize = $cfg::mt_blksize;
    }

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

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

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

    } elsif ($cfg::compress eq "compress") {
	$::path{'compress'} = &checkinpath($cfg::compress);
	push(@::remoteprogs, $::path{$cfg::compress});
	$::z = " | $::path{$cfg::compress} -c";
	$::unz = "$::path{$cfg::compress} -dc | ";

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

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

    # Block padding
    if (($cfg::pad_blocks eq "true") and defined($::tapedevice)) {
	$::dd_write_pad_flag = "conv=noerror,sync";
	$::dd_read_pad_flag = "conv=noerror";
	$buffer_write_pad_flag = "-B";
	$buffer_read_pad_flag = "";
	$mbuffer_write_pad_flag = "";
	$mbuffer_read_pad_flag = "";
    } else {
	$::dd_write_pad_flag = "conv=noerror";
	$::dd_read_pad_flag = "conv=noerror";
	$buffer_write_pad_flag = "";
	$buffer_read_pad_flag = "";
	$mbuffer_write_pad_flag = "";
	$mbuffer_read_pad_flag = "";
    }

    # Buffer setup
    if ($cfg::buffer ne 'false') {
	&checkvar(\$cfg::buffer_megs,'buffer_megs','exist');
	&checkvar(\$cfg::buffer_fill_pct,'buffer_fill_pct','exist','75');
	&checkvar(\$cfg::buffer_pause_usec,'buffer_pause_usec','exist','100');
	if ($cfg::buffer_megs !~ m/^\d+$/) {
	    push(@::errors,"\$buffer_megs must be set to integer number of megabytes");
	}
	if ($cfg::buffer_fill_pct !~ m/^\d+$/) {
	    push(@::errors,"\$buffer_fill_pct must be set to an integer");
	}
	if ($cfg::buffer_pause_usec !~ m/^\d+$/) {
	    push(@::errors,"\$buffer_pause_usec must be set to an integer");
	}
	if ($cfg::buffer eq "buffer") {

	    $::path{'buffer'} = &checkinpath('buffer');
	    push(@::remoteprogs, $::path{'buffer'});

	    my $write_flags;
	    my $read_flags;
	    my $megs = $cfg::buffer_megs . "m";
	    my $bufcmd = "$::path{buffer} -m $megs -p $cfg::buffer_fill_pct $buffer_blk_flag -t ";

	    if (defined($::tapedevice)) {
		$write_flags = "-u $cfg::buffer_pause_usec $buffer_write_pad_flag -o ";
		$read_flags = "-u $cfg::buffer_pause_usec $buffer_read_pad_flag -i ";
	    } else {
		$write_flags = "$buffer_write_pad_flag -o ";
		$read_flags = "$buffer_read_pad_flag -i ";
	    }
	    $::buffer_cmd = " | $bufcmd";
	    $::write_cmd = "$bufcmd $write_flags";
	    $::read_cmd = "$bufcmd $read_flags";

	} elsif ($cfg::buffer eq "mbuffer") {

	    $::path{'mbuffer'} = &checkinpath('mbuffer');
	    push(@::remoteprogs, $::path{'mbuffer'});

	    my $megs = $cfg::buffer_megs . "M";
	    my $bufcmd = "$::path{mbuffer} -q -m $megs -p $cfg::buffer_fill_pct $mbuffer_blk_flag ";

	    $::buffer_cmd = " | $bufcmd";
	    $::write_cmd = "$bufcmd -f -o ";
	    if (defined($::opt{'volumes'})) {
		$::read_cmd = "$bufcmd -f -n $::opt{volumes} -i ";
	    } else {
		$::read_cmd = "$bufcmd -f -i ";
	    }
	}
    } else {

	# If buffering disabled, use dd or cat depending on if blocking turned off on not
	if ($cfg::blksize eq '0') {
	    $::buffer_cmd = "";
	    $::write_cmd = "$::path{cat} > ";
	    $::read_cmd = "$::path{cat} ";
	} else {
	    $::buffer_cmd = "";
	    $::write_cmd = "$::path{dd} $::dd_blk_flag $::dd_write_pad_flag of=";
	    $::read_cmd = "$::path{dd} $::dd_blk_flag $::dd_read_pad_flag if=";
	}
    }

    # Sets / filesystems
    if (defined($::opt{'dir'})) {

	# Single directory
	if ($::opt{'dir'} =~ /^(\S+):/) {
	    $::remotehosts{$1} = 1;
	} else {
	    $::local = 1;
	}

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

    } elsif (defined($::opt{'set'})) {

	if (defined($::use_pipe)) {
	    push(@::errors,"can't use -set with -pipe option");
	}

	foreach my $set (keys %cfg::set) {
	    if ($set eq 'all') {
		push(@::errors,"can't define a set named 'all'");
	    }
	}

	my @do_sets;
	if ($::opt{'set'} eq 'all') {
	    @do_sets = keys(%cfg::set);
	    if (scalar(@do_sets) == 0) {
		push(@::errors,"no backup sets defined");
	    }
	} else {
	    @do_sets = ($::opt{'set'});
	}

	foreach my $this_set (@do_sets) {
	    if (!defined($cfg::set{$this_set})) {
		push(@::errors,"set $this_set is not defined");
	    } else {
		foreach my $dir (&split_list($cfg::set{$this_set})) {
		    if ($dir =~ /^(\S+):/g) {
			$::remotehosts{$1} = 1;
		    } else {
			$::local = 1;
		    }
		}
	    }
	}
    }

    # Subtree pruning
    foreach my $fs (keys %cfg::prune) {
	$fs = &nuke_trailing_slash($fs);
	foreach my $expr (&split_list($cfg::prune{$fs})) {
	    $::prune{$fs}{$expr} = 1;
	}
    }

    # Verbose flag
    if ($cfg::verbose eq "true") {
	$::dump_verb_flag = "-v";
	$::afio_verb_flag = "-v";
	$::cpio_verb_flag = "-v";
	$::tar_verb_flag = "--verbose";
	$::star_verb_flag = "-v";
	$::pax_verb_flag = "-v";
	$::zip_verb_flag = "-v";
	$::ar_verb_flag = "v";
	$::shar_verb_flag = "";
	$::lha_verb_flag = "";
	$::rsync_verb_flag = "--verbose";
    } else {
	$::dump_verb_flag = "";
	$::afio_verb_flag = "";
	$::cpio_verb_flag = "";
	$::tar_verb_flag = "";
	$::star_verb_flag = "-silent";
	$::pax_verb_flag = "";
	$::zip_verb_flag = "-q";
	$::ar_verb_flag = "";
	$::shar_verb_flag = "-q";
	$::lha_verb_flag = "q";
	$::rsync_verb_flag = "";
    }

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

    # atime preserve flag
    if ($cfg::atime_preserve eq "true") {
	$::afio_atime_flag = "-a";
	$::tar_atime_flag = "--atime-preserve";
	$::star_atime_flag = "-atime";
    } else {
	$::afio_atime_flag = "";
	$::tar_atime_flag = "";
	$::star_atime_flag = "";
    }

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

	&checkvar(\$cfg::dump_length,'dump_length','exist','0');
	&checkvar(\$cfg::dump_use_dumpdates,'dump_use_dumpdates','bool','false');

	$::path{'dump'} = &checkinpath('dump');
	$::path{'restore'} = &checkinpath('restore');
	push(@::remoteprogs, $::path{'dump'});

	# Length of tape
	if ($cfg::dump_length !~ m/^\d+$/) {
	    push(@::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) {
	    $::dump_len_flag = "-a";
	} else {
	    $::dump_len_flag = "-B $cfg::dump_length";
	}

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

	&checkvar(\$cfg::afio_echo_block,'afio_echo_block','bool','false');
	&checkvar(\$cfg::afio_compress_cache_size,'afio_compress_cache_size','exist','2');
	&checkvar(\$cfg::afio_compress_threshold,'afio_compress_threshold','exist','3');
	&checkvar(\$cfg::afio_nocompress_types,'afio_nocompress_types','exist','.lzo');

	$::path{'afio'} = &checkinpath('afio');
	push(@::remoteprogs, $::path{'afio'});

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

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

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

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

	    } elsif ($cfg::compress eq "zip") {
		$::afio_z_flag = "-P $::path{zip} -Q -$cfg::compr_level -Q - -Q - -Z";
		$::afio_unz_flag = "-P $::path{funzip} -Q \"\" -Z";

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

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

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

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

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

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

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

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

	&checkvar(\$cfg::cpio_format,'cpio_format','bin odc newc crc tar ustar hpbin hpodc','newc');

	$::path{'cpio'} = &checkinpath('cpio');
	push(@::remoteprogs, $::path{'cpio'});

	if ($cfg::type eq 'copy') {
	    if (!defined($::use_file)) {
		push(@::errors,"Can't use type \"copy\" unless archiving to disk!");
	    }
	    if (defined($::use_pipe)) {
		push(@::errors,"Can't use type \"copy\" with -pipe!");
	    }
	}

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

	$::path{'rsync'} = &checkinpath('rsync');
	$::path{'sed'} = &checkinpath('sed');
	push(@::remoteprogs, $::path{'rsync'});

	if (!defined($::use_file)) {
	    push(@::errors,"Can't use type \"rsync\" unless archiving to disk!");
	}
	if (defined($::use_pipe)) {
	    push(@::errors,"Can't use type \"rsync\" with -pipe!");
	}

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

	&checkvar(\$cfg::tar_echo_record_num,'tar_echo_record_num','bool','false');

	$::path{'tar'} = &checkinpath('tar');
	push(@::remoteprogs, $::path{'tar'});

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

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

	&checkvar(\$cfg::star_acl,'star_acl','bool','true');
	&checkvar(\$cfg::star_fifo,'star_fifo','bool','true');
	&checkvar(\$cfg::star_format,'star_format','tar star gnutar ustar pax xstar xustar exustar suntar','exustar');
	&checkvar(\$cfg::star_echo_block_num,'star_echo_block_num','bool','false');

	$::path{'star'} = &checkinpath('star');
	push(@::remoteprogs, $::path{'star'});

	# Echo block number
	$::star_blocknum_flag = "";
	if ($cfg::verbose eq "true") {
	    if ($cfg::star_echo_block_num eq "true") {
		$::star_blocknum_flag = "-block-number";
	    }
	}

	# ACL flag
	if ($cfg::star_acl eq "true") {
	    $::star_acl_flag = "-acl";
	} else {
	    $::star_acl_flag = "";
	}

	# fifo
	if ($cfg::star_fifo eq "true") {
	    $::star_fifo_flag = "-fifo";
	    if ($cfg::verbose eq "true") {
		$::star_fifo_flag .= " -fifostats";
	    }
	} else {
	    $::star_fifo_flag = "";
	}

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

	&checkvar(\$cfg::pax_format,'pax_format','cpio bcpio sv4cpio sv4crc tar ustar');

	$::path{'pax'} = &checkinpath('pax');
	push(@::remoteprogs, $::path{'pax'});

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

	&checkvar(\$cfg::zip_nocompress_types,'zip_nocompress_types','exist','mp3 MP3 Z z gz gif zip ZIP lha jpeg jpg JPG taz tgz deb rpm bz2 lzo');

	$::path{'zip'} = &checkinpath('zip');
	push(@::remoteprogs, $::path{'zip'});
	$::path{'unzip'} = &checkinpath('unzip');

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

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

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

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

	$::path{'ar'} = &checkinpath('ar');
	push(@::remoteprogs, $::path{'ar'});

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

	$::path{'shar'} = &checkinpath('shar');
	push(@::remoteprogs, $::path{'shar'});

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

	$::path{'lha'} = &checkinpath('lha');
	push(@::remoteprogs, $::path{'lha'});

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

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

	# Nothing specific to check

    } # type-specific


    # Tmp dir
    $cfg::tmpdir = &nuke_trailing_slash($cfg::tmpdir);
    if ($cfg::tmpdir !~ m:^/:) {
	push(@::errors,"\$tmpdir must be absolute path: $cfg::tmpdir");
    }
    if (! -d "$cfg::tmpdir") {
	push(@::errors,"\$tmpdir $cfg::tmpdir is not a directory");
    }
    if (! -w "$cfg::tmpdir") {
	push(@::errors,"\$tmpdir $cfg::tmpdir is not writable");
    }

	$cfg::hostname = `hostname`;
	chomp($cfg::hostname);

	# Use a subdirectory of the user-specified directory as our tmpdir
	# Also note that we make it closer to globally unique as we sometimes
	# use this variable for remote systems, so PID isn't enough
    $cfg::tmpdir = $cfg::tmpdir .'/flexbackup.'.$$.'.'.$cfg::hostname;
    mkdir ($cfg::tmpdir) || die "Can't create temporary directory, $!";

    # Levels
    if (defined($::opt{'level'}) and
	(defined($::opt{'incremental'}) or
	 defined($::opt{'differential'}) or
	 defined($::opt{'full'}))) {
	push(@::errors,"Can't use -level AND -incremental/-differential/-full");
    }

    if (!defined($::opt{'level'})) {
	if (defined($::opt{'incremental'})) {
	    $::opt{'level'} = 'incremental';
	} elsif (defined($::opt{'differential'})) {
	    $::opt{'level'} = 'differential';
	} elsif (defined($::opt{'full'})) {
	    $::opt{'level'} = 'full';
	} else {
	    $::opt{'level'} = 0;
	}
    }

    if (($::opt{'level'} !~ m/^\d+$/) and
	($::opt{'level'} !~ m/^(full|differential|incremental)$/)) {
	push(@::errors,"-level must be numeric, or full/differential/incremental");
    }

    # Check for digits or change full/diff to level number
    # Incremental + fs=all we have to handle later since it might be
    # different for each fs
    if ($::opt{'level'} =~ m/^\d+$/) {
	# Make string variable numeric
	$::level = POSIX::strtod($::opt{'level'});
	if (($cfg::type eq 'dump') and ($::level > 9)) {
	    push(@::errors,"can't use level > 9 and type=dump");
	}
    } elsif ($::opt{'level'} eq "full") {
	$::level = 0;
    } elsif ($::opt{'level'} eq "differential") {
	$::level = 1;
    } elsif ($::opt{'level'} eq "incremental") {
	# If incremental + one fs, we can find the level now.
	if (defined($::opt{'dir'})) {
	    $::level = &get_incremental_level($::opt{'dir'});
	    if (($cfg::type eq 'dump') and ($::level > 9)) {
		push(@::errors,"can't use level > 9 and type=dump");
	    }
	} else {
	    # If we are doing a set have to postpone till later; each
	    # fs might have a different level...
	    undef $::level;
	    $::set_incremental = 1;
	}
    }

    # Package delta option
    if (defined($::opt{'pkgdelta'})) {

	&checkvar(\$cfg::pkgdelta_archive_list,'pkgdelta_archive_list','true false rootonly','rootonly');
	&checkvar(\$cfg::pkgdelta_archive_unowned,'pkgdelta_archive_unowned','bool','true');
	&checkvar(\$cfg::pkgdelta_archive_changed,'pkgdelta_archive_changed','bool','true');

	if ($::opt{'pkgdelta'} eq 'rpm') {
	    $::pkgdelta = 'rpm';
	    $::path{'rpm'} = &checkinpath('rpm');

	} elsif ($::opt{'pkgdelta'} =~ /freebsd/i) {
	    $::pkgdelta = 'freebsd';
	    $::path{'pkg_info'} = &checkinpath('pkg_info');

	} else {
	    push(@::errors,"$::opt{pkgdelta} not a valid option for -pkgdelta");
	}
    }

    # Check toc/rmindex/rmfile flags
    if (defined($::opt{'toc'}) or defined($::opt{'rmindex'})) {
	if ($cfg::indexes eq "false") {
	    push(@::errors,"Can't do -toc/rmindex with \$indexes set to false");
	}
    }
    if (defined($::opt{'rmindex'}) and (${$::opt{'rmindex'}}[0] eq '')) {
	push(@::errors,"-rmindex requires 'key:filenum', 'key' or 'all'");
    }
    if (defined($::opt{'rmfile'}) and (${$::opt{'rmfile'}}[0] eq '')) {
	push(@::errors,"-rmfile requires a filename or 'all'");
    }

    # Check log/stamp dirs (only if we are in a 'write' mode)
    if ($::mode =~ m/^(set|dir|newtape)$/) {
	$::path{$cfg::comp_log} = &checkinpath($cfg::comp_log) if ($cfg::comp_log ne "false");
	$cfg::logdir = &nuke_trailing_slash($cfg::logdir);
	$cfg::stampdir = &nuke_trailing_slash($cfg::stampdir);
	if ($cfg::logdir !~ m:^/:) {
	    push(@::errors,"\$logdir must be absolute path: $cfg::logdir");
	}
	if ($cfg::stampdir !~ m:^/:) {
	    push(@::errors,"\$stampdir must be absolute path: $cfg::stampdir");
	}
	if (! -d "$cfg::logdir") {
	    mkdir("$cfg::logdir",0755) or push(@::errors,"Can't mkdir $cfg::logdir: $OS_ERROR");
	}
	if (! -w "$cfg::logdir") {
	    push(@::errors,"Can't write to $cfg::logdir");
	}
	if (! -d "$cfg::stampdir") {
	    mkdir("$cfg::stampdir",0755) or push(@::errors,"Can't mkdir $cfg::stampdir: $OS_ERROR");
	}
	if (! -w "$cfg::stampdir") {
	    push(@::errors,"Can't write to $cfg::stampdir: $OS_ERROR");
	}
    }

    # Tie index database
    if (($::mode !~ m/^(list|extract|restore|compare|test-tape-drive)$/) and
	($cfg::indexes eq "true")) {
	tie(%::index,"AnyDBM_File",$cfg::index,O_CREAT|O_RDWR,0640) or
	    push(@::errors,"Can't tie DB $cfg::index");
    }

    # Sanity check some accessory tape flags
    if (($::mode =~ m/^(list|extract|restore|compare)$/) and defined($::opt{'erase'})) {
	push(@::errors,"-erase can't be used in -$::mode mode");
    }
    if (($::mode =~ m/^(set|dir|newtape)$/) and defined($::opt{'num'})) {
	push(@::errors,"-num Can't be used in -$::mode mode");
    }
    if (defined($::use_file) or defined($::use_blockdevice)) {
	if (defined($::opt{'num'})) {
	    push(@::errors,"Can't use -num unless reading from tape");
	}
	if (defined($::opt{'erase'}) or defined($::opt{'rewind'}) or defined($::opt{'reten'})) {
	    push(@::errors,"Can't use -erase/-rewind/-reten unless using a tape");
	}
    }

    # Testing
    if (defined($::debug)) {
	&log('(debug) no backup or mt commands will be executed');
	&log('(debug) no old stamps or old log files will be removed');
    }

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

    # Requirements for testing
    if (defined($::opt{'test-tape-drive'})) {
	if (defined($::use_file)) {
	    push(@::errors,"No use trying tape drive tests on directories!");
	} elsif (defined($::use_blockdevice)) {
	    push(@::errors,"No use trying tape drive tests on block devices!");
	}
	$::path{'diff'} = &checkinpath('diff');
	$::path{'tr'} = &checkinpath('tr');
    }

    if (@::errors) {
	print $::msg "\nErrors:\n";
	while(@::errors) {
	    print $::msg " " . shift(@::errors) . "\n";
	}
	exit(1);
    }

}

######################################################################
# Check buffer, shelltype, and any remote hosts for required programs
######################################################################
sub test_before_run {

    if ($cfg::buffer ne 'false') {
	&test_bufferprog($::buffer_cmd, 'localhost');
    }

    &check_shell('localhost');

    &check_remote_progs(\%::remotehosts, \@::remoteprogs);

    if (@::errors) {
	print $::msg "\nErrors:\n";
	while(@::errors) {
	    print $::msg " " . shift(@::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: v1_2_1 $ ';
    $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 . " (http://flexbackup.sourceforge.net)");

}

######################################################################
# Return current time in ctime format if normal
# in YYYYMMDDHHMM.SS format if 'numeric' is given
######################################################################
sub current_time {

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

    if (defined($format) and ($format eq 'numeric')) {
	$string = strftime("%Y%m%d%H%M", localtime($current_time));
    } elsif (defined($format) and ($format eq 'ctime')) {
	$string = strftime("%a %b %d %H:%M:%S %Y", 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 my $mode (@modes) {
	if (defined($::opt{$mode})) {
	    $arg = $::opt{$mode};
	}
    }

    # If reading from stdin
    if (defined($::use_pipe)) {
	# -pipe and file arg doesn't make sense, yell
	if ($arg ne '') {
	    print STDERR "Error: when using -pipe, don't specify file name.\n";
	    die();
	} else {
	    # Set file to "-" for stdin
	    return('-');
	}
    }

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

    # If the flag given but null, and $device is a dir, spew
    if (($arg eq '') and (defined($::use_file))) {
	print STDERR "Error: when extracting from a file, you must specify file name.\n";
	print STDERR "(like \"-list file.tar.bz2\")\n";
	die();
    }

    # 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;
	$::use_file = 1;
	$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
	undef $::tapedevice;
	undef $::remotetapehost;

    } elsif (defined($::use_file) and (-f "$cfg::device/$arg")) {
	$file = $cfg::device . "/" . $arg;
	$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
	undef $::tapedevice;
	undef $::remotetapehost;

    } elsif (-d "$arg") {
	$file = $arg;
	$::use_file = 1;
	$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
	undef $::tapedevice;
	undef $::remotetapehost;

    } elsif (defined($::use_file) and (-d "$cfg::device/$arg")) {
	$file = $cfg::device . "/" . $arg;
	$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
	undef $::tapedevice;
	undef $::remotetapehost;

    } else {
	if (defined($::use_file)) {
	    print STDERR "Error: file \"$arg\" or \"$cfg::device/$arg\" not found\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|star|pax|a|shar|filelist)\.(gz|bz2|lzo|Z|zip|lzma)$/) {
	$cfg::type = $1;
	$cfg::compress = $2;
	$cfg::type =~ s/^a$/ar/;
	$cfg::compress =~ s/gz/gzip/;
	$cfg::compress =~ s/bz2/bzip2/;
	$cfg::compress =~ s/lzo/lzop/;
	$cfg::compress =~ s/Z/compress/;
	$cfg::compress =~ s/lzma/lzma/;
	&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
	&optioncheck();                  # redo to set a few variables over

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

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

    } elsif (-d "$file") {
	$cfg::type = "copy";
	$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/\.tbz2?$/) {
	$cfg::type = "tar";
	$cfg::compress = "bzip2";
	&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");
	&optioncheck();                  # redo to set a few variables over

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

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

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

    }

    return($file);

}

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

    my $ref = shift(@_);        # ref to variable
    my $varname = shift(@_);    # name of variable
    my $ok = shift(@_);         # list of ok values, "bool", "exists"
    my $default = shift(@_);    # default to use if not set
    my @ok;
    my $found = 0;

    if (!defined($ok)) {
	die("checkvar called incorrectly");
    }

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

    if (!defined($$ref)) {
	if (!defined($::opt{'nodefaults'}) and defined($default)) {
	    print $::msg " \$$varname not found in config: default=$default\n";
	    $$ref = $default;
	} else {
	    push(@::errors,"\$$varname not defined");
	}
    } else {
	if ($ok[0] ne "exist") {
	    foreach (@ok) {
		if ($_ eq $$ref) {
		    $found = 1;
		}
	    }
	    if ($found == 0 ) {
		$_ = join(", ",@ok);
		push(@::errors,"\$$varname must be one of $_");
	    }
	}
    }

}

######################################################################
# Check to see if a program is found in $PATH
######################################################################
sub checkinpath {

    my $file = shift(@_);

    if (defined($cfg::path{$file})) {

	# Override in config file

	if ($cfg::path{$file} =~ m:^/:) {

	    # Starts with /; full path override
	    if (-e $cfg::path{$file} && -x _) {
		print $::msg "path $file = $cfg::path{$file}\n";
		return "$cfg::path{$file}";
	    } else {
		push(@::errors,"$cfg::path{$file} not found");
		return(0);
	    }

	} elsif (($cfg::path{$file} =~ m:^\s*sudo\s+-u\s+\S+\s+(\S+):) or
		 ($cfg::path{$file} =~ m:^\s*sudo\s+(\S+):)) {

	    # some sort of sudo...
	    my $prog = $1;

	    &checkinpath('sudo');

	    # sudo with full pathname
	    if (($prog =~ m:^/:) and (-e $prog) and (-x _)) {
		print $::msg "path $file = $cfg::path{$file}\n";
		return "$cfg::path{$file}";
	    }
	    # sudo with just command name
	    my @path = split(/:/,$ENV{'PATH'});
	    foreach my $dir (@path) {
		if (-e "${dir}/$prog" && -x _) {
		    return "$cfg::path{$file}";
		}
	    }

	    push(@::errors,"sudo $prog not found in \$PATH");
	    return(0);

	} else {

	    # Didn't start with /; just overriding name of command
	    # search PATH for it
	    my @path = split(/:/,$ENV{'PATH'});
	    foreach my $dir (@path) {
		if (-e "${dir}/$cfg::path{$file}" && -x _) {
		    return "$cfg::path{$file}";
		}
	    }

	    push(@::errors,"$cfg::path{$file} not found in \$PATH");
	    return(0);

	}

    } else {

	# Not spec'ed as an override in config file; search PATH
	my @path = split(/:/,$ENV{'PATH'});
	foreach my $dir (@path) {
	    if (-e "${dir}/$file" && -x _) {
		return "$file";
	    }
	}

	push(@::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($::debug)) {
	system("($cmd) 2>&1 | $::path{tee} -a $::log");
    } else {
	&log("(debug) command output would be here");
    }

    if (!defined($::use_file)) {
	&line();
	&mt('generic-query');
    }

    &line();

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

}

######################################################################
# Return a command possibly wrapped in ssh/rsh
######################################################################
sub maybe_remote_cmd {

    my $cmd = shift(@_);
    my $host = shift(@_);
    my $quote = shift(@_);
    my $is_pipeline = 0;

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

    if ($cmd =~ m:\s+(\||&&)\s+:) {
	$is_pipeline = 1;
    }

    if (defined($host) and ($host ne '')) {

	# If remote shell is smart enough use pipeline exit detectors
	if (($is_pipeline == 1) and ($::shelltype{$host} eq 'bash2')) {
	    $cmd  = "$::remoteshell $host " . $quote . $cmd . $::bash_pipe_exit . $quote;
	} elsif (($is_pipeline == 1) and ($::shelltype{$host} eq 'zsh')) {
	    $cmd  = "$::remoteshell $host " . $quote . $cmd . $::zsh_pipe_exit . $quote;
	} else {
	    $cmd  = "$::remoteshell $host " . $quote . $cmd . $quote;
	}

    } else {
	$cmd  = "$cmd";
    }
    return($cmd);

}

######################################################################
# Append to the pipelins string appropriate commands to write archive
######################################################################
sub append_writer_cmd {

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

    # Possibly override device
    if (!defined($dev)) {
	$dev = $::device;
    }

    if (defined($::use_pipe)) {

	$cmd .= $::buffer_cmd;

    } elsif (!defined($::remotetapehost)) {

	$cmd .= " | " . $::write_cmd . '"' . $dev . '"' ;

    } else {

	$cmd .= "$::buffer_cmd | ";
	$cmd .= &maybe_remote_cmd($::write_cmd . '"' . $dev . '"', $::remotetapehost);
    }

    return($cmd);
}

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

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

    &line();

    if (($cfg::staticlogs eq 'false') and ($cfg::staticfiles eq 'false')) {
	$::log = "flexbackup.$op." . &current_time('numeric') . ".log";
    } else {
	$::log = "flexbackup.$op.log";
    }

    if (! open(LOG,">$::log")) {
	$::log = "$cfg::tmpdir/$::log";
	if (! open(LOG,">$::log")) {
	    die "Can't write to $::log: $OS_ERROR";
	}
    }
    close(LOG);

    &log("| Logging output to \"$::log\"");

    $::device = &maybe_get_filename();

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

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

    if (defined($::opt{'num'})) {
	&log("| Positioning tape at file number $::opt{num}");
	&mt("rewind","fsf $::opt{num}");
    } else {
	if (defined($::use_pipe)) {
	    &log("| Reading from stdin (type=$cfg::type compress=$cfg::compress)");
	} elsif (defined($::use_file)) {
	    &log("| Reading from on-disk file $::device");
	} elsif (defined($::use_blockdevice)) {
	    &log("| Reading from block device $::device");
	} else {
	    &log("| Reading from CURRENT TAPE POSITION");
	}
    }

    &line();

    if (!defined($::use_file)) {
	&mt('generic-query');
	&line();
    }

    $cmd = &read_function($::device);

    if (defined($::remotetapehost)) {
	$cmd = &maybe_remote_cmd($cmd, $::remotetapehost);
	# Buffer both sides if remote
	$cmd .= $::buffer_cmd;
    }

    $cmd .= " | $::unz ";

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

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

    return($cmd);

}

######################################################################
# Read from file/device - in future buffer cmds might need a blocking
# dd read ahead of them
######################################################################
sub read_function {

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

    # If reading from stdin arg is '-'
    if ($file eq '-') {

	$cmd = $::buffer_cmd;
	$cmd =~ s/^\s*\|\s*//; # Nuke leading " | " we normally use

    } else {

	$cmd = $::read_cmd . '"' . $file . '"';

    }

    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 =~ s/(\S+:)//) {
	$host = $1;
	$path = $spec;
    } 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 STDOUT "\n";
    while(<STDIN>) {
	print;
    }
    exit(0);
}

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

    # Assume stuff based on how we are called first
    if (defined($::opt{'set'})) {
	if (!defined($::set_incremental) and
	    ($::level == 0) and
	    !defined($::use_file)) {
	    # Set level zero, using device. Retension & erase a new tape
	    # (config file may tell us not to erase)
	    if ($cfg::erase_tape_set_level_zero eq "true") {
		$::do_reten = 1;
		$::do_erase = 1;
	    } else {
		$::do_reten = 0;
		$::do_erase = 0;
	    }
	    $::do_rewind_after = 1;
	} else {
	    # Using files, set incremental backup, or set non-zero
	    # don't erase + go to end of tape
	    $::do_reten = 0;
	    $::do_erase = 0;
	    $::do_rewind_after = 1;
	}
    } elsif (defined($::opt{'dir'})) {
	# Just one filesystem - assume we append to tape
	$::do_reten = 0;
	$::do_erase = 0;
	$::do_rewind_after = 1;
    } else {
	# We're doing a read of some sort
	$::do_reten = 0;
	$::do_erase = 0; # -erase has no effect anyway here
	$::do_rewind_after = 0;
    }

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

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

    my $string = shift(@_);
    my $initial_tab;
    my $subsequent_tab;

    local($Text::Wrap::columns) = 76;

    # Older perl's don't have this var. Use twice to shut up
    # -w in that case.  Output almost the same...
    local($Text::Wrap::separator) = " \\\n";
    local($Text::Wrap::separator) = " \\\n";

    # This make it easier to cut-n-paste for debugging commands manually
    if (defined($::debug)) {
	$initial_tab = " ";
	$subsequent_tab = "   ";
    } else {
	$initial_tab = "| ";
	$subsequent_tab = "|   ";
    }

    my @lines = wrap($initial_tab, $subsequent_tab, ($string));
    foreach (@lines) {
	&log($_);
    }

}

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

    my $key;
    my $dev = $cfg::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($::use_file)) {
	$dev .= "/$cfg::keyfile";
	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");

	    # Make sure keyfile entry is there
	    if (!defined($::index{"$key|$cfg::keyfile"})) {
		my $label = "<index keyfile, dir=$cfg::device>";
		if (defined($::debug)) {
		    &log("(debug) \$::index{$key|$cfg::keyfile} = $label");
		} else {
		    $::index{"$key|$cfg::keyfile"} = $label;
		}
	    }

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

    &log("| Creating index key $key");
    $string = "$::path{printf} \'$key\\nThis is a flexbackup index key\\n\' ";
    $string = &append_writer_cmd($string, $dev);
    if (defined($::debug)) {
	&log("(debug) $string");
    } else {
	`$string 2> /dev/null`;
    }

    $::nextfile = 1;

    if (defined($::use_file)) {
	my $label = "<index keyfile, dir=$cfg::device>";
	if (defined($::debug)) {
	    &log("(debug) \$::index{$key|$cfg::keyfile} = $label");
	} else {
	    $::index{"$key|$cfg::keyfile"} = $label;
	}
    } else {
	my $label = "<tape index key>";
	if (defined($::debug)) {
	    &log("(debug) \$::index{$key|0} = $label");
	} else {
	    $::index{"$key|0"} = $label;
	}
    }

    # So that we won't generate duplicate keys...
    # (as long as two processes with -newtape aren't run in parallel)
    sleep(1);

    return($key);
}

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

    my $quiet = shift(@_);
    my $key;

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

    # If writing to a file see if there is already an index key and use it
    if (defined($::use_file)) {
	my $dev = "$cfg::device/$cfg::keyfile";
	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 {

	my $string = "$::path{dd} $::dd_blk_flag $::dd_write_pad_flag count=1 if=$::device";
	if (defined($::remotetapehost)) {
	    $string = &maybe_remote_cmd($string, $::remotetapehost);
	}

	if (defined($::debug)) {
	    &log("(debug) $string");
	    $key = '';
	} else {
	    $key = `$string 2> /dev/null`;
	    @_ = split(/\n/,$key);
	    $key = $_[0];
	}

	if (defined($key)) {
	    chomp($key);
	    if ($key !~ m/^\d+$/) {
		if (!defined($quiet)) {
		    &log("| ERROR: Tape doesn't have an index! (use -newtape?)");
		}
		$::nextfile = 0;
		return('');
	    }
	} else {
	    if (!defined($quiet)) {
		&log("| ERROR: Tape doesn't have an index! (use -newtape?)");
	    }
	    $::nextfile = 0;
	    return('');
	}

    }

    # Find the number of existing files
    $::nextfile = 0;

    unless (defined($::use_file)) {
	foreach (sort keys %::index) {
	    my ($tape,$filenum) = split(/\|/,$_);
	    if ($tape eq $key) {
		if ($filenum > $::nextfile) {
		    $::nextfile = $filenum;
		}
	    }
	}
	# Set for the next file
	$::nextfile++;
	&log("| Found index key $key, next file is $::nextfile");
    } else {
	&log("| Found directory index key $key");
    }

    return($key);

}

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

    my $arg = shift(@_);
    my %desired_keys;
    my $tape;
    my $desired;
    my $label;
    my $dir;
    my $file;
    my %tape_files;
    my %disk_files;

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

    if (defined($arg)) {

	# Print toc for current tape if given argument
	$desired_keys{$arg} = 1;

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

	# Print toc for a specific tape
	&log("| Listing specific index");
	$desired_keys{"$::opt{toc}"} = 1;
	&line();

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

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

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

	# Print everything we know about
	&log("| Listing all in database");
	foreach (keys %::index) {
	    ($tape,$file) = split(/\|/,$_);
	    $desired_keys{$tape} = 1;
	}
	&line();

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

    # Go through the index and fill hashes
    foreach my $key (keys %::index) {
	($tape,$file) = split(/\|/,$key);
	if ($file =~ m/^\d+$/) {
	    $tape_files{$tape}{$file} = $::index{$key};
	} else {
	    $disk_files{$tape}{$file} = $::index{$key};
	}
    }

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

	my $found = 0;
	my $length = 45;

	foreach $tape (sort bynumber keys %tape_files) {
	    if ($tape eq $desired) {
		$found = 1;
		&log('');
		&log("File  Contents    (tape index $tape)");
		&log("-" x $length);
		foreach $file (sort bynumber keys %{$tape_files{$tape}}) {
		    $_ = sprintf("%-04s",$file);
		    &log($_ . " " . $tape_files{$tape}{$file});
		}
	    }
	}

	foreach $dir (sort bynumber keys %disk_files) {
	    if ($dir eq $desired) {
		my @array;
		$found = 1;
		foreach $file (sort keys %{$disk_files{$dir}}) {
		    if ((! -e "$cfg::device/$file") and
			(!defined($::opt{'toc'}) or ($::opt{'toc'} eq ''))) {
			&log("| Bogus index entry - $file does not exist");
			&rmindex("$dir:$file");
			delete $disk_files{$dir}{$file};
		    }
		}
		&log('');
		&log("File  Contents    (dir index $dir)");
		&log("-" x $length);
		foreach $file (keys %{$disk_files{$dir}}) {
		    push(@array, $file . " " . $disk_files{$dir}{$file});
		}
		foreach (sort byfilename @array) {
		    &log($_);
		}
	    }
	}

	if ($found == 0) {
	    &log("Key $desired not found in index");
	}

	&log('');

    }

}

######################################################################
# Nuke stuff from DB
######################################################################
sub rmindex {

    my $arg = shift(@_);
    my $key;
    my $tape;
    my $filenum;
    my $file;
    my $found = 0;

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

    # Figure out if we delete all for one tape, single entry for one tape,
    # or the entire db
    if ($arg =~ m/^(\d+)(:all)?$/) {
	$key = $1;
    } elsif ($arg =~ m/^(\d+):(.+)$/) {
	$key = $1;
	$file = $2;
    } elsif ($arg eq "all") {
	&log("| Removing all in database!!!");
	&log("| Hit CTRL-C to abort within 5 seconds..");
	&line();
	sleep(5);
	foreach (keys %::index) {
	    delete $::index{$_};
	}
	return;
    } else {
	die("Invalid key or key:fileno spec $arg");
    }


    if ($key =~ m/^\d+$/) {

	# This section deletes a whole index record, or maybe just
	# individual file records
	foreach (sort keys %::index) {
	    ($tape,$filenum) = split(/\|/,$_);

	    if (defined($file)) {
		# One file entry
		if (($tape eq $key)
		    and
		    (defined($::use_file) or ($filenum != 0))
		    and
		    ($filenum eq $file)) {
		    &log("| Deleting record for $tape file $filenum");
		    $found++;
		    if (defined($::debug)) {
			&log("(debug) delete \$::index{$tape|$filenum}");
		    } else {
			delete $::index{"$tape|$filenum"};
		    }
		}

	    } else {

		# Whole tape/dir entry
		if ($tape eq $key) {
		    &log("| Deleting record for $tape file $filenum");
		    $found++;
		    if (defined($::debug)) {
			&log("(debug) delete \$::index{$tape|$filenum}");
		    } else {
			delete $::index{"$tape|$filenum"};
		    }
		}
	    }
	}

	if ($found eq 0) {
	    &log("| Record for $arg not found");
	}

	&line();
	return;
    }
}

######################################################################
# Nuke file from on disk, and stuff from DB
######################################################################
sub rmfile {

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

    return if !defined($::use_file);

    $key = &get_tape_key('quiet');

    foreach my $arg (@{$::opt{'rmfile'}}) {

	my $file = "$cfg::device/$arg";

	if ($arg eq 'all') {
	    # Nuke all files in this dir
	    opendir(DIR,$cfg::device) or die ("Can't open dir $cfg::device: $OS_ERROR");
	    foreach my $f (readdir(DIR)) {
		next if ($f =~ m:^\.\.?$:);
		#next if ($f =~ m%^$cfg::keyfile$%);
		if ( -f "$cfg::device/$f") {
		    &log("| Erasing archive $f");
		    unlink("$cfg::device/$f") or die ("Can't rm $cfg::device/$f: $OS_ERROR");
		}
		if ( -d "$cfg::device/$f") {
		    &log("| Erasing directory $f");
		    system("rm -rf $cfg::device/$f") and die ("Can't rm $cfg::device/$f: $OS_ERROR");
		}
	    }
	    closedir(DIR);
	    # Nuke all db entries for this key
	    if ($key ne '') {
		&rmindex("$key:all");
	    }
	} elsif (-f $file) {
	    &log("| Deleting file $file");
	    unlink($file) or die ("Can't rm $file: $OS_ERROR");
	    if ($key ne '') {
		# Nuke db entry for this file
		&rmindex("$key:$arg");
	    }
	} elsif (-d $file) {
	    &log("| Deleting directory $file");
	    system("rm -rf $file") and die ("Can't rm $file: $OS_ERROR");
	    if ($key ne '') {
		# Nuke db entry for this file
		&rmindex("$key:$arg");
	    }
	} else {
	    warn("Error: $file doesn't exist");
	}
    }
}

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

    my $key;

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

    return if (defined($::use_file));

    $key = &get_tape_key('quiet');
    if ($key ne '') {
	&rmindex("$key:all");
    }

}

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


######################################################################
# Sort by archive filename
######################################################################
sub byfilename {

    return 0 if ($a =~ m/^$cfg::keyfile/);
    return 1 if ($b =~ m/^$cfg::keyfile/);

    my $alabel;
    my $alevel;
    my $blabel;
    my $blevel;

    if ($a =~ m/^(.+?)\.(\d+)(\.(\d+))?\./) {
	$alabel = $1;
	$alevel = $2;
	if ($b =~ m/^(.+?)\.(\d+)(\.(\d+))?\./) {
	    $blabel = $1;
	    $blevel = $2;

	    if ($alabel eq $blabel) {
		return($alevel <=> $blevel);
	    }
	}
    }

    return($a cmp $b);
}


######################################################################
# Figure out numeric level for '-level incremental', for a certain fs.
# Try to find last the stamp file, then add one to the level
######################################################################
sub get_incremental_level {

    my $fs = shift(@_);

    my $label = &get_label($fs);
    my $highestlevel = 0;

    opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR");
    foreach my $file (readdir(DIR)) {
	next if ($file !~ m/^$cfg::sprefix$label\.(\d+)$/);
	if ($1 > $highestlevel) {
	    $highestlevel = $1;
	}
    }
    close(DIR);

    $highestlevel++;

    return($highestlevel);

}

######################################################################
# Common commands to invoke 'find' & get a desired file list on stdout
######################################################################
sub file_list_cmd {

    my $dir = shift(@_);
    my $timestampfile = shift(@_);
    my $separator = shift(@_);
    my $level = shift(@_);
    my $remote = shift(@_);
    my $otherarg = shift(@_);

    if (!defined($separator) or ($separator !~ m/^(null|newline)$/)) {
	$separator = 'null';
    }

    my $cmd = '';
    # FreeBSD wants -E to enable extended regex
    if ($::uname =~ /FreeBSD/) {
	$cmd .= "$::path{find} -E . ";
    } else {
	$cmd .= "$::path{find} . ";
    }

    my $prunekey;
    if (defined($remote)) {
	$prunekey = "$remote:$dir";
    } else {
	$prunekey = $dir;
    }

    if (defined(%{$::prune{$prunekey}})) {
	# FreeBSD needs -E (above) and no backslashes around the (|) chars
	if ($::uname =~ /FreeBSD/) {
	    $cmd .= '-regex "\./(';
	    $cmd .= join('|', keys %{$::prune{$prunekey}});
	    $cmd .= ')/.*" ';
	} else {
	    $cmd .= '-regex "\./\(';
	    $cmd .= join('\|', keys %{$::prune{$prunekey}});
	    $cmd .= '\)/.*" ';
	}
	$cmd .= '-prune -o ';
    } else {
	# Can't use find -depth with -prune (see single unix spec etc)
	# (not toally required anyway, only if you are archiving dirs you
	# don't have permissions on and are running as non-root)
	$cmd .= "-depth ";
    }

    $cmd .= "$::mountpoint_flag ";
    $cmd .= "! -type s ";

    if (defined($otherarg)) {
	$cmd .= $otherarg . " ";
    }

    if ($level != 0) {

	# If local, we can use the flexbackup timetamp native and ctime
	# checks can be used.  Remote, we'll be creating stamp with "touch
	# -t"...  but ctime can't be touched backwards.  Turn it off.
	#
	# If atime preserve is set, can't use ctime checks anyway since
	# preserving atime changes the ctime.

	if (($cfg::atime_preserve eq 'false') and !defined($remote)) {
	    $cmd .= '\( ';
	}

	$cmd .= "-newer \"$timestampfile\" ";

	if (($cfg::atime_preserve eq 'false') and !defined($remote)) {
	    $cmd .= "-or -cnewer \"$timestampfile\" " . '\) ';
	}
    }

    $cmd .= "$::exclude_expr ";

    if (!defined($::pkgdelta)) {
	if ($separator eq 'newline') {
	    $cmd .= "-print ";
	} else {
	    $cmd .= "-print0 ";
	}

    } else {

	# Use the normal level & timestamp mechanism to get a list of files
	# Then only keep unowned or owned+changed files

	my $host;
	my $find = &maybe_remote_cmd("cd \"$dir\"; $cmd -print", $remote);
	my $write = "> $::pkgdelta_filelist";
	if(defined($remote)) {
	    &log("| Listing level $level to-be-archived files for $remote:$dir");
	    $write = &maybe_remote_cmd("$::path{cat} $write", $remote);
	    $write = "| $write";
	    $host = $remote;
	} else {
	    &log("| Listing level $level to-be-archived files for $dir");
	    $host = 'localhost';
	}
	&log("| Finding subset of files based on packaging system delta");
	if (!defined($::debug)) {
	    open(LIST,"$find |") || die;
	    open(NEWLIST,"$write") || die;
	    while(<LIST>) {

		my $key;
		my $archive = 0;
		chomp(my $file = $_);

		# Strip leading ./
		$file =~  s:^\./::g;

		# Don't care about the backup dir itself
		next if ($file eq '.');

		if ($dir eq '/') {
		    $key = "/$file";
		    } else {
		    $key = "$dir/$file";
			}

		if (($cfg::pkgdelta_archive_unowned eq 'true') and
		    !defined($::packaged{$host}{$key})) {
		    $archive = 1;
		}

		if (($cfg::pkgdelta_archive_changed eq 'true') and
		    defined($::changed{$host}{$key})) {
		    $archive = 1;
		}

		if ($archive == 1) {
		    if ($separator eq 'null') {
			print NEWLIST "./$file\0";
		    } else {
			print NEWLIST "./$file\n";
		    }
		}

	    }
	    close(LIST);
	    close(NEWLIST);
	}

	&line();

	$cmd = "$::path{cat} $::pkgdelta_filelist ";
    }

    return($cmd);

}

######################################################################
# List installed packages, fills %package_list hash
######################################################################
sub list_packages {

    my $host = shift (@_);
    my $cnt = 0;

    if ($::pkgdelta eq 'rpm') {

	my $cmd = "$::path{rpm} -q -a --queryformat '%{name}-%{version}-%{release}.%{arch}.rpm\\n'";

	if ($host ne 'localhost') {
	    &log("| Identifying all RPM packages on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Identifying all RPM packages...");
	}
	if (defined($::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		if (m:^(.*)$:) {
		    $::package_list{$host}{$1} = 1;
		    if (&POSIX::isatty($::msg)) {
			print $::msg &spinner(++$cnt) . "\r";
		    }
		}
	    }
	    close(LIST);
	}

    } elsif ($::pkgdelta eq 'freebsd') {

	my $cmd = "$::path{pkg_info}";

	if ($host ne 'localhost') {
	    &log("| Identifying all FreeBSD packages on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Identifying all FreeBSD packages...");
	}
	if (defined($::debug)) {
	    &log("(debug) $cmd");
	} else {
	    my (@junk, $pkg);
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		if (&POSIX::isatty($::msg)) {
		    print $::msg &spinner(++$cnt) . "\r";
		}
		($pkg, @junk) = split (/\s+/, $_);
		$::package_list{$host}{$pkg} = 1;
	    }
	    close(LIST);
	}

    }

}

######################################################################
# Fill %packaged with a list of files on host owned by packages
######################################################################
sub find_packaged_files {

    my $host = shift (@_);
    my $cnt = 0;

    return if ($cfg::pkgdelta_archive_unowned eq 'false');

    if ($::pkgdelta eq 'rpm') {

	my $cmd = "$::path{rpm} -q -a -l";

	if ($host ne 'localhost') {
	    &log("| Finding all files owned by RPM packages on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Finding all files owned by RPM packages...");
	}
	if (defined($::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		if (m:^(/.*)$:) {
		    $::packaged{$host}{$1} = 1;
		    if (&POSIX::isatty($::msg)) {
			print $::msg &spinner(++$cnt) . "\r";
		    }
		}
	    }
	    close(LIST);
	}

    } elsif ($::pkgdelta eq 'freebsd') {

	my $cmd = "$::path{pkg_info} -f -q -a";
	my ($fullpath, $localbase, $alt_localbase);
	$localbase = '/usr/local';
	$alt_localbase = '';
	$fullpath = '';

	if ($host ne 'localhost') {
	    &log("| Finding all files owned by FreeBSD packages on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Finding all files owned by FreeBSD packages...");
	}
	if (defined($::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd 2> /dev/null |") || die;
	    while(<LIST>) {
		# If it starts with '@' then it's a pkg directive,
		# else it's a (relative) path
		#
		if (/^\@/) {
		    if (/\@cwd\s+(\S+)/) {
			my ($name, $path, $suffix);

			$localbase = $1;
			$alt_localbase = '';
			($name,$path,$suffix) = fileparse($localbase,'\.\S+');
			$path =~ s/\/$//;
			# In some (default) situations there are some packages which are
			# installed relative to a PREFIX which is actually a link in the /
			# filesystem. The following hack gets around that and creates an
			# entry in $packaged twice--once for the full path that would be seen via
			# pkg_info -L and one for the "unlinked" version. In this manner
			# no matter which FS is being dumped, the code to filter out
			# packaged files will always work.
			#
			if (-l $path) {
			    my $link;
			    $link = readlink ($path);
			    $link = '/' . $link . '/' . $name;
			    $alt_localbase = $link;
			}
		    }
		    if (/\@dirrm\s+(\S+)/) {
			$fullpath = $localbase . '/' . $1;
			$::packaged{$host}{$fullpath} = 1;
			if ($alt_localbase ne '') {
			    $fullpath = $alt_localbase . '/' . $1;
			    $::packaged{$host}{$fullpath} = 1;
			}
			if (&POSIX::isatty($::msg)) {
			    print $::msg &spinner(++$cnt) . "\r";
			}
		    }
		}
		else {
		    $fullpath = $localbase . '/' . $_;
		    chomp ($fullpath);
		    $::packaged{$host}{$fullpath} = 1;
		    if ($alt_localbase ne '') {
			$fullpath = $alt_localbase . '/' . $_;
			chomp ($fullpath);
			$::packaged{$host}{$fullpath} = 1;
		    }
		if (&POSIX::isatty($::msg)) {
		    print $::msg &spinner(++$cnt) . "\r";
		}
		}
	    }
	    close(LIST);
	}
    }
}


######################################################################
# Fill %changed with a list of packaged files on host that have been
# modified
######################################################################
sub find_changed_files {

    my $host = shift (@_);
    my $cnt = 0;

    return if ($cfg::pkgdelta_archive_changed eq 'false');

    if ($::pkgdelta eq 'rpm') {

	my $cmd = "$::path{rpm} -V -a";
	my ($num);

	if ($host ne 'localhost') {
	    &log("| Finding changed package files on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Finding changed package files...");
	}

	$num = scalar (keys %{$::package_list{$host}});

	&log("| Analyzing $num packages may take quite a while, please be patient");
	if (defined($::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		if (&POSIX::isatty($::msg)) {
		    print $::msg &spinner(++$cnt) . "\r";
		}
		# ex: if size, md5sum, and timestamp changed on a config file
		# S.5....T c /etc/ntp.conf
		if (m:^([\.S][\.M][\.5][\.D][\.L][\.U][\.G][\.T]) [dgc ] (.*)$:) {
		    $::changed{$host}{$2} = 1;
		}
	    }
	    close(LIST);
	}

    } elsif ($::pkgdelta eq 'freebsd') {

	my $cmd = "$::path{pkg_info} -g -a -q";
	my ($num);

	if ($host ne 'localhost') {
	    &log("| Finding changed package files on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Finding changed package files...");
	}

	$num = scalar (keys %{$::package_list{$host}});

	&log("| Analyzing $num packages may take quite a while, please be patient");
	if (defined($::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd 2> /dev/null |") || die;
	    while(<LIST>) {
		if (&POSIX::isatty($::msg)) {
		    print $::msg &spinner(++$cnt) . "\r";
		}
		if (/^(\S+)\s+fails.*MD5.*checksum$/) {
		    $::changed{$host}{$1} = 1;
		}
	    }
	    close(LIST);
	}

    }
}

#############################################################################
# Actually test to see if we can run buffer. In situations where SysV shared
# memory is low, or buffer can't run, buffer can fail
#############################################################################
sub test_bufferprog {

    my $buffer_cmd = shift(@_);
    my $host = shift(@_);
    my $tmp_script = "$cfg::tmpdir/buftest.$host.$PROCESS_ID.sh";
    my $retval = 0;
    my $pipecmd;

    $buffer_cmd =~ s:^\s*\|\s*::;
    $buffer_cmd =~ s:\s*\|\s*$::;

    # Create a script which tests the buffer program
    open(SCR,"> $tmp_script") || die;
    print SCR "#!/bin/sh\n";
    print SCR "tmp_data=$cfg::tmpdir/buftest.$host.$$.txt\n";
    print SCR "tmp_err=$cfg::tmpdir/buftest.$host.$$.err\n";
    print SCR "echo testme > \$tmp_data\n";
    print SCR "$buffer_cmd > /dev/null 2> \$tmp_err < \$tmp_data\n";
    print SCR "res=\$?\n";
    print SCR "out=\`cat \$tmp_err\`\n";
    print SCR "if [ \$res -eq 0 ]; then\n";
    print SCR "   echo successful\n";
    print SCR "else\n";
    print SCR "   echo \"unsuccessful: exit code \$res: \$out\" \n";
    print SCR "fi\n";
    print SCR "rm -f \$tmp_data \$tmp_err\n";
    close(SCR);

    if ($host eq 'localhost') {
	print $::msg "| Checking '$cfg::buffer' on this machine... ";
	$pipecmd = "sh $tmp_script ";
    } else {
	print $::msg "| Checking '$cfg::buffer' on host $host... ";
	$pipecmd =  "cat $tmp_script | ($::remoteshell $host 'mkdir -p $cfg::tmpdir;
 		     cat - > $tmp_script; sh $tmp_script; rm -rf $cfg::tmpdir')";
    }

    if (!defined($::debug)) {

	open(PIPE,"$pipecmd |") || die;
	while (<PIPE>) {
	    if (/^unsuccessful: exit code (\d+): (.*)/) {
		$retval = $1;
		my $out = $2;
		if ($retval != 0) {
		    push(@::errors, "Problems encountered testing '$cfg::buffer' on host '$host':");

		    if ($out ne '') {
			push(@::errors, "  --> " . $out);
		    }

		    if (($cfg::buffer eq 'buffer') and ($retval == 255)) {
			push(@::errors, "  You don't have enough shared memory to run '$cfg::buffer' on $host, or");
			push(@::errors, "  have exceeded buffering limits. Try lowering the amount specified in");
			push(@::errors, "  \$buffer_megs in your flexbackup.conf file, or reconfigure your");
			push(@::errors, "  kernel to include more SysV shared memory pages if using *BSD.");
		    } else {
			push(@::errors, "  Unknown problem trying to run '$cfg::buffer' (exit code $retval). Try disabling it");
			push(@::errors, "  or lowering \$buffer_megs.");
		    }
		}
	    }
	}
	close (PIPE);

    } else {
	print $::msg "\n(debug) 'buffer' test script:\n($tmp_script)\n\n"
	      . `cat $tmp_script`;
	print $::msg "\n(debug) $pipecmd\n";
    }

    if ($retval == 0) {
	print $::msg "Ok\n";
    }  else {
	print $::msg "Failed!\n";
    }
    unlink("$tmp_script");

    return($retval);
}


#############################################################################
# Check that programs exist on remote systems
# Check buffer execution on them too
#############################################################################
sub check_remote_progs {

    my $remotehost_ref = shift(@_);
    my $remoteprogs_ref = shift(@_);
    my $err = 0;
    my @progs;

    foreach my $host (keys %$remotehost_ref) {
	&check_shell($host);
    }

    foreach (@$remoteprogs_ref) {
	# Could be '0' if original checkinpath failed on localhost
	if ($_ ne '0') {
	    push(@progs,"type $_ 2>&1");
	} else {
	    $err++;
	}
    }
    my $string = join ('; ',@progs);
    foreach my $host (keys %$remotehost_ref) {
	print $::msg "| Checking for required programs on host $host... ";
	my $cmd = "$::remoteshell $host \"sh -c '$string'\"";
	if (defined($::debug)) {
	    print $::msg "\n(debug) $cmd\n";
	    next;
	}
	if (!(open(PIPE,"$cmd |"))) {
	    push (@::errors, "Could not open pipe to remote shell - $!");
	    $err++;
	    last;
	}

	while (<PIPE>) {
	    if (m/(\S+) not found/) {
		push(@::errors, "Could not find program '$1' on remote machine '$host'");
		$err++;
	    }
	}
	close (PIPE);

	if ($err == 0) {
	    print $::msg "Ok\n";
	} else {
	    print $::msg "Failed!\n";
	}

    }

    if ($cfg::buffer ne 'false') {
	foreach my $host (keys %$remotehost_ref) {
	    &test_bufferprog($::buffer_cmd, $host);
	}
    }

}

#############################################################################
# Check shell on remote systems
# (Mainly to see if we should use bash pipe exit trick at this point)
#############################################################################
sub check_shell {

    my $host = shift(@_);
    my $pipecmd;

    $pipecmd = 'set x = 1 && test $x && echo csh:yes; echo tcsh:$tcsh; echo bash:$BASH_VERSION; echo zsh:$ZSH_VERSION; echo ksh:$KSH_VERSION';

    if ($host eq 'localhost') {
	print $::msg "| Checking /bin/sh on this machine... ";
    } else {
	print $::msg "| Checking shell on $host... ";
	$pipecmd = "$::remoteshell $host '" . $pipecmd . "'";
    }

    $::shelltype{$host} = 'unknown';

    if (defined($::debug)) {
	print $::msg "\n(debug) $pipecmd\n";
    }

    if (!(open(PIPE,"$pipecmd 2>&1 |"))) {
	return;
    }

    while (<PIPE>) {

	if (m/^(\S+):(\S.+)$/) {
	    my $shell = $1;
	    my $ver = $2;
	    if ($shell eq 'bash') {
		if ($ver =~ m/^2/) {
		    $::shelltype{$host} = 'bash2';
		} else {
		    $::shelltype{$host} = 'bash1';
		}
	    } else {
		$::shelltype{$host} = $shell;
	    }
	}
    }
    close (PIPE);

    if (($::shelltype{$host} eq 'unknown') and ($::uname !~ m/Linux/)) {
	print $::msg "$::shelltype{$host} (probably Bourne Shell)\n";
    } else {
	print $::msg "$::shelltype{$host}\n";
    }
}


#############################################################################
# Wipe a tape for use.
#############################################################################
sub newtape () {

    my $retval;

    if (defined($::tapedevice)) {
	&log('| Rewinding & erasing tape...');
    }
    &mt('rewind');
    &maybe_delete_old_index();
    &mt('rewind');
    &mt('generic-erase');
    $retval = &new_tape_key();

    return($retval);
}


#############################################################################
# Test writing a couple files to tape, then read & diff.  To help make
# sure filemarks, blocks, padding, are working as we need.
#############################################################################
sub test_tape_drive {

    my $cmd;
    my $tmp1 = "$cfg::tmpdir/test1.$PROCESS_ID";
    my $tmp2 = "$cfg::tmpdir/test2.$PROCESS_ID";
    my $tmp3 = "$cfg::tmpdir/test3.$PROCESS_ID";
    my $fail = 0;
    my $configfile;

    if (defined($::opt{'c'})) {
	$configfile = $::opt{'c'};
    } else {
	$configfile = $::CONFFILE;
    }

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

    &log("| Testing will *erase* the tape currently in the drive!");
    &log("| Hit CTRL-C to abort within 10 seconds...");
    &line();
    sleep(10);
    &log("| If for some reason this program does not exit within a few minutes,");
    &log("| Hit CTRL-C, and try adjusting \$blksize, \$pad_blocks, or \$mt_blksize.");
    &line();

    &newtape();
    &line();

    &mt('generic-query');
    &log('');
    &log("Writing test file \#1");
    $cmd = "$::path{cat} $0";
    $cmd = &append_writer_cmd($cmd);
    if (!defined($::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log($cmd);
    }

    &mt('generic-query');
    &log("Writing test file \#2");
    $cmd = "$::path{cat} $configfile";
    $cmd = &append_writer_cmd($cmd);
    if (!defined($::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log($cmd);
    }

    &mt('generic-query');
    &log("Writing test file \#3");
    $cmd = "$::path{cat} $0";
    $cmd = &append_writer_cmd($cmd);
    if (!defined($::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log($cmd);
    }

    &mt('generic-query');
    &log('');
    &log('Rewinding...');
    &mt('rewind');
    if ($cfg::indexes eq 'true') {
	&log('Skipping index label...');
	&mt('fsf 1');
    }
    &mt('generic-query');
    &log('');

    &log("Reading test file \#1");
    $cmd = &read_function($::device);
    if (defined($::remotetapehost)) {
	$cmd = &maybe_remote_cmd($cmd, $::remotetapehost);
	# Buffer both sides if remote
	$cmd .= $::buffer_cmd;
    }
    # if pad blocks was true we have nulls at the end (won't be in this script otherwise)
    if ($cfg::pad_blocks eq 'true') {
	$cmd .= " | $::path{tr} -d '\\0' > $tmp1";
    } else {
	$cmd .= "> $tmp1";
    }
    if (!defined($::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log("(debug) $cmd");
    }

    &mt('generic-query');
    &log("Reading test file \#2");
    $cmd = &read_function($::device);
    if (defined($::remotetapehost)) {
	$cmd = &maybe_remote_cmd($cmd, $::remotetapehost);
	# Buffer both sides if remote
	$cmd .= $::buffer_cmd;
    }
    # if pad blocks was true we have nulls at the end (won't be in config file otherwise)
    if ($cfg::pad_blocks eq 'true') {
	$cmd .= " | $::path{tr} -d '\\0' > $tmp2";
    } else {
	$cmd .= "> $tmp2";
    }
    if (!defined($::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log("(debug) $cmd");
    }

    &mt('generic-query');
    &log("Reading test file \#3");
    $cmd = &read_function($::device);
    if (defined($::remotetapehost)) {
	$cmd = &maybe_remote_cmd($cmd, $::remotetapehost);
	# Buffer both sides if remote
	$cmd .= $::buffer_cmd;
    }
    # if pad blocks was true we have nulls at the end (won't be in this script otherwise)
    if ($cfg::pad_blocks eq 'true') {
	$cmd .= " | $::path{tr} -d '\\0' > $tmp3";
    } else {
	$cmd .= "> $tmp3";
    }
    if (!defined($::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log("(debug) $cmd");
    }

    &mt('generic-query');
    &log('');
    &mt('rewind');
    &log("Comparing...");
    if (!defined($::debug)) {
	system("$::path{diff} -q $0 $tmp1");
	if ($CHILD_ERROR) {
	    $fail++;
	}
	system("$::path{diff} -q $configfile $tmp2");
	if ($CHILD_ERROR) {
	    $fail++;
	}
	system("$::path{diff} -q $0 $tmp3");
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log("(debug) $::path{diff} -q $0 $tmp1");
	&log("(debug) $::path{diff} -q $configfile $tmp2");
	&log("(debug) $::path{diff} -q $0 $tmp3");
    }

    unlink $tmp1;
    unlink $tmp2;
    unlink $tmp3;

    if ($fail != 0) {
	print $::msg "\nFAILURE! Problem with tape driver or parameters.  Please see the FAQ\n";
	print $::msg "or try changing the \$blksize, \$pad_blocks, or \$mt_blksize settings.\n";
	exit(1);
    } else {
	print $::msg "SUCCESS! Tape drive parameters seem to work just fine\n";
    }

}


######################################################################
# Check if the week day is as specified before backup (for complex cron setups)
######################################################################
sub check_wday {

    if (defined($::opt{'wday'})) {
	my @now = localtime;
	my $wday_now = $now[6];

	# Just silently hard-limit these to valid set
	if ($::opt{'wday'} >= 7) {
	    $::opt{'wday'} = 0;
	}
	if ($::opt{'wday'} < 0) {
	    $::opt{'wday'} = 0;
	}

	if ($wday_now != $::opt{'wday'}) {
	    exit(0);
	}
    }
}

######################################################################
# Split whitespace-separated list.
# If it contains quotes, do a bit differently so we can have
# items containing whitespace, as long as all elements are quoted.
######################################################################
sub split_list {

    my $string = shift(@_);
    my @array;

    if ($string =~ m/\"/) {
	$string =~ s/^\s*\"//;
	$string =~ s/\"\s*$//;
	@array = split(/\"\s+\"/,$string);
    } elsif ($string =~ m/\'/) {
	$string =~ s/^\s*\'//;
	$string =~ s/\'\s*$//;
	@array = split(/\'\s+\'/,$string);
    } else {
	@array = split(/\s+/,$string);
    }

    return(@array);
}


######################################################################
# To show activity....
######################################################################
sub spinner {

    my $index = shift(@_);
    my (@spinner) = ('|','/','-','\\','|','/','-','\\');

    $index = $index % $#spinner;

    return($spinner[$index]);
}
flexbackup 1.2.1-6.2 / usr / bin / flexbackup
