#!/usr/local/bin/perl -w ###################################################################### # # Edwin Huffstutler, # $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 : backup directory tree, level 0 # flexbackup -set : backup set "tag" (def. in config file), level 0 # flexbackup -set all : backup all sets, level 0 # flexbackup [...] -level : backup level, can be integer or # full/differential/incremental # flexbackup [...] -pkgdelta : prune backup to files not part of a package # or changed from distributed version # can be "rpm" or "freebsd" package systems # flexbackup [...] -wday : 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 : restore the files listed in text file # into your current working directory # flexbackup -extract -onefile : restore the single file specified by # 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 : read file number n from tape; if not given # uses current tape position # flexbackup [...] : if archiving to files rather than a device, # list/extract/compare/restore options take # flexbackup [...] -pipe : read archive from stdin # flexbackup [...] -volumes : # 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 : list table of contents for specific key # flexbackup -rmindex all : force db delete of all index info # flexbackup -rmindex : force db delete of specified tape/dir index # flexbackup -rmindex : : 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 : if backups to disk, rm file & index info # flexbackup -rmfile all : if backups to disk, rm all files/index for dir # flexbackup [...] -c : use instead of /usr/local/etc/flexbackup.conf # for configuration # flexbackup [...] -type : override $type from config file # flexbackup [...] -compress : override $compress from config file # flexbackup [...] -device : override $device from config file # flexbackup [...] -d 'var=val' : override config file setting of $var # flexbackup -dir -erase : force a rewind/erase before backup # flexbackup -dir -norewind : don't rewind tape after a single backup # flexbackup -set -noreten : don't retension for level 0 set backups # flexbackup -set -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($_ = ); 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 &&" # at the front makes the cd happen in a subshell. If # its not "cd , 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() { 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() { 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() { 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() { last if (m/^\#\s+USAGE:/); } while() { 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() { 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 = ); close(KEY); &log("| Directory's existing key is $key"); # Make sure keyfile entry is there if (!defined($::index{"$key|$cfg::keyfile"})) { my $label = ""; 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 = ""; if (defined($::debug)) { &log("(debug) \$::index{$key|$cfg::keyfile} = $label"); } else { $::index{"$key|$cfg::keyfile"} = $label; } } else { my $label = ""; 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 = ); 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() { 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() { 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() { 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() { 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() { # 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() { 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() { 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 () { 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 () { 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 () { 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]); }