#!/usr/bin/perl -w
######################################################################
#
# Edwin Huffstutler, <edwinh@computer.org>
# $Id: flexbackup,v 1.147.2.70 2003/06/18 19:51:14 edwinh Exp $
# $Name: v1_1_7 $
#
#      >>>> Also see the config file, README file, & 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.
# 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
#                                    a filename argument
# 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 -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 English;
use strict;

# No output buffering
$OUTPUT_AUTOFLUSH = 1;

package main;

# 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"
$main::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
#
$main::bash_pipe_exit = '; x=(${PIPESTATUS[@]}); i=0; while [ $i -lt ${#x[@]} ]; do [ ${x[$i]} -eq 0 ] || exit ${x[$i]}; i=$(($i+1)); done';
$main::zsh_pipe_exit = '; x=(${pipestatus[@]}); i=1; while [ $i -le ${#x[@]} ]; do [ ${x[$i]} -eq 0 ] || exit ${x[$i]}; i=$(($i+1)); done';

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

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

# Version
if (defined($main::opt{'version'})) {
    print "flexbackup version " . &versionstring() . "\n";
    print '$Id: flexbackup,v 1.147.2.70 2003/06/18 19:51:14 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 "\nflexbackup version " . &versionstring() . "\n";
&readconfigfile();
print "\n";

# Set OS type
chomp($main::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
$main::date = &current_time('numeric');

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

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

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

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

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

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

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

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

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

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

}

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

exit(0);

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

    # FIXME better on exit if error....
    # (clean the log, finish the fs loop, etc)
    # Find any die/exit from wahtever this calls past logfile open,
    # and percolate it up...

    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 = '';


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

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

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

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

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


    # Remember old log files (will remove at end of job)
    # ("old" = any higher- or equal-numbered logs for this label)
    if (!defined($main::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|\.Z|\.zip)?$/);

	    # Find normal old logs
	    if ($lf =~ m/^$cfg::prefix$label\.(\d+)(\.(\d+))?(\.gz|\.bz2|\.Z|\.zip)?$/) {
		if ($1 >= $main::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 (($main::level == 0) and ($lf =~ m/^$cfg::prefix$label\.(incremental)(\.(\d+))?(\.gz|\.bz2|\.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($main::pkgdelta)) {
	if (defined($main::local)) {
	    &list_packages('localhost');
	    &find_packaged_files('localhost');
	    &find_changed_files('localhost');
	}
	foreach my $host (keys %main::remotehosts) {
	    &list_packages($host);
	    &find_packaged_files($host);
	    &find_changed_files($host);
	}
	$main::pkgdelta_filelist = "$cfg::tmpdir/pkgdelta.$PROCESS_ID";
	&line();
    }

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

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

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

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

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

	    # Maybe rewind/erase
	    if ($main::do_erase == 1) {
		$tape_key = &newtape();
	    } else {
		&mt('rewind');
		$tape_key = &get_tape_key();
		if(defined($main::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($main::tapedevice)) {
		# Multiple tapes are only for level 0
		if (!defined($main::set_incremental) and ($main::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($main::set_incremental)) {
		    $level = $main::level;
		} else {
		    $level = &get_incremental_level($dir);
		}

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

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

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

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

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

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

	}  # end foreach set

    } else {

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

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

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

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

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

    } # end set or single fs

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

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

    # Remove old log files now that we are done
    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($main::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 = "$main::path{gzip} -f \"$main::log\"";
	} elsif ($cfg::comp_log eq "bzip2") {
	    $logext = ".bz2";
	    $comp_cmd = "$main::path{bzip2} -f \"$main::log\"";
	} elsif ($cfg::comp_log eq "zip") {
	    $logext = ".zip";
	    $comp_cmd = "$main::path{cat} \"$main::log\" | $main::path{zip} -q - - > \"$main::log" . $logext . "\"; $main::path{rm} -f \"$main::log\"";
	} elsif ($cfg::comp_log eq "compress") {
	    $logext = ".Z";
	    $comp_cmd = "$main::path{compress} -f \"$main::log\"";
	}
	undef $main::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');

    &toc_routine($tape_key);

    exit(0);

}

######################################################################
# 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;

    &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($main::use_file)) {

	my $filename = $level;

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

	if ($cfg::staticfiles eq 'true') {
	    $filename .= "." . $cfg::type;
	} else {
	    $filename .= "." . $main::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$//;
	}

	# 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 "zip") {
		$filename .= ".zip";
	    } elsif ($cfg::compress eq "compress") {
		$filename .= ".Z";
	    }
	} elsif ($cfg::type eq "afio") {
	    # tag these a little different, the archive file itself isn't a
	    # .gz or .bz2, but the files in it are....
	    if ($cfg::compress eq "gzip") {
		$filename .= "-gz";
	    } elsif ($cfg::compress eq "bzip2") {
		$filename .= "-bz2";
	    } elsif ($cfg::compress eq "zip") {
		$filename .= "-zip";
	    } elsif ($cfg::compress eq "compress") {
		$filename .= "-Z";
	    }
	}

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

    }

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

    # Label for this archive
    chomp($host = `hostname`);
    $title = $cfg::type . "+" . $cfg::compress;
    $title =~ s/\+false//;
    if (!defined($main::pkgdelta)) {
	$title = "level $level $dir $main::date_at_start $title from $host";
	$title_without_type = "level $level $dir $main::date_at_start from $host";
    } else {
	$pkglist = "flexbackup.$main::pkgdelta.packagelist";
	$title = "level $level+$main::pkgdelta $dir $main::date_at_start $title from $host";
	$title_without_type = "level $level+$main::pkgdelta $dir $main::date_at_start from $host";
    }

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

    # Write list of packages
    if (defined($main::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("$main::path{cat} $write", $remote);
	    $write = "| $write";
	    $h = $remote;
	} else {
	    $h = 'localhost';
	}
	if (!defined($main::debug)) {
	    open(LIST,"$write") || die;
	    foreach my $pkg (sort keys %{$main::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($label, $localdir, $title, $level, $remote);
    } elsif ($cfg::type eq 'filelist') {
	($remove, @cmds) = &backup_filelist($label, $localdir, $title, $level, $remote);
    }

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

    # Create/nuke tmp file list if we did local package delta
    if (defined($main::pkgdelta)) {
	if (
	    ($cfg::pkgdelta_archive_list eq 'true') or
	    (($cfg::pkgdelta_archive_list eq 'rootonly') and ($localdir eq '/'))
	    ) {
	    push(@cmds, &maybe_remote_cmd("$main::path{rm} -f $main::pkgdelta_filelist $pkglist", $remote));
	} else {
	    push(@cmds, &maybe_remote_cmd("$main::path{rm} -f $pkglist", $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 ($main::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($main::debug)) {
	foreach $cmd (@cmds) {

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

	    if ($CHILD_ERROR) {
		&log('');
		&log("ERROR from backup, exiting");

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

		# Put ERROR in the index if tapedevice, or nuke index if file
		if (defined($indexkey)) {
		    if (defined($main::use_file)) {
			delete $main::index{$indexkey};
		    } else {
			$main::index{$indexkey} .= "\n\t---> ERROR occurred during write, above may not be valid";
		    }
		}
		# If file, rm botched file regardless of index
		if (defined($main::use_file)) {
		    if ($cfg::type eq 'copy') {
			system("rm -rf $main::device");
		    } else {
			unlink($main::device);
		    }
		}

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

		exit(1);
	    }
	    close(LOG);

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

    # Actually remove the old stamp files now that we are done
    foreach my $ts (sort keys %oldstamps) {
	print "| Removing out of date level $oldstamps{$ts} timestamp for $dir\n";
	if (!defined($main::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: $main::date_at_start");
    &log("| Backup end:   $t");
    if (!defined($main::debug)) {
	system("$main::path{touch} -t \"$main::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($main::debug)) and defined($main::tapedevice)) {
	sleep 10;
    }

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

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

}

######################################################################
# 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(%{$main::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($main::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 .= "dump -$level ";
    $cmd .= "$main::dump_blk_flag ";
    if ($cfg::dump_use_dumpdates eq "true") {
	$cmd .= "-u ";
    } else {
	$cmd .= $date_flag;
    }
    $cmd .= "$main::dump_len_flag ";
    $cmd .= "-f - ";
    $cmd .= "$dir $main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::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 = "$main::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 = "$main::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 .= "($main::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 .= "$main::path{afio} -o ";
    $cmd .= "$no_compress ";
    $cmd .= "-z ";
    $cmd .= "-1 m ";
    $cmd .= "$main::afio_z_flag ";
    $cmd .= "$main::afio_verb_flag ";
    $cmd .= "$main::afio_sparse_flag ";
    $cmd .= "$main::afio_atime_flag ";
    $cmd .= "$main::afio_bnum_flag ";
    $cmd .= "$main::afio_blk_flag ";
    $cmd .= "-";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::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 = "$main::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 .= "$main::path{cpio} -o ";
    $cmd .= "-0 ";
    $cmd .= "-H $cfg::cpio_format ";
    $cmd .= "$main::cpio_verb_flag ";
    $cmd .= "$main::cpio_blk_flag ";
    $cmd .= "$main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 {

    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 = "$main::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 .= "$main::path{cpio} -o ";
    $cmd .= "-0 ";
    $cmd .= "-H $cfg::cpio_format ";
    $cmd .= "$main::cpio_verb_flag ";
    $cmd .= "$main::cpio_blk_flag ";

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

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

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

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

    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 = "$main::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 .= "$main::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') {
	$cmd .= "--label \"$title\" ";
    }
    $cmd .= "$main::tar_verb_flag ";
    $cmd .= "$main::tar_sparse_flag ";
    $cmd .= "$main::tar_atime_flag ";
    $cmd .= "$main::tar_recnum_flag ";
    $cmd .= "$main::tar_blk_flag ";
    $cmd .= "--file - ";
    $cmd .= "$main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::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 .= "$main::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 .= "$main::star_fifo_flag ";
    $cmd .= "$main::star_acl_flag ";
    $cmd .= "$main::star_verb_flag ";
    $cmd .= "$main::star_sparse_flag ";
    $cmd .= "$main::star_atime_flag ";
    $cmd .= "$main::star_blocknum_flag ";
    $cmd .= "$main::star_blk_flag ";
    $cmd .= "file=- ";
    $cmd .= "$main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::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 = "$main::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 .= "$main::path{pax} -w ";
    $cmd .= "-d ";
    $cmd .= "-s %^./%% ";
    $cmd .= "-x $cfg::pax_format ";
    $cmd .= "$main::pax_verb_flag ";
    $cmd .= "$main::pax_blk_flag ";
    $cmd .= "$main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::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 = "$main::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 .= "$main::path{zip} -@ ";
    $cmd .= "-b $cfg::tmpdir "; # temp file path
    $cmd .= "-y "; # store symlinks
    $cmd .= "$main::zip_compr_flag ";
    $cmd .= "$main::zip_noz_flag "; # nocompress list
    $cmd .= "$main::zip_verb_flag "; # verbose flag
    $cmd .= "$tmpzip";

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

    $cmd = "$main::path{cat} $tmpzip ";
    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::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 = "$main::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 .= "$main::path{ar} rc";
    $cmd .= "$main::ar_verb_flag ";
    $cmd .= "$tmpfile ";
    $cmd .= "`$main::path{cat} $filelist`";
    $cmd .= "; $main::path{cat} $tmpfile $main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::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 .= "$main::path{shar} ";
    $cmd .= "$main::shar_verb_flag ";
    if ($cfg::label ne 'false') {
	$cmd .= "-n \"$title\" ";
    }
    $cmd .= "-S ";
    $cmd .= "$main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::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 .= "$main::path{lha} a";
    $cmd .= "$main::lha_verb_flag ";
    $cmd .= "$tmpfile ";
    $cmd .= "`$main::path{cat} $filelist`";
    $cmd .= "; $main::path{cat} $tmpfile $main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 = "$main::path{touch} -t \"$time\" $stamp";
	push(@cmds, &maybe_remote_cmd($cmd, $remote));
	$remove .= " $stamp";
    } else {
	$stamp = &get_last_date($label, $level, 'filename');
    }

    &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; $main::path{cat} $filelist 1>&2; $main::path{cat} $filelist ";
    $cmd .= "$main::z";

    # Buffer both sides if remote
    if (defined($remote)) {
	$cmd .= $main::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 .= "$main::path{restore} -t ";
	$cmd .= "$main::dump_verb_flag ";
	$cmd .= "$main::dump_blk_flag ";
	$cmd .= "-f -";

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

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

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

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

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

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

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

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

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

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

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

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

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

	$cmd .= "$main::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($main::opt{'flist'})) {
	# Have to get a list of the files for restore to use
	open(LIST,"$main::opt{flist}") or die ("Can't open $main::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 $main::opt{flist}");
    }

    if (defined($main::opt{'onefile'})) {
	open(NEWLIST,">$newlist") or die ("Can't open $newlist: $OS_ERROR");
	$_ = $main::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 .= "$main::path{restore} -x ";
	$cmd .= "$main::dump_verb_flag ";
	$cmd .= "$main::dump_blk_flag ";
	$cmd .= "-o ";
	$cmd .= "-f -";
	$cmd .= $restore_files;

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

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

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

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

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

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

    } elsif ($cfg::type eq 'ar') {
	my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID";
	$cmd .= "$main::path{cat} > $tmpfile; ";
	$cmd .= "$main::path{ar} xo";
	$cmd .= "$main::ar_verb_flag ";
	$cmd .= "$tmpfile ";
	$cmd .= $restore_files;
	$cmd .= "; ";
	$cmd .= "$main::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 eq 'copy') {

	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 .= "$main::path{cat} > $tmpfile ; ";
	$cmd .= "$main::path{lha} x";
	$cmd .= "$main::lha_verb_flag ";
	$cmd .= "$tmpfile ";
	$cmd .= $restore_files;
	$cmd .= "; ";
	$cmd .= "$main::path{rm} -f $tmpfile";

    }

    &run_or_echo_then_query($cmd);

    if (defined($main::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 .= "$main::path{restore} -C ";
	$cmd .= "$main::dump_blk_flag ";
	$cmd .= "-f -";

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

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

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

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

    } 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 .= "$main::path{restore} -i ";
	$cmd .= "$main::dump_verb_flag ";
	$cmd .= "$main::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: $main::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\n";
    }

    if (($do_log == 1) and defined($main::log)) {
	open(LOG,">>$main::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 '|';
	print '-' x $length;
	print "\n";
    }

    if (($do_log == 1) and defined($main::log)) {
	open(LOG,">>$main::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 = $main::opt{'d'};

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

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

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

}

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

    my (@operations) = (@_);

    # Set hardware compression when we do the blocksize
    if ($cfg::compress eq "hardware") {
	foreach my $operation (@operations) {
	    if ($operation =~ m/generic-blocksize/) {
		if ($main::uname =~ /Linux/) {
		    push(@operations,'compression 1');
		} elsif ($main::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 ($main::uname =~ /FreeBSD/) {
		push(@operations,'seteotmodel 1');
	    }
	}
    }

    foreach my $operation (@operations) {

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

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

	# mt flavors for erase
	# (some mt's have no "erase", just rewind before starting...)
	if ($operation eq 'generic-erase') {

	    if ($cfg::erase_rewind_only eq "true") {
		$operation = 'rewind';
	    } elsif ($main::uname =~ /Linux/) {
		$operation = 'erase';
	    } elsif ($main::uname =~ /OpenBSD/) {
		$operation = 'erase';
	    } elsif ($main::uname =~ /FreeBSD/) {
		$operation = 'erase';
	    } elsif ($main::uname =~ /OSF1/) {
		$operation = 'erase';
	    } elsif ($main::uname =~ /AIX/) {
		$operation = 'erase';
	    } elsif ($main::uname =~ /HP-UX/) {
		$operation = 'erase';
	    } elsif ($main::uname =~ /SunOS/) {
		$operation = 'erase';
	    } elsif ($main::uname =~ /IRIX/) {
		$operation = 'erase';
	    } else {
		$operation = 'erase';
	    }
	}

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

	if (defined($main::use_file)) {

	    # mt ops skipped for files

	} elsif (defined($main::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 = "$main::path{mt} -f $main::device $operation > /dev/null 2>&1";
		if (defined($main::remotetapehost)) {
		    $command = &maybe_remote_cmd($command, $main::remotetapehost);
		}
		system($command);
		if ($CHILD_ERROR) {
		    &log("| Trying \"mt defblksize\" instead of \"mt setblk\"");
		    my $oldoperation = $operation;
		    $operation =~ s/setblk/defblksize/;
		    $command = "$main::path{mt} -f $main::device $operation > /dev/null 2>&1";
		    if (defined($main::remotetapehost)) {
			$command = &maybe_remote_cmd($command, $main::remotetapehost);
		    }
		    system($command);
		    if ($CHILD_ERROR) {
			&log("Error setting block size");
			&log("Neither of these commands worked:");
			&log("  $main::path{mt} -f $main::device $oldoperation");
			&log("  $main::path{mt} -f $main::device $operation");
			exit(1);
		    } # error on second guess
		} # error on first guess
	    } # operation = setblk

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

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

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

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

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

	} # not a file

    } # foreach operation

}

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

    my $realdev;
    my $buffer_blk_flag;
    my $buffer_pad_flag;
    my $mbuffer_blk_flag;
    my $mbuffer_pad_flag;

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

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

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

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

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

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

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

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

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

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

    # Check device (or dir)
    $main::ftape = 0;
    if ($cfg::type eq 'filelist') {

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

    } elsif (-c $realdev) {

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

    } elsif (-b $realdev) {

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

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

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

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

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

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

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

    # Exclude regexp for find
    $main::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 . '"';
	    }

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

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

    # Block size
    &check(\$cfg::blksize,'blksize','exist');
    if ($cfg::blksize !~ m/^\d+$/) {
	push(@main::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
	$main::dd_blk_flag = "ibs=" . $cfg::blksize . "k obs=" . $cfg::blksize . "k";
	# dump blocksize just in k like the config file
	$main::dump_blk_flag = "-b $cfg::blksize";
	# afio blocksize needs k appended
	$main::afio_blk_flag = "-b " . $cfg::blksize . "k";
	# cpio blocks are in bytes
	$main::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.
	$main::tar_blk_flag = "-b " . $cfg::blksize * 2;
	# star blocks are in 512-byte units
	$main::star_blk_flag = "blocks=" . $cfg::blksize * 2;
	# pax blocksize needs k appended
	$main::pax_blk_flag = "-b " . $cfg::blksize . "k";
    } else {
	$buffer_blk_flag = "";
	$mbuffer_blk_flag = "";
	$main::dd_blk_flag = "";
	$main::dump_blk_flag = "";
	$main::afio_blk_flag = "";
	$main::cpio_blk_flag = "";
	$main::tar_blk_flag =  "";
	$main::star_blk_flag =  "";
	$main::pax_blk_flag = "";
    }

    # mt block size (in bytes not k)
    if (!defined($cfg::mt_blksize)) {
	$cfg::mt_blksize = $cfg::blksize * 1024;
	$main::mt_blksize = $cfg::mt_blksize;
    }
    if ($cfg::mt_blksize !~ m/^\d+$/) {
	push(@main::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(@main::errors,"\$mt_blksize ($cfg::mt_blksize) should be a factor of \$blksize ($tmp)");
	    }
	}
	$main::mt_blksize = $cfg::mt_blksize;
    }

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

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

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

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

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

    # Buffer setup
    if (($cfg::buffer ne 'false') and ($cfg::buffer_megs !~ m/^\d+$/)) {
	push(@main::errors,"\$buffer_megs must be set to integer number of megabytes");
    }
    if ($cfg::buffer eq "buffer") {

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

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

	if (defined($main::tapedevice)) {
	    $write_flags = "-u 100 -t -p 75 $buffer_pad_flag -o ";
	    $read_flags = "-u 100 -t -p 75 $buffer_pad_flag -i ";
	} else {
	    $write_flags = "-t -p 75 $buffer_pad_flag -o ";
	    $read_flags = "-t -p 75 $buffer_pad_flag -i ";
	}
	$main::buffer_cmd = " | $bufcmd";
	$main::write_cmd = "$bufcmd $write_flags";
	$main::read_cmd = "$bufcmd $read_flags";

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

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

	my $megs = $cfg::buffer_megs . "M";
	my $bufcmd = "$main::path{mbuffer} -m $megs $buffer_blk_flag";

	$main::buffer_cmd = " | $bufcmd -q";
	$main::write_cmd = "$bufcmd | $main::path{dd} $main::dd_blk_flag $main::dd_pad_flag of=";
	$main::read_cmd = "$main::path{dd} $main::dd_blk_flag $main::dd_pad_flag if=";

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

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

	my $megs = $cfg::buffer_megs . "m";
	my $bufcmd = "$main::path{bfr} -b $megs";

	$main::buffer_cmd = " | $bufcmd";
	$main::write_cmd = "$bufcmd | $main::path{dd} $main::dd_blk_flag $main::dd_pad_flag of=";
	$main::read_cmd = "$main::path{dd} $main::dd_blk_flag $main::dd_pad_flag if=";

    } else {

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

    }

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

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

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

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

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

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

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

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

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

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

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

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

	&check(\$cfg::dump_length,'dump_length','exist');
	&check(\$cfg::dump_use_dumpdates,'dump_use_dumpdates');

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

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

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

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

	&check(\$cfg::afio_echo_block,'afio_echo_block');
	&check(\$cfg::afio_compress_cache_size,'afio_compress_cache_size','exist');
	&check(\$cfg::afio_compress_threshold,'afio_compress_threshold','exist');

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

	&check(\$cfg::afio_nocompress_types,'afio_nocompress_types','exist');

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	&check(\$cfg::tar_echo_record_num,'tar_echo_record_num');

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	$main::zip_noz_flag = "";
	if (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 (@_) {
		$_ = "." . $_;
	    }
	    $main::zip_noz_flag = " -n " . join(":",@_);
	}

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

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

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

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

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

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

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

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

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

    } # type-specific


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

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

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

    if (($main::opt{'level'} !~ m/^\d+$/) and
	($main::opt{'level'} !~ m/^(full|differential|incremental)$/)) {
	push(@main::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 ($main::opt{'level'} =~ m/^\d+$/) {
	# Make string variable numeric
	$main::level = POSIX::strtod($main::opt{'level'});
	if (($cfg::type eq 'dump') and ($main::level > 9)) {
	    push(@main::errors,"can't use level > 9 and type=dump");
	}
    } elsif ($main::opt{'level'} eq "full") {
	$main::level = 0;
    } elsif ($main::opt{'level'} eq "differential") {
	$main::level = 1;
    } elsif ($main::opt{'level'} eq "incremental") {
	# If incremental + one fs, we can find the level now.
	if (defined($main::opt{'dir'})) {
	    $main::level = &get_incremental_level($main::opt{'dir'});
	    if (($cfg::type eq 'dump') and ($main::level > 9)) {
		push(@main::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 $main::level;
	    $main::set_incremental = 1;
	}
    }

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

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

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

	} elsif ($main::opt{'pkgdelta'} eq 'freebsd') {
	    #
	    # JR: FIXME FIXME FIXME
	    # pkg_info doesn't have the '-g' flag before 4.3-RELEASE so we need to look
	    # at the uname value and complain if pkgdelta is used on a FreeBSD box with a
	    # release before that.
	    #
	    $main::pkgdelta = 'freebsd';
	    $main::path{'pkg_info'} = &checkinpath('pkg_info');

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

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

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

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

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

    # Test
    if (defined($main::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($main::opt{'flist'})) {
	if (defined($main::opt{'extract'})) {
	    if (! -r $main::opt{'flist'}) {
		push(@main::errors,"list of files $main::opt{flist} not readable: $OS_ERROR");
	    }
	} else {
	    push(@main::errors,"-flist can only be used with -extract");
	}
    }
    if (defined($main::opt{'onefile'}) and !defined($main::opt{'extract'})) {
	push(@main::errors,"-onefile can only be used with -extract");
    }

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

    if (@main::errors) {
	print "\nErrors:\n";
	while(@main::errors) {
	    print " " . shift(@main::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($main::buffer_cmd, 'localhost');
    }

    &check_shell('localhost');

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

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

}

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

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

}

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

    my $ver = ' $Name: v1_1_7 $ ';
    $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($main::opt{$mode})) {
	    $arg = $main::opt{$mode};
	}
    }

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

    # if the flag given but null, and $device is a dir, spew
    if (($arg eq '') and (defined($main::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;
	$main::use_file = 1;
	$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
	undef $main::tapedevice;
	undef $main::remotetapehost;

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

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

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

    } else {
	if (defined($main::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)\.(gz|bz2|Z|zip)$/) {
	$cfg::type = $1;
	$cfg::compress = $2;
	$cfg::type =~ s/^a$/ar/;
	$cfg::compress =~ s/gz/gzip/;
	$cfg::compress =~ s/bz2/bzip2/;
	$cfg::compress =~ s/Z/compress/;
	&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
	&optioncheck();                  # redo to set a few variables over

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

    } elsif ($file =~ m/\.(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/\.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 check {

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

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

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

}

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

    my $file = 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 "path $file = $cfg::path{$file}\n";
		return "$cfg::path{$file}";
	    } else {
		push(@main::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 "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(@main::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(@main::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(@main::errors,"$file not found in \$PATH");
	return(0);
    }

}

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

    my $cmd = shift(@_);

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

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

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

    &line();

    # Maybe rewind (usually false for reads)
    if (($main::do_rewind_after == 1) and !defined($main::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 ($main::shelltype{$host} eq 'bash2')) {
	    $cmd  = "$main::remoteshell $host " . $quote . $cmd . $main::bash_pipe_exit . $quote;
	} elsif (($is_pipeline == 1) and ($main::shelltype{$host} eq 'zsh')) {
	    $cmd  = "$main::remoteshell $host " . $quote . $cmd . $main::zsh_pipe_exit . $quote;
	} else {
	    $cmd  = "$main::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(@_);

    if (!defined($main::remotetapehost)) {

	$cmd .= " | " . $main::write_cmd . '"' . $main::device . '"' ;

    } else {

	$cmd .= "$main::buffer_cmd | ";
	$cmd .= &maybe_remote_cmd($main::write_cmd . '"' . $main::device . '"', $main::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')) {
	$main::log = "flexbackup.$op." . &current_time('numeric') . ".log";
    } else {
	$main::log = "flexbackup.$op.log";
    }

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

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

    $main::device = &maybe_get_filename();

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

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

    if (defined($main::opt{'num'})) {
	if (defined($main::use_file)) {
	    die("Can't use -num unless reading from tape");
	} else {
	    &log("| Positioning tape at file number $main::opt{num}");
	    &mt("rewind","fsf $main::opt{num}");
	}
    } else {
	if (defined($main::use_file)) {
	    &log("| Reading from on-disk file $main::device");
	} elsif (defined($main::blockdevice)) {
	    &log("| Reading from block device $main::device");
	} else {
	    &log("| Reading from CURRENT TAPE POSITION");
	}
    }

    &line();

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

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

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

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

    if ($main::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;

    # bfr/mbuffer need a blocking dd read ahead of them
    if ($cfg::buffer =~ m/^(bfr|mbuffer)$/) {
	$cmd = $main::read_cmd . '"' . $file . '"' . $main::buffer_cmd;
    } else {
	$cmd = $main::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 "\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($main::opt{'set'})) {
	if (!defined($main::set_incremental) and
	    ($main::level == 0) and
	    !defined($main::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") {
		$main::do_reten = 1;
		$main::do_erase = 1;
	    } else {
		$main::do_reten = 0;
		$main::do_erase = 0;
	    }
	    $main::do_rewind_after = 1;
	} else {
	    # Using files, set incremental backup, or set non-zero
	    # don't erase + go to end of tape
	    $main::do_reten = 0;
	    $main::do_erase = 0;
	    $main::do_rewind_after = 1;
	}
    } elsif (defined($main::opt{'dir'})) {
	# Just one filesystem - assume we append to tape
	$main::do_reten = 0;
	$main::do_erase = 0;
	$main::do_rewind_after = 1;
    } else {
	# We're doing a read of some sort
	$main::do_reten = 0;
	$main::do_erase = 0; # -erase has no effect anyway here
	$main::do_rewind_after = 0;
    }

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

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

    my $string = shift(@_);
    my $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($main::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
# Also sets main::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($main::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($main::index{"$key|$cfg::keyfile"})) {
		my $label = "<index keyfile, dir=$cfg::device>";
		if (defined($main::debug)) {
		    &log("(debug) \$main::index{$key|$cfg::keyfile} = $label");
		} else {
		    $main::index{"$key|$cfg::keyfile"} = $label;
		}
	    }

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

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

    $main::nextfile = 1;

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


    return($key);
}

######################################################################
# Get existing index key
# Also sets main::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($main::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 = "$main::path{dd} $main::dd_blk_flag $main::dd_pad_flag count=1 if=$main::device";
	if (defined($main::remotetapehost)) {
	    $string = &maybe_remote_cmd($string, $main::remotetapehost);
	}

	if (defined($main::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?)");
		}
		$main::nextfile = 0;
		return('');
	    }
	} else {
	    if (!defined($quiet)) {
		&log("| ERROR: Tape doesn't have an index! (use -newtape?)");
	    }
	    $main::nextfile = 0;
	    return('');
	}

    }

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

    unless (defined($main::use_file)) {
	foreach (sort keys %main::index) {
	    my ($tape,$filenum) = split(/\|/,$_);
	    if ($tape eq $key) {
		if ($filenum > $main::nextfile) {
		    $main::nextfile = $filenum;
		}
	    }
	}
	# Set for the next file
	$main::nextfile++;
	&log("| Found index key $key, next file is $main::nextfile");
    } 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 ($main::opt{'toc'} =~ m/^\d+$/) {

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

    } elsif ($main::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 ($main::opt{'toc'} eq "all") {

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

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

    # Go through the index and fill hashes
    foreach my $key (keys %main::index) {
	($tape,$file) = split(/\|/,$key);
	if ($file =~ m/^\d+$/) {
	    $tape_files{$tape}{$file} = $main::index{$key};
	} else {
	    $disk_files{$tape}{$file} = $main::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($main::opt{'toc'}) or ($main::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 %main::index) {
	    delete $main::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 %main::index) {
	    ($tape,$filenum) = split(/\|/,$_);

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

	    } else {

		# Whole tape/dir entry
		if ($tape eq $key) {
		    &log("| Deleting record for $tape file $filenum");
		    $found++;
		    if (defined($main::debug)) {
			&log("(debug) delete \$main::index{$tape|$filenum}");
		    } else {
			delete $main::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($main::use_file);

    $key = &get_tape_key('quiet');

    foreach my $arg (@{$main::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($main::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 = '';
    $cmd .= "$main::path{find} . ";

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

    if (defined(%{$main::prune{$prunekey}})) {
	$cmd .= '-regex "\./\(';
	$cmd .= join('\|', keys %{$main::prune{$prunekey}});
	$cmd .= '\)/.*" -prune -o ';
    } else {
	# Can't use find -depth with the -prune w/ gnu findutils 4.1.7
	# It wasn't really required anyway...
	$cmd .= "-depth ";
    }

    $cmd .= "$main::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 .= "$main::exclude_expr ";

    if (!defined($main::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 = "> $main::pkgdelta_filelist";
	if(defined($remote)) {
	    &log("| Listing level $level to-be-archived files for $remote:$dir");
	    $write = &maybe_remote_cmd("$main::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($main::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($main::packaged{$host}{$key})) {
		    $archive = 1;
		}

		if (($cfg::pkgdelta_archive_changed eq 'true') and
		    defined($main::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 = "$main::path{cat} $main::pkgdelta_filelist ";
    }

    return($cmd);

}

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

    my $host = shift (@_);

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

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

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

	if ($host ne 'localhost') {
	    &log("| Listing all RPM packages on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Listing all RPM packages...");
	}
	if (defined($main::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		if (m:^(.*)$:) {
		    $main::package_list{$host}{$1} = 1;
		}
	    }
	    close(LIST);
	}

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

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

	if ($host ne 'localhost') {
	    &log("| Listing all FreeBSD packages on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Listing all FreeBSD packages...");
	}
	if (defined($main::debug)) {
	    &log("(debug) $cmd");
	} else {
	    my (@junk, $pkg);
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		($pkg, @junk) = split (/\s+/, $_);
		$main::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 (@_);

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

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

	my $cmd = "$main::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($main::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		if (m:^(/.*)$:) {
		    $main::packaged{$host}{$1} = 1;
		}
	    }
	    close(LIST);
	}

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

	my $cmd = "$main::path{pkg_info} -q -a -L";

	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($main::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		if (m:^(/.*)$:) {
		    $main::packaged{$host}{$1} = 1;
		}
	    }
	    close(LIST);
	}
    }

}


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

    my $host = shift (@_);

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

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

	my $cmd = "$main::path{rpm} -V -a";

	if ($host ne 'localhost') {
	    &log("| Finding changed package files on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Finding changed package files...");
	}
	&log("| May take quite a while, please be patient");
	if (defined($main::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		# 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 ] (.*)$:) {
		    $main::changed{$host}{$2} = 1;
		}
	    }
	    close(LIST);
	}

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

	my $cmd = "$main::path{pkg_info} -g -a -q";

	if ($host ne 'localhost') {
	    &log("| Finding changed package files on host $host...");
	    $cmd = &maybe_remote_cmd($cmd, $host);
	} else {
	    &log("| Finding changed package files...");
	}
	&log("| May take quite a while, please be patient");
	if (defined($main::debug)) {
	    &log("(debug) $cmd");
	} else {
	    open(LIST,"$cmd |") || die;
	    while(<LIST>) {
		if (/^(\S+)\s+fails.*MD5.*checksum$/) {
		    $main::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=/tmp/bufftest\$\$.txt\n";
    print SCR "tmp_err=/tmp/bufftest\$\$.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 "| Checking '$cfg::buffer' on this machine... ";
	$pipecmd = "sh $tmp_script ";
    } else {
	print "| Checking '$cfg::buffer' on host $host... ";
	$pipecmd =  "cat $tmp_script | ($main::remoteshell $host 'cat > $tmp_script; sh $tmp_script; rm -f $tmp_script')";
    }

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

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

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

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

    } else {
	print "\n(debug) $pipecmd\n";
    }

    if ($retval == 0) {
	print "Ok\n";
    }  else {
	print "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 "| Checking for required programs on host $host... ";
	my $cmd = "$main::remoteshell $host sh -c '$string'";
	if (defined($main::debug)) {
	    print "\n(debug) $cmd\n";
	    next;
	}
	if (!(open(PIPE,"$cmd |"))) {
	    push (@main::errors, "Could not open pipe to remote shell - $!");
	    $err++;
	    last;
	}

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

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

    }

    if ($cfg::buffer ne 'false') {
	foreach my $host (keys %$remotehost_ref) {
	    &test_bufferprog($main::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 "| Checking /bin/sh on this machine... ";
    } else {
	print "| Checking shell on $host... ";
	$pipecmd = "$main::remoteshell $host '" . $pipecmd . "'";
    }

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

    if (defined($main::debug)) {
	print "\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/) {
		    $main::shelltype{$host} = 'bash2';
		} else {
		    $main::shelltype{$host} = 'bash1';
		}
	    } else {
		$main::shelltype{$host} = $shell;
	    }
	}
    }
    close (PIPE);

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


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

    my $retval;

    if (defined($main::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($main::opt{'c'})) {
	$configfile = $main::opt{'c'};
    } else {
	$configfile = $main::CONFFILE;
    }

    &mt("generic-blocksize $main::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 = "$main::path{cat} $0";
    $cmd = &append_writer_cmd($cmd);
    if (!defined($main::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log($cmd);
    }

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

    &mt('generic-query');
    &log("Writing test file \#3");
    $cmd = "$main::path{cat} $0";
    $cmd = &append_writer_cmd($cmd);
    if (!defined($main::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($main::device);
    if (defined($main::remotetapehost)) {
	$cmd = &maybe_remote_cmd($cmd, $main::remotetapehost);
	# Buffer both sides if remote
	$cmd .= $main::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 .= " | $main::path{tr} -d '\\0' > $tmp1";
    } else {
	$cmd .= "> $tmp1";
    }
    if (!defined($main::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log("(debug) $cmd");
    }

    &mt('generic-query');
    &log("Reading test file \#2");
    $cmd = &read_function($main::device);
    if (defined($main::remotetapehost)) {
	$cmd = &maybe_remote_cmd($cmd, $main::remotetapehost);
	# Buffer both sides if remote
	$cmd .= $main::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 .= " | $main::path{tr} -d '\\0' > $tmp2";
    } else {
	$cmd .= "> $tmp2";
    }
    if (!defined($main::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log("(debug) $cmd");
    }

    &mt('generic-query');
    &log("Reading test file \#3");
    $cmd = &read_function($main::device);
    if (defined($main::remotetapehost)) {
	$cmd = &maybe_remote_cmd($cmd, $main::remotetapehost);
	# Buffer both sides if remote
	$cmd .= $main::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 .= " | $main::path{tr} -d '\\0' > $tmp3";
    } else {
	$cmd .= "> $tmp3";
    }
    if (!defined($main::debug)) {
	system($cmd);
	if ($CHILD_ERROR) {
	    $fail++;
	}
    } else {
	&log("(debug) $cmd");
    }

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

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

    if ($fail != 0) {
	print "\nFAILURE! Problem with tape driver or parameters.  Please see the FAQ\n";
	print "or try changing the \$blksize, \$pad_blocks, or \$mt_blksize settings.\n";
	exit(1);
    } else {
	print "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($main::opt{'wday'})) {
	my @now = localtime;
	my $wday_now = $now[6];

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

	if ($wday_now != $main::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);
}
