#!/usr/local/bin/perl -w
######################################################################
#
# Edwin Huffstutler, <edwinh@computer.org>
# $Id: flexbackup,v 1.185 2003/10/10 14:12:09 edwinh Exp $
# $Name: v1_2_1 $
#
# >>>> Also see the config file, README, manpages, & FAQ <<<<
#
# USAGE:
# flexbackup -help : this message
#
# BACKUP:
# flexbackup -dir <dir> : backup directory tree, level 0
# flexbackup -set <tag> : backup set "tag" (def. in config file), level 0
# flexbackup -set all : backup all sets, level 0
# flexbackup [...] -level <n> : backup level, can be integer or
# full/differential/incremental
# flexbackup [...] -pkgdelta <x> : prune backup to files not part of a package
# or changed from distributed version
# <x> can be "rpm" or "freebsd" package systems
# flexbackup [...] -wday <n> : backup only if the week day matches
# the input number. Sunday is 0 or 7.
# flexbackup [...] -pipe : write to stdout rather than file/device
# flexbackup [...] -ignore-errors : continue backups even if commands return error
# status
# READING ARCHIVES:
# flexbackup -list : list files in archive
# flexbackup -extract : extract all files from archive into your
# current working directory
# flexbackup -extract -flist <f> : restore the files listed in text file <f>
# into your current working directory
# flexbackup -extract -onefile <f>: restore the single file specified by <f>
# into your current working directory
# flexbackup -compare : compare archive with the files in your
# current directory
# flexbackup -restore : interactive restore (dump type only for now)
# flexbackup [...] -num <n> : read file number n from tape; if not given
# uses current tape position
# flexbackup [...] <file> : if archiving to files rather than a device,
# list/extract/compare/restore options take
# flexbackup [...] -pipe : read archive from stdin
# flexbackup [...] -volumes <n> : # of volumes in input
# (EXPERIMENTAL mbuffer multivolume support)
# INDEX RELATED:
# flexbackup -toc : list current device's table of contents
# flexbackup -toc all : list all known table of contents
# flexbackup -toc <key> : list table of contents for specific key
# flexbackup -rmindex all : force db delete of all index info
# flexbackup -rmindex <key> : force db delete of specified tape/dir index
# flexbackup -rmindex <key>:<x> : force db delete of specified tape:file
#
# TESTING/DEBUG:
# flexbackup -test-tape-drive : tries writing/reading files to make sure you
# have tape driver & parameters set up right
# flexbackup [...] -n : don't run actual dump or mt commands, just echo
# flexbackup [...] -type filelist : special backup type that just saves list of
# files that would have been archived
# MISC:
# flexbackup -newtape : erase & create new index key (but no backup)
# flexbackup -rmfile <file> : if backups to disk, rm file & index info
# flexbackup -rmfile all : if backups to disk, rm all files/index for dir
# flexbackup [...] -c <file> : use <file> instead of /usr/local/etc/flexbackup.conf
# for configuration
# flexbackup [...] -type <x> : override $type from config file
# flexbackup [...] -compress <x> : override $compress from config file
# flexbackup [...] -device <dev> : override $device from config file
# flexbackup [...] -d 'var=val' : override config file setting of $var
# flexbackup -dir <x> -erase : force a rewind/erase before backup
# flexbackup -dir <x> -norewind : don't rewind tape after a single backup
# flexbackup -set <x> -noreten : don't retension for level 0 set backups
# flexbackup -set <x> -noerase : don't rewind/erase for level 0 set backups
# flexbackup [...] -reten : force a retension before read
# flexbackup [...] -nodefaults : don't use any default values for config variables
# flexbackup -version : show version
#
######################################################################
#
# flexbackup is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# flexbackup is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with flexbackup; see the file COPYING. If not, write to
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#
######################################################################
use POSIX;
use AnyDBM_File;
use Getopt::Long;
use Text::Wrap;
use File::Basename;
use English;
use strict;
# No output buffering
$OUTPUT_AUTOFLUSH = 1;
# Set the traditional UNIX system locale behavior (touch doesn't read LANG)
my $loc = POSIX::setlocale( &POSIX::LC_ALL, "C" );
# See if afio is calling us as a control script
if (defined($ARGV[0]) and ($ARGV[0] =~ /flexbackup.volume_header_info/)) {
&print_afio_volume_header();
}
# This is changed during "make install"
$::CONFFILE="/usr/local/etc/flexbackup.conf";
# This took awhile to figure out. if the shell is capable of it, we use
# this on the end of any pipelines to see if any of the commands in the
# pipeline failed, rather than just the last one.
#
# If /bin/sh is really bash2 in disguise, or remote shell is bash2/zsh,
# we can use their status array variables
#
# With plain sh, we don't know if the non-last command in the pipe fails
# See exit-status collecting trick in the code.
#
# With tcsh/csh as a remote shell, you don't know which command, but
# $? is still set if anything in the pipeline failed
#
$::bash_pipe_exit = '; x=(${PIPESTATUS[@]}); i=0; while [ $i -lt ${#x[@]} ]; do [ ${x[$i]} -eq 0 ] || exit ${x[$i]}; i=$(($i+1)); done';
$::zsh_pipe_exit = '; x=(${pipestatus[@]}); i=1; while [ $i -le ${#x[@]} ]; do [ ${x[$i]} -eq 0 ] || exit ${x[$i]}; i=$(($i+1)); done';
# tar has a limit of this many chars in its volume label
$::tar_max_label = 99;
# Get commandline flags
%::opt = ();
if (! &::GetOptions(\%::opt,
"c=s",
"compare:s",
"compress=s",
"d=s%",
"dir=s",
"pipe",
"pkgdelta=s",
"device=s",
"differential",
"erase!",
"extract:s",
"flist=s",
"full",
"help",
"incremental",
"ignore-errors",
"level=s",
"list:s",
"onefile=s",
"n",
"newtape",
"nodefaults",
"num:i",
"restore:s",
"reten!",
"rewind!",
"rmfile:s@",
"rmindex:s@",
"set=s",
"test-tape-drive",
"toc:s",
"type=s",
"version",
"volumes:i",
"wday=i"
)) {
exit(0);
}
# Default fd for messages (we might have stdout as archive output)
if (defined($::opt{'pipe'})) {
$::msg = *STDERR;
} else {
$::msg = *STDOUT;
}
# Give usage message
if (defined($::opt{'help'})) {
&usage();
exit(0);
}
# Version
if (defined($::opt{'version'})) {
print $::msg "flexbackup version " . &versionstring() . "\n";
print $::msg '$Id: flexbackup,v 1.185 2003/10/10 14:12:09 edwinh Exp $ ' . "\n";
exit(0);
}
# Exit if -wday given and it isn't that day of the week (see FAQ)
&check_wday();
# Get/read config file
print $::msg "\nflexbackup version " . &versionstring() . "\n";
&readconfigfile();
print $::msg "\n";
# Set OS type
chomp($::uname = `uname -s`);
# Sanity check commandline flags and config file options
&optioncheck();
&line('screen');
# Check shells, buffer is runnable, remote progs...
&test_before_run();
# See about rewind/erase/reten flags
&set_tape_operation_defaults();
# Get current date string
$::date = ¤t_time('numeric');
# Decide what to do
if (defined($::opt{'restore'})) {
&restore_routine();
} elsif (defined($::opt{'extract'})) {
&extract_routine();
} elsif (defined($::opt{'compare'})) {
&compare_routine();
} elsif (defined($::opt{'list'})) {
&list_routine();
} elsif (defined($::opt{'dir'}) or defined($::opt{'set'})) {
&backup_routine();
} elsif (defined($::opt{'toc'})) {
&line();
# Only do this if we're going to grab current tape index
if ($::opt{'toc'} eq '') {
&mt("generic-blocksize $::mt_blksize");
}
&toc_routine();
} elsif (defined($::opt{'rmindex'})) {
&line();
foreach my $arg (@{$::opt{'rmindex'}}) {
&rmindex($arg);
}
} elsif (defined($::opt{'newtape'})) {
&line();
&mt("generic-blocksize $::mt_blksize");
&newtape();
} elsif (defined($::opt{'rmfile'})) {
&line();
&rmfile();
} elsif (defined($::opt{'test-tape-drive'})) {
&line();
&test_tape_drive();
}
if (($::mode !~ m/^(list|extract|restore|compare|test-tape-drive)$/) and
($cfg::indexes eq "true")) {
untie(%::index);
}
exit(0);
######################################################################
# Backup
######################################################################
sub backup_routine {
my @files;
my $label;
my $tapecounter = 0;
my %oldlogs;
my $fs;
my $logfile;
my $symlink = '';;
my $logext = '';
my $comp_cmd;
my $tape_key;
my $logsuffix = '';
my $error = 0;
# Figure out log file name & empty log file
if (defined($::opt{'set'})) {
$label = &get_label($::opt{'set'});
} else {
$label = &get_label($::opt{'dir'});
}
if ($cfg::staticlogs eq 'false' ) {
$logsuffix = ".$::date";
}
if (!defined($::set_incremental)) {
$logfile = "$cfg::prefix$label.$::level" . $logsuffix;
} else {
$logfile = "$cfg::prefix$label.incremental" . $logsuffix;
}
$symlink = "$cfg::prefix$label.latest";
$::log = "$cfg::logdir/$logfile";
if (! open(LOG,">$::log")) {
die "Can't write to $::log: $OS_ERROR";
}
close(LOG);
&line();
&mt("generic-blocksize $::mt_blksize");
# Remember old log files (will remove at end of job)
# ("old" = any higher- or equal-numbered logs for this label)
if (!defined($::set_incremental)) {
opendir(DIR,"$cfg::logdir") or die("Can't open cfg::logdir: $OS_ERROR");
@files = readdir(DIR);
foreach my $lf (reverse sort @files) {
# Skip our own log
next if ($lf =~ m/^$logfile(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/);
# Find normal old logs
if ($lf =~ m/^$cfg::prefix$label\.(\d+)(\.(\d+))?(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/) {
if ($1 >= $::level) {
# Might be from $staticlogs=true or false
if (defined($3)) {
$oldlogs{"$cfg::logdir/$lf"} = $1 . "|" . $3;
} else {
$oldlogs{"$cfg::logdir/$lf"} = $1;
}
}
}
# If this is a level 0, we can nuke incremental logs
if (($::level == 0) and ($lf =~ m/^$cfg::prefix$label\.(incremental)(\.(\d+))?(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/)) {
# Might be from $staticlogs=true or false
if (defined($3)) {
$oldlogs{"$cfg::logdir/$lf"} = $1 . "|" . $3;
} else {
$oldlogs{"$cfg::logdir/$lf"} = $1;
}
}
}
close(DIR);
}
# Possibly populate package-file hashes if we are using
# -pkgdelta. This is so we only have to run through these operations
# once per machine if multiple fs's are being run
if (defined($::pkgdelta)) {
if (defined($::local)) {
&list_packages('localhost');
&find_packaged_files('localhost');
&find_changed_files('localhost');
}
foreach my $host (keys %::remotehosts) {
&list_packages($host);
&find_packaged_files($host);
&find_changed_files($host);
}
$::pkgdelta_filelist = "$cfg::tmpdir/pkgdelta.$PROCESS_ID";
&line();
}
##########################
#
# Main backup routine
#
##########################
if (defined($::opt{'set'})) {
if (!defined($::set_incremental)) {
&log("| Doing level $::level backup of set $::opt{set} using $cfg::type");
} else {
&log("| Doing incremental backup of $::opt{set} using $cfg::type");
}
# All sets or just one?
my @do_sets;
if ($::opt{'set'} eq 'all') {
@do_sets = keys(%cfg::set);
if (defined($::tapedevice)) {
$_ = scalar(@do_sets);
$_ = join(" ", @do_sets) . " ($_ tapes)";
} else {
$_ = join(" ", @do_sets);
}
&log("| All sets = $_");
} else {
@do_sets = ($::opt{'set'});
}
my $num_tapes = scalar(@do_sets) - 1;
foreach my $this_set (@do_sets) {
# Maybe retension
if (($::do_reten == 1) and defined($::tapedevice)) {
&log('| Retensioning tape...');
&mt('retension');
}
# Maybe rewind/erase
if ($::do_erase == 1) {
$tape_key = &newtape();
} else {
&mt('rewind');
$tape_key = &get_tape_key();
if(defined($::tapedevice)) {
&log('| Making sure tape is at end of data...');
}
&mt('generic-eod');
}
# Print what this set contains
&log("| Backup set \"$this_set\" ($cfg::set{$this_set})");
# Show tape position
if (defined($::tapedevice)) {
# Multiple tapes are only for level 0
if (!defined($::set_incremental) and ($::level == 0)) {
&log("| Tape \#$tapecounter");
}
&line();
&mt('generic-query');
}
# Iterate over the filesystems in the set and back 'em up
foreach my $dir (&split_list($cfg::set{$this_set})) {
my $level;
# Get rid of trailing /
$dir = &nuke_trailing_slash($dir);
# If level is icremental for the set, each dir might
# have a different numeric level
if (!defined($::set_incremental)) {
$level = $::level;
} else {
$level = &get_incremental_level($dir);
}
$error = &backup($dir, $tape_key, $level);
last if ($error != 0);
if ($cfg::indexes eq "true") {
$::nextfile++;
}
}
# Prompt for new tape if more than one set in list & level 0
if (!defined($::set_incremental) and ($::level == 0)) {
if ($tapecounter < $num_tapes) {
# Maybe rewind (usually true)
if ($::do_rewind_after == 1) {
if(defined($::tapedevice)) {
&log("| Rewinding...");
}
&mt('rewind');
&line();
}
if (defined($::tapedevice)) {
&toc_routine($tape_key);
}
$tapecounter++;
if (defined($::tapedevice)) {
print $::msg "\n";
while(1) {
print $::msg "---> Insert tape \#$tapecounter (enter y to continue) ";
chomp($_ = <STDIN>);
last if ($_ =~ m/^y/i);
}
print $::msg "\n";
&line();
}
} # end not at last tape
} # end if level == 0
} # end foreach set
} else {
# Just one filesystem, -dir given
&log("| Doing level $::level backup of $::opt{dir} using $cfg::type");
# Maybe retension
if ($::do_reten == 1) {
if (defined($::tapedevice)) {
&log('| Retensioning tape...');
}
&mt('retension');
}
# Maybe rewind/erase
if ($::do_erase == 1) {
$tape_key = &newtape();
} else {
&mt('rewind');
$tape_key = &get_tape_key();
if (defined($::tapedevice)) {
&log('| Making sure tape is at end of data...');
}
&mt('generic-eod');
}
if (defined($::tapedevice)) {
&line();
&mt('generic-query');
}
$error = &backup($::opt{'dir'}, $tape_key, $::level);
} # end set or single fs
if (defined($::tapedevice)) {
&line();
}
# Maybe rewind (usually true)
if (($::do_rewind_after == 1) and defined($::tapedevice)) {
&log("| Rewinding...");
&mt('rewind');
}
# Remove old log files now that we are done
if ($error == 0) {
my $rmlogs = 0;
foreach my $lf (sort keys %oldlogs) {
$rmlogs++;
my ($lev,$d) = split(/\|/,$oldlogs{$lf});
if (defined($d)) {
&log("| Removing old level $lev log of $label (dated $d)");
} else{
&log("| Removing old level $lev log of $label");
}
if (!defined($::debug)) {
unlink("$lf") or warn("Can't remove $lf: $OS_ERROR\n");
}
}
&line('log') if ($rmlogs > 0);
}
# Compress log file
if ($cfg::comp_log ne 'false') {
if ($cfg::comp_log eq "gzip") {
$logext = ".gz";
$comp_cmd = "$::path{gzip} -f \"$::log\"";
} elsif ($cfg::comp_log eq "bzip2") {
$logext = ".bz2";
$comp_cmd = "$::path{bzip2} -f \"$::log\"";
} elsif ($cfg::comp_log eq "lzop") {
$logext = ".lzo";
$comp_cmd = "$::path{lzop} -U -f \"$::log\"";
} elsif ($cfg::comp_log eq "zip") {
$logext = ".zip";
$comp_cmd = "$::path{cat} \"$::log\" | $::path{zip} -q - - > \"$::log" . $logext . "\"; $::path{rm} -f \"$::log\"";
} elsif ($cfg::comp_log eq "compress") {
$logext = ".Z";
$comp_cmd = "$::path{compress} -f \"$::log\"";
}
undef $::log;
&log("| Compressing log ($logfile" . "$logext)", 'screen');
system("$comp_cmd");
if ($CHILD_ERROR) {
warn("Error compressing log file\n");
}
}
# Symlink the "latest" log file for this level
unlink("$cfg::logdir/$symlink" . $logext);
&log("| Linking $symlink" . "$logext -> $logfile" . $logext, 'screen');
symlink("$logfile" . $logext,"$cfg::logdir/$symlink" . $logext);
&line('screen');
if ($error == 0) {
&toc_routine($tape_key);
}
exit($error);
}
######################################################################
# Backup a filesystem
######################################################################
sub backup {
my $dir = shift(@_);
my $tape_key = shift(@_);
my $level = shift(@_);
my $title;
my $title_without_type;
my @cmds;
my @echo_cmds;
my $cmd;
my $localdir = $dir;
my $label = &get_label($dir);
my $host;
my @files;
my %oldstamps;
my $remote;
my $tapehost;
my $indexkey;
my $catchexit;
my $exitscript = "$cfg::tmpdir/collectexit.$PROCESS_ID.sh";
my $result = "$cfg::tmpdir/exitstatus.$PROCESS_ID";
my $pkglist;
my $error = 0;
&line();
if ($localdir =~ s/^(.+)://) {
$remote = $1;
chomp($tapehost = `hostname`);
if (($tapehost eq $remote)
or
($remote =~ /^localhost/)) {
die("Remote host and this host are the same! No scooby snack for you!");
}
} else {
undef $remote;
}
# Remember old stamp files (will remove at end of job)
# "old" = any higher-numbered stamps for this label
# (we will be touching the one of equal level, so don't mark for removal)
opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR");
@files = readdir(DIR);
foreach my $f (reverse sort @files) {
next if ($f !~ m/^$cfg::sprefix$label\.(\d+)$/);
if ($1 > $level) {
$oldstamps{"$cfg::stampdir/$f"} = $1
}
}
close(DIR);
# Create file name if writing to a file
# (config file's $device points to a dir in this case)
if (defined($::use_file)) {
my $filename = $level;
if (defined($::pkgdelta)) {
$filename .= $::pkgdelta;
}
if ($cfg::staticfiles eq 'true') {
$filename .= "." . $cfg::type;
} else {
$filename .= "." . $::date . "." . $cfg::type;
}
# Some types need the filename modified
if ($cfg::type eq 'ar') {
$filename =~ s/ar$/a/;
} elsif ($cfg::type eq 'copy') {
$filename =~ s/\.copy$//;
} elsif ($cfg::type eq 'rsync') {
$filename =~ s/\.rsync$//;
}
# Note compression setting in filename
if ($cfg::type =~ m/^(tar|dump|cpio|star|pax|ar|shar|filelist)$/) {
if ($cfg::compress eq "gzip") {
$filename .= ".gz";
} elsif ($cfg::compress eq "bzip2") {
$filename .= ".bz2";
} elsif ($cfg::compress eq "lzop") {
$filename .= ".lzo";
} elsif ($cfg::compress eq "zip") {
$filename .= ".zip";
} elsif ($cfg::compress eq "compress") {
$filename .= ".Z";
}
} elsif ($cfg::type eq "afio") {
# tag these a little different, the archive file itself isn't a
# .gz or .bz2, but the files in it are....
if ($cfg::compress eq "gzip") {
$filename .= "-gz";
} elsif ($cfg::compress eq "bzip2") {
$filename .= "-bz2";
} elsif ($cfg::compress eq "lzop") {
$filename .= "-lzo";
} elsif ($cfg::compress eq "zip") {
$filename .= "-zip";
} elsif ($cfg::compress eq "compress") {
$filename .= "-Z";
}
}
# Overwrite device var to be the archive filename
$::device = $cfg::device . "/" . $label . "." . $filename;
}
# Just get the date for now; don't write the timestamp
# Until after the backup has run
$::date_at_start = ¤t_time('ctime');
$::stamp_at_start = ¤t_time('numeric');
# Label for this archive
chomp($host = `hostname`);
$title = $cfg::type . "+" . $cfg::compress;
$title =~ s/\+false//;
if (!defined($::pkgdelta)) {
$title = "level $level $dir $::date_at_start $title from $host";
$title_without_type = "level $level $dir $::date_at_start from $host";
} else {
$pkglist = "flexbackup.$::pkgdelta.packagelist";
$title = "level $level+$::pkgdelta $dir $::date_at_start $title from $host";
$title_without_type = "level $level+$::pkgdelta $dir $::date_at_start from $host";
}
# Modify table of contents
if (($tape_key ne '')
and
($cfg::indexes eq "true")) {
# If writing to files, store the filename
if (defined($::use_file)) {
@_ = split(/\//,$::device);
$_ = pop(@_);
$indexkey = "$tape_key|$_";
if (defined($::debug)) {
&log("(debug) \$::index{$indexkey} = $title_without_type");
} else {
$::index{$indexkey} = "$title_without_type";
}
} elsif (defined($::use_blockdevice)) {
# no indexes anyway
} else {
$indexkey = "$tape_key|$::nextfile";
if (defined($::debug)) {
&log("(debug) \$::index{$indexkey} = $title");
} else {
$::index{$indexkey} = $title;
}
&log("| File number $::nextfile, tape index $tape_key");
}
}
# Write list of packages
if (defined($::pkgdelta) and
(
($cfg::pkgdelta_archive_list eq 'true') or
(($cfg::pkgdelta_archive_list eq 'rootonly') and ($localdir eq '/'))
)
) {
$pkglist = "$localdir/$pkglist";
my $write = "> $pkglist";
my $h;
if(defined($remote)) {
$write = &maybe_remote_cmd("$::path{cat} $write", $remote);
$write = "| $write";
$h = $remote;
} else {
$h = 'localhost';
}
if (!defined($::debug)) {
open(LIST,"$write") || die;
foreach my $pkg (sort keys %{$::package_list{$h}}) {
print LIST "$pkg\n";
}
close(LIST);
}
}
&log("| Backup of: $dir");
my $remove = '';
if ($cfg::type eq 'dump') {
($remove, @cmds) = &backup_dump($label, $localdir, $level, $remote);
} elsif ($cfg::type eq 'afio') {
($remove, @cmds) = &backup_afio($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'cpio') {
($remove, @cmds) = &backup_cpio($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'tar') {
($remove, @cmds) = &backup_tar($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'star') {
($remove, @cmds) = &backup_star($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'pax') {
($remove, @cmds) = &backup_pax($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'zip') {
($remove, @cmds) = &backup_zip($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'ar') {
($remove, @cmds) = &backup_ar($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'shar') {
($remove, @cmds) = &backup_shar($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'lha') {
($remove, @cmds) = &backup_lha($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'copy') {
($remove, @cmds) = &backup_copy_cpio($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'rsync') {
($remove, @cmds) = &backup_copy_rsync($label, $localdir, $title, $level, $remote);
} elsif ($cfg::type eq 'filelist') {
($remove, @cmds) = &backup_filelist($label, $localdir, $title, $level, $remote);
}
# Nuke any tmp files used in the above routines
if ($remove ne '') {
push(@cmds, &maybe_remote_cmd("$::path{rm} -f $remove", $remote));
}
# Create/nuke tmp file list if we did local package delta
if (defined($::pkgdelta)) {
if (
($cfg::pkgdelta_archive_list eq 'true') or
(($cfg::pkgdelta_archive_list eq 'rootonly') and ($localdir eq '/'))
) {
push(@cmds, &maybe_remote_cmd("$::path{rm} -f $::pkgdelta_filelist $pkglist", $remote));
} else {
push(@cmds, &maybe_remote_cmd("$::path{rm} -f $pkglist", $remote));
}
}
# Strip multiple spaces
foreach my $cmd (@cmds) {
$cmd =~ s/\s+/ /g;
}
# Use pipeline exitcode hook if /bin/sh can't report pipeline status
if ($::shelltype{'localhost'} =~ m/^(unknown|bash1|ksh)$/) {
$catchexit = 1;
unlink($result);
open(SCR, "> $exitscript") || die;
print SCR '#!/bin/sh' . "\n";
print SCR '"$@"' . "\n";;
print SCR '[ $? = 0 ] || echo $@ >> ' . $result . "\n";
close(SCR);
chmod(0755, $exitscript);
push(@cmds, "[ ! -e $result ]");
}
# Replace piped commands with exit status collector if we need to
foreach my $cmd (@cmds) {
if (defined($catchexit)) {
# Save ssh commands temporarily so we don't replace pipes inside them
my $saveremote;
if ($cmd =~ s/($cfg::remoteshell .* \'.*\')/XXXflexbackupXXX/) {
$saveremote = $1;
}
# Replace piped or anded commands with catch-script
# -Not if the command started a subshell ( .. )
if ($cmd =~ s:\s+(\||&&)\s+([^\(]): $1 $exitscript $2:g) {
# You would think we'd put it on the front of the pipe as
# well. Can't do this globally because the "cd <dir> &&"
# at the front makes the cd happen in a subshell. If
# its not "cd <something>, do it.
if ($cmd !~ m:^\s*cd\s+\"[^\"]+\"\s*(;|&&):) {
$cmd = "$exitscript $cmd";
}
# Take care of subshell
$cmd =~ s:\s+(\||&&)\s+(\()\s*: $1 \( $exitscript :g;
}
# Put any ssh stuff back
$cmd =~ s:XXXflexbackupXXX:$saveremote:;
}
}
# Format commands for nice printing
@echo_cmds = @cmds;
foreach my $line (@echo_cmds) {
&split_and_echo($line);
}
&line();
# Enough fooling around... run it.
if (!defined($::debug)) {
foreach $cmd (@cmds) {
if (defined($::use_pipe)) {
system("$cmd");
} else {
if ($::shelltype{'localhost'} eq 'bash2') {
# /bin/sh is really bash2 on this system
open(CMD,"($cmd " . $::bash_pipe_exit . ") 2>&1 |") || die;
} elsif ($::shelltype{'localhost'} eq 'zsh') {
# Does anybody make /bin/sh be zsh? probably not...
open(CMD,"($cmd " . $::zsh_pipe_exit . ") 2>&1 |") || die;
} else {
open(CMD,"($cmd) 2>&1 |") || die;
}
open(LOG,">>$::log") || die;
while(<CMD>) {
print $::msg $_;
print LOG $_;
}
close(LOG);
close(CMD);
}
if ($CHILD_ERROR) {
&log('');
# If using exit trick, cat the result file; otherwise use normal output
if (defined($catchexit)) {
my $out = `cat $result`;
&log("ERROR: non-zero exit from:\n$out");
} else {
&log("ERROR: non-zero exit from:\n$cmd");
}
if (defined($::opt{'ignore-errors'})) {
$error = 0;
&log('');
&log("ERROR: will continue anyway");
} else {
$error++;
&log('');
&log("ERROR: exiting");
# Put ERROR in the index if tapedevice, or nuke index if file
if (defined($indexkey)) {
if (defined($::use_file)) {
delete $::index{$indexkey};
} elsif (defined($::use_blockdevice)) {
# no indexes anyway
} else {
$::index{$indexkey} .= "\n\t---> ERROR during write, above may not be valid";
}
}
# If file, rm botched file regardless of index
if (defined($::use_file)) {
if ($cfg::type =~ m/^(copy|rsync)$/) {
system("rm -rf $::device");
} else {
unlink($::device);
}
}
} # ignore error defined
} # CHILD_ERROR
} # foreach cmd
} else {
&log("(debug) command output would be here");
}
&line();
# Actually remove the old stamp files now that we are done
if ($error == 0) {
foreach my $ts (sort keys %oldstamps) {
print $::msg "| Removing out of date level $oldstamps{$ts} timestamp for $dir\n";
if (!defined($::debug)) {
unlink("$ts") or warn("Can't remove $ts: $OS_ERROR\n");
}
}
}
# Create timestamp file, but use date from before the backup started
# so next time we will catch files that might have been touched during the run
my $t = ¤t_time('ctime');
&log("| Backup start: $::date_at_start");
&log("| Backup end: $t");
if (($error == 0) and !defined($::debug)) {
system("$::path{touch} -t \"$::stamp_at_start\" \"$cfg::stampdir/$cfg::sprefix$label.$level\"");
}
&line();
# Got errors unless I paused before trying to access the tape right way...
if ((!defined($::debug)) and defined($::tapedevice)) {
sleep 10;
}
# Show where we are on the tape
&mt('generic-query');
if (defined($catchexit)) {
unlink($result);
unlink($exitscript);
}
return($error);
}
######################################################################
# Return command to backup a directory using dump
######################################################################
sub backup_dump {
my $label = shift(@_);
my $dir = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $date_flag;
my $remove = '';
# Need this check here in case fs=all, level=incremental, and we go beyond 9
if ($level > 9) {
die("Can't use level > 9 and type=dump");
}
# Warnings about stuff dump can't do
if (defined($cfg::exclude_expr[0])) {
&log("| NOTE: \$exclude_expr is ignored for type=dump");
}
my $prunekey;
if (defined($remote)) {
$prunekey = "$remote:$dir";
} else {
$prunekey = $dir;
}
if (defined(%{$::prune{$prunekey}})) {
&log("| NOTE: \$prune is ignored for type=dump");
}
if ($cfg::traverse_fs ne 'false') {
&log("| NOTE: \$traverse_fs is always false for type=dump");
}
if (defined($::pkgdelta)) {
&log("| NOTE: packaging system delta ignored for for type=dump");
}
# With this one we don't have to put a stampfile on the remote system
# since we only need the date string
my $time = &get_last_date($label, $level, 'ctime');
if ($level == 0) {
$date_flag = "";
} else {
$date_flag = "-T \"$time\" ";
}
$cmd = '';
$cmd .= "dump -$level ";
$cmd .= "$::dump_blk_flag ";
if ($cfg::dump_use_dumpdates eq "true") {
$cmd .= "-u ";
} else {
$cmd .= $date_flag;
}
$cmd .= "$::dump_len_flag ";
$cmd .= "-f - ";
$cmd .= "$dir $::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using afio
######################################################################
sub backup_afio {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $tmplabel = "$cfg::tmpdir/label.$PROCESS_ID";
my $tmpnocompress = "$cfg::tmpdir/nocompress.$PROCESS_ID";
my $remove = '';
my $no_compress = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
# list of file exenstions to not compress
if (($cfg::compress !~ /^(false|hardware)$/) and ($cfg::afio_nocompress_types ne "")) {
$cmd = "$::path{printf} \"$cfg::afio_nocompress_types\" > $tmpnocompress";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$no_compress = "-E $tmpnocompress";
$remove .= " $tmpnocompress";
}
if ($cfg::label ne 'false') {
$cmd = "$::path{printf} \"Volume Label:\\n$title\\n\\n\" > $tmplabel";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $tmplabel";
}
$cmd = "cd \"$dir\" && ";
if ($cfg::label ne 'false') {
$cmd .= "($::path{printf} \"//--$tmplabel flexbackup.volume_header_info\\n\" && ";
}
$cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote);
if ($cfg::label ne 'false') {
$cmd .= ")";
}
$cmd .= " | ";
$cmd .= "$::path{afio} -o ";
$cmd .= "$no_compress ";
$cmd .= "-z ";
$cmd .= "-1 m ";
$cmd .= "$::afio_z_flag ";
$cmd .= "$::afio_verb_flag ";
$cmd .= "$::afio_sparse_flag ";
$cmd .= "$::afio_atime_flag ";
$cmd .= "$::afio_bnum_flag ";
$cmd .= "$::afio_blk_flag ";
$cmd .= "-";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using cpio
######################################################################
sub backup_cpio {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
if ($cfg::label ne 'false') {
# Kludge a title by replacing / with - in the title
# then touch a file in the dir we are going to back up.
$title =~ s%/%-%g;
$cmd = "$::path{touch} \"$dir/$title\"";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " \"$dir/$title\"";
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote);
$cmd .= "| ";
$cmd .= "$::path{cpio} -o ";
$cmd .= "-0 ";
$cmd .= "-H $cfg::cpio_format ";
$cmd .= "$::cpio_verb_flag ";
$cmd .= "$::cpio_blk_flag ";
$cmd .= "$::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to copy directory tree
######################################################################
sub backup_copy_cpio {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote);
$cmd .= "| ";
$cmd .= "$::path{cpio} -o ";
$cmd .= "-0 ";
$cmd .= "-H $cfg::cpio_format ";
$cmd .= "$::cpio_verb_flag ";
$cmd .= "$::cpio_blk_flag ";
# Buffer both sides / compress if remote
if (defined($remote)) {
$cmd .= "$::z";
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Yell if destination exists
if (-d "$::device") {
&log("| Existing destination directory $::device found!");
&log("| It will be *deleted*, unless you hit CTRL-C");
&log("| and abort within 10 seconds...");
&line();
sleep(10);
system("rm -rf $::device");
}
# Expand cpio archive on other side of pipe
$cmd .= " | ";
if (defined($remote)) {
$cmd .= "$::unz";
}
$cmd .= "(";
$cmd .= "mkdir -p $::device ; ";
$cmd .= "cd $::device ; ";
$cmd .= "$::path{cpio} -i ";
$cmd .= "-m ";
$cmd .= "-d ";
$cmd .= "$::cpio_blk_flag";
$cmd .= ")";
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to copy directory tree via rsync
######################################################################
sub backup_copy_rsync {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $remove = '';
if ($cfg::buffer ne 'false') {
&log("| NOTE: \$buffer is ignored for type=rsync");
}
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote);
# Just the find may run on the remote - rsync call will always be local
$cmd = &maybe_remote_cmd($cmd, $remote);
# Have to take leading './' off to make rsync's include/exclude work right
$cmd .= " | $::path{sed} -e \"s/\\.\\///g\" | ";
$cmd .= "$::path{rsync} ";
$cmd .= "--include-from=- --exclude=* ";
$cmd .= "--archive ";
$cmd .= "$::rsync_verb_flag ";
$cmd .= "--delete --delete-excluded ";
if ($cfg::compress ne 'false') {
$cmd .= "--compress ";
}
if (defined($remote)) {
$cmd .= "--rsh=$::path{$cfg::remoteshell} ";
if ($cfg::remoteuser ne '') {
$cmd .= "$cfg::remoteuser" . '@' . "$remote:";
} else {
$cmd .= "$remote:";
}
}
$cmd .= "$dir/ $::device";
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using tar
######################################################################
sub backup_tar {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote);
$cmd .= "| ";
$cmd .= "$::path{tar} --create ";
$cmd .= "--null ";
$cmd .= "--files-from=- ";
$cmd .= "--ignore-failed-read ";
$cmd .= "--same-permissions ";
$cmd .= "--no-recursion ";
$cmd .= "--totals ";
if ($cfg::label ne 'false') {
if (length($title) > $::tar_max_label) {
&log("| NOTE: truncating tar label (> $::tar_max_label chars)");
$title = substr($title, 0, $::tar_max_label);
}
$cmd .= "--label \"$title\" ";
}
$cmd .= "$::tar_verb_flag ";
$cmd .= "$::tar_sparse_flag ";
$cmd .= "$::tar_atime_flag ";
$cmd .= "$::tar_recnum_flag ";
$cmd .= "$::tar_blk_flag ";
$cmd .= "--file - ";
$cmd .= "$::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using star
######################################################################
sub backup_star {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote);
$cmd .= "| ";
$cmd .= "$::path{star} -c ";
$cmd .= "list=- ";
$cmd .= "-p ";
$cmd .= "-l ";
$cmd .= "-D ";
$cmd .= "-B ";
$cmd .= "-dirmode ";
if ($cfg::label ne 'false') {
$cmd .= "VOLHDR=\"$title\" ";
}
$cmd .= "H=$cfg::star_format ";
$cmd .= "$::star_fifo_flag ";
$cmd .= "$::star_acl_flag ";
$cmd .= "$::star_verb_flag ";
$cmd .= "$::star_sparse_flag ";
$cmd .= "$::star_atime_flag ";
$cmd .= "$::star_blocknum_flag ";
$cmd .= "$::star_blk_flag ";
$cmd .= "file=- ";
$cmd .= "$::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using pax
######################################################################
sub backup_pax {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
if ($cfg::label ne 'false') {
# Kludge a title by replacing / with - in the title
# then touch a file in the dir we are going to back up.
$title =~ s%/%-%g;
$cmd = "$::path{touch} \"$dir/$title\"";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " \"$dir/$title\"";
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote);
$cmd .= "| ";
$cmd .= "$::path{pax} -w ";
$cmd .= "-d ";
$cmd .= "-s %^./%% ";
$cmd .= "-x $cfg::pax_format ";
$cmd .= "$::pax_verb_flag ";
$cmd .= "$::pax_blk_flag ";
$cmd .= "$::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using zip
######################################################################
sub backup_zip {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $tmpzip = "$cfg::tmpdir/archive.$PROCESS_ID.zip";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
if ($cfg::label ne 'false') {
# Kludge a title by replacing / with - in the title
# then touch a file in the dir we are going to back up.
$title =~ s%/%-%g;
$cmd = "$::path{touch} \"$dir/$title\"";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " \"$dir/$title\"";
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote);
$cmd .= "| ";
$cmd .= "$::path{zip} -@ ";
$cmd .= "-b $cfg::tmpdir "; # temp file path
$cmd .= "-y "; # store symlinks
$cmd .= "$::zip_compr_flag ";
$cmd .= "$::zip_noz_flag "; # nocompress list
$cmd .= "$::zip_verb_flag "; # verbose flag
$cmd .= "$tmpzip";
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
push(@cmds,$cmd);
$cmd = "$::path{cat} $tmpzip ";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
$remove .= " $tmpzip";
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using ar
######################################################################
sub backup_ar {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $filelist = "$cfg::tmpdir/arlist.$PROCESS_ID";
my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID";
my $remove = '';
&log("| NOTE: ar archives will not descend directories");
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
if ($cfg::label ne 'false') {
# Kludge a title by replacing / with - in the title
# then touch a file in the dir we are going to back up.
$title =~ s%/%-%g;
$title =~ s% %_%g;
$cmd = "$::path{touch} \"$dir/$title\"";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " \"$dir/$title\"";
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote, '-maxdepth 1 ! -type d');
$cmd .= "> $filelist; ";
$cmd .= "$::path{ar} rc";
$cmd .= "$::ar_verb_flag ";
$cmd .= "$tmpfile ";
$cmd .= "`$::path{cat} $filelist`";
$cmd .= "; $::path{cat} $tmpfile $::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
$remove .= " $filelist $tmpfile";
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using shar
######################################################################
sub backup_shar {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote, '! -type d');
$cmd .= " | ";
$cmd .= "$::path{shar} ";
$cmd .= "$::shar_verb_flag ";
if ($cfg::label ne 'false') {
$cmd .= "-n \"$title\" ";
}
$cmd .= "-S ";
$cmd .= "$::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
return($remove, @cmds);
}
######################################################################
# Return command to backup a directory using lha
######################################################################
sub backup_lha {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $filelist = "$cfg::tmpdir/lhalist.$PROCESS_ID";
my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
if ($cfg::label ne 'false') {
# Kludge a title by replacing / with - in the title
# then touch a file in the dir we are going to back up.
$title =~ s%/%-%g;
$title =~ s% %_%g;
$cmd = "echo \"$title\" > \"$dir/$title\"";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " \"$dir/$title\"";
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote);
$cmd .= "> $filelist; ";
$cmd .= "$::path{lha} a";
$cmd .= "$::lha_verb_flag ";
$cmd .= "$tmpfile ";
$cmd .= "`$::path{cat} $filelist`";
$cmd .= "; $::path{cat} $tmpfile $::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
$remove .= " $filelist $tmpfile";
return($remove, @cmds);
}
######################################################################
# Just back up the file listing (useful for debugging)
######################################################################
sub backup_filelist {
my $label = shift(@_);
my $dir = shift(@_);
my $title = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $cmd = '';
my @cmds;
my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID";
my $filelist = "$cfg::tmpdir/filelist.$PROCESS_ID";
my $remove = '';
if (defined($remote) and ($level != 0)) {
my $time = &get_last_date($label, $level, 'numeric');
$cmd = "$::path{touch} -t \"$time\" $stamp";
push(@cmds, &maybe_remote_cmd($cmd, $remote));
$remove .= " $stamp";
} else {
$stamp = &get_last_date($label, $level, 'filename');
}
if (defined $::use_pipe) {
&log("| NOTE: Writing list of files that would have been backed up to stdout");
} else {
&log("| NOTE: Writing list of files that would have been backed up to current directory");
}
$cmd = "cd \"$dir\" && ";
$cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote);
$cmd .= "> $filelist; $::path{cat} $filelist 1>&2; $::path{cat} $filelist ";
$cmd .= "$::z";
# Buffer both sides if remote
if (defined($remote)) {
$cmd .= $::buffer_cmd;
}
# Wrap all that together
$cmd = &maybe_remote_cmd($cmd, $remote);
# Append writer stuff
$cmd = &append_writer_cmd($cmd);
push(@cmds, $cmd);
$remove .= " $filelist";
return($remove, @cmds);
}
######################################################################
# List the files in an archive
######################################################################
sub list_routine {
my $cmd = &setup_before_read('list');
if ($cfg::type eq 'dump') {
$cmd .= "$::path{restore} -t ";
$cmd .= "$::dump_verb_flag ";
$cmd .= "$::dump_blk_flag ";
$cmd .= "-f -";
} elsif ($cfg::type eq 'afio') {
$cmd .= "$::path{afio} -t ";
$cmd .= "-z ";
# Don't use label reader if reading from pipe (needs stdin)
if (!defined($::use_pipe)) {
$cmd .= "-D $0 ";
}
$cmd .= "$::afio_unz_flag ";
$cmd .= "$::afio_verb_flag ";
$cmd .= "$::afio_sparse_flag ";
$cmd .= "$::afio_bnum_flag ";
$cmd .= "$::afio_blk_flag ";
$cmd .= "-";
} elsif ($cfg::type eq 'cpio') {
$cmd .= "$::path{cpio} -t ";
$cmd .= "$::cpio_verb_flag ";
$cmd .= "$::cpio_blk_flag";
} elsif ($cfg::type eq 'tar') {
$cmd .= "$::path{tar} --list ";
$cmd .= "--totals ";
$cmd .= "$::tar_verb_flag ";
$cmd .= "$::tar_sparse_flag ";
$cmd .= "$::tar_recnum_flag ";
$cmd .= "$::tar_blk_flag ";
$cmd .= "-B ";
$cmd .= "--file -";
} elsif ($cfg::type eq 'star') {
$cmd .= "$::path{star} -t ";
$cmd .= "$::star_fifo_flag ";
$cmd .= "$::star_verb_flag ";
$cmd .= "$::star_sparse_flag ";
$cmd .= "$::star_blocknum_flag ";
$cmd .= "$::star_blk_flag ";
$cmd .= "-B ";
$cmd .= "file=-";
} elsif ($cfg::type eq 'pax') {
$cmd .= "$::path{pax} ";
$cmd .= "$::pax_verb_flag ";
} elsif ($cfg::type eq 'zip') {
my $tmpfile = "$cfg::tmpdir/zip.$PROCESS_ID";
$cmd .= "$::path{cat} > $tmpfile ; ";
$cmd .= "$::path{unzip} -l ";
$cmd .= "$::zip_verb_flag ";
$cmd .= "$tmpfile ; ";
$cmd .= "$::path{rm} -f $tmpfile";
} elsif ($cfg::type eq 'ar') {
my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID";
$cmd .= "$::path{cat} > $tmpfile; ";
$cmd .= "$::path{ar} t";
$cmd .= "$::ar_verb_flag ";
$cmd .= "$tmpfile; ";
$cmd .= "$::path{rm} -f $tmpfile";
} elsif ($cfg::type eq 'shar') {
$cmd .= "perl -pe 'last if (! m/^#/)'";
} elsif ($cfg::type =~ m/^(copy|rsync)$/) {
if ($cfg::verbose eq "true") {
$cmd = "ls -laR $::device";
} else {
$cmd = "ls -aR $::device";
}
} elsif ($cfg::type eq 'lha') {
my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID";
$cmd .= "$::path{cat} > $tmpfile ; ";
$cmd .= "$::path{lha} l";
$cmd .= "$::lha_verb_flag ";
$cmd .= "$tmpfile ; ";
$cmd .= "$::path{rm} -f $tmpfile";
} elsif ($cfg::type eq 'filelist') {
$cmd .= "$::path{cat}";
}
&run_or_echo_then_query($cmd);
}
######################################################################
# Extract files (maybe a list) to current directory
######################################################################
sub extract_routine {
my $restore_files = '';
my $newlist = "$cfg::tmpdir/extract.$PROCESS_ID";
my $cmd = &setup_before_read('extract');
if (defined($::opt{'flist'})) {
# Have to get a list of the files for restore to use
open(LIST,"$::opt{flist}") or die ("Can't open $::opt{flist}: $OS_ERROR");
open(NEWLIST,">$newlist") or die ("Can't open $newlist: $OS_ERROR");
while(<LIST>) {
chomp;
$_ =~ s%^/%%;
$_ =~ s%^\./%%;
# Some types need the leading ./ to extract the file list,
# since its stored that way
if ($cfg::type =~ m/^(tar|lha)$/) {
$_ = './' . $_;
}
print NEWLIST "$_\n";
$restore_files .= " $_";
}
close(LIST);
close(NEWLIST);
&log("| Extracting files listed in $::opt{flist}");
}
if (defined($::opt{'onefile'})) {
open(NEWLIST,">$newlist") or die ("Can't open $newlist: $OS_ERROR");
$_ = $::opt{'onefile'};
$_ =~ s%^/%%;
$_ =~ s%^\./%%;
# Some types need the leading ./ to extract the file list,
# since its stored that way
if ($cfg::type =~ m/^(tar|lha)$/) {
$_ = './' . $_;
}
print NEWLIST "$_\n";
$restore_files .= " $_";
close(NEWLIST);
&log("| Extracting single file" . $restore_files);
}
if ($cfg::type eq 'dump') {
$cmd .= "$::path{restore} -x ";
$cmd .= "$::dump_verb_flag ";
$cmd .= "$::dump_blk_flag ";
$cmd .= "-f -";
$cmd .= $restore_files;
} elsif ($cfg::type eq 'afio') {
$cmd .= "$::path{afio} -i ";
if ($restore_files ne '') {
$cmd .= "-w $newlist ";
}
$cmd .= "-z ";
$cmd .= "-x ";
# Don't use label reader if reading from pipe (needs stdin)
if (!defined($::use_pipe)) {
$cmd .= "-D $0 ";
}
$cmd .= "$::afio_unz_flag ";
$cmd .= "$::afio_verb_flag ";
$cmd .= "$::afio_sparse_flag ";
$cmd .= "$::afio_bnum_flag ";
$cmd .= "$::afio_blk_flag ";
$cmd .= "-";
} elsif ($cfg::type eq 'cpio') {
$cmd .= "$::path{cpio} -i ";
if ($restore_files ne '') {
$cmd .= "-E $newlist ";
}
$cmd .= "-m ";
$cmd .= "-d ";
$cmd .= "$::cpio_verb_flag ";
$cmd .= "$::cpio_blk_flag";
} elsif ($cfg::type eq 'tar') {
$cmd .= "$::path{tar} --extract ";
if ($restore_files ne '') {
$cmd .= "--files-from $newlist ";
}
$cmd .= "--totals ";
$cmd .= "--same-permissions ";
$cmd .= "$::tar_verb_flag ";
$cmd .= "$::tar_sparse_flag ";
$cmd .= "$::tar_recnum_flag ";
$cmd .= "$::tar_blk_flag ";
$cmd .= "-B ";
$cmd .= "--file -";
} elsif ($cfg::type eq 'star') {
$cmd .= "$::path{star} -x ";
if ($restore_files ne '') {
$cmd .= "list=$newlist ";
}
$cmd .= "-p ";
$cmd .= "$::star_fifo_flag ";
$cmd .= "$::star_verb_flag ";
$cmd .= "$::star_sparse_flag ";
$cmd .= "$::star_blocknum_flag ";
$cmd .= "$::star_blk_flag ";
$cmd .= "-B ";
$cmd .= "file=-";
} elsif ($cfg::type eq 'pax') {
$cmd .= "$::path{pax} -r ";
$cmd .= "$::pax_verb_flag ";
$cmd .= $restore_files;
} elsif ($cfg::type eq 'zip') {
my $tmpfile = "$cfg::tmpdir/zip.$PROCESS_ID";
$cmd .= "$::path{cat} > $tmpfile ; ";
$cmd .= "$::path{unzip} ";
$cmd .= "$tmpfile ";
$cmd .= $restore_files;
$cmd .= "; ";
$cmd .= "$::path{rm} -f $tmpfile";
} elsif ($cfg::type eq 'ar') {
my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID";
$cmd .= "$::path{cat} > $tmpfile; ";
$cmd .= "$::path{ar} xo";
$cmd .= "$::ar_verb_flag ";
$cmd .= "$tmpfile ";
$cmd .= $restore_files;
$cmd .= "; ";
$cmd .= "$::path{rm} -f $tmpfile";
} elsif ($cfg::type eq 'shar') {
$cmd .= "sh ";
if ($restore_files ne '') {
&log("| NOTE: \"-flist/-onefile\" ignored for shar");
}
} elsif ($cfg::type =~ m/^(copy|rsync)$/) {
die("Ummm... just copy your files, you have the whole tree...");
} elsif ($cfg::type eq 'filelist') {
die("You can't extract the 'filelist' type, it's just for testing...");
} elsif ($cfg::type eq 'lha') {
my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID";
$cmd .= "$::path{cat} > $tmpfile ; ";
$cmd .= "$::path{lha} x";
$cmd .= "$::lha_verb_flag ";
$cmd .= "$tmpfile ";
$cmd .= $restore_files;
$cmd .= "; ";
$cmd .= "$::path{rm} -f $tmpfile";
}
&run_or_echo_then_query($cmd);
if (defined($::opt{'flist'})) {
unlink("$newlist") or die ("Can't remove $newlist: $OS_ERROR");
}
}
######################################################################
# Compare an archive to current directory
######################################################################
sub compare_routine {
my $cmd = &setup_before_read('compare');
if ($cfg::type eq 'dump') {
$cmd .= "$::path{restore} -C ";
$cmd .= "$::dump_blk_flag ";
$cmd .= "-f -";
} elsif ($cfg::type eq 'afio') {
$cmd .= "$::path{afio} -r ";
$cmd .= "-z ";
# Don't use label reader if reading from pipe (needs stdin)
if (!defined($::use_pipe)) {
$cmd .= "-D $0 ";
}
$cmd .= "$::afio_unz_flag ";
$cmd .= "$::afio_sparse_flag ";
$cmd .= "$::afio_blk_flag ";
$cmd .= "-";
} elsif ($cfg::type eq 'tar') {
$cmd .= "$::path{tar} --diff ";
$cmd .= "--totals ";
$cmd .= "$::tar_blk_flag ";
$cmd .= "$::tar_sparse_flag ";
$cmd .= "$::tar_recnum_flag ";
$cmd .= "-B ";
$cmd .= "--file -";
} elsif ($cfg::type eq 'star') {
$cmd .= "$::path{star} -diff ";
$cmd .= "$::star_fifo_flag ";
$cmd .= "$::star_blk_flag ";
$cmd .= "$::star_sparse_flag ";
$cmd .= "$::star_blocknum_flag ";
$cmd .= "-B ";
$cmd .= "file=-";
} elsif ($cfg::type =~ m/^(copy|rsync)$/) {
$::path{'diff'} = &checkinpath('diff');
$cmd = "$::path{diff} -r -q ";
$cmd .= ". $::device";
} else {
die("$cfg::type not capable of comparing files");
}
&run_or_echo_then_query($cmd);
}
######################################################################
# Interactive restore
######################################################################
sub restore_routine {
my $cmd = &setup_before_read('restore');
if ($cfg::type eq 'dump') {
$cmd .= "$::path{restore} -i ";
$cmd .= "$::dump_verb_flag ";
$cmd .= "$::dump_blk_flag ";
$cmd .= "-f -";
} else {
die("Interactive restore for $cfg::type not implemented");
}
&run_or_echo_then_query($cmd);
}
######################################################################
# Return the "label" name of the filesystem/dir
######################################################################
sub get_label {
my $path = shift(@_);
my $host = '';
my $label;
if ($path =~ s/(\S+)://) {
$host = $1 . "-";
$label = $path;
} else {
$label = $path;
}
$label =~ s%^/%%; # nuke leading slash
$label =~ s%/%-%g; # turn / into -
$label = 'root' if ($label eq '');
return($host . $label);
}
######################################################################
# Return a date string of the timestamp file
# from the last dump of lower level
# in YYYYMMDDhhmm.ss format if arg 'numeric'
# in ctime format if if arg 'ctime'
# timestamp reference file if arg 'filename'
######################################################################
sub get_last_date {
my $label = shift(@_);
my $thislevel = shift(@_);
my $format = shift(@_);
my $lastlevel;
my $targetfile = '';
my $numeric_val;
my $string_val;
my $mtime;
# use the epoch for level 0
if ($thislevel == 0) {
$numeric_val = '197001010000.00';
$string_val = "Thu Jan 01 00:00:00 1970";
} else {
# Find last stamp file
opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR");
close(DIR);
my $tmp = $thislevel - 1;
foreach my $lev (reverse (0..$tmp)) {
my $file = "$cfg::stampdir/$cfg::sprefix" . "$label.$lev";
if (-e "$file") {
$lastlevel = $lev;
$targetfile = $file;
last;
}
}
# get date from targetfile
# or complain if no timestamp
if ($targetfile ne '') {
$mtime = (stat($targetfile))[9];
$string_val = strftime("%a %b %d %H:%M:%S %Y", localtime($mtime));
$numeric_val = strftime("%Y%m%d%H%M.%S", localtime($mtime));
} else {
die("Can't do a level $thislevel backup - no level 0 timestamp found");
}
}
&log("| Date of this level $thislevel backup: $::date_at_start");
if ($thislevel == 0) {
&log("| Date of last level $thislevel backup: the epoch");
} else {
&log("| Date of last level $lastlevel backup: $string_val");
}
&line();
if (!defined($format)) {
$format = 'ctime';
}
if ($format eq 'numeric') {
return($numeric_val);
} elsif ($format eq 'ctime') {
return($string_val);
} elsif ($format eq 'filename') {
return($targetfile);
} else {
return($string_val);
}
}
######################################################################
# Echo message to screen and log
# optionally just one or the other
######################################################################
sub log {
my $msg = shift(@_);
my $only = shift(@_);
my $do_screen = 1;
my $do_log = 1;
if (!defined($only)) {
$do_screen = 1;
$do_log = 1;
} elsif ($only eq 'screen') {
$do_screen = 1;
$do_log = 0;
} elsif ($only eq 'log') {
$do_screen = 0;
$do_log = 1;
}
if ($do_screen == 1) {
print $::msg "$msg\n";
}
if (($do_log == 1) and defined($::log)) {
open(LOG,">>$::log") || warn("can't open logfile");
print LOG "$msg\n";
close(LOG);
}
}
######################################################################
# Echo a line to both screen and log
# optionally just one or the other
######################################################################
sub line {
my $only = shift(@_);
my $do_screen = 1;
my $do_log = 1;
my $length = 60;
if (!defined($only)) {
$do_screen = 1;
$do_log = 1;
} elsif ($only eq 'screen') {
$do_screen = 1;
$do_log = 0;
} elsif ($only eq 'log') {
$do_screen = 0;
$do_log = 1;
}
if ($do_screen == 1) {
print $::msg '|';
print $::msg '-' x $length;
print $::msg "\n";
}
if (($do_log == 1) and defined($::log)) {
open(LOG,">>$::log") || warn("can't open logfile");
print LOG '|';
print LOG '-' x $length;
print LOG "\n";
close(LOG);
}
}
######################################################################
# Read configuration file
######################################################################
sub readconfigfile {
my $configfile;
my $var;
my $value;
my $defines = $::opt{'d'};
if (defined($::opt{'c'})) {
$configfile = $::opt{'c'};
} else {
$configfile = $::CONFFILE;
}
if (! -r "$configfile") {
die("config file $configfile: $OS_ERROR");
}
system("perl -c \"$configfile\"");
if ($CHILD_ERROR) {
die("syntax error in config file $configfile");
}
package cfg;
require "$configfile";
package main;
# Overrides
foreach $var (keys %$defines) {
$value = $$defines{$var};
&log("(override) $var = $value");
eval("\$cfg::$var=\"$value\"");
}
}
######################################################################
# Do a tape operation
######################################################################
sub mt {
my (@operations) = (@_);
# Set hardware compression when we do the blocksize
if ($cfg::compress eq "hardware") {
foreach my $operation (@operations) {
if ($operation =~ m/generic-blocksize/) {
if ($::uname =~ /Linux/) {
push(@operations,'compression 1');
} elsif ($::uname =~ /FreeBSD/) {
push(@operations,'comp on');
} else {
push(@operations,'compression 1');
}
}
}
}
# We want 1-filemark behavior always
# Set if currently doing blocksize command
foreach my $operation (@operations) {
if ($operation =~ m/generic-blocksize/) {
if ($::uname =~ /FreeBSD/) {
push(@operations,'seteotmodel 1');
}
}
}
foreach my $operation (@operations) {
# mt flavors for block number
if ($operation eq 'generic-query') {
if ($::uname =~ /Linux/) {
$operation = 'tell';
if ($::ftape == 1) {
$operation = 'getsize';
}
} elsif ($::uname =~ /OpenBSD/) {
$operation = 'status';
} elsif ($::uname =~ /FreeBSD/) {
$operation = 'rdhpos';
} elsif ($::uname =~ /OSF1/) {
$operation = 'status';
} elsif ($::uname =~ /AIX/) {
$operation = 'status';
} elsif ($::uname =~ /HP-UX/) {
$operation = 'status';
} elsif ($::uname =~ /SunOS/) {
$operation = 'status';
} elsif ($::uname =~ /IRIX/) {
$operation = 'status';
} else {
$operation = 'status';
}
}
# mt flavors for eod
if ($operation eq 'generic-eod') {
if ($::uname =~ /Linux/) {
$operation = 'eod';
if ($::ftape == 1) {
$operation = 'eom';
}
} elsif ($::uname =~ /OpenBSD/) {
$operation = 'eod';
} elsif ($::uname =~ /FreeBSD/) {
$operation = 'eod';
} elsif ($::uname =~ /OSF1/) {
$operation = 'seod';
} elsif ($::uname =~ /AIX/) {
$operation = 'fsf 1000';
} elsif ($::uname =~ /HP-UX/) {
$operation = 'eod';
} elsif ($::uname =~ /SunOS/) {
$operation = 'eom';
} elsif ($::uname =~ /IRIX/) {
$operation = 'eod';
} else {
$operation = 'eod';
}
}
# mt flavors for erase
# (some mt's have no "erase", just rewind before starting...)
if ($operation eq 'generic-erase') {
if ($cfg::erase_rewind_only eq "true") {
$operation = 'rewind';
} elsif ($::uname =~ /Linux/) {
$operation = 'erase';
} elsif ($::uname =~ /OpenBSD/) {
$operation = 'erase';
} elsif ($::uname =~ /FreeBSD/) {
$operation = 'erase';
} elsif ($::uname =~ /OSF1/) {
$operation = 'erase';
} elsif ($::uname =~ /AIX/) {
$operation = 'erase';
} elsif ($::uname =~ /HP-UX/) {
$operation = 'erase';
} elsif ($::uname =~ /SunOS/) {
$operation = 'erase';
} elsif ($::uname =~ /IRIX/) {
$operation = 'erase';
} else {
$operation = 'erase';
}
}
# mt flavors for setblk
if ($operation =~ /generic-blocksize/) {
if ($::uname =~ /Linux/) {
$operation =~ s/generic-blocksize/setblk/;
} elsif ($::uname =~ /OpenBSD/) {
$operation =~ s/generic-blocksize/blocksize/;
} elsif ($::uname =~ /FreeBSD/) {
$operation =~ s/generic-blocksize/blocksize/;
} elsif ($::uname =~ /OSF1/) {
$operation =~ s/generic-blocksize/setblk/;
} elsif ($::uname =~ /AIX/) {
$operation =~ s/generic-blocksize/setblk/;
} elsif ($::uname =~ /HP-UX/) {
$operation =~ s/generic-blocksize/setblk/;
} elsif ($::uname =~ /SunOS/) {
$operation =~ s/generic-blocksize/setblk/;
} elsif ($::uname =~ /IRIX/) {
$operation =~ s/generic-blocksize/setblksz/;
} else {
$operation =~ s/generic-blocksize/setblk/;
}
}
if (defined($::use_file)) {
# mt ops skipped for files
} elsif (defined($::use_blockdevice)) {
# mt ops skipped for block device
} else {
my $command;
# Override mt operation so user can set for unknown flavors
# or for debugging info, like mt tell -> mt status
if(defined($cfg::mt{$operation})) {
$operation = $cfg::mt{$operation};
next if ($operation eq 'nop');
}
if ($operation =~ /setblk/) {
# Try and see which of setblk/defblksize will work
# This is kludgy, but doable
$command = "$::path{mt} -f $::device $operation > /dev/null 2>&1";
if (defined($::remotetapehost)) {
$command = &maybe_remote_cmd($command, $::remotetapehost);
}
if (defined($::debug)) {
&log("(debug) $command");
}
system($command);
if ($CHILD_ERROR) {
&log("| Trying \"mt defblksize\" instead of \"mt setblk\"");
my $oldoperation = $operation;
$operation =~ s/setblk/defblksize/;
$command = "$::path{mt} -f $::device $operation > /dev/null 2>&1";
if (defined($::remotetapehost)) {
$command = &maybe_remote_cmd($command, $::remotetapehost);
}
if (defined($::debug)) {
&log("(debug) $command");
}
system($command);
if ($CHILD_ERROR) {
&log("Error setting block size");
&log("Neither of these commands worked:");
&log(" $::path{mt} -f $::device $oldoperation");
&log(" $::path{mt} -f $::device $operation");
exit(1);
} # error on second guess
} # error on first guess
} # operation = setblk
$command = "$::path{mt} -f $::device $operation 2>&1 ";
if (defined($::remotetapehost)) {
$command = &maybe_remote_cmd($command, $::remotetapehost);
}
if (!defined($::debug)) {
open(CMD,"($command) 2>&1 |") || die;
if (defined($::log)) { open(LOG,">>$::log") || die; }
while(<CMD>) {
print $_;
if (defined($::log)) { print LOG $_; }
}
close(CMD);
if (defined($::log)) { close(LOG); }
} else {
&log("(debug) $command");
}
} # not a file
} # foreach operation
}
######################################################################
# Option error checking & init stuff
######################################################################
sub optioncheck {
my $buffer_blk_flag;
my $buffer_write_pad_flag;
my $buffer_read_pad_flag;
my $mbuffer_blk_flag;
my $mbuffer_write_pad_flag;
my $mbuffer_read_pad_flag;
# Archive type on commandline
if (defined($::opt{'type'})) {
$cfg::type = $::opt{'type'};
}
# Compress flag on commandline
if (defined($::opt{'compress'})) {
$cfg::compress = $::opt{'compress'};
}
# Device flag on commandline
if (defined($::opt{'device'})) {
$cfg::device = $::opt{'device'};
if (defined($::opt{'stdout'})) {
push(@::errors,"Can't use -device and -pipe at the same time");
}
}
# Debug
if (defined($::opt{'n'})) {
$::debug = 1;
}
# Flag old config file
if (defined(@cfg::filesystems) or defined($cfg::mt_var_blksize)) {
# so strict shuts up
my $junk = @cfg::filesystems;
$junk = $cfg::mt_var_blksize;
push(@::errors,"You've got an old 1.0.x configuration file, please update it!");
}
# Mode
my (@modelist) = qw(set dir list extract compare restore toc newtape rmindex rmfile test-tape-drive);
my @modes;
my $modecount = 0;
$::mode = '';
foreach my $mode (@modelist) {
if (defined($::opt{$mode})) {
$modecount++;
$::mode = $mode;
push(@modes,$mode);
}
}
if ($modecount > 1) {
$_ = join(" -",@modes);
push(@::errors,"Can't specify more than one mode (given \"-$_\")");
}
if ($modecount == 0) {
push(@::errors,"Nothing to do (see -help)");
}
# First check if things are defined in the config file
# Checks exist, true/false, or one of options
&checkvar(\$cfg::type,'type','dump afio cpio tar star pax zip ar shar lha copy rsync filelist','tar');
&checkvar(\$cfg::compress,'compress','gzip bzip2 lzop compress zip false hardware','gzip');
&checkvar(\$cfg::compr_level,'compr_level','exist','4');
&checkvar(\$cfg::verbose,'verbose','bool','true');
&checkvar(\$cfg::sparse,'sparse','bool','true');
&checkvar(\$cfg::label,'label','bool','true');
&checkvar(\$cfg::atime_preserve,'atime_preserve','bool','false');
&checkvar(\$cfg::indexes,'indexes','bool','true');
&checkvar(\$cfg::staticfiles,'staticfiles','bool','false');
&checkvar(\$cfg::buffer,'buffer','false buffer mbuffer','false');
&checkvar(\$cfg::pad_blocks,'pad_blocks','bool','true');
&checkvar(\$cfg::device,'device','exist','/dev/tape');
&checkvar(\$cfg::remoteshell,'remoteshell','ssh ssh2 ssh1 rsh','ssh');
&checkvar(\$cfg::remoteuser,'remoteuser','exist','');
&checkvar(\$cfg::erase_tape_set_level_zero,'erase_tape_set_level_zero','bool','true');
&checkvar(\$cfg::erase_rewind_only,'erase_rewind_only','bool','false');
&checkvar(\$cfg::logdir,'logdir','exist','/var/log/flexbackup');
&checkvar(\$cfg::tmpdir,'tmpdir','exist','/tmp');
&checkvar(\$cfg::comp_log,'comp_log','gzip bzip2 lzop compress zip false','gzip');
&checkvar(\$cfg::stampdir,'stampdir','exist','/var/lib/flexbackup');
&checkvar(\$cfg::index,'index','exist','/var/lib/flexbackup/index');
&checkvar(\$cfg::keyfile,'keyfile','exist','00-index-key');
&checkvar(\$cfg::staticlogs,'staticlogs','bool','false');
&checkvar(\$cfg::prefix,'prefix','exist','');
&checkvar(\$cfg::sprefix,'sprefix','exist','');
if (@::errors) {
print $::msg "Errors:\n";
while(@::errors) {
print $::msg " " . shift(@::errors) . "\n";
}
exit(1);
}
# Check we can find rsh or ssh
$::path{$cfg::remoteshell} = &checkinpath($cfg::remoteshell);
if ($cfg::remoteuser ne '') {
$::remoteshell = "$::path{$cfg::remoteshell} -l $cfg::remoteuser";
} else {
$::remoteshell = $::path{$cfg::remoteshell};
}
# Check we can find common stuff
$::path{'touch'} = &checkinpath('touch');
$::path{'hostname'} = &checkinpath('hostname');
$::path{'cat'} = &checkinpath('cat');
$::path{'rm'} = &checkinpath('rm');
$::path{'tee'} = &checkinpath('tee');
$::path{'find'} = &checkinpath('find');
$::path{'dd'} = &checkinpath('dd');
$::path{'printf'} = &checkinpath('printf');
push(@::remoteprogs,($::path{'touch'},$::path{'rm'},$::path{'find'},$::path{'printf'}));
# Check device (or dir)
$::ftape = 0;
if (defined($::opt{'pipe'})) {
# Dump to stdout.
# Disable indexing, all messages to stderr
$::use_file = 1;
$::use_pipe = 1;
$cfg::indexes = 'false';
$cfg::device = '-';
} elsif ($cfg::type eq 'filelist') {
$::use_file = 1;
chomp($cfg::device = `pwd`);
$cfg::device =~ s:/$::;
$cfg::indexes = 'false';
# Can we write to cwd?
if (! -w $cfg::device) {
push(@::errors,"Can't write to $cfg::device");
}
} else {
# Chase device links
my $realdev = $cfg::device;
while (-l "$realdev") {
my @pathname = split('/',$realdev);
$realdev = readlink("$realdev");
# If a relative link we'll need the dir from the link
if ($realdev !~ m:^/:) {
pop(@pathname);
$realdev = join('/',@pathname) . "/$realdev";
}
}
if (-c $realdev) {
# Check for ftape driver
if ($realdev =~ /n?z?[qr]ft(\d+)/) {
$::ftape = 1;
}
$::tapedevice = 1;
} elsif (-b $realdev) {
# In case of floppy or similar.
# Can't do multiple files this way; turn indexing off
$::use_blockdevice = 1;
$cfg::indexes = 'false';
} elsif (-d "$cfg::device") {
if ($cfg::device !~ m:^/:) {
push(@::errors,"Please give full path, not relative (\$device=$cfg::device)");
} else {
$::use_file = 1;
$cfg::device =~ s:/$::; # nuke trailing slash if any
}
} elsif ($cfg::device =~ m%(\S+):(/dev/.*)%) {
$::remotetapehost = $1;
$cfg::device = $2;
$::tapedevice = 1;
} else {
push(@::errors,"\$device must be set to a directory, a local device, or a remote device");
}
# Can we write to it?
if ((! -w $cfg::device) and
!defined($::remotetapehost) and
($::mode =~ m/^(set|dir|newtape)$/)) {
push(@::errors,"Can't write to $cfg::device");
}
}
$::device = $cfg::device;
# Set mt type
if (defined($::tapedevice)) {
if ($::ftape == 1) {
$::path{'mt'} = &checkinpath('ftmt');
} else {
$::path{'mt'} = &checkinpath('mt');
}
}
# Exclude regexp for find
$::exclude_expr = '';
if (defined($cfg::exclude_expr[0])) {
my @excl_array;
my $expr;
foreach $expr (@cfg::exclude_expr) {
# People just don't grok regex's.
#
# If the first character is a *, they obviously got it wrong,
# we can try to assume what they meant.
#
# If the user put "*.whatever" as an expression, turn this
# "glob" into a regex for them
# If the user put "*whatever" as an expression, turn this
# "glob" into a regex for them
if ($expr =~ m/^\*\./) {
$expr =~ s/^\*\./.\*\\./;
}
if ($expr =~ m/^\*/) {
$expr =~ s/^\*/.*/;
}
# AAAH! Csh should be banned from the face of the earth!
#
# If an expression contains $ at the end we need to be careful
# and leave it out of the quotes, or csh will yack if doing a
# remote backup. This happens only if the user's shell is
# csh/tcsh. Then the string is doublequoted inside single
# quotes and there is _no way_ for csh do deal with $ in that
# situation. This took a LONG time to figure out.
if ($expr =~ m/^(.+)\$$/) {
$expr = '"' . $1 . '"' . '$'; #' (comment to fool emacs 20.7
} else {
$expr = '"' . $expr . '"';
}
$::exclude_expr .= "! -regex $expr ";
}
}
# Traverse mountpoints?
&checkvar(\$cfg::traverse_fs,'traverse_fs','false local all','false');
if ($cfg::traverse_fs eq "local") {
$::mountpoint_flag = "! -fstype nfs ! -fstype smbfs ! -fstype bind ! -fstype proc ! -fstype devpts ! -fstype devfs ! -fstype tmpfs";
} elsif ($cfg::traverse_fs eq "all") {
$::mountpoint_flag = "! -fstype proc ! -fstype devpts ! -fstype devfs ! -fstype tmpfs";
} else {
$::mountpoint_flag = "-xdev";
}
# Block size
&checkvar(\$cfg::blksize,'blksize','exist','10');
# Isn't required; if commented out in config we use same as $blksize
#&checkvar(\$cfg::mt_blksize,'mt_blksize','exist');
if ($cfg::blksize !~ m/^\d+$/) {
push(@::errors,"\$blksize must be set to an integer");
}
if ($cfg::blksize ne '0') {
# buffer blocksize needs k appended
$buffer_blk_flag = "-s " . $cfg::blksize . "k";
# mbuffer blocksize in bytes
$mbuffer_blk_flag = "-s " . $cfg::blksize * 1024;
# dd blocksize needs k appended
$::dd_blk_flag = "ibs=" . $cfg::blksize . "k obs=" . $cfg::blksize . "k";
# dump blocksize just in k like the config file
$::dump_blk_flag = "-b $cfg::blksize";
# afio blocksize needs k appended
$::afio_blk_flag = "-b " . $cfg::blksize . "k";
# cpio blocks are in bytes
$::cpio_blk_flag = "-C " . $cfg::blksize * 1024;
# tar blocks are in 512-byte units
# long name is really --blocking-factor but changed from --block-size
# only in recent versions. just use the short flag.
$::tar_blk_flag = "-b " . $cfg::blksize * 2;
# star blocks are in 512-byte units
$::star_blk_flag = "blocks=" . $cfg::blksize * 2;
# pax blocksize needs k appended
$::pax_blk_flag = "-b " . $cfg::blksize . "k";
} else {
$buffer_blk_flag = "";
$mbuffer_blk_flag = "";
$::dd_blk_flag = "";
$::dump_blk_flag = "";
$::afio_blk_flag = "";
$::cpio_blk_flag = "";
$::tar_blk_flag = "";
$::star_blk_flag = "";
$::pax_blk_flag = "";
}
# mt block size (in bytes not k)
if (!defined($cfg::mt_blksize)) {
$cfg::mt_blksize = $cfg::blksize * 1024;
$::mt_blksize = $cfg::mt_blksize;
}
if ($cfg::mt_blksize !~ m/^\d+$/) {
push(@::errors,"\$mt_blksize must be set to an integer");
} else {
if ($cfg::mt_blksize != 0) {
my $tmp = $cfg::blksize * 1024;
if ($tmp%$cfg::mt_blksize != 0) {
push(@::errors,"\$mt_blksize ($cfg::mt_blksize) should be a factor of \$blksize ($tmp)");
}
}
$::mt_blksize = $cfg::mt_blksize;
}
# Generic compression (afio archives will do their own flags)
if ($cfg::compress eq "gzip") {
$::path{'gzip'} = &checkinpath($cfg::compress);
push(@::remoteprogs, $::path{$cfg::compress});
if ($cfg::compr_level !~ m/^[123456789]$/) {
push(@::errors,"\$compr_level must be set to 1-9");
} else {
$::z = " | $::path{$cfg::compress} -$cfg::compr_level";
}
$::unz = "$::path{$cfg::compress} -dq | ";
} elsif ($cfg::compress eq "bzip2") {
$::path{'bzip2'} = &checkinpath($cfg::compress);
push(@::remoteprogs, $::path{$cfg::compress});
if ($cfg::compr_level !~ m/^[123456789]$/) {
push(@::errors,"\$compr_level must be set to 1-9");
} else {
$::z = " | $::path{$cfg::compress} -$cfg::compr_level";
}
$::unz = "$::path{$cfg::compress} -d | ";
} elsif ($cfg::compress eq "lzop") {
$::path{'lzop'} = &checkinpath($cfg::compress);
push(@::remoteprogs, $::path{$cfg::compress});
if ($cfg::compr_level !~ m/^[123456789]$/) {
push(@::errors,"\$compr_level must be set to 1-9");
} else {
$::z = " | $::path{$cfg::compress} -$cfg::compr_level";
}
$::unz = "$::path{$cfg::compress} -d | ";
} elsif ($cfg::compress eq "compress") {
$::path{'compress'} = &checkinpath($cfg::compress);
push(@::remoteprogs, $::path{$cfg::compress});
$::z = " | $::path{$cfg::compress} -c";
$::unz = "$::path{$cfg::compress} -dc | ";
} elsif ($cfg::compress eq "zip") {
$::path{'zip'} = &checkinpath('zip');
push(@::remoteprogs, $::path{'zip'});
$::path{'funzip'} = &checkinpath('funzip');
if ($cfg::compr_level !~ m/^[123456789]$/) {
push(@::errors,"\$compr_level must be set to 1-9");
} else {
$::z = " | $::path{zip} -$cfg::compr_level - -";
$::unz = "$::path{funzip} | ";
}
} else {
$::z = "";
$::unz = "";
}
# Block padding
if (($cfg::pad_blocks eq "true") and defined($::tapedevice)) {
$::dd_write_pad_flag = "conv=noerror,sync";
$::dd_read_pad_flag = "conv=noerror";
$buffer_write_pad_flag = "-B";
$buffer_read_pad_flag = "";
$mbuffer_write_pad_flag = "";
$mbuffer_read_pad_flag = "";
} else {
$::dd_write_pad_flag = "conv=noerror";
$::dd_read_pad_flag = "conv=noerror";
$buffer_write_pad_flag = "";
$buffer_read_pad_flag = "";
$mbuffer_write_pad_flag = "";
$mbuffer_read_pad_flag = "";
}
# Buffer setup
if ($cfg::buffer ne 'false') {
&checkvar(\$cfg::buffer_megs,'buffer_megs','exist');
&checkvar(\$cfg::buffer_fill_pct,'buffer_fill_pct','exist','75');
&checkvar(\$cfg::buffer_pause_usec,'buffer_pause_usec','exist','100');
if ($cfg::buffer_megs !~ m/^\d+$/) {
push(@::errors,"\$buffer_megs must be set to integer number of megabytes");
}
if ($cfg::buffer_fill_pct !~ m/^\d+$/) {
push(@::errors,"\$buffer_fill_pct must be set to an integer");
}
if ($cfg::buffer_pause_usec !~ m/^\d+$/) {
push(@::errors,"\$buffer_pause_usec must be set to an integer");
}
if ($cfg::buffer eq "buffer") {
$::path{'buffer'} = &checkinpath('buffer');
push(@::remoteprogs, $::path{'buffer'});
my $write_flags;
my $read_flags;
my $megs = $cfg::buffer_megs . "m";
my $bufcmd = "$::path{buffer} -m $megs -p $cfg::buffer_fill_pct $buffer_blk_flag -t ";
if (defined($::tapedevice)) {
$write_flags = "-u $cfg::buffer_pause_usec $buffer_write_pad_flag -o ";
$read_flags = "-u $cfg::buffer_pause_usec $buffer_read_pad_flag -i ";
} else {
$write_flags = "$buffer_write_pad_flag -o ";
$read_flags = "$buffer_read_pad_flag -i ";
}
$::buffer_cmd = " | $bufcmd";
$::write_cmd = "$bufcmd $write_flags";
$::read_cmd = "$bufcmd $read_flags";
} elsif ($cfg::buffer eq "mbuffer") {
$::path{'mbuffer'} = &checkinpath('mbuffer');
push(@::remoteprogs, $::path{'mbuffer'});
my $megs = $cfg::buffer_megs . "M";
my $bufcmd = "$::path{mbuffer} -q -m $megs -p $cfg::buffer_fill_pct $mbuffer_blk_flag ";
$::buffer_cmd = " | $bufcmd";
$::write_cmd = "$bufcmd -f -o ";
if (defined($::opt{'volumes'})) {
$::read_cmd = "$bufcmd -f -n $::opt{volumes} -i ";
} else {
$::read_cmd = "$bufcmd -f -i ";
}
}
} else {
# If buffering disabled, use dd or cat depending on if blocking turned off on not
if ($cfg::blksize eq '0') {
$::buffer_cmd = "";
$::write_cmd = "$::path{cat} > ";
$::read_cmd = "$::path{cat} ";
} else {
$::buffer_cmd = "";
$::write_cmd = "$::path{dd} $::dd_blk_flag $::dd_write_pad_flag of=";
$::read_cmd = "$::path{dd} $::dd_blk_flag $::dd_read_pad_flag if=";
}
}
# Sets / filesystems
if (defined($::opt{'dir'})) {
# Single directory
if ($::opt{'dir'} =~ /^(\S+):/) {
$::remotehosts{$1} = 1;
} else {
$::local = 1;
}
# Get rid of trailing /
$::opt{'dir'} = &nuke_trailing_slash($::opt{'dir'});
} elsif (defined($::opt{'set'})) {
if (defined($::use_pipe)) {
push(@::errors,"can't use -set with -pipe option");
}
foreach my $set (keys %cfg::set) {
if ($set eq 'all') {
push(@::errors,"can't define a set named 'all'");
}
}
my @do_sets;
if ($::opt{'set'} eq 'all') {
@do_sets = keys(%cfg::set);
if (scalar(@do_sets) == 0) {
push(@::errors,"no backup sets defined");
}
} else {
@do_sets = ($::opt{'set'});
}
foreach my $this_set (@do_sets) {
if (!defined($cfg::set{$this_set})) {
push(@::errors,"set $this_set is not defined");
} else {
foreach my $dir (&split_list($cfg::set{$this_set})) {
if ($dir =~ /^(\S+):/g) {
$::remotehosts{$1} = 1;
} else {
$::local = 1;
}
}
}
}
}
# Subtree pruning
foreach my $fs (keys %cfg::prune) {
$fs = &nuke_trailing_slash($fs);
foreach my $expr (&split_list($cfg::prune{$fs})) {
$::prune{$fs}{$expr} = 1;
}
}
# Verbose flag
if ($cfg::verbose eq "true") {
$::dump_verb_flag = "-v";
$::afio_verb_flag = "-v";
$::cpio_verb_flag = "-v";
$::tar_verb_flag = "--verbose";
$::star_verb_flag = "-v";
$::pax_verb_flag = "-v";
$::zip_verb_flag = "-v";
$::ar_verb_flag = "v";
$::shar_verb_flag = "";
$::lha_verb_flag = "";
$::rsync_verb_flag = "--verbose";
} else {
$::dump_verb_flag = "";
$::afio_verb_flag = "";
$::cpio_verb_flag = "";
$::tar_verb_flag = "";
$::star_verb_flag = "-silent";
$::pax_verb_flag = "";
$::zip_verb_flag = "-q";
$::ar_verb_flag = "";
$::shar_verb_flag = "-q";
$::lha_verb_flag = "q";
$::rsync_verb_flag = "";
}
# Sparse flag
if ($cfg::sparse eq "true") {
$::afio_sparse_flag = "";
$::cpio_sparse_flag = "";
$::tar_sparse_flag = "--sparse";
$::star_sparse_flag = "-sparse";
} else {
$::afio_sparse_flag = "-j";
$::cpio_sparse_flag = "";
$::tar_sparse_flag = "";
$::star_sparse_flag = "";
}
# atime preserve flag
if ($cfg::atime_preserve eq "true") {
$::afio_atime_flag = "-a";
$::tar_atime_flag = "--atime-preserve";
$::star_atime_flag = "-atime";
} else {
$::afio_atime_flag = "";
$::tar_atime_flag = "";
$::star_atime_flag = "";
}
# Type-specific setup
if ($cfg::type eq 'dump') {
&checkvar(\$cfg::dump_length,'dump_length','exist','0');
&checkvar(\$cfg::dump_use_dumpdates,'dump_use_dumpdates','bool','false');
$::path{'dump'} = &checkinpath('dump');
$::path{'restore'} = &checkinpath('restore');
push(@::remoteprogs, $::path{'dump'});
# Length of tape
if ($cfg::dump_length !~ m/^\d+$/) {
push(@::errors,"\$dump_length must be set to integer number of kilobytes");
}
# If length set to 0 will will try autosize
if ($cfg::dump_length == 0) {
$::dump_len_flag = "-a";
} else {
$::dump_len_flag = "-B $cfg::dump_length";
}
} elsif ($cfg::type eq 'afio') {
&checkvar(\$cfg::afio_echo_block,'afio_echo_block','bool','false');
&checkvar(\$cfg::afio_compress_cache_size,'afio_compress_cache_size','exist','2');
&checkvar(\$cfg::afio_compress_threshold,'afio_compress_threshold','exist','3');
&checkvar(\$cfg::afio_nocompress_types,'afio_nocompress_types','exist','mp3 MP3 Z z gz gif zip ZIP lha jpeg jpg JPG taz tgz deb rpm bz2 lzo');
$::path{'afio'} = &checkinpath('afio');
push(@::remoteprogs, $::path{'afio'});
# Compress flag for afio must be handled differently
if ($cfg::compress =~ m/^(gzip|bzip2|lzop|compress|zip)$/) {
if ($cfg::compress eq "gzip") {
$::afio_z_flag = "-P $::path{$cfg::compress} -Q -$cfg::compr_level -Z";
$::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Q -q -Z";
} elsif ($cfg::compress eq "bzip2") {
$::afio_z_flag = "-P $::path{$cfg::compress} -Q -$cfg::compr_level -Z";
$::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Z";
} elsif ($cfg::compress eq "lzop") {
$::afio_z_flag = "-P $::path{$cfg::compress} -Q -$cfg::compr_level -Z";
$::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Z";
} elsif ($cfg::compress eq "zip") {
$::afio_z_flag = "-P $::path{zip} -Q -$cfg::compr_level -Q - -Q - -Z";
$::afio_unz_flag = "-P $::path{funzip} -Q \"\" -Z";
} elsif ($cfg::compress eq "compress") {
$::afio_z_flag = "-P $::path{$cfg::compress} -Q -c -Z";
$::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Q -c -Z";
}
$::unz = ""; # Reset & just use this for reading the archive file.
# Compression cache size
if ($cfg::afio_compress_cache_size !~ m/^\d+$/) {
push(@::errors,"\$afio_compress_cache_size must be set to an integer");
} else {
if ($cfg::afio_compress_cache_size != 0) {
$::afio_z_flag .= " -M " . $cfg::afio_compress_cache_size . "m";
}
}
# Compression threshold
if ($cfg::afio_compress_threshold !~ m/^\d+$/) {
push(@::errors,"\$afio_compress_threshold must be set to an integer");
} else {
if ($cfg::afio_compress_threshold != 0) {
$::afio_z_flag .= " -T " . $cfg::afio_compress_threshold . "k";
}
}
} else {
$::afio_z_flag = "";
$::afio_unz_flag = "";
}
# Echo block number
$::afio_bnum_flag = "";
if ($cfg::verbose eq "true") {
if ($cfg::afio_echo_block eq "true") {
$::afio_bnum_flag = "-B";
}
}
} elsif (($cfg::type eq 'cpio') or ($cfg::type eq 'copy')) {
&checkvar(\$cfg::cpio_format,'cpio_format','bin odc newc crc tar ustar hpbin hpodc','newc');
$::path{'cpio'} = &checkinpath('cpio');
push(@::remoteprogs, $::path{'cpio'});
if ($cfg::type eq 'copy') {
if (!defined($::use_file)) {
push(@::errors,"Can't use type \"copy\" unless archiving to disk!");
}
if (defined($::use_pipe)) {
push(@::errors,"Can't use type \"copy\" with -pipe!");
}
}
} elsif ($cfg::type eq 'rsync') {
$::path{'rsync'} = &checkinpath('rsync');
$::path{'sed'} = &checkinpath('sed');
push(@::remoteprogs, $::path{'rsync'});
if (!defined($::use_file)) {
push(@::errors,"Can't use type \"rsync\" unless archiving to disk!");
}
if (defined($::use_pipe)) {
push(@::errors,"Can't use type \"rsync\" with -pipe!");
}
} elsif ($cfg::type eq 'tar') {
&checkvar(\$cfg::tar_echo_record_num,'tar_echo_record_num','bool','false');
$::path{'tar'} = &checkinpath('tar');
push(@::remoteprogs, $::path{'tar'});
# Echo record number
$::tar_recnum_flag = "";
if ($cfg::verbose eq "true") {
if ($cfg::tar_echo_record_num eq "true") {
$::tar_recnum_flag = "-R";
}
}
} elsif ($cfg::type eq 'star') {
&checkvar(\$cfg::star_acl,'star_acl','bool','true');
&checkvar(\$cfg::star_fifo,'star_fifo','bool','true');
&checkvar(\$cfg::star_format,'star_format','tar star gnutar ustar pax xstar xustar exustar suntar','exustar');
&checkvar(\$cfg::star_echo_block_num,'star_echo_block_num','bool','false');
$::path{'star'} = &checkinpath('star');
push(@::remoteprogs, $::path{'star'});
# Echo block number
$::star_blocknum_flag = "";
if ($cfg::verbose eq "true") {
if ($cfg::star_echo_block_num eq "true") {
$::star_blocknum_flag = "-block-number";
}
}
# ACL flag
if ($cfg::star_acl eq "true") {
$::star_acl_flag = "-acl";
} else {
$::star_acl_flag = "";
}
# fifo
if ($cfg::star_fifo eq "true") {
$::star_fifo_flag = "-fifo";
if ($cfg::verbose eq "true") {
$::star_fifo_flag .= " -fifostats";
}
} else {
$::star_fifo_flag = "";
}
} elsif ($cfg::type eq 'pax') {
&checkvar(\$cfg::pax_format,'pax_format','cpio bcpio sv4cpio sv4crc tar ustar');
$::path{'pax'} = &checkinpath('pax');
push(@::remoteprogs, $::path{'pax'});
} elsif ($cfg::type eq 'zip') {
&checkvar(\$cfg::zip_nocompress_types,'zip_nocompress_types','exist','mp3 MP3 Z z gz gif zip ZIP lha jpeg jpg JPG taz tgz deb rpm bz2 lzo');
$::path{'zip'} = &checkinpath('zip');
push(@::remoteprogs, $::path{'zip'});
$::path{'unzip'} = &checkinpath('unzip');
$::zip_compr_flag = "-$cfg::compr_level";
if ($cfg::compress =~ /^(gzip|bzip2|lzop|compress|zip)$/) {
warn("Using type \"zip\" with compress=$cfg::compress makes no sense");
warn("Setting compression to false");
$::unz = "";
$::z = "";
$cfg::compress = "false";
}
$::zip_noz_flag = "";
if (defined($cfg::zip_nocompress_types) and $cfg::zip_nocompress_types ne "") {
# Add dots to file extensions, make -n flag
@_ = split(" ",$cfg::zip_nocompress_types);
foreach (@_) {
$_ = "." . $_;
}
$::zip_noz_flag = " -n " . join(":",@_);
}
} elsif ($cfg::type eq 'ar') {
$::path{'ar'} = &checkinpath('ar');
push(@::remoteprogs, $::path{'ar'});
} elsif ($cfg::type eq 'shar') {
$::path{'shar'} = &checkinpath('shar');
push(@::remoteprogs, $::path{'shar'});
} elsif ($cfg::type eq 'lha') {
$::path{'lha'} = &checkinpath('lha');
push(@::remoteprogs, $::path{'lha'});
if ($cfg::compress =~ /^(gzip|bzip2|lzop|compress|zip)$/) {
warn("Using type \"lha\" with compress=$cfg::compress makes no sense");
warn("Setting compression to false");
$::unz = "";
$::z = "";
$cfg::compress = "false";
}
} elsif ($cfg::type eq 'filelist') {
# Nothing specific to check
} # type-specific
# Tmp dir
$cfg::tmpdir = &nuke_trailing_slash($cfg::tmpdir);
if ($cfg::tmpdir !~ m:^/:) {
push(@::errors,"\$tmpdir must be absolute path: $cfg::tmpdir");
}
if (! -d "$cfg::tmpdir") {
push(@::errors,"\$tmpdir $cfg::tmpdir is not a directory");
}
if (! -w "$cfg::tmpdir") {
push(@::errors,"\$tmpdir $cfg::tmpdir is not writable");
}
# Levels
if (defined($::opt{'level'}) and
(defined($::opt{'incremental'}) or
defined($::opt{'differential'}) or
defined($::opt{'full'}))) {
push(@::errors,"Can't use -level AND -incremental/-differential/-full");
}
if (!defined($::opt{'level'})) {
if (defined($::opt{'incremental'})) {
$::opt{'level'} = 'incremental';
} elsif (defined($::opt{'differential'})) {
$::opt{'level'} = 'differential';
} elsif (defined($::opt{'full'})) {
$::opt{'level'} = 'full';
} else {
$::opt{'level'} = 0;
}
}
if (($::opt{'level'} !~ m/^\d+$/) and
($::opt{'level'} !~ m/^(full|differential|incremental)$/)) {
push(@::errors,"-level must be numeric, or full/differential/incremental");
}
# Check for digits or change full/diff to level number
# Incremental + fs=all we have to handle later since it might be
# different for each fs
if ($::opt{'level'} =~ m/^\d+$/) {
# Make string variable numeric
$::level = POSIX::strtod($::opt{'level'});
if (($cfg::type eq 'dump') and ($::level > 9)) {
push(@::errors,"can't use level > 9 and type=dump");
}
} elsif ($::opt{'level'} eq "full") {
$::level = 0;
} elsif ($::opt{'level'} eq "differential") {
$::level = 1;
} elsif ($::opt{'level'} eq "incremental") {
# If incremental + one fs, we can find the level now.
if (defined($::opt{'dir'})) {
$::level = &get_incremental_level($::opt{'dir'});
if (($cfg::type eq 'dump') and ($::level > 9)) {
push(@::errors,"can't use level > 9 and type=dump");
}
} else {
# If we are doing a set have to postpone till later; each
# fs might have a different level...
undef $::level;
$::set_incremental = 1;
}
}
# Package delta option
if (defined($::opt{'pkgdelta'})) {
&checkvar(\$cfg::pkgdelta_archive_list,'pkgdelta_archive_list','true false rootonly','rootonly');
&checkvar(\$cfg::pkgdelta_archive_unowned,'pkgdelta_archive_unowned','bool','true');
&checkvar(\$cfg::pkgdelta_archive_changed,'pkgdelta_archive_changed','bool','true');
if ($::opt{'pkgdelta'} eq 'rpm') {
$::pkgdelta = 'rpm';
$::path{'rpm'} = &checkinpath('rpm');
} elsif ($::opt{'pkgdelta'} =~ /freebsd/i) {
$::pkgdelta = 'freebsd';
$::path{'pkg_info'} = &checkinpath('pkg_info');
} else {
push(@::errors,"$::opt{pkgdelta} not a valid option for -pkgdelta");
}
}
# Check toc/rmindex/rmfile flags
if (defined($::opt{'toc'}) or defined($::opt{'rmindex'})) {
if ($cfg::indexes eq "false") {
push(@::errors,"Can't do -toc/rmindex with \$indexes set to false");
}
}
if (defined($::opt{'rmindex'}) and (${$::opt{'rmindex'}}[0] eq '')) {
push(@::errors,"-rmindex requires 'key:filenum', 'key' or 'all'");
}
if (defined($::opt{'rmfile'}) and (${$::opt{'rmfile'}}[0] eq '')) {
push(@::errors,"-rmfile requires a filename or 'all'");
}
# Check log/stamp dirs (only if we are in a 'write' mode)
if ($::mode =~ m/^(set|dir|newtape)$/) {
$::path{$cfg::comp_log} = &checkinpath($cfg::comp_log) if ($cfg::comp_log ne "false");
$cfg::logdir = &nuke_trailing_slash($cfg::logdir);
$cfg::stampdir = &nuke_trailing_slash($cfg::stampdir);
if ($cfg::logdir !~ m:^/:) {
push(@::errors,"\$logdir must be absolute path: $cfg::logdir");
}
if ($cfg::stampdir !~ m:^/:) {
push(@::errors,"\$stampdir must be absolute path: $cfg::stampdir");
}
if (! -d "$cfg::logdir") {
mkdir("$cfg::logdir",0755) or push(@::errors,"Can't mkdir $cfg::logdir: $OS_ERROR");
}
if (! -w "$cfg::logdir") {
push(@::errors,"Can't write to $cfg::logdir");
}
if (! -d "$cfg::stampdir") {
mkdir("$cfg::stampdir",0755) or push(@::errors,"Can't mkdir $cfg::stampdir: $OS_ERROR");
}
if (! -w "$cfg::stampdir") {
push(@::errors,"Can't write to $cfg::stampdir: $OS_ERROR");
}
}
# Tie index database
if (($::mode !~ m/^(list|extract|restore|compare|test-tape-drive)$/) and
($cfg::indexes eq "true")) {
tie(%::index,"AnyDBM_File",$cfg::index,O_CREAT|O_RDWR,0640) or
push(@::errors,"Can't tie DB $cfg::index");
}
# Sanity check some accessory tape flags
if (($::mode =~ m/^(list|extract|restore|compare)$/) and defined($::opt{'erase'})) {
push(@::errors,"-erase can't be used in -$::mode mode");
}
if (($::mode =~ m/^(set|dir|newtape)$/) and defined($::opt{'num'})) {
push(@::errors,"-num Can't be used in -$::mode mode");
}
if (defined($::use_file) or defined($::use_blockdevice)) {
if (defined($::opt{'num'})) {
push(@::errors,"Can't use -num unless reading from tape");
}
if (defined($::opt{'erase'}) or defined($::opt{'rewind'}) or defined($::opt{'reten'})) {
push(@::errors,"Can't use -erase/-rewind/-reten unless using a tape");
}
}
# Testing
if (defined($::debug)) {
&log('(debug) no backup or mt commands will be executed');
&log('(debug) no old stamps or old log files will be removed');
}
# Check extract list
if (defined($::opt{'flist'})) {
if (defined($::opt{'extract'})) {
if (! -r $::opt{'flist'}) {
push(@::errors,"list of files $::opt{flist} not readable: $OS_ERROR");
}
} else {
push(@::errors,"-flist can only be used with -extract");
}
}
if (defined($::opt{'onefile'}) and !defined($::opt{'extract'})) {
push(@::errors,"-onefile can only be used with -extract");
}
# Requirements for testing
if (defined($::opt{'test-tape-drive'})) {
if (defined($::use_file)) {
push(@::errors,"No use trying tape drive tests on directories!");
} elsif (defined($::use_blockdevice)) {
push(@::errors,"No use trying tape drive tests on block devices!");
}
$::path{'diff'} = &checkinpath('diff');
$::path{'tr'} = &checkinpath('tr');
}
if (@::errors) {
print $::msg "\nErrors:\n";
while(@::errors) {
print $::msg " " . shift(@::errors) . "\n";
}
exit(1);
}
}
######################################################################
# Check buffer, shelltype, and any remote hosts for required programs
######################################################################
sub test_before_run {
if ($cfg::buffer ne 'false') {
&test_bufferprog($::buffer_cmd, 'localhost');
}
&check_shell('localhost');
&check_remote_progs(\%::remotehosts, \@::remoteprogs);
if (@::errors) {
print $::msg "\nErrors:\n";
while(@::errors) {
print $::msg " " . shift(@::errors) . "\n";
}
exit(1);
}
}
######################################################################
# Print usage summary from the header
######################################################################
sub usage {
open(FILE,"$0") or die "Can't open $0: $OS_ERROR";
while(<FILE>) {
last if (m/^\#\s+USAGE:/);
}
while(<FILE>) {
last if (m/^\#\#\#\#\#\#\#/);
s/^\#//;
print;
}
close(FILE);
}
######################################################################
# Return version string from CVS tag
######################################################################
sub versionstring {
my $ver = ' $Name: v1_2_1 $ ';
$ver =~ s/Name//g;
$ver =~ s/[:\$]//g;
$ver =~ s/\s+//g;
$ver =~ s/^v//g;
$ver =~ s/_/\./g;
if ($ver eq '') {
$ver = "devel";
}
return($ver . " (http://flexbackup.sourceforge.net)");
}
######################################################################
# Return current time in ctime format if normal
# in YYYYMMDDHHMM.SS format if 'numeric' is given
######################################################################
sub current_time {
my $format = shift(@_);
my $string;
my $current_time = time;
if (defined($format) and ($format eq 'numeric')) {
$string = strftime("%Y%m%d%H%M", localtime($current_time));
} elsif (defined($format) and ($format eq 'ctime')) {
$string = strftime("%a %b %d %H:%M:%S %Y", localtime($current_time));
} else {
$string = strftime("%a %b %d %H:%M:%S %Y", localtime($current_time));
}
return($string);
}
######################################################################
# Possibly return a filename to use
# if running list/extract/compare/restore
######################################################################
sub maybe_get_filename {
my @modes = qw(list extract compare restore);
my $arg;
my $file;
my $ftype;
# grab filename from option argument
# optionscheck already guarantees only one is set
foreach my $mode (@modes) {
if (defined($::opt{$mode})) {
$arg = $::opt{$mode};
}
}
# If reading from stdin
if (defined($::use_pipe)) {
# -pipe and file arg doesn't make sense, yell
if ($arg ne '') {
print STDERR "Error: when using -pipe, don't specify file name.\n";
die();
} else {
# Set file to "-" for stdin
return('-');
}
}
# If the flag given but null, and $device was not set to a dir, just return
if (($arg eq '') and (!defined($::use_file))) {
return($::device);
}
# If the flag given but null, and $device is a dir, spew
if (($arg eq '') and (defined($::use_file))) {
print STDERR "Error: when extracting from a file, you must specify file name.\n";
print STDERR "(like \"-list file.tar.bz2\")\n";
die();
}
# Look for file in current dir first (or full path given)
# Then in $device dir (if conf file set to backup to files)
if (-f "$arg") {
$file = $arg;
$::use_file = 1;
$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
undef $::tapedevice;
undef $::remotetapehost;
} elsif (defined($::use_file) and (-f "$cfg::device/$arg")) {
$file = $cfg::device . "/" . $arg;
$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
undef $::tapedevice;
undef $::remotetapehost;
} elsif (-d "$arg") {
$file = $arg;
$::use_file = 1;
$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
undef $::tapedevice;
undef $::remotetapehost;
} elsif (defined($::use_file) and (-d "$cfg::device/$arg")) {
$file = $cfg::device . "/" . $arg;
$cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape
undef $::tapedevice;
undef $::remotetapehost;
} else {
if (defined($::use_file)) {
print STDERR "Error: file \"$arg\" or \"$cfg::device/$arg\" not found\n";
print STDERR "(like \"-list file.tar.bz2\")\n";
die();
} else {
die("Error: file \"$arg\" not found");
}
}
# Try and guess file types and commpression scheme
# might as well since we are reading from a file in this case
if ($file =~ m/\.(dump|cpio|tar|star|pax|a|shar|filelist)\.(gz|bz2|lzo|Z|zip)$/) {
$cfg::type = $1;
$cfg::compress = $2;
$cfg::type =~ s/^a$/ar/;
$cfg::compress =~ s/gz/gzip/;
$cfg::compress =~ s/bz2/bzip2/;
$cfg::compress =~ s/lzo/lzop/;
$cfg::compress =~ s/Z/compress/;
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.afio-(gz|bz2|lzo|Z|zip)$/) {
$cfg::type = "afio";
$cfg::compress = $1;
$cfg::compress =~ s/gz/gzip/;
$cfg::compress =~ s/bz2/bzip2/;
$cfg::compress =~ s/lzo/lzop/;
$cfg::compress =~ s/Z/compress/;
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.(dump|afio|cpio|tar|star|pax|zip|a|shar|lha|filelist)$/) {
$cfg::type = $1;
$cfg::type =~ s/^a$/ar/;
$cfg::compress = "false";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif (-d "$file") {
$cfg::type = "copy";
$cfg::compress = "false";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.tgz$/) {
$cfg::type = "tar";
$cfg::compress = "gzip";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.tbz2?$/) {
$cfg::type = "tar";
$cfg::compress = "bzip2";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.taz$/) {
$cfg::type = "tar";
$cfg::compress = "compress";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.rpm$/) {
$cfg::type = "cpio";
$cfg::compress = "false";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.deb$/) {
$cfg::type = "ar";
$cfg::compress = "false";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.jar$/i) {
$cfg::type = "zip";
$cfg::compress = "false";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
} elsif ($file =~ m/\.lzh$/i) {
$cfg::type = "lha";
$cfg::compress = "false";
&log("| Auto-set to type=$cfg::type compress=$cfg::compress");
&optioncheck(); # redo to set a few variables over
}
return($file);
}
######################################################################
# Check validity of a config option
######################################################################
sub checkvar {
my $ref = shift(@_); # ref to variable
my $varname = shift(@_); # name of variable
my $ok = shift(@_); # list of ok values, "bool", "exists"
my $default = shift(@_); # default to use if not set
my @ok;
my $found = 0;
if (!defined($ok)) {
die("checkvar called incorrectly");
}
if ($ok eq 'bool') {
@ok = ('true','false');
} else {
@ok = split(" ",$ok);
}
if (!defined($$ref)) {
if (!defined($::opt{'nodefaults'}) and defined($default)) {
print $::msg " \$$varname not found in config: default=$default\n";
$$ref = $default;
} else {
push(@::errors,"\$$varname not defined");
}
} else {
if ($ok[0] ne "exist") {
foreach (@ok) {
if ($_ eq $$ref) {
$found = 1;
}
}
if ($found == 0 ) {
$_ = join(", ",@ok);
push(@::errors,"\$$varname must be one of $_");
}
}
}
}
######################################################################
# Check to see if a program is found in $PATH
######################################################################
sub checkinpath {
my $file = shift(@_);
if (defined($cfg::path{$file})) {
# Override in config file
if ($cfg::path{$file} =~ m:^/:) {
# Starts with /; full path override
if (-e $cfg::path{$file} && -x _) {
print $::msg "path $file = $cfg::path{$file}\n";
return "$cfg::path{$file}";
} else {
push(@::errors,"$cfg::path{$file} not found");
return(0);
}
} elsif (($cfg::path{$file} =~ m:^\s*sudo\s+-u\s+\S+\s+(\S+):) or
($cfg::path{$file} =~ m:^\s*sudo\s+(\S+):)) {
# some sort of sudo...
my $prog = $1;
&checkinpath('sudo');
# sudo with full pathname
if (($prog =~ m:^/:) and (-e $prog) and (-x _)) {
print $::msg "path $file = $cfg::path{$file}\n";
return "$cfg::path{$file}";
}
# sudo with just command name
my @path = split(/:/,$ENV{'PATH'});
foreach my $dir (@path) {
if (-e "${dir}/$prog" && -x _) {
return "$cfg::path{$file}";
}
}
push(@::errors,"sudo $prog not found in \$PATH");
return(0);
} else {
# Didn't start with /; just overriding name of command
# search PATH for it
my @path = split(/:/,$ENV{'PATH'});
foreach my $dir (@path) {
if (-e "${dir}/$cfg::path{$file}" && -x _) {
return "$cfg::path{$file}";
}
}
push(@::errors,"$cfg::path{$file} not found in \$PATH");
return(0);
}
} else {
# Not spec'ed as an override in config file; search PATH
my @path = split(/:/,$ENV{'PATH'});
foreach my $dir (@path) {
if (-e "${dir}/$file" && -x _) {
return "$file";
}
}
push(@::errors,"$file not found in \$PATH");
return(0);
}
}
######################################################################
# Run a command, or echo it depending on the -n flag
# Then show tape drive position
######################################################################
sub run_or_echo_then_query {
my $cmd = shift(@_);
&split_and_echo($cmd);
&line();
if (!defined($::debug)) {
system("($cmd) 2>&1 | $::path{tee} -a $::log");
} else {
&log("(debug) command output would be here");
}
if (!defined($::use_file)) {
&line();
&mt('generic-query');
}
&line();
# Maybe rewind (usually false for reads)
if (($::do_rewind_after == 1) and !defined($::use_file)) {
&log("| Rewinding...");
&mt('rewind');
&line();
}
}
######################################################################
# Return a command possibly wrapped in ssh/rsh
######################################################################
sub maybe_remote_cmd {
my $cmd = shift(@_);
my $host = shift(@_);
my $quote = shift(@_);
my $is_pipeline = 0;
if (!defined($quote)) {
$quote = "'";
}
if ($cmd =~ m:\s+(\||&&)\s+:) {
$is_pipeline = 1;
}
if (defined($host) and ($host ne '')) {
# If remote shell is smart enough use pipeline exit detectors
if (($is_pipeline == 1) and ($::shelltype{$host} eq 'bash2')) {
$cmd = "$::remoteshell $host " . $quote . $cmd . $::bash_pipe_exit . $quote;
} elsif (($is_pipeline == 1) and ($::shelltype{$host} eq 'zsh')) {
$cmd = "$::remoteshell $host " . $quote . $cmd . $::zsh_pipe_exit . $quote;
} else {
$cmd = "$::remoteshell $host " . $quote . $cmd . $quote;
}
} else {
$cmd = "$cmd";
}
return($cmd);
}
######################################################################
# Append to the pipelins string appropriate commands to write archive
######################################################################
sub append_writer_cmd {
my $cmd = shift(@_);
my $dev = shift(@_);
# Possibly override device
if (!defined($dev)) {
$dev = $::device;
}
if (defined($::use_pipe)) {
$cmd .= $::buffer_cmd;
} elsif (!defined($::remotetapehost)) {
$cmd .= " | " . $::write_cmd . '"' . $dev . '"' ;
} else {
$cmd .= "$::buffer_cmd | ";
$cmd .= &maybe_remote_cmd($::write_cmd . '"' . $dev . '"', $::remotetapehost);
}
return($cmd);
}
######################################################################
# Stuff to do before list/restore/extract/compare
# return command to get archive on stdout
######################################################################
sub setup_before_read {
my $op = shift(@_);
my $cmd;
&line();
if (($cfg::staticlogs eq 'false') and ($cfg::staticfiles eq 'false')) {
$::log = "flexbackup.$op." . ¤t_time('numeric') . ".log";
} else {
$::log = "flexbackup.$op.log";
}
if (! open(LOG,">$::log")) {
$::log = "$cfg::tmpdir/$::log";
if (! open(LOG,">$::log")) {
die "Can't write to $::log: $OS_ERROR";
}
}
close(LOG);
&log("| Logging output to \"$::log\"");
$::device = &maybe_get_filename();
&mt("generic-blocksize $::mt_blksize");
# Maybe retension
if (($::do_reten == 1) and !defined($::use_file)) {
&log('| Retensioning tape...');
&mt('retension');
}
if (defined($::opt{'num'})) {
&log("| Positioning tape at file number $::opt{num}");
&mt("rewind","fsf $::opt{num}");
} else {
if (defined($::use_pipe)) {
&log("| Reading from stdin (type=$cfg::type compress=$cfg::compress)");
} elsif (defined($::use_file)) {
&log("| Reading from on-disk file $::device");
} elsif (defined($::use_blockdevice)) {
&log("| Reading from block device $::device");
} else {
&log("| Reading from CURRENT TAPE POSITION");
}
}
&line();
if (!defined($::use_file)) {
&mt('generic-query');
&line();
}
$cmd = &read_function($::device);
if (defined($::remotetapehost)) {
$cmd = &maybe_remote_cmd($cmd, $::remotetapehost);
# Buffer both sides if remote
$cmd .= $::buffer_cmd;
}
$cmd .= " | $::unz ";
if ($::device =~ m/\.rpm$/) {
$cmd .= "rpm2cpio | ";
}
$cmd =~ s/\s+/ /g;
return($cmd);
}
######################################################################
# Read from file/device - in future buffer cmds might need a blocking
# dd read ahead of them
######################################################################
sub read_function {
my $file = shift(@_);
my $cmd;
# If reading from stdin arg is '-'
if ($file eq '-') {
$cmd = $::buffer_cmd;
$cmd =~ s/^\s*\|\s*//; # Nuke leading " | " we normally use
} else {
$cmd = $::read_cmd . '"' . $file . '"';
}
return($cmd);
}
######################################################################
# Get rid of trailing slash on path or host:/path specs
######################################################################
sub nuke_trailing_slash {
my $spec = shift(@_);
my $host;
my $path;
if ($spec =~ s/(\S+:)//) {
$host = $1;
$path = $spec;
} else {
$host = '';
$path = $spec;
}
if ($path ne "/") {
$path =~ s%/$%%;
}
return($host . $path);
}
######################################################################
# Print the volume label from an afio control file
######################################################################
sub print_afio_volume_header {
# for now just echo our stdin
print STDOUT "\n";
while(<STDIN>) {
print;
}
exit(0);
}
######################################################################
# Figure out which of rewind/erase/reten we are going to assume
######################################################################
sub set_tape_operation_defaults {
# Assume stuff based on how we are called first
if (defined($::opt{'set'})) {
if (!defined($::set_incremental) and
($::level == 0) and
!defined($::use_file)) {
# Set level zero, using device. Retension & erase a new tape
# (config file may tell us not to erase)
if ($cfg::erase_tape_set_level_zero eq "true") {
$::do_reten = 1;
$::do_erase = 1;
} else {
$::do_reten = 0;
$::do_erase = 0;
}
$::do_rewind_after = 1;
} else {
# Using files, set incremental backup, or set non-zero
# don't erase + go to end of tape
$::do_reten = 0;
$::do_erase = 0;
$::do_rewind_after = 1;
}
} elsif (defined($::opt{'dir'})) {
# Just one filesystem - assume we append to tape
$::do_reten = 0;
$::do_erase = 0;
$::do_rewind_after = 1;
} else {
# We're doing a read of some sort
$::do_reten = 0;
$::do_erase = 0; # -erase has no effect anyway here
$::do_rewind_after = 0;
}
# Then see if commandline flags override anything
if (defined($::opt{'reten'})) {
$::do_reten = $::opt{'reten'};
}
if (defined($::opt{'erase'})) {
$::do_erase = $::opt{'erase'};
}
if (defined($::opt{'rewind'})) {
$::do_rewind_after = $::opt{'rewind'};
}
}
######################################################################
# Split long lines for echoing
######################################################################
sub split_and_echo {
my $string = shift(@_);
my $initial_tab;
my $subsequent_tab;
local($Text::Wrap::columns) = 76;
# Older perl's don't have this var. Use twice to shut up
# -w in that case. Output almost the same...
local($Text::Wrap::separator) = " \\\n";
local($Text::Wrap::separator) = " \\\n";
# This make it easier to cut-n-paste for debugging commands manually
if (defined($::debug)) {
$initial_tab = " ";
$subsequent_tab = " ";
} else {
$initial_tab = "| ";
$subsequent_tab = "| ";
}
my @lines = wrap($initial_tab, $subsequent_tab, ($string));
foreach (@lines) {
&log($_);
}
}
######################################################################
# Create new tape "key" and return it (YYYYMMDDHHMMSS)
# Also sets ::nextfile
######################################################################
sub new_tape_key {
my $key;
my $dev = $cfg::device;
my $old;
my $string;
return('') if $cfg::indexes eq "false";
$key = ¤t_time('numeric');
# If writing to a file see if there is already an index key and use it
if (defined($::use_file)) {
$dev .= "/$cfg::keyfile";
if (-r $dev) {
open(KEY,$dev) or die("Can't open existing key $dev: $OS_ERROR");
chomp($key = <KEY>);
close(KEY);
&log("| Directory's existing key is $key");
# Make sure keyfile entry is there
if (!defined($::index{"$key|$cfg::keyfile"})) {
my $label = "<index keyfile, dir=$cfg::device>";
if (defined($::debug)) {
&log("(debug) \$::index{$key|$cfg::keyfile} = $label");
} else {
$::index{"$key|$cfg::keyfile"} = $label;
}
}
# Figure out the existing files
foreach (sort keys %::index) {
my ($tape,$filenum) = split(/\|/,$_);
if ($tape eq $key) {
$::nextfile = $filenum;
}
}
# Set for the next file
$::nextfile++;
return($key);
}
}
&log("| Creating index key $key");
$string = "$::path{printf} \'$key\\nThis is a flexbackup index key\\n\' ";
$string = &append_writer_cmd($string, $dev);
if (defined($::debug)) {
&log("(debug) $string");
} else {
`$string 2> /dev/null`;
}
$::nextfile = 1;
if (defined($::use_file)) {
my $label = "<index keyfile, dir=$cfg::device>";
if (defined($::debug)) {
&log("(debug) \$::index{$key|$cfg::keyfile} = $label");
} else {
$::index{"$key|$cfg::keyfile"} = $label;
}
} else {
my $label = "<tape index key>";
if (defined($::debug)) {
&log("(debug) \$::index{$key|0} = $label");
} else {
$::index{"$key|0"} = $label;
}
}
# So that we won't generate duplicate keys...
# (as long as two processes with -newtape aren't run in parallel)
sleep(1);
return($key);
}
######################################################################
# Get existing index key
# Also sets ::nextfile
######################################################################
sub get_tape_key {
my $quiet = shift(@_);
my $key;
return('') if $cfg::indexes eq "false";
# If writing to a file see if there is already an index key and use it
if (defined($::use_file)) {
my $dev = "$cfg::device/$cfg::keyfile";
if (-r $dev) {
open(KEY,$dev) or die("Can't open existing key $dev: $OS_ERROR");
chomp($key = <KEY>);
close(KEY);
} else {
return(&new_tape_key());
}
} else {
my $string = "$::path{dd} $::dd_blk_flag $::dd_write_pad_flag count=1 if=$::device";
if (defined($::remotetapehost)) {
$string = &maybe_remote_cmd($string, $::remotetapehost);
}
if (defined($::debug)) {
&log("(debug) $string");
$key = '';
} else {
$key = `$string 2> /dev/null`;
@_ = split(/\n/,$key);
$key = $_[0];
}
if (defined($key)) {
chomp($key);
if ($key !~ m/^\d+$/) {
if (!defined($quiet)) {
&log("| ERROR: Tape doesn't have an index! (use -newtape?)");
}
$::nextfile = 0;
return('');
}
} else {
if (!defined($quiet)) {
&log("| ERROR: Tape doesn't have an index! (use -newtape?)");
}
$::nextfile = 0;
return('');
}
}
# Find the number of existing files
$::nextfile = 0;
unless (defined($::use_file)) {
foreach (sort keys %::index) {
my ($tape,$filenum) = split(/\|/,$_);
if ($tape eq $key) {
if ($filenum > $::nextfile) {
$::nextfile = $filenum;
}
}
}
# Set for the next file
$::nextfile++;
&log("| Found index key $key, next file is $::nextfile");
} else {
&log("| Found directory index key $key");
}
return($key);
}
######################################################################
# Print table of contents
# Can give a specific key as argument
# Or uses command flag (specific key, current tape/dir, or "all")
######################################################################
sub toc_routine {
my $arg = shift(@_);
my %desired_keys;
my $tape;
my $desired;
my $label;
my $dir;
my $file;
my %tape_files;
my %disk_files;
return if $cfg::indexes eq "false";
if (defined($arg)) {
# Print toc for current tape if given argument
$desired_keys{$arg} = 1;
} elsif ($::opt{'toc'} =~ m/^\d+$/) {
# Print toc for a specific tape
&log("| Listing specific index");
$desired_keys{"$::opt{toc}"} = 1;
&line();
} elsif ($::opt{'toc'} eq '') {
# Print toc for current tape/device
&mt('rewind');
my $key = &get_tape_key();
&mt('rewind');
if ($key ne '') {
$desired_keys{$key} = 1;
}
&line();
} elsif ($::opt{'toc'} eq "all") {
# Print everything we know about
&log("| Listing all in database");
foreach (keys %::index) {
($tape,$file) = split(/\|/,$_);
$desired_keys{$tape} = 1;
}
&line();
} else {
die("Invalid key spec $::opt{toc}");
}
# Go through the index and fill hashes
foreach my $key (keys %::index) {
($tape,$file) = split(/\|/,$key);
if ($file =~ m/^\d+$/) {
$tape_files{$tape}{$file} = $::index{$key};
} else {
$disk_files{$tape}{$file} = $::index{$key};
}
}
# Print the toc of each tape in our desired list
foreach $desired (sort bynumber keys %desired_keys) {
my $found = 0;
my $length = 45;
foreach $tape (sort bynumber keys %tape_files) {
if ($tape eq $desired) {
$found = 1;
&log('');
&log("File Contents (tape index $tape)");
&log("-" x $length);
foreach $file (sort bynumber keys %{$tape_files{$tape}}) {
$_ = sprintf("%-04s",$file);
&log($_ . " " . $tape_files{$tape}{$file});
}
}
}
foreach $dir (sort bynumber keys %disk_files) {
if ($dir eq $desired) {
my @array;
$found = 1;
foreach $file (sort keys %{$disk_files{$dir}}) {
if ((! -e "$cfg::device/$file") and
(!defined($::opt{'toc'}) or ($::opt{'toc'} eq ''))) {
&log("| Bogus index entry - $file does not exist");
&rmindex("$dir:$file");
delete $disk_files{$dir}{$file};
}
}
&log('');
&log("File Contents (dir index $dir)");
&log("-" x $length);
foreach $file (keys %{$disk_files{$dir}}) {
push(@array, $file . " " . $disk_files{$dir}{$file});
}
foreach (sort byfilename @array) {
&log($_);
}
}
}
if ($found == 0) {
&log("Key $desired not found in index");
}
&log('');
}
}
######################################################################
# Nuke stuff from DB
######################################################################
sub rmindex {
my $arg = shift(@_);
my $key;
my $tape;
my $filenum;
my $file;
my $found = 0;
return if $cfg::indexes eq "false";
# Figure out if we delete all for one tape, single entry for one tape,
# or the entire db
if ($arg =~ m/^(\d+)(:all)?$/) {
$key = $1;
} elsif ($arg =~ m/^(\d+):(.+)$/) {
$key = $1;
$file = $2;
} elsif ($arg eq "all") {
&log("| Removing all in database!!!");
&log("| Hit CTRL-C to abort within 5 seconds..");
&line();
sleep(5);
foreach (keys %::index) {
delete $::index{$_};
}
return;
} else {
die("Invalid key or key:fileno spec $arg");
}
if ($key =~ m/^\d+$/) {
# This section deletes a whole index record, or maybe just
# individual file records
foreach (sort keys %::index) {
($tape,$filenum) = split(/\|/,$_);
if (defined($file)) {
# One file entry
if (($tape eq $key)
and
(defined($::use_file) or ($filenum != 0))
and
($filenum eq $file)) {
&log("| Deleting record for $tape file $filenum");
$found++;
if (defined($::debug)) {
&log("(debug) delete \$::index{$tape|$filenum}");
} else {
delete $::index{"$tape|$filenum"};
}
}
} else {
# Whole tape/dir entry
if ($tape eq $key) {
&log("| Deleting record for $tape file $filenum");
$found++;
if (defined($::debug)) {
&log("(debug) delete \$::index{$tape|$filenum}");
} else {
delete $::index{"$tape|$filenum"};
}
}
}
}
if ($found eq 0) {
&log("| Record for $arg not found");
}
&line();
return;
}
}
######################################################################
# Nuke file from on disk, and stuff from DB
######################################################################
sub rmfile {
my $key;
my $tape;
my $filenum;
return if !defined($::use_file);
$key = &get_tape_key('quiet');
foreach my $arg (@{$::opt{'rmfile'}}) {
my $file = "$cfg::device/$arg";
if ($arg eq 'all') {
# Nuke all files in this dir
opendir(DIR,$cfg::device) or die ("Can't open dir $cfg::device: $OS_ERROR");
foreach my $f (readdir(DIR)) {
next if ($f =~ m:^\.\.?$:);
#next if ($f =~ m%^$cfg::keyfile$%);
if ( -f "$cfg::device/$f") {
&log("| Erasing archive $f");
unlink("$cfg::device/$f") or die ("Can't rm $cfg::device/$f: $OS_ERROR");
}
if ( -d "$cfg::device/$f") {
&log("| Erasing directory $f");
system("rm -rf $cfg::device/$f") and die ("Can't rm $cfg::device/$f: $OS_ERROR");
}
}
closedir(DIR);
# Nuke all db entries for this key
if ($key ne '') {
&rmindex("$key:all");
}
} elsif (-f $file) {
&log("| Deleting file $file");
unlink($file) or die ("Can't rm $file: $OS_ERROR");
if ($key ne '') {
# Nuke db entry for this file
&rmindex("$key:$arg");
}
} elsif (-d $file) {
&log("| Deleting directory $file");
system("rm -rf $file") and die ("Can't rm $file: $OS_ERROR");
if ($key ne '') {
# Nuke db entry for this file
&rmindex("$key:$arg");
}
} else {
warn("Error: $file doesn't exist");
}
}
}
######################################################################
# Remove index records for a tape we are about to erase
######################################################################
sub maybe_delete_old_index {
my $key;
return if $cfg::indexes eq "false";
return if (defined($::use_file));
$key = &get_tape_key('quiet');
if ($key ne '') {
&rmindex("$key:all");
}
}
######################################################################
# Sort by number
######################################################################
sub bynumber {
$a <=> $b;
}
######################################################################
# Sort by archive filename
######################################################################
sub byfilename {
return 0 if ($a =~ m/^$cfg::keyfile/);
return 1 if ($b =~ m/^$cfg::keyfile/);
my $alabel;
my $alevel;
my $blabel;
my $blevel;
if ($a =~ m/^(.+?)\.(\d+)(\.(\d+))?\./) {
$alabel = $1;
$alevel = $2;
if ($b =~ m/^(.+?)\.(\d+)(\.(\d+))?\./) {
$blabel = $1;
$blevel = $2;
if ($alabel eq $blabel) {
return($alevel <=> $blevel);
}
}
}
return($a cmp $b);
}
######################################################################
# Figure out numeric level for '-level incremental', for a certain fs.
# Try to find last the stamp file, then add one to the level
######################################################################
sub get_incremental_level {
my $fs = shift(@_);
my $label = &get_label($fs);
my $highestlevel = 0;
opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR");
foreach my $file (readdir(DIR)) {
next if ($file !~ m/^$cfg::sprefix$label\.(\d+)$/);
if ($1 > $highestlevel) {
$highestlevel = $1;
}
}
close(DIR);
$highestlevel++;
return($highestlevel);
}
######################################################################
# Common commands to invoke 'find' & get a desired file list on stdout
######################################################################
sub file_list_cmd {
my $dir = shift(@_);
my $timestampfile = shift(@_);
my $separator = shift(@_);
my $level = shift(@_);
my $remote = shift(@_);
my $otherarg = shift(@_);
if (!defined($separator) or ($separator !~ m/^(null|newline)$/)) {
$separator = 'null';
}
my $cmd = '';
# FreeBSD wants -E to enable extended regex
if ($::uname =~ /FreeBSD/) {
$cmd .= "$::path{find} -E . ";
} else {
$cmd .= "$::path{find} . ";
}
my $prunekey;
if (defined($remote)) {
$prunekey = "$remote:$dir";
} else {
$prunekey = $dir;
}
if (defined(%{$::prune{$prunekey}})) {
# FreeBSD needs -E (above) and no backslashes around the (|) chars
if ($::uname =~ /FreeBSD/) {
$cmd .= '-regex "\./(';
$cmd .= join('|', keys %{$::prune{$prunekey}});
$cmd .= ')/.*" ';
} else {
$cmd .= '-regex "\./\(';
$cmd .= join('\|', keys %{$::prune{$prunekey}});
$cmd .= '\)/.*" ';
}
$cmd .= '-prune -o ';
} else {
# Can't use find -depth with -prune (see single unix spec etc)
# (not toally required anyway, only if you are archiving dirs you
# don't have permissions on and are running as non-root)
$cmd .= "-depth ";
}
$cmd .= "$::mountpoint_flag ";
$cmd .= "! -type s ";
if (defined($otherarg)) {
$cmd .= $otherarg . " ";
}
if ($level != 0) {
# If local, we can use the flexbackup timetamp native and ctime
# checks can be used. Remote, we'll be creating stamp with "touch
# -t"... but ctime can't be touched backwards. Turn it off.
#
# If atime preserve is set, can't use ctime checks anyway since
# preserving atime changes the ctime.
if (($cfg::atime_preserve eq 'false') and !defined($remote)) {
$cmd .= '\( ';
}
$cmd .= "-newer \"$timestampfile\" ";
if (($cfg::atime_preserve eq 'false') and !defined($remote)) {
$cmd .= "-or -cnewer \"$timestampfile\" " . '\) ';
}
}
$cmd .= "$::exclude_expr ";
if (!defined($::pkgdelta)) {
if ($separator eq 'newline') {
$cmd .= "-print ";
} else {
$cmd .= "-print0 ";
}
} else {
# Use the normal level & timestamp mechanism to get a list of files
# Then only keep unowned or owned+changed files
my $host;
my $find = &maybe_remote_cmd("cd \"$dir\"; $cmd -print", $remote);
my $write = "> $::pkgdelta_filelist";
if(defined($remote)) {
&log("| Listing level $level to-be-archived files for $remote:$dir");
$write = &maybe_remote_cmd("$::path{cat} $write", $remote);
$write = "| $write";
$host = $remote;
} else {
&log("| Listing level $level to-be-archived files for $dir");
$host = 'localhost';
}
&log("| Finding subset of files based on packaging system delta");
if (!defined($::debug)) {
open(LIST,"$find |") || die;
open(NEWLIST,"$write") || die;
while(<LIST>) {
my $key;
my $archive = 0;
chomp(my $file = $_);
# Strip leading ./
$file =~ s:^\./::g;
# Don't care about the backup dir itself
next if ($file eq '.');
if ($dir eq '/') {
$key = "/$file";
} else {
$key = "$dir/$file";
}
if (($cfg::pkgdelta_archive_unowned eq 'true') and
!defined($::packaged{$host}{$key})) {
$archive = 1;
}
if (($cfg::pkgdelta_archive_changed eq 'true') and
defined($::changed{$host}{$key})) {
$archive = 1;
}
if ($archive == 1) {
if ($separator eq 'null') {
print NEWLIST "./$file\0";
} else {
print NEWLIST "./$file\n";
}
}
}
close(LIST);
close(NEWLIST);
}
&line();
$cmd = "$::path{cat} $::pkgdelta_filelist ";
}
return($cmd);
}
######################################################################
# List installed packages, fills %package_list hash
######################################################################
sub list_packages {
my $host = shift (@_);
my $cnt = 0;
if ($::pkgdelta eq 'rpm') {
my $cmd = "$::path{rpm} -q -a --queryformat '%{name}-%{version}-%{release}.%{arch}.rpm\\n'";
if ($host ne 'localhost') {
&log("| Identifying all RPM packages on host $host...");
$cmd = &maybe_remote_cmd($cmd, $host);
} else {
&log("| Identifying all RPM packages...");
}
if (defined($::debug)) {
&log("(debug) $cmd");
} else {
open(LIST,"$cmd |") || die;
while(<LIST>) {
if (m:^(.*)$:) {
$::package_list{$host}{$1} = 1;
if (&POSIX::isatty($::msg)) {
print $::msg &spinner(++$cnt) . "\r";
}
}
}
close(LIST);
}
} elsif ($::pkgdelta eq 'freebsd') {
my $cmd = "$::path{pkg_info}";
if ($host ne 'localhost') {
&log("| Identifying all FreeBSD packages on host $host...");
$cmd = &maybe_remote_cmd($cmd, $host);
} else {
&log("| Identifying all FreeBSD packages...");
}
if (defined($::debug)) {
&log("(debug) $cmd");
} else {
my (@junk, $pkg);
open(LIST,"$cmd |") || die;
while(<LIST>) {
if (&POSIX::isatty($::msg)) {
print $::msg &spinner(++$cnt) . "\r";
}
($pkg, @junk) = split (/\s+/, $_);
$::package_list{$host}{$pkg} = 1;
}
close(LIST);
}
}
}
######################################################################
# Fill %packaged with a list of files on host owned by packages
######################################################################
sub find_packaged_files {
my $host = shift (@_);
my $cnt = 0;
return if ($cfg::pkgdelta_archive_unowned eq 'false');
if ($::pkgdelta eq 'rpm') {
my $cmd = "$::path{rpm} -q -a -l";
if ($host ne 'localhost') {
&log("| Finding all files owned by RPM packages on host $host...");
$cmd = &maybe_remote_cmd($cmd, $host);
} else {
&log("| Finding all files owned by RPM packages...");
}
if (defined($::debug)) {
&log("(debug) $cmd");
} else {
open(LIST,"$cmd |") || die;
while(<LIST>) {
if (m:^(/.*)$:) {
$::packaged{$host}{$1} = 1;
if (&POSIX::isatty($::msg)) {
print $::msg &spinner(++$cnt) . "\r";
}
}
}
close(LIST);
}
} elsif ($::pkgdelta eq 'freebsd') {
my $cmd = "$::path{pkg_info} -f -q -a";
my ($fullpath, $localbase, $alt_localbase);
$localbase = '/usr/local';
$alt_localbase = '';
$fullpath = '';
if ($host ne 'localhost') {
&log("| Finding all files owned by FreeBSD packages on host $host...");
$cmd = &maybe_remote_cmd($cmd, $host);
} else {
&log("| Finding all files owned by FreeBSD packages...");
}
if (defined($::debug)) {
&log("(debug) $cmd");
} else {
open(LIST,"$cmd 2> /dev/null |") || die;
while(<LIST>) {
# If it starts with '@' then it's a pkg directive,
# else it's a (relative) path
#
if (/^\@/) {
if (/\@cwd\s+(\S+)/) {
my ($name, $path, $suffix);
$localbase = $1;
$alt_localbase = '';
($name,$path,$suffix) = fileparse($localbase,'\.\S+');
$path =~ s/\/$//;
# In some (default) situations there are some packages which are
# installed relative to a PREFIX which is actually a link in the /
# filesystem. The following hack gets around that and creates an
# entry in $packaged twice--once for the full path that would be seen via
# pkg_info -L and one for the "unlinked" version. In this manner
# no matter which FS is being dumped, the code to filter out
# packaged files will always work.
#
if (-l $path) {
my $link;
$link = readlink ($path);
$link = '/' . $link . '/' . $name;
$alt_localbase = $link;
}
}
if (/\@dirrm\s+(\S+)/) {
$fullpath = $localbase . '/' . $1;
$::packaged{$host}{$fullpath} = 1;
if ($alt_localbase ne '') {
$fullpath = $alt_localbase . '/' . $1;
$::packaged{$host}{$fullpath} = 1;
}
if (&POSIX::isatty($::msg)) {
print $::msg &spinner(++$cnt) . "\r";
}
}
}
else {
$fullpath = $localbase . '/' . $_;
chomp ($fullpath);
$::packaged{$host}{$fullpath} = 1;
if ($alt_localbase ne '') {
$fullpath = $alt_localbase . '/' . $_;
chomp ($fullpath);
$::packaged{$host}{$fullpath} = 1;
}
if (&POSIX::isatty($::msg)) {
print $::msg &spinner(++$cnt) . "\r";
}
}
}
close(LIST);
}
}
}
######################################################################
# Fill %changed with a list of packaged files on host that have been
# modified
######################################################################
sub find_changed_files {
my $host = shift (@_);
my $cnt = 0;
return if ($cfg::pkgdelta_archive_changed eq 'false');
if ($::pkgdelta eq 'rpm') {
my $cmd = "$::path{rpm} -V -a";
my ($num);
if ($host ne 'localhost') {
&log("| Finding changed package files on host $host...");
$cmd = &maybe_remote_cmd($cmd, $host);
} else {
&log("| Finding changed package files...");
}
$num = scalar (keys %{$::package_list{$host}});
&log("| Analyzing $num packages may take quite a while, please be patient");
if (defined($::debug)) {
&log("(debug) $cmd");
} else {
open(LIST,"$cmd |") || die;
while(<LIST>) {
if (&POSIX::isatty($::msg)) {
print $::msg &spinner(++$cnt) . "\r";
}
# ex: if size, md5sum, and timestamp changed on a config file
# S.5....T c /etc/ntp.conf
if (m:^([\.S][\.M][\.5][\.D][\.L][\.U][\.G][\.T]) [dgc ] (.*)$:) {
$::changed{$host}{$2} = 1;
}
}
close(LIST);
}
} elsif ($::pkgdelta eq 'freebsd') {
my $cmd = "$::path{pkg_info} -g -a -q";
my ($num);
if ($host ne 'localhost') {
&log("| Finding changed package files on host $host...");
$cmd = &maybe_remote_cmd($cmd, $host);
} else {
&log("| Finding changed package files...");
}
$num = scalar (keys %{$::package_list{$host}});
&log("| Analyzing $num packages may take quite a while, please be patient");
if (defined($::debug)) {
&log("(debug) $cmd");
} else {
open(LIST,"$cmd 2> /dev/null |") || die;
while(<LIST>) {
if (&POSIX::isatty($::msg)) {
print $::msg &spinner(++$cnt) . "\r";
}
if (/^(\S+)\s+fails.*MD5.*checksum$/) {
$::changed{$host}{$1} = 1;
}
}
close(LIST);
}
}
}
#############################################################################
# Actually test to see if we can run buffer. In situations where SysV shared
# memory is low, or buffer can't run, buffer can fail
#############################################################################
sub test_bufferprog {
my $buffer_cmd = shift(@_);
my $host = shift(@_);
my $tmp_script = "$cfg::tmpdir/buftest.$host.$PROCESS_ID.sh";
my $retval = 0;
my $pipecmd;
$buffer_cmd =~ s:^\s*\|\s*::;
$buffer_cmd =~ s:\s*\|\s*$::;
# Create a script which tests the buffer program
open(SCR,"> $tmp_script") || die;
print SCR "#!/bin/sh\n";
print SCR "tmp_data=/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 $::msg "| Checking '$cfg::buffer' on this machine... ";
$pipecmd = "sh $tmp_script ";
} else {
print $::msg "| Checking '$cfg::buffer' on host $host... ";
$pipecmd = "cat $tmp_script | ($::remoteshell $host 'cat > $tmp_script; sh $tmp_script; rm -f $tmp_script')";
}
if (!defined($::debug)) {
open(PIPE,"$pipecmd |") || die;
while (<PIPE>) {
if (/^unsuccessful: exit code (\d+): (.*)/) {
$retval = $1;
my $out = $2;
if ($retval != 0) {
push(@::errors, "Problems encountered testing '$cfg::buffer' on host '$host':");
if ($out ne '') {
push(@::errors, " --> " . $out);
}
if (($cfg::buffer eq 'buffer') and ($retval == 255)) {
push(@::errors, " You don't have enough shared memory to run '$cfg::buffer' on $host, or");
push(@::errors, " have exceeded buffering limits. Try lowering the amount specified in");
push(@::errors, " \$buffer_megs in your flexbackup.conf file, or reconfigure your");
push(@::errors, " kernel to include more SysV shared memory pages if using *BSD.");
} else {
push(@::errors, " Unknown problem trying to run '$cfg::buffer' (exit code $retval). Try disabling it");
push(@::errors, " or lowering \$buffer_megs.");
}
}
}
}
close (PIPE);
} else {
print $::msg "\n(debug) $pipecmd\n";
}
if ($retval == 0) {
print $::msg "Ok\n";
} else {
print $::msg "Failed!\n";
}
unlink("$tmp_script");
return($retval);
}
#############################################################################
# Check that programs exist on remote systems
# Check buffer execution on them too
#############################################################################
sub check_remote_progs {
my $remotehost_ref = shift(@_);
my $remoteprogs_ref = shift(@_);
my $err = 0;
my @progs;
foreach my $host (keys %$remotehost_ref) {
&check_shell($host);
}
foreach (@$remoteprogs_ref) {
# Could be '0' if original checkinpath failed on localhost
if ($_ ne '0') {
push(@progs,"type $_ 2>&1");
} else {
$err++;
}
}
my $string = join ('; ',@progs);
foreach my $host (keys %$remotehost_ref) {
print $::msg "| Checking for required programs on host $host... ";
my $cmd = "$::remoteshell $host \"sh -c '$string'\"";
if (defined($::debug)) {
print $::msg "\n(debug) $cmd\n";
next;
}
if (!(open(PIPE,"$cmd |"))) {
push (@::errors, "Could not open pipe to remote shell - $!");
$err++;
last;
}
while (<PIPE>) {
if (m/(\S+) not found/) {
push(@::errors, "Could not find program '$1' on remote machine '$host'");
$err++;
}
}
close (PIPE);
if ($err == 0) {
print $::msg "Ok\n";
} else {
print $::msg "Failed!\n";
}
}
if ($cfg::buffer ne 'false') {
foreach my $host (keys %$remotehost_ref) {
&test_bufferprog($::buffer_cmd, $host);
}
}
}
#############################################################################
# Check shell on remote systems
# (Mainly to see if we should use bash pipe exit trick at this point)
#############################################################################
sub check_shell {
my $host = shift(@_);
my $pipecmd;
$pipecmd = 'set x = 1 && test $x && echo csh:yes; echo tcsh:$tcsh; echo bash:$BASH_VERSION; echo zsh:$ZSH_VERSION; echo ksh:$KSH_VERSION';
if ($host eq 'localhost') {
print $::msg "| Checking /bin/sh on this machine... ";
} else {
print $::msg "| Checking shell on $host... ";
$pipecmd = "$::remoteshell $host '" . $pipecmd . "'";
}
$::shelltype{$host} = 'unknown';
if (defined($::debug)) {
print $::msg "\n(debug) $pipecmd\n";
}
if (!(open(PIPE,"$pipecmd 2>&1 |"))) {
return;
}
while (<PIPE>) {
if (m/^(\S+):(\S.+)$/) {
my $shell = $1;
my $ver = $2;
if ($shell eq 'bash') {
if ($ver =~ m/^2/) {
$::shelltype{$host} = 'bash2';
} else {
$::shelltype{$host} = 'bash1';
}
} else {
$::shelltype{$host} = $shell;
}
}
}
close (PIPE);
if (($::shelltype{$host} eq 'unknown') and ($::uname !~ m/Linux/)) {
print $::msg "$::shelltype{$host} (probably Bourne Shell)\n";
} else {
print $::msg "$::shelltype{$host}\n";
}
}
#############################################################################
# Wipe a tape for use.
#############################################################################
sub newtape () {
my $retval;
if (defined($::tapedevice)) {
&log('| Rewinding & erasing tape...');
}
&mt('rewind');
&maybe_delete_old_index();
&mt('rewind');
&mt('generic-erase');
$retval = &new_tape_key();
return($retval);
}
#############################################################################
# Test writing a couple files to tape, then read & diff. To help make
# sure filemarks, blocks, padding, are working as we need.
#############################################################################
sub test_tape_drive {
my $cmd;
my $tmp1 = "$cfg::tmpdir/test1.$PROCESS_ID";
my $tmp2 = "$cfg::tmpdir/test2.$PROCESS_ID";
my $tmp3 = "$cfg::tmpdir/test3.$PROCESS_ID";
my $fail = 0;
my $configfile;
if (defined($::opt{'c'})) {
$configfile = $::opt{'c'};
} else {
$configfile = $::CONFFILE;
}
&mt("generic-blocksize $::mt_blksize");
&log("| Testing will *erase* the tape currently in the drive!");
&log("| Hit CTRL-C to abort within 10 seconds...");
&line();
sleep(10);
&log("| If for some reason this program does not exit within a few minutes,");
&log("| Hit CTRL-C, and try adjusting \$blksize, \$pad_blocks, or \$mt_blksize.");
&line();
&newtape();
&line();
&mt('generic-query');
&log('');
&log("Writing test file \#1");
$cmd = "$::path{cat} $0";
$cmd = &append_writer_cmd($cmd);
if (!defined($::debug)) {
system($cmd);
if ($CHILD_ERROR) {
$fail++;
}
} else {
&log($cmd);
}
&mt('generic-query');
&log("Writing test file \#2");
$cmd = "$::path{cat} $configfile";
$cmd = &append_writer_cmd($cmd);
if (!defined($::debug)) {
system($cmd);
if ($CHILD_ERROR) {
$fail++;
}
} else {
&log($cmd);
}
&mt('generic-query');
&log("Writing test file \#3");
$cmd = "$::path{cat} $0";
$cmd = &append_writer_cmd($cmd);
if (!defined($::debug)) {
system($cmd);
if ($CHILD_ERROR) {
$fail++;
}
} else {
&log($cmd);
}
&mt('generic-query');
&log('');
&log('Rewinding...');
&mt('rewind');
if ($cfg::indexes eq 'true') {
&log('Skipping index label...');
&mt('fsf 1');
}
&mt('generic-query');
&log('');
&log("Reading test file \#1");
$cmd = &read_function($::device);
if (defined($::remotetapehost)) {
$cmd = &maybe_remote_cmd($cmd, $::remotetapehost);
# Buffer both sides if remote
$cmd .= $::buffer_cmd;
}
# if pad blocks was true we have nulls at the end (won't be in this script otherwise)
if ($cfg::pad_blocks eq 'true') {
$cmd .= " | $::path{tr} -d '\\0' > $tmp1";
} else {
$cmd .= "> $tmp1";
}
if (!defined($::debug)) {
system($cmd);
if ($CHILD_ERROR) {
$fail++;
}
} else {
&log("(debug) $cmd");
}
&mt('generic-query');
&log("Reading test file \#2");
$cmd = &read_function($::device);
if (defined($::remotetapehost)) {
$cmd = &maybe_remote_cmd($cmd, $::remotetapehost);
# Buffer both sides if remote
$cmd .= $::buffer_cmd;
}
# if pad blocks was true we have nulls at the end (won't be in config file otherwise)
if ($cfg::pad_blocks eq 'true') {
$cmd .= " | $::path{tr} -d '\\0' > $tmp2";
} else {
$cmd .= "> $tmp2";
}
if (!defined($::debug)) {
system($cmd);
if ($CHILD_ERROR) {
$fail++;
}
} else {
&log("(debug) $cmd");
}
&mt('generic-query');
&log("Reading test file \#3");
$cmd = &read_function($::device);
if (defined($::remotetapehost)) {
$cmd = &maybe_remote_cmd($cmd, $::remotetapehost);
# Buffer both sides if remote
$cmd .= $::buffer_cmd;
}
# if pad blocks was true we have nulls at the end (won't be in this script otherwise)
if ($cfg::pad_blocks eq 'true') {
$cmd .= " | $::path{tr} -d '\\0' > $tmp3";
} else {
$cmd .= "> $tmp3";
}
if (!defined($::debug)) {
system($cmd);
if ($CHILD_ERROR) {
$fail++;
}
} else {
&log("(debug) $cmd");
}
&mt('generic-query');
&log('');
&mt('rewind');
&log("Comparing...");
if (!defined($::debug)) {
system("$::path{diff} -q $0 $tmp1");
if ($CHILD_ERROR) {
$fail++;
}
system("$::path{diff} -q $configfile $tmp2");
if ($CHILD_ERROR) {
$fail++;
}
system("$::path{diff} -q $0 $tmp3");
if ($CHILD_ERROR) {
$fail++;
}
} else {
&log("(debug) $::path{diff} -q $0 $tmp1");
&log("(debug) $::path{diff} -q $configfile $tmp2");
&log("(debug) $::path{diff} -q $0 $tmp3");
}
unlink $tmp1;
unlink $tmp2;
unlink $tmp3;
if ($fail != 0) {
print $::msg "\nFAILURE! Problem with tape driver or parameters. Please see the FAQ\n";
print $::msg "or try changing the \$blksize, \$pad_blocks, or \$mt_blksize settings.\n";
exit(1);
} else {
print $::msg "SUCCESS! Tape drive parameters seem to work just fine\n";
}
}
######################################################################
# Check if the week day is as specified before backup (for complex cron setups)
######################################################################
sub check_wday {
if (defined($::opt{'wday'})) {
my @now = localtime;
my $wday_now = $now[6];
# Just silently hard-limit these to valid set
if ($::opt{'wday'} >= 7) {
$::opt{'wday'} = 0;
}
if ($::opt{'wday'} < 0) {
$::opt{'wday'} = 0;
}
if ($wday_now != $::opt{'wday'}) {
exit(0);
}
}
}
######################################################################
# Split whitespace-separated list.
# If it contains quotes, do a bit differently so we can have
# items containing whitespace, as long as all elements are quoted.
######################################################################
sub split_list {
my $string = shift(@_);
my @array;
if ($string =~ m/\"/) {
$string =~ s/^\s*\"//;
$string =~ s/\"\s*$//;
@array = split(/\"\s+\"/,$string);
} elsif ($string =~ m/\'/) {
$string =~ s/^\s*\'//;
$string =~ s/\'\s*$//;
@array = split(/\'\s+\'/,$string);
} else {
@array = split(/\s+/,$string);
}
return(@array);
}
######################################################################
# To show activity....
######################################################################
sub spinner {
my $index = shift(@_);
my (@spinner) = ('|','/','-','\\','|','/','-','\\');
$index = $index % $#spinner;
return($spinner[$index]);
}
syntax highlighted by Code2HTML, v. 0.9.1