1#!/usr/bin/perl -w 2###################################################################### 3# 4# Edwin Huffstutler, <edwinh@computer.org> 5# $Id: flexbackup,v 1.185 2003/10/10 14:12:09 edwinh Exp $ 6# $Name: v1_2_1 $ 7# 8# >>>> Also see the config file, README, manpages, & FAQ <<<< 9# 10# USAGE: 11# flexbackup -help : this message 12# 13# BACKUP: 14# flexbackup -dir <dir> : backup directory tree, level 0 15# flexbackup -set <tag> : backup set "tag" (def. in config file), level 0 16# flexbackup -set all : backup all sets, level 0 17# flexbackup [...] -level <n> : backup level, can be integer or 18# full/differential/incremental 19# flexbackup [...] -pkgdelta <x> : prune backup to files not part of a package 20# or changed from distributed version 21# <x> can be "rpm" or "freebsd" package systems 22# flexbackup [...] -wday <n> : backup only if the week day matches 23# the input number. Sunday is 0 or 7. 24# flexbackup [...] -pipe : write to stdout rather than file/device 25# flexbackup [...] -ignore-errors : continue backups even if commands return error 26# status 27# READING ARCHIVES: 28# flexbackup -list : list files in archive 29# flexbackup -extract : extract all files from archive into your 30# current working directory 31# flexbackup -extract -flist <f> : restore the files listed in text file <f> 32# into your current working directory 33# flexbackup -extract -onefile <f>: restore the single file specified by <f> 34# into your current working directory 35# flexbackup -compare : compare archive with the files in your 36# current directory 37# flexbackup -restore : interactive restore (dump type only for now) 38# flexbackup [...] -num <n> : read file number n from tape; if not given 39# uses current tape position 40# flexbackup [...] <file> : if archiving to files rather than a device, 41# list/extract/compare/restore options take 42# flexbackup [...] -pipe : read archive from stdin 43# flexbackup [...] -volumes <n> : # of volumes in input 44# (EXPERIMENTAL mbuffer multivolume support) 45# INDEX RELATED: 46# flexbackup -toc : list current device's table of contents 47# flexbackup -toc all : list all known table of contents 48# flexbackup -toc <key> : list table of contents for specific key 49# flexbackup -rmindex all : force db delete of all index info 50# flexbackup -rmindex <key> : force db delete of specified tape/dir index 51# flexbackup -rmindex <key>:<x> : force db delete of specified tape:file 52# 53# TESTING/DEBUG: 54# flexbackup -test-tape-drive : tries writing/reading files to make sure you 55# have tape driver & parameters set up right 56# flexbackup [...] -n : don't run actual dump or mt commands, just echo 57# flexbackup [...] -type filelist : special backup type that just saves list of 58# files that would have been archived 59# MISC: 60# flexbackup -newtape : erase & create new index key (but no backup) 61# flexbackup -rmfile <file> : if backups to disk, rm file & index info 62# flexbackup -rmfile all : if backups to disk, rm all files/index for dir 63# flexbackup [...] -c <file> : use <file> instead of /etc/flexbackup.conf 64# for configuration 65# flexbackup [...] -type <x> : override $type from config file 66# flexbackup [...] -compress <x> : override $compress from config file 67# flexbackup [...] -device <dev> : override $device from config file 68# flexbackup [...] -d 'var=val' : override config file setting of $var 69# flexbackup -dir <x> -erase : force a rewind/erase before backup 70# flexbackup -dir <x> -norewind : don't rewind tape after a single backup 71# flexbackup -set <x> -noreten : don't retension for level 0 set backups 72# flexbackup -set <x> -noerase : don't rewind/erase for level 0 set backups 73# flexbackup [...] -reten : force a retension before read 74# flexbackup [...] -nodefaults : don't use any default values for config variables 75# flexbackup -version : show version 76# 77###################################################################### 78# 79# flexbackup is free software; you can redistribute it and/or modify 80# it under the terms of the GNU General Public License as published by 81# the Free Software Foundation; either version 2, or (at your option) 82# any later version. 83# 84# flexbackup is distributed in the hope that it will be useful, 85# but WITHOUT ANY WARRANTY; without even the implied warranty of 86# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 87# GNU General Public License for more details. 88# 89# You should have received a copy of the GNU General Public License 90# along with flexbackup; see the file COPYING. If not, write to 91# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 92# 93###################################################################### 94 95use POSIX; 96use AnyDBM_File; 97use Getopt::Long; 98use Text::Wrap; 99use File::Basename; 100use English; 101use strict; 102 103# No output buffering 104$OUTPUT_AUTOFLUSH = 1; 105 106# Set the traditional UNIX system locale behavior (touch doesn't read LANG) 107my $loc = POSIX::setlocale( &POSIX::LC_ALL, "C" ); 108 109# See if afio is calling us as a control script 110if (defined($ARGV[0]) and ($ARGV[0] =~ /flexbackup.volume_header_info/)) { 111 &print_afio_volume_header(); 112} 113 114# This is changed during "make install" 115$::CONFFILE="/etc/flexbackup.conf"; 116 117# This took awhile to figure out. if the shell is capable of it, we use 118# this on the end of any pipelines to see if any of the commands in the 119# pipeline failed, rather than just the last one. 120# 121# If /bin/sh is really bash2 in disguise, or remote shell is bash2/zsh, 122# we can use their status array variables 123# 124# With plain sh, we don't know if the non-last command in the pipe fails 125# See exit-status collecting trick in the code. 126# 127# With tcsh/csh as a remote shell, you don't know which command, but 128# $? is still set if anything in the pipeline failed 129# 130$::bash_pipe_exit = '; x=(${PIPESTATUS[@]}); i=0; while [ $i -lt ${#x[@]} ]; do [ ${x[$i]} -eq 0 ] || exit ${x[$i]}; i=$(($i+1)); done'; 131$::zsh_pipe_exit = '; x=(${pipestatus[@]}); i=1; while [ $i -le ${#x[@]} ]; do [ ${x[$i]} -eq 0 ] || exit ${x[$i]}; i=$(($i+1)); done'; 132 133# tar has a limit of this many chars in its volume label 134$::tar_max_label = 99; 135 136# Define the prune hash to avoid warnings with perl 5.12 137use vars qw( %prune ); 138 139# Get commandline flags 140%::opt = (); 141if (! &::GetOptions(\%::opt, 142 "c=s", 143 "compare:s", 144 "compress=s", 145 "d=s%", 146 "dir=s", 147 "pipe", 148 "pkgdelta=s", 149 "device=s", 150 "differential", 151 "erase!", 152 "extract:s", 153 "flist=s", 154 "full", 155 "help", 156 "incremental", 157 "ignore-errors", 158 "level=s", 159 "list:s", 160 "onefile=s", 161 "n", 162 "newtape", 163 "nodefaults", 164 "num:i", 165 "restore:s", 166 "reten!", 167 "rewind!", 168 "rmfile:s@", 169 "rmindex:s@", 170 "set=s", 171 "test-tape-drive", 172 "toc:s", 173 "type=s", 174 "version", 175 "volumes:i", 176 "wday=i" 177 )) { 178 exit(0); 179} 180 181# Default fd for messages (we might have stdout as archive output) 182if (defined($::opt{'pipe'})) { 183 $::msg = *STDERR; 184} else { 185 $::msg = *STDOUT; 186} 187 188# Give usage message 189if (defined($::opt{'help'})) { 190 &usage(); 191 exit(0); 192} 193 194# Version 195if (defined($::opt{'version'})) { 196 print $::msg "flexbackup version " . &versionstring() . "\n"; 197 print $::msg '$Id: flexbackup,v 1.185 2003/10/10 14:12:09 edwinh Exp $ ' . "\n"; 198 exit(0); 199} 200 201# Exit if -wday given and it isn't that day of the week (see FAQ) 202&check_wday(); 203 204# Get/read config file 205print $::msg "\nflexbackup version " . &versionstring() . "\n"; 206&readconfigfile(); 207print $::msg "\n"; 208 209# Set OS type 210chomp($::uname = `uname -s`); 211 212# Sanity check commandline flags and config file options 213&optioncheck(); 214&line('screen'); 215 216# Check shells, buffer is runnable, remote progs... 217&test_before_run(); 218 219# See about rewind/erase/reten flags 220&set_tape_operation_defaults(); 221 222# Get current date string 223$::date = ¤t_time('numeric'); 224 225# Decide what to do 226if (defined($::opt{'restore'})) { 227 &restore_routine(); 228 229} elsif (defined($::opt{'extract'})) { 230 &extract_routine(); 231 232} elsif (defined($::opt{'compare'})) { 233 &compare_routine(); 234 235} elsif (defined($::opt{'list'})) { 236 &list_routine(); 237 238} elsif (defined($::opt{'dir'}) or defined($::opt{'set'})) { 239 &backup_routine(); 240 241} elsif (defined($::opt{'toc'})) { 242 &line(); 243 # Only do this if we're going to grab current tape index 244 if ($::opt{'toc'} eq '') { 245 &mt("generic-blocksize $::mt_blksize"); 246 } 247 &toc_routine(); 248 249} elsif (defined($::opt{'rmindex'})) { 250 &line(); 251 foreach my $arg (@{$::opt{'rmindex'}}) { 252 &rmindex($arg); 253 } 254 255} elsif (defined($::opt{'newtape'})) { 256 &line(); 257 &mt("generic-blocksize $::mt_blksize"); 258 &newtape(); 259 260} elsif (defined($::opt{'rmfile'})) { 261 &line(); 262 &rmfile(); 263 264} elsif (defined($::opt{'test-tape-drive'})) { 265 &line(); 266 &test_tape_drive(); 267 268} 269 270if (($::mode !~ m/^(list|extract|restore|compare|test-tape-drive)$/) and 271 ($cfg::indexes eq "true")) { 272 untie(%::index); 273} 274 275system ('rm', '-rf', $cfg::tmpdir); 276exit(0); 277 278###################################################################### 279# Backup 280###################################################################### 281sub backup_routine { 282 283 my @files; 284 my $label; 285 my $tapecounter = 0; 286 my %oldlogs; 287 my $fs; 288 my $logfile; 289 my $symlink = '';; 290 my $logext = ''; 291 my $comp_cmd; 292 my $tape_key; 293 my $logsuffix = ''; 294 my $error = 0; 295 296 # Figure out log file name & empty log file 297 if (defined($::opt{'set'})) { 298 $label = &get_label($::opt{'set'}); 299 } else { 300 $label = &get_label($::opt{'dir'}); 301 } 302 303 if ($cfg::staticlogs eq 'false' ) { 304 $logsuffix = ".$::date"; 305 } 306 307 if (!defined($::set_incremental)) { 308 $logfile = "$cfg::prefix$label.$::level" . $logsuffix; 309 } else { 310 $logfile = "$cfg::prefix$label.incremental" . $logsuffix; 311 } 312 313 $symlink = "$cfg::prefix$label.latest"; 314 $::log = "$cfg::logdir/$logfile"; 315 if (! open(LOG,">$::log")) { 316 die "Can't write to $::log: $OS_ERROR"; 317 } 318 close(LOG); 319 320 &line(); 321 &mt("generic-blocksize $::mt_blksize"); 322 323 324 # Remember old log files (will remove at end of job) 325 # ("old" = any higher- or equal-numbered logs for this label) 326 if (!defined($::set_incremental)) { 327 opendir(DIR,"$cfg::logdir") or die("Can't open cfg::logdir: $OS_ERROR"); 328 @files = readdir(DIR); 329 foreach my $lf (reverse sort @files) { 330 331 # Skip our own log 332 next if ($lf =~ m/^$logfile(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/); 333 334 # Find normal old logs 335 if ($lf =~ m/^$cfg::prefix$label\.(\d+)(\.(\d+))?(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/) { 336 if ($1 >= $::level) { 337 # Might be from $staticlogs=true or false 338 if (defined($3)) { 339 $oldlogs{"$cfg::logdir/$lf"} = $1 . "|" . $3; 340 } else { 341 $oldlogs{"$cfg::logdir/$lf"} = $1; 342 } 343 } 344 } 345 346 # If this is a level 0, we can nuke incremental logs 347 if (($::level == 0) and ($lf =~ m/^$cfg::prefix$label\.(incremental)(\.(\d+))?(\.gz|\.bz2|\.lzo|\.Z|\.zip)?$/)) { 348 # Might be from $staticlogs=true or false 349 if (defined($3)) { 350 $oldlogs{"$cfg::logdir/$lf"} = $1 . "|" . $3; 351 } else { 352 $oldlogs{"$cfg::logdir/$lf"} = $1; 353 } 354 } 355 } 356 close(DIR); 357 } 358 359 360 # Possibly populate package-file hashes if we are using 361 # -pkgdelta. This is so we only have to run through these operations 362 # once per machine if multiple fs's are being run 363 if (defined($::pkgdelta)) { 364 if (defined($::local)) { 365 &list_packages('localhost'); 366 &find_packaged_files('localhost'); 367 &find_changed_files('localhost'); 368 } 369 foreach my $host (keys %::remotehosts) { 370 &list_packages($host); 371 &find_packaged_files($host); 372 &find_changed_files($host); 373 } 374 $::pkgdelta_filelist = "$cfg::tmpdir/pkgdelta.$PROCESS_ID"; 375 &line(); 376 } 377 378 ########################## 379 # 380 # Main backup routine 381 # 382 ########################## 383 if (defined($::opt{'set'})) { 384 385 if (!defined($::set_incremental)) { 386 &log("| Doing level $::level backup of set $::opt{set} using $cfg::type"); 387 } else { 388 &log("| Doing incremental backup of $::opt{set} using $cfg::type"); 389 } 390 391 # All sets or just one? 392 my @do_sets; 393 if ($::opt{'set'} eq 'all') { 394 @do_sets = keys(%cfg::set); 395 if (defined($::tapedevice)) { 396 $_ = scalar(@do_sets); 397 $_ = join(" ", @do_sets) . " ($_ tapes)"; 398 } else { 399 $_ = join(" ", @do_sets); 400 } 401 &log("| All sets = $_"); 402 } else { 403 @do_sets = ($::opt{'set'}); 404 } 405 406 my $num_tapes = scalar(@do_sets) - 1; 407 foreach my $this_set (@do_sets) { 408 409 # Maybe retension 410 if (($::do_reten == 1) and defined($::tapedevice)) { 411 &log('| Retensioning tape...'); 412 &mt('retension'); 413 } 414 415 # Maybe rewind/erase 416 if ($::do_erase == 1) { 417 $tape_key = &newtape(); 418 } else { 419 &mt('rewind'); 420 $tape_key = &get_tape_key(); 421 if(defined($::tapedevice)) { 422 &log('| Making sure tape is at end of data...'); 423 } 424 &mt('generic-eod'); 425 } 426 427 # Print what this set contains 428 &log("| Backup set \"$this_set\" ($cfg::set{$this_set})"); 429 430 # Show tape position 431 if (defined($::tapedevice)) { 432 # Multiple tapes are only for level 0 433 if (!defined($::set_incremental) and ($::level == 0)) { 434 &log("| Tape \#$tapecounter"); 435 } 436 &line(); 437 &mt('generic-query'); 438 } 439 440 # Iterate over the filesystems in the set and back 'em up 441 foreach my $dir (&split_list($cfg::set{$this_set})) { 442 443 my $level; 444 445 # Get rid of trailing / 446 $dir = &nuke_trailing_slash($dir); 447 448 # If level is incremental for the set, each dir might 449 # have a different numeric level 450 if (!defined($::set_incremental)) { 451 $level = $::level; 452 } else { 453 $level = &get_incremental_level($dir); 454 } 455 456 $error = &backup($dir, $tape_key, $level); 457 last if ($error != 0); 458 459 if ($cfg::indexes eq "true") { 460 $::nextfile++; 461 } 462 } 463 464 # Prompt for new tape if more than one set in list & level 0 465 if (!defined($::set_incremental) and ($::level == 0)) { 466 if ($tapecounter < $num_tapes) { 467 468 # Maybe rewind (usually true) 469 if ($::do_rewind_after == 1) { 470 if(defined($::tapedevice)) { 471 &log("| Rewinding..."); 472 } 473 &mt('rewind'); 474 &line(); 475 } 476 477 if (defined($::tapedevice)) { 478 &toc_routine($tape_key); 479 } 480 481 $tapecounter++; 482 if (defined($::tapedevice)) { 483 print $::msg "\n"; 484 while(1) { 485 print $::msg "---> Insert tape \#$tapecounter (enter y to continue) "; 486 chomp($_ = <STDIN>); 487 last if ($_ =~ m/^y/i); 488 } 489 print $::msg "\n"; 490 &line(); 491 } 492 493 } # end not at last tape 494 } # end if level == 0 495 496 } # end foreach set 497 498 } else { 499 500 # Just one filesystem, -dir given 501 &log("| Doing level $::level backup of $::opt{dir} using $cfg::type"); 502 503 # Maybe retension 504 if ($::do_reten == 1) { 505 if (defined($::tapedevice)) { 506 &log('| Retensioning tape...'); 507 } 508 &mt('retension'); 509 } 510 511 # Maybe rewind/erase 512 if ($::do_erase == 1) { 513 $tape_key = &newtape(); 514 } else { 515 &mt('rewind'); 516 $tape_key = &get_tape_key(); 517 if (defined($::tapedevice)) { 518 &log('| Making sure tape is at end of data...'); 519 } 520 &mt('generic-eod'); 521 } 522 523 if (defined($::tapedevice)) { 524 &line(); 525 &mt('generic-query'); 526 } 527 528 $error = &backup($::opt{'dir'}, $tape_key, $::level); 529 530 } # end set or single fs 531 532 if (defined($::tapedevice)) { 533 &line(); 534 } 535 536 # Maybe rewind (usually true) 537 if (($::do_rewind_after == 1) and defined($::tapedevice)) { 538 &log("| Rewinding..."); 539 &mt('rewind'); 540 } 541 542 # Remove old log files now that we are done 543 if ($error == 0) { 544 my $rmlogs = 0; 545 foreach my $lf (sort keys %oldlogs) { 546 $rmlogs++; 547 my ($lev,$d) = split(/\|/,$oldlogs{$lf}); 548 if (defined($d)) { 549 &log("| Removing old level $lev log of $label (dated $d)"); 550 } else{ 551 &log("| Removing old level $lev log of $label"); 552 } 553 if (!defined($::debug)) { 554 unlink("$lf") or warn("Can't remove $lf: $OS_ERROR\n"); 555 } 556 } 557 &line('log') if ($rmlogs > 0); 558 } 559 560 # Compress log file 561 if ($cfg::comp_log ne 'false') { 562 if ($cfg::comp_log eq "gzip") { 563 $logext = ".gz"; 564 $comp_cmd = "$::path{gzip} -f \"$::log\""; 565 } elsif ($cfg::comp_log eq "bzip2") { 566 $logext = ".bz2"; 567 $comp_cmd = "$::path{bzip2} -f \"$::log\""; 568 } elsif ($cfg::comp_log eq "lzop") { 569 $logext = ".lzo"; 570 $comp_cmd = "$::path{lzop} -U -f \"$::log\""; 571 } elsif ($cfg::comp_log eq "zip") { 572 $logext = ".zip"; 573 $comp_cmd = "$::path{cat} \"$::log\" | $::path{zip} -q - - > \"$::log" . $logext . "\"; $::path{rm} -f \"$::log\""; 574 } elsif ($cfg::comp_log eq "compress") { 575 $logext = ".Z"; 576 $comp_cmd = "$::path{compress} -f \"$::log\""; 577 } 578 undef $::log; 579 &log("| Compressing log ($logfile" . "$logext)", 'screen'); 580 system("$comp_cmd"); 581 if ($CHILD_ERROR) { 582 warn("Error compressing log file\n"); 583 } 584 } 585 586 # Symlink the "latest" log file for this level 587 unlink("$cfg::logdir/$symlink" . $logext); 588 &log("| Linking $symlink" . "$logext -> $logfile" . $logext, 'screen'); 589 symlink("$logfile" . $logext,"$cfg::logdir/$symlink" . $logext); 590 591 &line('screen'); 592 593 if ($error == 0) { 594 &toc_routine($tape_key); 595 } 596 597 exit($error); 598 599} 600 601###################################################################### 602# Backup a filesystem 603###################################################################### 604sub backup { 605 606 my $dir = shift(@_); 607 my $tape_key = shift(@_); 608 my $level = shift(@_); 609 my $title; 610 my $title_without_type; 611 my @cmds; 612 my @echo_cmds; 613 my $cmd; 614 my $localdir = $dir; 615 my $label = &get_label($dir); 616 my $host; 617 my @files; 618 my %oldstamps; 619 my $remote; 620 my $tapehost; 621 my $indexkey; 622 my $catchexit; 623 my $exitscript = "$cfg::tmpdir/collectexit.$PROCESS_ID.sh"; 624 my $result = "$cfg::tmpdir/exitstatus.$PROCESS_ID"; 625 my $pkglist; 626 my $error = 0; 627 628 &line(); 629 630 631 if ($localdir =~ s/^(.+)://) { 632 $remote = $1; 633 chomp($tapehost = `hostname`); 634 if (($tapehost eq $remote) 635 or 636 ($remote =~ /^localhost/)) { 637 die("Remote host and this host are the same! No scooby snack for you!"); 638 } 639 640 } else { 641 undef $remote; 642 } 643 644 # Remember old stamp files (will remove at end of job) 645 # "old" = any higher-numbered stamps for this label 646 # (we will be touching the one of equal level, so don't mark for removal) 647 opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR"); 648 @files = readdir(DIR); 649 foreach my $f (reverse sort @files) { 650 next if ($f !~ m/^$cfg::sprefix$label\.(\d+)$/); 651 if ($1 > $level) { 652 $oldstamps{"$cfg::stampdir/$f"} = $1 653 } 654 } 655 close(DIR); 656 657 # Create file name if writing to a file 658 # (config file's $device points to a dir in this case) 659 if (defined($::use_file)) { 660 661 my $filename = $level; 662 663 if (defined($::pkgdelta)) { 664 $filename .= $::pkgdelta; 665 } 666 667 if ($cfg::staticfiles eq 'true') { 668 $filename .= "." . $cfg::type; 669 } else { 670 $filename .= "." . $::date . "." . $cfg::type; 671 } 672 673 # Some types need the filename modified 674 if ($cfg::type eq 'ar') { 675 $filename =~ s/ar$/a/; 676 } elsif ($cfg::type eq 'copy') { 677 $filename =~ s/\.copy$//; 678 } elsif ($cfg::type eq 'rsync') { 679 $filename =~ s/\.rsync$//; 680 } 681 682 # Note compression setting in filename 683 if ($cfg::type =~ m/^(tar|dump|cpio|star|pax|ar|shar|filelist)$/) { 684 if ($cfg::compress eq "gzip") { 685 $filename .= ".gz"; 686 } elsif ($cfg::compress eq "bzip2") { 687 $filename .= ".bz2"; 688 } elsif ($cfg::compress eq "lzop") { 689 $filename .= ".lzo"; 690 } elsif ($cfg::compress eq "zip") { 691 $filename .= ".zip"; 692 } elsif ($cfg::compress eq "compress") { 693 $filename .= ".Z"; 694 } elsif ($cfg::compress eq "lzma") { 695 $filename .= ".lzma"; 696 } 697 } elsif ($cfg::type eq "afio") { 698 # tag these a little different, the archive file itself isn't a 699 # .gz or .bz2, but the files in it are.... 700 if ($cfg::compress eq "gzip") { 701 $filename .= "-gz"; 702 } elsif ($cfg::compress eq "bzip2") { 703 $filename .= "-bz2"; 704 } elsif ($cfg::compress eq "lzop") { 705 $filename .= "-lzo"; 706 } elsif ($cfg::compress eq "zip") { 707 $filename .= "-zip"; 708 } elsif ($cfg::compress eq "compress") { 709 $filename .= "-Z"; 710 } elsif ($cfg::compress eq "lzma") { 711 $filename .= "-lzma"; 712 } 713 } 714 715 # Overwrite device var to be the archive filename 716 $::device = $cfg::device . "/" . $label . "." . $filename; 717 718 } 719 720 # Just get the date for now; don't write the timestamp 721 # Until after the backup has run 722 $::date_at_start = ¤t_time('ctime'); 723 $::stamp_at_start = ¤t_time('numeric'); 724 725 # Label for this archive 726 chomp($host = `hostname`); 727 $title = $cfg::type . "+" . $cfg::compress; 728 $title =~ s/\+false//; 729 if (!defined($::pkgdelta)) { 730 $title = "level $level $dir $::date_at_start $title from $host"; 731 $title_without_type = "level $level $dir $::date_at_start from $host"; 732 } else { 733 $pkglist = "flexbackup.$::pkgdelta.packagelist"; 734 $title = "level $level+$::pkgdelta $dir $::date_at_start $title from $host"; 735 $title_without_type = "level $level+$::pkgdelta $dir $::date_at_start from $host"; 736 } 737 738 # Modify table of contents 739 if (($tape_key ne '') 740 and 741 ($cfg::indexes eq "true")) { 742 # If writing to files, store the filename 743 if (defined($::use_file)) { 744 @_ = split(/\//,$::device); 745 $_ = pop(@_); 746 $indexkey = "$tape_key|$_"; 747 if (defined($::debug)) { 748 &log("(debug) \$::index{$indexkey} = $title_without_type"); 749 } else { 750 $::index{$indexkey} = "$title_without_type"; 751 } 752 } elsif (defined($::use_blockdevice)) { 753 # no indexes anyway 754 } else { 755 $indexkey = "$tape_key|$::nextfile"; 756 if (defined($::debug)) { 757 &log("(debug) \$::index{$indexkey} = $title"); 758 } else { 759 $::index{$indexkey} = $title; 760 } 761 &log("| File number $::nextfile, tape index $tape_key"); 762 } 763 } 764 765 # Write list of packages 766 if (defined($::pkgdelta) and 767 ( 768 ($cfg::pkgdelta_archive_list eq 'true') or 769 (($cfg::pkgdelta_archive_list eq 'rootonly') and ($localdir eq '/')) 770 ) 771 ) { 772 $pkglist = "$localdir/$pkglist"; 773 my $write = "> $pkglist"; 774 my $h; 775 776 if(defined($remote)) { 777 $write = &maybe_remote_cmd("$::path{cat} $write", $remote); 778 $write = "| $write"; 779 $h = $remote; 780 } else { 781 $h = 'localhost'; 782 } 783 if (!defined($::debug)) { 784 open(LIST,"$write") || die; 785 foreach my $pkg (sort keys %{$::package_list{$h}}) { 786 print LIST "$pkg\n"; 787 } 788 close(LIST); 789 } 790 } 791 792 &log("| Backup of: $dir"); 793 my $remove = ''; 794 if ($cfg::type eq 'dump') { 795 ($remove, @cmds) = &backup_dump($label, $localdir, $level, $remote); 796 } elsif ($cfg::type eq 'afio') { 797 ($remove, @cmds) = &backup_afio($label, $localdir, $title, $level, $remote); 798 } elsif ($cfg::type eq 'cpio') { 799 ($remove, @cmds) = &backup_cpio($label, $localdir, $title, $level, $remote); 800 } elsif ($cfg::type eq 'tar') { 801 ($remove, @cmds) = &backup_tar($label, $localdir, $title, $level, $remote); 802 } elsif ($cfg::type eq 'star') { 803 ($remove, @cmds) = &backup_star($label, $localdir, $title, $level, $remote); 804 } elsif ($cfg::type eq 'pax') { 805 ($remove, @cmds) = &backup_pax($label, $localdir, $title, $level, $remote); 806 } elsif ($cfg::type eq 'zip') { 807 ($remove, @cmds) = &backup_zip($label, $localdir, $title, $level, $remote); 808 } elsif ($cfg::type eq 'ar') { 809 ($remove, @cmds) = &backup_ar($label, $localdir, $title, $level, $remote); 810 } elsif ($cfg::type eq 'shar') { 811 ($remove, @cmds) = &backup_shar($label, $localdir, $title, $level, $remote); 812 } elsif ($cfg::type eq 'lha') { 813 ($remove, @cmds) = &backup_lha($label, $localdir, $title, $level, $remote); 814 } elsif ($cfg::type eq 'copy') { 815 ($remove, @cmds) = &backup_copy_cpio($label, $localdir, $title, $level, $remote); 816 } elsif ($cfg::type eq 'rsync') { 817 ($remove, @cmds) = &backup_copy_rsync($label, $localdir, $title, $level, $remote); 818 } elsif ($cfg::type eq 'filelist') { 819 ($remove, @cmds) = &backup_filelist($label, $localdir, $title, $level, $remote); 820 } 821 822 if(defined($remote)) { 823 # create our temporary directory as first remote command 824 unshift(@cmds, &maybe_remote_cmd("$::path{mkdir} -p $cfg::tmpdir", $remote)); 825 } 826 827 # Nuke any tmp files used in the above routines 828 if ($remove ne '') { 829 push(@cmds, &maybe_remote_cmd("$::path{rm} -f $remove", $remote)); 830 } 831 832 # Create/nuke tmp file list if we did local package delta 833 if (defined($::pkgdelta)) { 834 if ( 835 ($cfg::pkgdelta_archive_list eq 'true') or 836 (($cfg::pkgdelta_archive_list eq 'rootonly') and ($localdir eq '/')) 837 ) { 838 push(@cmds, &maybe_remote_cmd("$::path{rm} -f $::pkgdelta_filelist $pkglist", $remote)); 839 } else { 840 push(@cmds, &maybe_remote_cmd("$::path{rm} -f $pkglist", $remote)); 841 } 842 } 843 844 if(defined($remote)) { 845 # remove temporary directory as our last remote command 846 push(@cmds, &maybe_remote_cmd("$::path{rm} -rf $cfg::tmpdir", $remote)); 847 } 848 849 # Strip multiple spaces 850 foreach my $cmd (@cmds) { 851 $cmd =~ s/\s+/ /g; 852 } 853 854 # Use pipeline exitcode hook if /bin/sh can't report pipeline status 855 if ($::shelltype{'localhost'} =~ m/^(unknown|bash1|ksh)$/) { 856 857 $catchexit = 1; 858 859 unlink($result); 860 open(SCR, "> $exitscript") || die; 861 print SCR '#!/bin/sh' . "\n"; 862 print SCR '"$@"' . "\n";; 863 print SCR '[ $? = 0 ] || echo $@ >> ' . $result . "\n"; 864 close(SCR); 865 chmod(0755, $exitscript); 866 867 push(@cmds, "[ ! -e $result ]"); 868 } 869 870 # Replace piped commands with exit status collector if we need to 871 foreach my $cmd (@cmds) { 872 873 if (defined($catchexit)) { 874 875 # Save ssh commands temporarily so we don't replace pipes inside them 876 my $saveremote; 877 if ($cmd =~ s/($cfg::remoteshell .* \'.*\')/XXXflexbackupXXX/) { 878 $saveremote = $1; 879 } 880 881 # Replace piped or anded commands with catch-script 882 # -Not if the command started a subshell ( .. ) 883 if ($cmd =~ s:\s+(\||&&)\s+([^\(]): $1 $exitscript $2:g) { 884 885 # You would think we'd put it on the front of the pipe as 886 # well. Can't do this globally because the "cd <dir> &&" 887 # at the front makes the cd happen in a subshell. If 888 # its not "cd <something>, do it. 889 if ($cmd !~ m:^\s*cd\s+\"[^\"]+\"\s*(;|&&):) { 890 $cmd = "$exitscript $cmd"; 891 } 892 893 # Take care of subshell 894 $cmd =~ s:\s+(\||&&)\s+(\()\s*: $1 \( $exitscript :g; 895 896 } 897 898 # Put any ssh stuff back 899 $cmd =~ s:XXXflexbackupXXX:$saveremote:; 900 } 901 } 902 903 # Format commands for nice printing 904 @echo_cmds = @cmds; 905 foreach my $line (@echo_cmds) { 906 &split_and_echo($line); 907 } 908 &line(); 909 910 # Enough fooling around... run it. 911 if (!defined($::debug)) { 912 foreach $cmd (@cmds) { 913 914 if (defined($::use_pipe)) { 915 system("$cmd"); 916 } else { 917 if ($::shelltype{'localhost'} eq 'bash2') { 918 # /bin/sh is really bash2 on this system 919 open(CMD,"($cmd " . $::bash_pipe_exit . ") 2>&1 |") || die; 920 } elsif ($::shelltype{'localhost'} eq 'zsh') { 921 # Does anybody make /bin/sh be zsh? probably not... 922 open(CMD,"($cmd " . $::zsh_pipe_exit . ") 2>&1 |") || die; 923 } else { 924 open(CMD,"($cmd) 2>&1 |") || die; 925 } 926 open(LOG,">>$::log") || die; 927 while(<CMD>) { 928 print $::msg $_; 929 print LOG $_; 930 } 931 close(LOG); 932 close(CMD); 933 } 934 935 if ($CHILD_ERROR) { 936 &log(''); 937 938 # If using exit trick, cat the result file; otherwise use normal output 939 if (defined($catchexit)) { 940 my $out = `cat $result`; 941 &log("ERROR: non-zero exit from:\n$out"); 942 } else { 943 &log("ERROR: non-zero exit from:\n$cmd"); 944 } 945 946 if (defined($::opt{'ignore-errors'})) { 947 948 $error = 0; 949 &log(''); 950 &log("ERROR: will continue anyway"); 951 952 } else { 953 954 $error++; 955 &log(''); 956 &log("ERROR: exiting"); 957 958 # Put ERROR in the index if tapedevice, or nuke index if file 959 if (defined($indexkey)) { 960 if (defined($::use_file)) { 961 delete $::index{$indexkey}; 962 } elsif (defined($::use_blockdevice)) { 963 # no indexes anyway 964 } else { 965 $::index{$indexkey} .= "\n\t---> ERROR during write, above may not be valid"; 966 } 967 } 968 969 # If file, rm botched file regardless of index 970 if (defined($::use_file)) { 971 if ($cfg::type =~ m/^(copy|rsync)$/) { 972 system("rm -rf $::device"); 973 } else { 974 unlink($::device); 975 } 976 } 977 978 } # ignore error defined 979 980 } # CHILD_ERROR 981 982 } # foreach cmd 983 984 } else { 985 &log("(debug) command output would be here"); 986 } 987 &line(); 988 989 # Actually remove the old stamp files now that we are done 990 if ($error == 0) { 991 foreach my $ts (sort keys %oldstamps) { 992 print $::msg "| Removing out of date level $oldstamps{$ts} timestamp for $dir\n"; 993 if (!defined($::debug)) { 994 unlink("$ts") or warn("Can't remove $ts: $OS_ERROR\n"); 995 } 996 } 997 } 998 999 # Create timestamp file, but use date from before the backup started 1000 # so next time we will catch files that might have been touched during the run 1001 my $t = ¤t_time('ctime'); 1002 &log("| Backup start: $::date_at_start"); 1003 &log("| Backup end: $t"); 1004 if (($error == 0) and !defined($::debug)) { 1005 system("$::path{touch} -t \"$::stamp_at_start\" \"$cfg::stampdir/$cfg::sprefix$label.$level\""); 1006 } 1007 1008 &line(); 1009 1010 # Got errors unless I paused before trying to access the tape right way... 1011 if ((!defined($::debug)) and defined($::tapedevice)) { 1012 sleep 10; 1013 } 1014 1015 # Show where we are on the tape 1016 &mt('generic-query'); 1017 1018 if (defined($catchexit)) { 1019 unlink($result); 1020 unlink($exitscript); 1021 } 1022 1023 return($error); 1024} 1025 1026###################################################################### 1027# Return command to backup a directory using dump 1028###################################################################### 1029sub backup_dump { 1030 1031 my $label = shift(@_); 1032 my $dir = shift(@_); 1033 my $level = shift(@_); 1034 my $remote = shift(@_); 1035 my $cmd = ''; 1036 my @cmds; 1037 my $date_flag; 1038 my $remove = ''; 1039 1040 # Need this check here in case fs=all, level=incremental, and we go beyond 9 1041 if ($level > 9) { 1042 die("Can't use level > 9 and type=dump"); 1043 } 1044 1045 # Warnings about stuff dump can't do 1046 if (defined($cfg::exclude_expr[0])) { 1047 &log("| NOTE: \$exclude_expr is ignored for type=dump"); 1048 } 1049 1050 my $prunekey; 1051 if (defined($remote)) { 1052 $prunekey = "$remote:$dir"; 1053 } else { 1054 $prunekey = $dir; 1055 } 1056 if (defined($prune{$prunekey})) { 1057 &log("| NOTE: \$prune is ignored for type=dump"); 1058 } 1059 1060 if ($cfg::traverse_fs ne 'false') { 1061 &log("| NOTE: \$traverse_fs is always false for type=dump"); 1062 } 1063 1064 if (defined($::pkgdelta)) { 1065 &log("| NOTE: packaging system delta ignored for for type=dump"); 1066 } 1067 1068 # With this one we don't have to put a stampfile on the remote system 1069 # since we only need the date string 1070 my $time = &get_last_date($label, $level, 'ctime'); 1071 if ($level == 0) { 1072 $date_flag = ""; 1073 } else { 1074 $date_flag = "-T \"$time\" "; 1075 } 1076 1077 $cmd = ''; 1078 $cmd .= "dump -$level "; 1079 $cmd .= "$::dump_blk_flag "; 1080 if ($cfg::dump_use_dumpdates eq "true") { 1081 $cmd .= "-u "; 1082 } else { 1083 $cmd .= $date_flag; 1084 } 1085 $cmd .= "$::dump_len_flag "; 1086 $cmd .= "-f - "; 1087 $cmd .= "$dir $::z"; 1088 1089 # Buffer both sides if remote 1090 if (defined($remote)) { 1091 $cmd .= $::buffer_cmd; 1092 } 1093 1094 # Wrap all that together 1095 $cmd = &maybe_remote_cmd($cmd, $remote); 1096 1097 # Append writer stuff 1098 $cmd = &append_writer_cmd($cmd); 1099 1100 push(@cmds, $cmd); 1101 1102 return($remove, @cmds); 1103 1104 1105} 1106 1107###################################################################### 1108# Return command to backup a directory using afio 1109###################################################################### 1110sub backup_afio { 1111 1112 my $label = shift(@_); 1113 my $dir = shift(@_); 1114 my $title = shift(@_); 1115 my $level = shift(@_); 1116 my $remote = shift(@_); 1117 my $cmd = ''; 1118 my @cmds; 1119 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1120 my $tmplabel = "$cfg::tmpdir/label.$PROCESS_ID"; 1121 my $tmpnocompress = "$cfg::tmpdir/nocompress.$PROCESS_ID"; 1122 my $remove = ''; 1123 my $no_compress = ''; 1124 1125 if (defined($remote) and ($level != 0)) { 1126 my $time = &get_last_date($label, $level, 'numeric'); 1127 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1128 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1129 $remove .= " $stamp"; 1130 } else { 1131 $stamp = &get_last_date($label, $level, 'filename'); 1132 } 1133 1134 # list of file exenstions to not compress 1135 if (($cfg::compress !~ /^(false|hardware)$/) and ($cfg::afio_nocompress_types ne "")) { 1136 $cmd = "$::path{printf} \"$cfg::afio_nocompress_types\" > $tmpnocompress"; 1137 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1138 $no_compress = "-E $tmpnocompress"; 1139 $remove .= " $tmpnocompress"; 1140 } 1141 1142 if ($cfg::label ne 'false') { 1143 $cmd = "$::path{printf} \"Volume Label:\\n$title\\n\\n\" > $tmplabel"; 1144 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1145 $remove .= " $tmplabel"; 1146 } 1147 1148 $cmd = "cd \"$dir\" && "; 1149 if ($cfg::label ne 'false') { 1150 $cmd .= "($::path{printf} \"//--$tmplabel flexbackup.volume_header_info\\n\" && "; 1151 } 1152 $cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote); 1153 if ($cfg::label ne 'false') { 1154 $cmd .= ")"; 1155 } 1156 $cmd .= " | "; 1157 1158 $cmd .= "$::path{afio} -o "; 1159 $cmd .= "$no_compress "; 1160 $cmd .= "-z "; 1161 $cmd .= "-1 mC "; 1162 $cmd .= "$::afio_z_flag "; 1163 $cmd .= "$::afio_verb_flag "; 1164 $cmd .= "$::afio_sparse_flag "; 1165 $cmd .= "$::afio_atime_flag "; 1166 $cmd .= "$::afio_bnum_flag "; 1167 $cmd .= "$::afio_blk_flag "; 1168 $cmd .= "-"; 1169 1170 # Buffer both sides if remote 1171 if (defined($remote)) { 1172 $cmd .= $::buffer_cmd; 1173 } 1174 1175 # Wrap all that together 1176 $cmd = &maybe_remote_cmd($cmd, $remote); 1177 1178 # Append writer stuff 1179 $cmd = &append_writer_cmd($cmd); 1180 1181 push(@cmds, $cmd); 1182 1183 return($remove, @cmds); 1184 1185} 1186 1187###################################################################### 1188# Return command to backup a directory using cpio 1189###################################################################### 1190sub backup_cpio { 1191 1192 my $label = shift(@_); 1193 my $dir = shift(@_); 1194 my $title = shift(@_); 1195 my $level = shift(@_); 1196 my $remote = shift(@_); 1197 my $cmd = ''; 1198 my @cmds; 1199 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1200 my $remove = ''; 1201 1202 if (defined($remote) and ($level != 0)) { 1203 my $time = &get_last_date($label, $level, 'numeric'); 1204 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1205 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1206 $remove .= " $stamp"; 1207 } else { 1208 $stamp = &get_last_date($label, $level, 'filename'); 1209 } 1210 1211 if ($cfg::label ne 'false') { 1212 # Kludge a title by replacing / with - in the title 1213 # then touch a file in the dir we are going to back up. 1214 $title =~ s%/%-%g; 1215 $cmd = "$::path{touch} \"$dir/$title\""; 1216 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1217 $remove .= " \"$dir/$title\""; 1218 } 1219 1220 $cmd = "cd \"$dir\" && "; 1221 $cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote); 1222 $cmd .= "| "; 1223 1224 $cmd .= "$::path{cpio} -o "; 1225 $cmd .= "-0 "; 1226 $cmd .= "-H $cfg::cpio_format "; 1227 $cmd .= "$::cpio_verb_flag "; 1228 $cmd .= "$::cpio_blk_flag "; 1229 $cmd .= "$::z"; 1230 1231 # Buffer both sides if remote 1232 if (defined($remote)) { 1233 $cmd .= $::buffer_cmd; 1234 } 1235 1236 # Wrap all that together 1237 $cmd = &maybe_remote_cmd($cmd, $remote); 1238 1239 # Append writer stuff 1240 $cmd = &append_writer_cmd($cmd); 1241 1242 push(@cmds, $cmd); 1243 1244 return($remove, @cmds); 1245 1246} 1247 1248###################################################################### 1249# Return command to copy directory tree 1250###################################################################### 1251sub backup_copy_cpio { 1252 1253 my $label = shift(@_); 1254 my $dir = shift(@_); 1255 my $title = shift(@_); 1256 my $level = shift(@_); 1257 my $remote = shift(@_); 1258 my $cmd = ''; 1259 my @cmds; 1260 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1261 my $remove = ''; 1262 1263 if (defined($remote) and ($level != 0)) { 1264 my $time = &get_last_date($label, $level, 'numeric'); 1265 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1266 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1267 $remove .= " $stamp"; 1268 } else { 1269 $stamp = &get_last_date($label, $level, 'filename'); 1270 } 1271 1272 $cmd = "cd \"$dir\" && "; 1273 $cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote); 1274 $cmd .= "| "; 1275 1276 $cmd .= "$::path{cpio} -o "; 1277 $cmd .= "-0 "; 1278 $cmd .= "-H $cfg::cpio_format "; 1279 $cmd .= "$::cpio_verb_flag "; 1280 $cmd .= "$::cpio_blk_flag "; 1281 1282 # Buffer both sides / compress if remote 1283 if (defined($remote)) { 1284 $cmd .= "$::z"; 1285 $cmd .= $::buffer_cmd; 1286 } 1287 1288 # Wrap all that together 1289 $cmd = &maybe_remote_cmd($cmd, $remote); 1290 1291 # Yell if destination exists 1292 if (-d "$::device") { 1293 &log("| Existing destination directory $::device found!"); 1294 &log("| It will be *deleted*, unless you hit CTRL-C"); 1295 &log("| and abort within 10 seconds..."); 1296 &line(); 1297 sleep(10); 1298 system("rm -rf $::device"); 1299 } 1300 1301 # Expand cpio archive on other side of pipe 1302 $cmd .= " | "; 1303 if (defined($remote)) { 1304 $cmd .= "$::unz"; 1305 } 1306 $cmd .= "("; 1307 $cmd .= "mkdir -p \"$::device\" ; "; 1308 $cmd .= "cd \"$::device\" ; "; 1309 $cmd .= "$::path{cpio} -i "; 1310 $cmd .= "-m "; 1311 $cmd .= "-d "; 1312 $cmd .= "$::cpio_blk_flag"; 1313 $cmd .= ")"; 1314 1315 push(@cmds, $cmd); 1316 1317 return($remove, @cmds); 1318 1319} 1320 1321###################################################################### 1322# Return command to copy directory tree via rsync 1323###################################################################### 1324sub backup_copy_rsync { 1325 1326 my $label = shift(@_); 1327 my $dir = shift(@_); 1328 my $title = shift(@_); 1329 my $level = shift(@_); 1330 my $remote = shift(@_); 1331 my $cmd = ''; 1332 my @cmds; 1333 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1334 my $remove = ''; 1335 1336 if ($cfg::buffer ne 'false') { 1337 &log("| NOTE: \$buffer is ignored for type=rsync"); 1338 } 1339 1340 if (defined($remote) and ($level != 0)) { 1341 my $time = &get_last_date($label, $level, 'numeric'); 1342 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1343 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1344 $remove .= " $stamp"; 1345 } else { 1346 $stamp = &get_last_date($label, $level, 'filename'); 1347 } 1348 1349 $cmd = "cd \"$dir\" && "; 1350 $cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote); 1351 1352 # Just the find may run on the remote - rsync call will always be local 1353 $cmd = &maybe_remote_cmd($cmd, $remote); 1354 1355 # Have to take leading './' off to make rsync's include/exclude work right 1356 $cmd .= " | $::path{sed} -e \"s/\\.\\///g\" | "; 1357 $cmd .= "$::path{rsync} "; 1358 $cmd .= "--files-from=- "; 1359 $cmd .= "--archive "; 1360 $cmd .= "$::rsync_verb_flag "; 1361 $cmd .= "--delete --delete-excluded "; 1362 if ($cfg::compress ne 'false') { 1363 $cmd .= "--compress "; 1364 } 1365 if (defined($remote)) { 1366 $cmd .= "--rsh=$::path{$cfg::remoteshell} "; 1367 if ($cfg::remoteuser ne '') { 1368 $cmd .= "$cfg::remoteuser" . '@' . "$remote:"; 1369 } else { 1370 $cmd .= "$remote:"; 1371 } 1372 } 1373 $cmd .= "\"$dir/\" \"$::device\""; 1374 1375 push(@cmds, $cmd); 1376 1377 return($remove, @cmds); 1378 1379} 1380 1381###################################################################### 1382# Return command to backup a directory using tar 1383###################################################################### 1384sub backup_tar { 1385 1386 my $label = shift(@_); 1387 my $dir = shift(@_); 1388 my $title = shift(@_); 1389 my $level = shift(@_); 1390 my $remote = shift(@_); 1391 my $cmd = ''; 1392 my @cmds; 1393 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1394 my $remove = ''; 1395 1396 if (defined($remote) and ($level != 0)) { 1397 my $time = &get_last_date($label, $level, 'numeric'); 1398 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1399 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1400 $remove .= " $stamp"; 1401 } else { 1402 $stamp = &get_last_date($label, $level, 'filename'); 1403 } 1404 1405 $cmd = "cd \"$dir\" && "; 1406 $cmd .= &file_list_cmd($dir, $stamp, 'null', $level, $remote); 1407 $cmd .= "| "; 1408 1409 $cmd .= "$::path{tar} --create "; 1410 $cmd .= "--null "; 1411 $cmd .= "--files-from=- "; 1412 $cmd .= "--ignore-failed-read "; 1413 $cmd .= "--same-permissions "; 1414 $cmd .= "--no-recursion "; 1415 $cmd .= "--totals "; 1416 if ($cfg::label ne 'false') { 1417 if (length($title) > $::tar_max_label) { 1418 &log("| NOTE: truncating tar label (> $::tar_max_label chars)"); 1419 $title = substr($title, 0, $::tar_max_label); 1420 } 1421 $cmd .= "--label \"$title\" "; 1422 } 1423 $cmd .= "$::tar_verb_flag "; 1424 $cmd .= "$::tar_sparse_flag "; 1425 $cmd .= "$::tar_atime_flag "; 1426 $cmd .= "$::tar_recnum_flag "; 1427 $cmd .= "$::tar_blk_flag "; 1428 $cmd .= "--file - "; 1429 $cmd .= "$::z"; 1430 1431 # Buffer both sides if remote 1432 if (defined($remote)) { 1433 $cmd .= $::buffer_cmd; 1434 } 1435 1436 # Wrap all that together 1437 $cmd = &maybe_remote_cmd($cmd, $remote); 1438 1439 # Append writer stuff 1440 $cmd = &append_writer_cmd($cmd); 1441 1442 push(@cmds, $cmd); 1443 1444 return($remove, @cmds); 1445 1446} 1447 1448###################################################################### 1449# Return command to backup a directory using star 1450###################################################################### 1451sub backup_star { 1452 1453 my $label = shift(@_); 1454 my $dir = shift(@_); 1455 my $title = shift(@_); 1456 my $level = shift(@_); 1457 my $remote = shift(@_); 1458 my $cmd = ''; 1459 my @cmds; 1460 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1461 my $remove = ''; 1462 1463 if (defined($remote) and ($level != 0)) { 1464 my $time = &get_last_date($label, $level, 'numeric'); 1465 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1466 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1467 $remove .= " $stamp"; 1468 } else { 1469 $stamp = &get_last_date($label, $level, 'filename'); 1470 } 1471 1472 $cmd = "cd \"$dir\" && "; 1473 $cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote); 1474 $cmd .= "| "; 1475 1476 $cmd .= "$::path{star} -c "; 1477 $cmd .= "list=- "; 1478 $cmd .= "-p "; 1479 $cmd .= "-l "; 1480 $cmd .= "-D "; 1481 $cmd .= "-B "; 1482 $cmd .= "-dirmode "; 1483 if ($cfg::label ne 'false') { 1484 $cmd .= "VOLHDR=\"$title\" "; 1485 } 1486 $cmd .= "H=$cfg::star_format "; 1487 $cmd .= "$::star_fifo_flag "; 1488 $cmd .= "$::star_acl_flag "; 1489 $cmd .= "$::star_verb_flag "; 1490 $cmd .= "$::star_sparse_flag "; 1491 $cmd .= "$::star_atime_flag "; 1492 $cmd .= "$::star_blocknum_flag "; 1493 $cmd .= "$::star_blk_flag "; 1494 $cmd .= "file=- "; 1495 $cmd .= "$::z"; 1496 1497 # Buffer both sides if remote 1498 if (defined($remote)) { 1499 $cmd .= $::buffer_cmd; 1500 } 1501 1502 # Wrap all that together 1503 $cmd = &maybe_remote_cmd($cmd, $remote); 1504 1505 # Append writer stuff 1506 $cmd = &append_writer_cmd($cmd); 1507 1508 push(@cmds, $cmd); 1509 1510 return($remove, @cmds); 1511 1512} 1513 1514###################################################################### 1515# Return command to backup a directory using pax 1516###################################################################### 1517sub backup_pax { 1518 1519 my $label = shift(@_); 1520 my $dir = shift(@_); 1521 my $title = shift(@_); 1522 my $level = shift(@_); 1523 my $remote = shift(@_); 1524 my $cmd = ''; 1525 my @cmds; 1526 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1527 my $remove = ''; 1528 1529 if (defined($remote) and ($level != 0)) { 1530 my $time = &get_last_date($label, $level, 'numeric'); 1531 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1532 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1533 $remove .= " $stamp"; 1534 } else { 1535 $stamp = &get_last_date($label, $level, 'filename'); 1536 } 1537 1538 if ($cfg::label ne 'false') { 1539 # Kludge a title by replacing / with - in the title 1540 # then touch a file in the dir we are going to back up. 1541 $title =~ s%/%-%g; 1542 $cmd = "$::path{touch} \"$dir/$title\""; 1543 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1544 $remove .= " \"$dir/$title\""; 1545 } 1546 1547 $cmd = "cd \"$dir\" && "; 1548 $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote); 1549 $cmd .= "| "; 1550 1551 $cmd .= "$::path{pax} -w "; 1552 $cmd .= "-d "; 1553 $cmd .= "-s %^./%% "; 1554 $cmd .= "-x $cfg::pax_format "; 1555 $cmd .= "$::pax_verb_flag "; 1556 $cmd .= "$::pax_blk_flag "; 1557 $cmd .= "$::z"; 1558 1559 # Buffer both sides if remote 1560 if (defined($remote)) { 1561 $cmd .= $::buffer_cmd; 1562 } 1563 1564 # Wrap all that together 1565 $cmd = &maybe_remote_cmd($cmd, $remote); 1566 1567 # Append writer stuff 1568 $cmd = &append_writer_cmd($cmd); 1569 1570 push(@cmds, $cmd); 1571 1572 return($remove, @cmds); 1573 1574} 1575 1576###################################################################### 1577# Return command to backup a directory using zip 1578###################################################################### 1579sub backup_zip { 1580 1581 my $label = shift(@_); 1582 my $dir = shift(@_); 1583 my $title = shift(@_); 1584 my $level = shift(@_); 1585 my $remote = shift(@_); 1586 my $cmd = ''; 1587 my @cmds; 1588 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1589 my $tmpzip = "$cfg::tmpdir/archive.$PROCESS_ID.zip"; 1590 my $remove = ''; 1591 1592 if (defined($remote) and ($level != 0)) { 1593 my $time = &get_last_date($label, $level, 'numeric'); 1594 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1595 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1596 $remove .= " $stamp"; 1597 } else { 1598 $stamp = &get_last_date($label, $level, 'filename'); 1599 } 1600 1601 if ($cfg::label ne 'false') { 1602 # Kludge a title by replacing / with - in the title 1603 # then touch a file in the dir we are going to back up. 1604 $title =~ s%/%-%g; 1605 $cmd = "$::path{touch} \"$dir/$title\""; 1606 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1607 $remove .= " \"$dir/$title\""; 1608 } 1609 1610 $cmd = "cd \"$dir\" && "; 1611 $cmd .= &file_list_cmd($dir, $stamp, 'newline', $level, $remote); 1612 $cmd .= "| "; 1613 1614 $cmd .= "$::path{zip} -@ "; 1615 $cmd .= "-b $cfg::tmpdir "; # temp file path 1616 $cmd .= "-y "; # store symlinks 1617 $cmd .= "$::zip_compr_flag "; 1618 $cmd .= "$::zip_noz_flag "; # nocompress list 1619 $cmd .= "$::zip_verb_flag "; # verbose flag 1620 $cmd .= "$tmpzip"; 1621 1622 # Wrap all that together 1623 $cmd = &maybe_remote_cmd($cmd, $remote); 1624 push(@cmds,$cmd); 1625 1626 $cmd = "$::path{cat} $tmpzip "; 1627 # Buffer both sides if remote 1628 if (defined($remote)) { 1629 $cmd .= $::buffer_cmd; 1630 } 1631 $cmd = &maybe_remote_cmd($cmd, $remote); 1632 1633 # Append writer stuff 1634 $cmd = &append_writer_cmd($cmd); 1635 1636 push(@cmds, $cmd); 1637 1638 $remove .= " $tmpzip"; 1639 1640 return($remove, @cmds); 1641 1642} 1643 1644 1645 1646###################################################################### 1647# Return command to backup a directory using ar 1648###################################################################### 1649sub backup_ar { 1650 1651 my $label = shift(@_); 1652 my $dir = shift(@_); 1653 my $title = shift(@_); 1654 my $level = shift(@_); 1655 my $remote = shift(@_); 1656 my $cmd = ''; 1657 my @cmds; 1658 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1659 my $filelist = "$cfg::tmpdir/arlist.$PROCESS_ID"; 1660 my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID"; 1661 my $remove = ''; 1662 1663 &log("| NOTE: ar archives will not recurse into subdirectories,"); 1664 &log("| which makes them inappropriate for most backups."); 1665 &log("| Be sure this is what you want."); 1666 1667 if (defined($remote) and ($level != 0)) { 1668 my $time = &get_last_date($label, $level, 'numeric'); 1669 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1670 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1671 $remove .= " $stamp"; 1672 } else { 1673 $stamp = &get_last_date($label, $level, 'filename'); 1674 } 1675 1676 if ($cfg::label ne 'false') { 1677 # Kludge a title by replacing / with - in the title 1678 # then touch a file in the dir we are going to back up. 1679 $title =~ s%/%-%g; 1680 $title =~ s% %_%g; 1681 $cmd = "$::path{touch} \"$dir/$title\""; 1682 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1683 $remove .= " \"$dir/$title\""; 1684 } 1685 1686 $cmd = "cd \"$dir\" && "; 1687 $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote, '-maxdepth 1 ! -type d'); 1688 $cmd .= "> $filelist; "; 1689 # Escape any spaces in filenames. 1690 $cmd .= "$::path{sed} -i -e 's/ /\\\\ /g' $filelist; "; 1691 1692 $cmd .= "$::path{ar} rc"; 1693 $cmd .= "$::ar_verb_flag "; 1694 $cmd .= "$tmpfile "; 1695 $cmd .= "\@$filelist "; 1696 $cmd .= "; $::path{cat} $tmpfile $::z"; 1697 1698 # Buffer both sides if remote 1699 if (defined($remote)) { 1700 $cmd .= $::buffer_cmd; 1701 } 1702 1703 # Wrap all that together 1704 $cmd = &maybe_remote_cmd($cmd, $remote); 1705 1706 # Append writer stuff 1707 $cmd = &append_writer_cmd($cmd); 1708 1709 push(@cmds, $cmd); 1710 1711 $remove .= " $filelist $tmpfile"; 1712 1713 return($remove, @cmds); 1714 1715} 1716 1717###################################################################### 1718# Return command to backup a directory using shar 1719###################################################################### 1720sub backup_shar { 1721 1722 my $label = shift(@_); 1723 my $dir = shift(@_); 1724 my $title = shift(@_); 1725 my $level = shift(@_); 1726 my $remote = shift(@_); 1727 my $cmd = ''; 1728 my @cmds; 1729 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1730 my $remove = ''; 1731 1732 if (defined($remote) and ($level != 0)) { 1733 my $time = &get_last_date($label, $level, 'numeric'); 1734 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1735 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1736 $remove .= " $stamp"; 1737 } else { 1738 $stamp = &get_last_date($label, $level, 'filename'); 1739 } 1740 1741 $cmd = "cd \"$dir\" && "; 1742 $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote, '! -type d'); 1743 $cmd .= " | "; 1744 1745 $cmd .= "$::path{shar} "; 1746 $cmd .= "$::shar_verb_flag "; 1747 if ($cfg::label ne 'false') { 1748 $cmd .= "-n \"$title\" "; 1749 } 1750 $cmd .= "-S "; 1751 $cmd .= "$::z"; 1752 1753 # Buffer both sides if remote 1754 if (defined($remote)) { 1755 $cmd .= $::buffer_cmd; 1756 } 1757 1758 # Wrap all that together 1759 $cmd = &maybe_remote_cmd($cmd, $remote); 1760 1761 # Append writer stuff 1762 $cmd = &append_writer_cmd($cmd); 1763 1764 push(@cmds, $cmd); 1765 1766 return($remove, @cmds); 1767 1768} 1769 1770 1771###################################################################### 1772# Return command to backup a directory using lha 1773###################################################################### 1774sub backup_lha { 1775 1776 my $label = shift(@_); 1777 my $dir = shift(@_); 1778 my $title = shift(@_); 1779 my $level = shift(@_); 1780 my $remote = shift(@_); 1781 my $cmd = ''; 1782 my @cmds; 1783 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1784 my $filelist = "$cfg::tmpdir/lhalist.$PROCESS_ID"; 1785 my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID"; 1786 my $remove = ''; 1787 1788 if (defined($remote) and ($level != 0)) { 1789 my $time = &get_last_date($label, $level, 'numeric'); 1790 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1791 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1792 $remove .= " $stamp"; 1793 } else { 1794 $stamp = &get_last_date($label, $level, 'filename'); 1795 } 1796 1797 if ($cfg::label ne 'false') { 1798 # Kludge a title by replacing / with - in the title 1799 # then touch a file in the dir we are going to back up. 1800 $title =~ s%/%-%g; 1801 $title =~ s% %_%g; 1802 $cmd = "echo \"$title\" > \"$dir/$title\""; 1803 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1804 $remove .= " \"$dir/$title\""; 1805 } 1806 1807 $cmd = "cd \"$dir\" && "; 1808 $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote); 1809 $cmd .= " | $::path{lha} a"; 1810 $cmd .= "$::lha_verb_flag "; 1811 $cmd .= "$tmpfile "; 1812 $cmd .= "; $::path{cat} $tmpfile $::z"; 1813 1814 # Buffer both sides if remote 1815 if (defined($remote)) { 1816 $cmd .= $::buffer_cmd; 1817 } 1818 1819 # Wrap all that together 1820 $cmd = &maybe_remote_cmd($cmd, $remote); 1821 1822 # Append writer stuff 1823 $cmd = &append_writer_cmd($cmd); 1824 1825 push(@cmds, $cmd); 1826 1827 $remove .= " $filelist $tmpfile"; 1828 1829 return($remove, @cmds); 1830 1831} 1832 1833###################################################################### 1834# Just back up the file listing (useful for debugging) 1835###################################################################### 1836sub backup_filelist { 1837 1838 my $label = shift(@_); 1839 my $dir = shift(@_); 1840 my $title = shift(@_); 1841 my $level = shift(@_); 1842 my $remote = shift(@_); 1843 my $cmd = ''; 1844 my @cmds; 1845 my $stamp = "$cfg::tmpdir/refdate.$PROCESS_ID"; 1846 my $filelist = "$cfg::tmpdir/filelist.$PROCESS_ID"; 1847 my $remove = ''; 1848 1849 if (defined($remote) and ($level != 0)) { 1850 my $time = &get_last_date($label, $level, 'numeric'); 1851 $cmd = "$::path{touch} -t \"$time\" $stamp"; 1852 push(@cmds, &maybe_remote_cmd($cmd, $remote)); 1853 $remove .= " $stamp"; 1854 } else { 1855 $stamp = &get_last_date($label, $level, 'filename'); 1856 } 1857 1858 if (defined $::use_pipe) { 1859 &log("| NOTE: Writing list of files that would have been backed up to stdout"); 1860 } else { 1861 &log("| NOTE: Writing list of files that would have been backed up to current directory"); 1862 } 1863 1864 $cmd = "cd \"$dir\" && "; 1865 $cmd .= &file_list_cmd( $dir, $stamp, 'newline', $level, $remote); 1866 $cmd .= "> $filelist; $::path{cat} $filelist 1>&2; $::path{cat} $filelist "; 1867 $cmd .= "$::z"; 1868 1869 # Buffer both sides if remote 1870 if (defined($remote)) { 1871 $cmd .= $::buffer_cmd; 1872 } 1873 1874 # Wrap all that together 1875 $cmd = &maybe_remote_cmd($cmd, $remote); 1876 1877 # Append writer stuff 1878 $cmd = &append_writer_cmd($cmd); 1879 1880 push(@cmds, $cmd); 1881 1882 $remove .= " $filelist"; 1883 1884 return($remove, @cmds); 1885 1886} 1887 1888###################################################################### 1889# List the files in an archive 1890###################################################################### 1891sub list_routine { 1892 1893 my $cmd = &setup_before_read('list'); 1894 1895 if ($cfg::type eq 'dump') { 1896 $cmd .= "$::path{restore} -t "; 1897 $cmd .= "$::dump_verb_flag "; 1898 $cmd .= "$::dump_blk_flag "; 1899 $cmd .= "-f -"; 1900 1901 } elsif ($cfg::type eq 'afio') { 1902 $cmd .= "$::path{afio} -t "; 1903 $cmd .= "-z "; 1904 # Don't use label reader if reading from pipe (needs stdin) 1905 if (!defined($::use_pipe)) { 1906 $cmd .= "-D $0 "; 1907 } 1908 $cmd .= "$::afio_unz_flag "; 1909 $cmd .= "$::afio_verb_flag "; 1910 $cmd .= "$::afio_sparse_flag "; 1911 $cmd .= "$::afio_bnum_flag "; 1912 $cmd .= "$::afio_blk_flag "; 1913 $cmd .= "-"; 1914 1915 } elsif ($cfg::type eq 'cpio') { 1916 $cmd .= "$::path{cpio} -t "; 1917 $cmd .= "$::cpio_verb_flag "; 1918 $cmd .= "$::cpio_blk_flag"; 1919 1920 } elsif ($cfg::type eq 'tar') { 1921 $cmd .= "$::path{tar} --list "; 1922 $cmd .= "--totals "; 1923 $cmd .= "$::tar_verb_flag "; 1924 $cmd .= "$::tar_sparse_flag "; 1925 $cmd .= "$::tar_recnum_flag "; 1926 $cmd .= "$::tar_blk_flag "; 1927 $cmd .= "-B "; 1928 $cmd .= "--file -"; 1929 1930 } elsif ($cfg::type eq 'star') { 1931 $cmd .= "$::path{star} -t "; 1932 $cmd .= "$::star_fifo_flag "; 1933 $cmd .= "$::star_verb_flag "; 1934 $cmd .= "$::star_sparse_flag "; 1935 $cmd .= "$::star_blocknum_flag "; 1936 $cmd .= "$::star_blk_flag "; 1937 $cmd .= "-B "; 1938 $cmd .= "file=-"; 1939 1940 } elsif ($cfg::type eq 'pax') { 1941 $cmd .= "$::path{pax} "; 1942 $cmd .= "$::pax_verb_flag "; 1943 1944 } elsif ($cfg::type eq 'zip') { 1945 my $tmpfile = "$cfg::tmpdir/zip.$PROCESS_ID"; 1946 $cmd .= "$::path{cat} > $tmpfile ; "; 1947 $cmd .= "$::path{unzip} -l "; 1948 $cmd .= "$::zip_verb_flag "; 1949 $cmd .= "$tmpfile ; "; 1950 $cmd .= "$::path{rm} -f $tmpfile"; 1951 1952 } elsif ($cfg::type eq 'ar') { 1953 my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID"; 1954 $cmd .= "$::path{cat} > $tmpfile; "; 1955 $cmd .= "$::path{ar} t"; 1956 $cmd .= "$::ar_verb_flag "; 1957 $cmd .= "$tmpfile; "; 1958 $cmd .= "$::path{rm} -f $tmpfile"; 1959 1960 } elsif ($cfg::type eq 'shar') { 1961 1962 $cmd .= "perl -pe 'last if (! m/^#/)'"; 1963 1964 } elsif ($cfg::type =~ m/^(copy|rsync)$/) { 1965 1966 if ($cfg::verbose eq "true") { 1967 $cmd = "ls -laR $::device"; 1968 } else { 1969 $cmd = "ls -aR $::device"; 1970 } 1971 1972 } elsif ($cfg::type eq 'lha') { 1973 my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID"; 1974 $cmd .= "$::path{cat} > $tmpfile ; "; 1975 $cmd .= "$::path{lha} l"; 1976 $cmd .= "$::lha_verb_flag "; 1977 $cmd .= "$tmpfile ; "; 1978 $cmd .= "$::path{rm} -f $tmpfile"; 1979 1980 } elsif ($cfg::type eq 'filelist') { 1981 1982 $cmd .= "$::path{cat}"; 1983 1984 } 1985 1986 &run_or_echo_then_query($cmd); 1987 1988} 1989 1990###################################################################### 1991# Extract files (maybe a list) to current directory 1992###################################################################### 1993sub extract_routine { 1994 1995 my $restore_files = ''; 1996 my $newlist = "$cfg::tmpdir/extract.$PROCESS_ID"; 1997 1998 my $cmd = &setup_before_read('extract'); 1999 2000 if (defined($::opt{'flist'})) { 2001 # Have to get a list of the files for restore to use 2002 open(LIST,"$::opt{flist}") or die ("Can't open $::opt{flist}: $OS_ERROR"); 2003 open(NEWLIST,">$newlist") or die ("Can't open $newlist: $OS_ERROR"); 2004 while(<LIST>) { 2005 chomp; 2006 $_ =~ s%^/%%; 2007 $_ =~ s%^\./%%; 2008 2009 # Some types need the leading ./ to extract the file list, 2010 # since its stored that way 2011 if ($cfg::type =~ m/^(tar|lha)$/) { 2012 $_ = './' . $_; 2013 } 2014 print NEWLIST "$_\n"; 2015 $restore_files .= " $_"; 2016 } 2017 close(LIST); 2018 close(NEWLIST); 2019 &log("| Extracting files listed in $::opt{flist}"); 2020 } 2021 2022 if (defined($::opt{'onefile'})) { 2023 open(NEWLIST,">$newlist") or die ("Can't open $newlist: $OS_ERROR"); 2024 $_ = $::opt{'onefile'}; 2025 $_ =~ s%^/%%; 2026 $_ =~ s%^\./%%; 2027 # Some types need the leading ./ to extract the file list, 2028 # since its stored that way 2029 if ($cfg::type =~ m/^(tar|lha)$/) { 2030 $_ = './' . $_; 2031 } 2032 print NEWLIST "$_\n"; 2033 $restore_files .= " $_"; 2034 close(NEWLIST); 2035 &log("| Extracting single file" . $restore_files); 2036 } 2037 2038 if ($cfg::type eq 'dump') { 2039 $cmd .= "$::path{restore} -x "; 2040 $cmd .= "$::dump_verb_flag "; 2041 $cmd .= "$::dump_blk_flag "; 2042 $cmd .= "-f -"; 2043 $cmd .= $restore_files; 2044 2045 } elsif ($cfg::type eq 'afio') { 2046 $cmd .= "$::path{afio} -i "; 2047 if ($restore_files ne '') { 2048 $cmd .= "-w $newlist "; 2049 } 2050 $cmd .= "-z "; 2051 $cmd .= "-x "; 2052 # Don't use label reader if reading from pipe (needs stdin) 2053 if (!defined($::use_pipe)) { 2054 $cmd .= "-D $0 "; 2055 } 2056 $cmd .= "$::afio_unz_flag "; 2057 $cmd .= "$::afio_verb_flag "; 2058 $cmd .= "$::afio_sparse_flag "; 2059 $cmd .= "$::afio_bnum_flag "; 2060 $cmd .= "$::afio_blk_flag "; 2061 $cmd .= "-"; 2062 2063 } elsif ($cfg::type eq 'cpio') { 2064 $cmd .= "$::path{cpio} -i "; 2065 if ($restore_files ne '') { 2066 $cmd .= "-E $newlist "; 2067 } 2068 $cmd .= "-m "; 2069 $cmd .= "-d "; 2070 $cmd .= "$::cpio_verb_flag "; 2071 $cmd .= "$::cpio_blk_flag"; 2072 2073 } elsif ($cfg::type eq 'tar') { 2074 $cmd .= "$::path{tar} --extract "; 2075 if ($restore_files ne '') { 2076 $cmd .= "--files-from $newlist "; 2077 } 2078 $cmd .= "--totals "; 2079 $cmd .= "--same-permissions "; 2080 $cmd .= "$::tar_verb_flag "; 2081 $cmd .= "$::tar_sparse_flag "; 2082 $cmd .= "$::tar_recnum_flag "; 2083 $cmd .= "$::tar_blk_flag "; 2084 $cmd .= "-B "; 2085 $cmd .= "--file -"; 2086 2087 } elsif ($cfg::type eq 'star') { 2088 $cmd .= "$::path{star} -x "; 2089 if ($restore_files ne '') { 2090 $cmd .= "list=$newlist "; 2091 } 2092 $cmd .= "-p "; 2093 $cmd .= "$::star_fifo_flag "; 2094 $cmd .= "$::star_verb_flag "; 2095 $cmd .= "$::star_sparse_flag "; 2096 $cmd .= "$::star_blocknum_flag "; 2097 $cmd .= "$::star_blk_flag "; 2098 $cmd .= "-B "; 2099 $cmd .= "file=-"; 2100 2101 } elsif ($cfg::type eq 'pax') { 2102 $cmd .= "$::path{pax} -r "; 2103 $cmd .= "$::pax_verb_flag "; 2104 $cmd .= $restore_files; 2105 2106 } elsif ($cfg::type eq 'zip') { 2107 my $tmpfile = "$cfg::tmpdir/zip.$PROCESS_ID"; 2108 $cmd .= "$::path{cat} > $tmpfile ; "; 2109 $cmd .= "$::path{unzip} "; 2110 $cmd .= "$tmpfile "; 2111 $cmd .= $restore_files; 2112 $cmd .= "; "; 2113 $cmd .= "$::path{rm} -f $tmpfile"; 2114 2115 } elsif ($cfg::type eq 'ar') { 2116 my $tmpfile = "$cfg::tmpdir/ar.$PROCESS_ID"; 2117 $cmd .= "$::path{cat} > $tmpfile; "; 2118 $cmd .= "$::path{ar} xo"; 2119 $cmd .= "$::ar_verb_flag "; 2120 $cmd .= "$tmpfile "; 2121 $cmd .= $restore_files; 2122 $cmd .= "; "; 2123 $cmd .= "$::path{rm} -f $tmpfile"; 2124 2125 } elsif ($cfg::type eq 'shar') { 2126 $cmd .= "sh "; 2127 if ($restore_files ne '') { 2128 &log("| NOTE: \"-flist/-onefile\" ignored for shar"); 2129 } 2130 2131 } elsif ($cfg::type =~ m/^(copy|rsync)$/) { 2132 2133 die("Ummm... just copy your files, you have the whole tree..."); 2134 2135 } elsif ($cfg::type eq 'filelist') { 2136 2137 die("You can't extract the 'filelist' type, it's just for testing..."); 2138 2139 } elsif ($cfg::type eq 'lha') { 2140 my $tmpfile = "$cfg::tmpdir/lha.$PROCESS_ID"; 2141 $cmd .= "$::path{cat} > $tmpfile ; "; 2142 $cmd .= "$::path{lha} x"; 2143 $cmd .= "$::lha_verb_flag "; 2144 $cmd .= "$tmpfile "; 2145 $cmd .= $restore_files; 2146 $cmd .= "; "; 2147 $cmd .= "$::path{rm} -f $tmpfile"; 2148 2149 } 2150 2151 &run_or_echo_then_query($cmd); 2152 2153 if (defined($::opt{'flist'})) { 2154 unlink("$newlist") or die ("Can't remove $newlist: $OS_ERROR"); 2155 } 2156} 2157 2158###################################################################### 2159# Compare an archive to current directory 2160###################################################################### 2161sub compare_routine { 2162 2163 my $cmd = &setup_before_read('compare'); 2164 2165 if ($cfg::type eq 'dump') { 2166 $cmd .= "$::path{restore} -C "; 2167 $cmd .= "$::dump_blk_flag "; 2168 $cmd .= "-f -"; 2169 2170 } elsif ($cfg::type eq 'afio') { 2171 $cmd .= "$::path{afio} -r "; 2172 $cmd .= "-z "; 2173 # Don't use label reader if reading from pipe (needs stdin) 2174 if (!defined($::use_pipe)) { 2175 $cmd .= "-D $0 "; 2176 } 2177 $cmd .= "$::afio_unz_flag "; 2178 $cmd .= "$::afio_sparse_flag "; 2179 $cmd .= "$::afio_blk_flag "; 2180 $cmd .= "-"; 2181 2182 } elsif ($cfg::type eq 'tar') { 2183 $cmd .= "$::path{tar} --diff "; 2184 $cmd .= "--totals "; 2185 $cmd .= "$::tar_blk_flag "; 2186 $cmd .= "$::tar_sparse_flag "; 2187 $cmd .= "$::tar_recnum_flag "; 2188 $cmd .= "-B "; 2189 $cmd .= "--file -"; 2190 2191 } elsif ($cfg::type eq 'star') { 2192 $cmd .= "$::path{star} -diff "; 2193 $cmd .= "$::star_fifo_flag "; 2194 $cmd .= "$::star_blk_flag "; 2195 $cmd .= "$::star_sparse_flag "; 2196 $cmd .= "$::star_blocknum_flag "; 2197 $cmd .= "-B "; 2198 $cmd .= "file=-"; 2199 2200 } elsif ($cfg::type =~ m/^(copy|rsync)$/) { 2201 2202 $::path{'diff'} = &checkinpath('diff'); 2203 2204 $cmd = "$::path{diff} -r -q "; 2205 $cmd .= ". $::device"; 2206 2207 } else { 2208 die("$cfg::type not capable of comparing files"); 2209 } 2210 2211 &run_or_echo_then_query($cmd); 2212 2213} 2214 2215###################################################################### 2216# Interactive restore 2217###################################################################### 2218sub restore_routine { 2219 2220 my $cmd = &setup_before_read('restore'); 2221 2222 if ($cfg::type eq 'dump') { 2223 $cmd .= "$::path{restore} -i "; 2224 $cmd .= "$::dump_verb_flag "; 2225 $cmd .= "$::dump_blk_flag "; 2226 $cmd .= "-f -"; 2227 2228 } else { 2229 die("Interactive restore for $cfg::type not implemented"); 2230 } 2231 2232 &run_or_echo_then_query($cmd); 2233 2234} 2235 2236###################################################################### 2237# Return the "label" name of the filesystem/dir 2238###################################################################### 2239sub get_label { 2240 2241 my $path = shift(@_); 2242 my $host = ''; 2243 my $label; 2244 2245 if ($path =~ s/(\S+)://) { 2246 $host = $1 . "-"; 2247 $label = $path; 2248 } else { 2249 $label = $path; 2250 } 2251 2252 $label =~ s%^/%%; # nuke leading slash 2253 $label =~ s%/%-%g; # turn / into - 2254 $label = 'root' if ($label eq ''); 2255 2256 return($host . $label); 2257 2258} 2259 2260###################################################################### 2261# Return a date string of the timestamp file 2262# from the last dump of lower level 2263# in YYYYMMDDhhmm.ss format if arg 'numeric' 2264# in ctime format if if arg 'ctime' 2265# timestamp reference file if arg 'filename' 2266###################################################################### 2267sub get_last_date { 2268 2269 my $label = shift(@_); 2270 my $thislevel = shift(@_); 2271 my $format = shift(@_); 2272 my $lastlevel; 2273 my $targetfile = ''; 2274 my $numeric_val; 2275 my $string_val; 2276 my $mtime; 2277 2278 2279 # use the epoch for level 0 2280 if ($thislevel == 0) { 2281 $numeric_val = '197001010000.00'; 2282 $string_val = "Thu Jan 01 00:00:00 1970"; 2283 2284 } else { 2285 2286 # Find last stamp file 2287 opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR"); 2288 close(DIR); 2289 my $tmp = $thislevel - 1; 2290 foreach my $lev (reverse (0..$tmp)) { 2291 my $file = "$cfg::stampdir/$cfg::sprefix" . "$label.$lev"; 2292 if (-e "$file") { 2293 $lastlevel = $lev; 2294 $targetfile = $file; 2295 last; 2296 } 2297 } 2298 2299 # get date from targetfile 2300 # or complain if no timestamp 2301 if ($targetfile ne '') { 2302 $mtime = (stat($targetfile))[9]; 2303 $string_val = strftime("%a %b %d %H:%M:%S %Y", localtime($mtime)); 2304 $numeric_val = strftime("%Y%m%d%H%M.%S", localtime($mtime)); 2305 } else { 2306 die("Can't do a level $thislevel backup - no level 0 timestamp found"); 2307 } 2308 2309 } 2310 2311 &log("| Date of this level $thislevel backup: $::date_at_start"); 2312 if ($thislevel == 0) { 2313 &log("| Date of last level $thislevel backup: the epoch"); 2314 } else { 2315 &log("| Date of last level $lastlevel backup: $string_val"); 2316 } 2317 &line(); 2318 2319 if (!defined($format)) { 2320 $format = 'ctime'; 2321 } 2322 2323 if ($format eq 'numeric') { 2324 return($numeric_val); 2325 } elsif ($format eq 'ctime') { 2326 return($string_val); 2327 } elsif ($format eq 'filename') { 2328 return($targetfile); 2329 } else { 2330 return($string_val); 2331 } 2332} 2333 2334###################################################################### 2335# Echo message to screen and log 2336# optionally just one or the other 2337###################################################################### 2338sub log { 2339 2340 my $msg = shift(@_); 2341 my $only = shift(@_); 2342 my $do_screen = 1; 2343 my $do_log = 1; 2344 2345 if (!defined($only)) { 2346 $do_screen = 1; 2347 $do_log = 1; 2348 } elsif ($only eq 'screen') { 2349 $do_screen = 1; 2350 $do_log = 0; 2351 } elsif ($only eq 'log') { 2352 $do_screen = 0; 2353 $do_log = 1; 2354 } 2355 2356 if ($do_screen == 1) { 2357 print $::msg "$msg\n"; 2358 } 2359 2360 if (($do_log == 1) and defined($::log)) { 2361 open(LOG,">>$::log") || warn("can't open logfile"); 2362 print LOG "$msg\n"; 2363 close(LOG); 2364 } 2365 2366} 2367 2368###################################################################### 2369# Echo a line to both screen and log 2370# optionally just one or the other 2371###################################################################### 2372sub line { 2373 2374 my $only = shift(@_); 2375 my $do_screen = 1; 2376 my $do_log = 1; 2377 2378 my $length = 60; 2379 2380 if (!defined($only)) { 2381 $do_screen = 1; 2382 $do_log = 1; 2383 } elsif ($only eq 'screen') { 2384 $do_screen = 1; 2385 $do_log = 0; 2386 } elsif ($only eq 'log') { 2387 $do_screen = 0; 2388 $do_log = 1; 2389 } 2390 2391 if ($do_screen == 1) { 2392 print $::msg '|'; 2393 print $::msg '-' x $length; 2394 print $::msg "\n"; 2395 } 2396 2397 if (($do_log == 1) and defined($::log)) { 2398 open(LOG,">>$::log") || warn("can't open logfile"); 2399 print LOG '|'; 2400 print LOG '-' x $length; 2401 print LOG "\n"; 2402 close(LOG); 2403 } 2404 2405} 2406 2407###################################################################### 2408# Read configuration file 2409###################################################################### 2410sub readconfigfile { 2411 2412 my $configfile; 2413 my $var; 2414 my $value; 2415 my $defines = $::opt{'d'}; 2416 2417 if (defined($::opt{'c'})) { 2418 $configfile = $::opt{'c'}; 2419 } else { 2420 $configfile = $::CONFFILE; 2421 } 2422 if (! -r "$configfile") { 2423 die("config file $configfile: $OS_ERROR"); 2424 } 2425 system("perl -c \"$configfile\""); 2426 if ($CHILD_ERROR) { 2427 die("syntax error in config file $configfile"); 2428 } 2429 2430 package cfg; 2431 require "$configfile"; 2432 package main; 2433 2434 # Overrides 2435 foreach $var (keys %$defines) { 2436 $value = $$defines{$var}; 2437 &log("(override) $var = $value"); 2438 eval("\$cfg::$var=\"$value\""); 2439 } 2440 2441} 2442 2443###################################################################### 2444# Do a tape operation 2445###################################################################### 2446sub mt { 2447 2448 my (@operations) = (@_); 2449 2450 # Set hardware compression when we do the blocksize 2451 if ($cfg::compress eq "hardware") { 2452 foreach my $operation (@operations) { 2453 if ($operation =~ m/generic-blocksize/) { 2454 if ($::uname =~ /Linux/) { 2455 push(@operations,'compression 1'); 2456 } elsif ($::uname =~ /FreeBSD/) { 2457 push(@operations,'comp on'); 2458 } else { 2459 push(@operations,'compression 1'); 2460 } 2461 } 2462 } 2463 } 2464 2465 # We want 1-filemark behavior always 2466 # Set if currently doing blocksize command 2467 foreach my $operation (@operations) { 2468 if ($operation =~ m/generic-blocksize/) { 2469 if ($::uname =~ /FreeBSD/) { 2470 push(@operations,'seteotmodel 1'); 2471 } 2472 } 2473 } 2474 2475 foreach my $operation (@operations) { 2476 2477 # mt flavors for block number 2478 if ($operation eq 'generic-query') { 2479 if ($::uname =~ /Linux/) { 2480 $operation = 'tell'; 2481 if ($::ftape == 1) { 2482 $operation = 'getsize'; 2483 } 2484 } elsif ($::uname =~ /OpenBSD/) { 2485 $operation = 'status'; 2486 } elsif ($::uname =~ /FreeBSD/) { 2487 $operation = 'rdhpos'; 2488 } elsif ($::uname =~ /OSF1/) { 2489 $operation = 'status'; 2490 } elsif ($::uname =~ /AIX/) { 2491 $operation = 'status'; 2492 } elsif ($::uname =~ /HP-UX/) { 2493 $operation = 'status'; 2494 } elsif ($::uname =~ /SunOS/) { 2495 $operation = 'status'; 2496 } elsif ($::uname =~ /IRIX/) { 2497 $operation = 'status'; 2498 } else { 2499 $operation = 'status'; 2500 } 2501 } 2502 2503 # mt flavors for eod 2504 if ($operation eq 'generic-eod') { 2505 if ($::uname =~ /Linux/) { 2506 $operation = 'eod'; 2507 if ($::ftape == 1) { 2508 $operation = 'eom'; 2509 } 2510 } elsif ($::uname =~ /OpenBSD/) { 2511 $operation = 'eod'; 2512 } elsif ($::uname =~ /FreeBSD/) { 2513 $operation = 'eod'; 2514 } elsif ($::uname =~ /OSF1/) { 2515 $operation = 'seod'; 2516 } elsif ($::uname =~ /AIX/) { 2517 $operation = 'fsf 1000'; 2518 } elsif ($::uname =~ /HP-UX/) { 2519 $operation = 'eod'; 2520 } elsif ($::uname =~ /SunOS/) { 2521 $operation = 'eom'; 2522 } elsif ($::uname =~ /IRIX/) { 2523 $operation = 'eod'; 2524 } else { 2525 $operation = 'eod'; 2526 } 2527 } 2528 2529 # mt flavors for erase 2530 # (some mt's have no "erase", just rewind before starting...) 2531 if ($operation eq 'generic-erase') { 2532 2533 if ($cfg::erase_rewind_only eq "true") { 2534 $operation = 'rewind'; 2535 } elsif ($::uname =~ /Linux/) { 2536 $operation = 'erase'; 2537 } elsif ($::uname =~ /OpenBSD/) { 2538 $operation = 'erase'; 2539 } elsif ($::uname =~ /FreeBSD/) { 2540 $operation = 'erase'; 2541 } elsif ($::uname =~ /OSF1/) { 2542 $operation = 'erase'; 2543 } elsif ($::uname =~ /AIX/) { 2544 $operation = 'erase'; 2545 } elsif ($::uname =~ /HP-UX/) { 2546 $operation = 'erase'; 2547 } elsif ($::uname =~ /SunOS/) { 2548 $operation = 'erase'; 2549 } elsif ($::uname =~ /IRIX/) { 2550 $operation = 'erase'; 2551 } else { 2552 $operation = 'erase'; 2553 } 2554 } 2555 2556 # mt flavors for setblk 2557 if ($operation =~ /generic-blocksize/) { 2558 if ($::uname =~ /Linux/) { 2559 $operation =~ s/generic-blocksize/setblk/; 2560 } elsif ($::uname =~ /OpenBSD/) { 2561 $operation =~ s/generic-blocksize/blocksize/; 2562 } elsif ($::uname =~ /FreeBSD/) { 2563 $operation =~ s/generic-blocksize/blocksize/; 2564 } elsif ($::uname =~ /OSF1/) { 2565 $operation =~ s/generic-blocksize/setblk/; 2566 } elsif ($::uname =~ /AIX/) { 2567 $operation =~ s/generic-blocksize/setblk/; 2568 } elsif ($::uname =~ /HP-UX/) { 2569 $operation =~ s/generic-blocksize/setblk/; 2570 } elsif ($::uname =~ /SunOS/) { 2571 $operation =~ s/generic-blocksize/setblk/; 2572 } elsif ($::uname =~ /IRIX/) { 2573 $operation =~ s/generic-blocksize/setblksz/; 2574 } else { 2575 $operation =~ s/generic-blocksize/setblk/; 2576 } 2577 } 2578 2579 if (defined($::use_file)) { 2580 # mt ops skipped for files 2581 } elsif (defined($::use_blockdevice)) { 2582 # mt ops skipped for block device 2583 } else { 2584 2585 my $command; 2586 2587 # Override mt operation so user can set for unknown flavors 2588 # or for debugging info, like mt tell -> mt status 2589 if(defined($cfg::mt{$operation})) { 2590 $operation = $cfg::mt{$operation}; 2591 next if ($operation eq 'nop'); 2592 } 2593 2594 if ($operation =~ /setblk/) { 2595 # Try and see which of setblk/defblksize will work 2596 # This is kludgy, but doable 2597 $command = "$::path{mt} -f $::device $operation > /dev/null 2>&1"; 2598 if (defined($::remotetapehost)) { 2599 $command = &maybe_remote_cmd($command, $::remotetapehost); 2600 } 2601 if (defined($::debug)) { 2602 &log("(debug) $command"); 2603 } 2604 system($command); 2605 if ($CHILD_ERROR) { 2606 &log("| Trying \"mt defblksize\" instead of \"mt setblk\""); 2607 my $oldoperation = $operation; 2608 $operation =~ s/setblk/defblksize/; 2609 $command = "$::path{mt} -f $::device $operation > /dev/null 2>&1"; 2610 if (defined($::remotetapehost)) { 2611 $command = &maybe_remote_cmd($command, $::remotetapehost); 2612 } 2613 if (defined($::debug)) { 2614 &log("(debug) $command"); 2615 } 2616 system($command); 2617 if ($CHILD_ERROR) { 2618 &log("Error setting block size"); 2619 &log("Neither of these commands worked:"); 2620 &log(" $::path{mt} -f $::device $oldoperation"); 2621 &log(" $::path{mt} -f $::device $operation"); 2622 exit(1); 2623 } # error on second guess 2624 } # error on first guess 2625 } # operation = setblk 2626 2627 $command = "$::path{mt} -f $::device $operation 2>&1 "; 2628 2629 if (defined($::remotetapehost)) { 2630 $command = &maybe_remote_cmd($command, $::remotetapehost); 2631 } 2632 2633 if (!defined($::debug)) { 2634 2635 open(CMD,"($command) 2>&1 |") || die; 2636 if (defined($::log)) { open(LOG,">>$::log") || die; } 2637 while(<CMD>) { 2638 print $_; 2639 if (defined($::log)) { print LOG $_; } 2640 } 2641 close(CMD); 2642 if (defined($::log)) { close(LOG); } 2643 2644 } else { 2645 &log("(debug) $command"); 2646 } 2647 2648 } # not a file 2649 2650 } # foreach operation 2651 2652} 2653 2654###################################################################### 2655# Option error checking & init stuff 2656###################################################################### 2657sub optioncheck { 2658 2659 my $buffer_blk_flag; 2660 my $buffer_write_pad_flag; 2661 my $buffer_read_pad_flag; 2662 2663 my $mbuffer_blk_flag; 2664 my $mbuffer_write_pad_flag; 2665 my $mbuffer_read_pad_flag; 2666 2667 # Archive type on commandline 2668 if (defined($::opt{'type'})) { 2669 $cfg::type = $::opt{'type'}; 2670 } 2671 2672 # Compress flag on commandline 2673 if (defined($::opt{'compress'})) { 2674 $cfg::compress = $::opt{'compress'}; 2675 } 2676 2677 # Device flag on commandline 2678 if (defined($::opt{'device'})) { 2679 $cfg::device = $::opt{'device'}; 2680 if (defined($::opt{'stdout'})) { 2681 push(@::errors,"Can't use -device and -pipe at the same time"); 2682 } 2683 } 2684 2685 # Debug 2686 if (defined($::opt{'n'})) { 2687 $::debug = 1; 2688 } 2689 2690 # Flag old config file 2691 if (@cfg::filesystems or defined($cfg::mt_var_blksize)) { 2692 # so strict shuts up 2693 my $junk = @cfg::filesystems; 2694 $junk = $cfg::mt_var_blksize; 2695 push(@::errors,"You've got an old 1.0.x configuration file, please update it!"); 2696 } 2697 2698 # Mode 2699 my (@modelist) = qw(set dir list extract compare restore toc newtape rmindex rmfile test-tape-drive); 2700 my @modes; 2701 my $modecount = 0; 2702 $::mode = ''; 2703 foreach my $mode (@modelist) { 2704 if (defined($::opt{$mode})) { 2705 $modecount++; 2706 $::mode = $mode; 2707 push(@modes,$mode); 2708 } 2709 } 2710 if ($modecount > 1) { 2711 $_ = join(" -",@modes); 2712 push(@::errors,"Can't specify more than one mode (given \"-$_\")"); 2713 } 2714 if ($modecount == 0) { 2715 push(@::errors,"Nothing to do (see -help)"); 2716 } 2717 2718 # First check if things are defined in the config file 2719 # Checks exist, true/false, or one of options 2720 &checkvar(\$cfg::type,'type','dump afio cpio tar star pax zip ar shar lha copy rsync filelist','tar'); 2721 &checkvar(\$cfg::compress,'compress','gzip bzip2 lzop compress zip false hardware lzma','gzip'); 2722 &checkvar(\$cfg::compr_level,'compr_level','exist','4'); 2723 &checkvar(\$cfg::verbose,'verbose','bool','true'); 2724 &checkvar(\$cfg::sparse,'sparse','bool','true'); 2725 &checkvar(\$cfg::label,'label','bool','true'); 2726 &checkvar(\$cfg::atime_preserve,'atime_preserve','bool','false'); 2727 &checkvar(\$cfg::indexes,'indexes','bool','true'); 2728 &checkvar(\$cfg::staticfiles,'staticfiles','bool','false'); 2729 &checkvar(\$cfg::buffer,'buffer','false buffer mbuffer','false'); 2730 &checkvar(\$cfg::pad_blocks,'pad_blocks','bool','true'); 2731 &checkvar(\$cfg::device,'device','exist','/dev/tape'); 2732 &checkvar(\$cfg::remoteshell,'remoteshell','ssh ssh2 ssh1 rsh','ssh'); 2733 &checkvar(\$cfg::remoteuser,'remoteuser','exist',''); 2734 &checkvar(\$cfg::erase_tape_set_level_zero,'erase_tape_set_level_zero','bool','true'); 2735 &checkvar(\$cfg::erase_rewind_only,'erase_rewind_only','bool','false'); 2736 &checkvar(\$cfg::logdir,'logdir','exist','/var/log/flexbackup'); 2737 &checkvar(\$cfg::tmpdir,'tmpdir','exist','/tmp'); 2738 &checkvar(\$cfg::comp_log,'comp_log','gzip bzip2 lzop compress zip false','gzip'); 2739 &checkvar(\$cfg::stampdir,'stampdir','exist','/var/lib/flexbackup'); 2740 &checkvar(\$cfg::index,'index','exist','/var/lib/flexbackup/index'); 2741 &checkvar(\$cfg::keyfile,'keyfile','exist','00-index-key'); 2742 &checkvar(\$cfg::staticlogs,'staticlogs','bool','false'); 2743 &checkvar(\$cfg::prefix,'prefix','exist',''); 2744 &checkvar(\$cfg::sprefix,'sprefix','exist',''); 2745 2746 if (@::errors) { 2747 print $::msg "Errors:\n"; 2748 while(@::errors) { 2749 print $::msg " " . shift(@::errors) . "\n"; 2750 } 2751 exit(1); 2752 } 2753 2754 # Check we can find rsh or ssh 2755 $::path{$cfg::remoteshell} = &checkinpath($cfg::remoteshell); 2756 if ($cfg::remoteuser ne '') { 2757 $::remoteshell = "$::path{$cfg::remoteshell} -l $cfg::remoteuser"; 2758 } else { 2759 $::remoteshell = $::path{$cfg::remoteshell}; 2760 } 2761 2762 # Check we can find common stuff 2763 $::path{'touch'} = &checkinpath('touch'); 2764 $::path{'hostname'} = &checkinpath('hostname'); 2765 $::path{'cat'} = &checkinpath('cat'); 2766 $::path{'rm'} = &checkinpath('rm'); 2767 $::path{'tee'} = &checkinpath('tee'); 2768 $::path{'find'} = &checkinpath('find'); 2769 $::path{'dd'} = &checkinpath('dd'); 2770 $::path{'printf'} = &checkinpath('printf'); 2771 $::path{'mkdir'} = &checkinpath('mkdir'); 2772 $::path{'sed'} = &checkinpath('sed'); 2773 2774 push(@::remoteprogs,($::path{'touch'},$::path{'rm'},$::path{'find'},$::path{'printf'},$::path{'mkdir'})); 2775 2776 # Check device (or dir) 2777 $::ftape = 0; 2778 if (defined($::opt{'pipe'})) { 2779 2780 # Dump to stdout. 2781 # Disable indexing, all messages to stderr 2782 $::use_file = 1; 2783 $::use_pipe = 1; 2784 $cfg::indexes = 'false'; 2785 $cfg::device = '-'; 2786 2787 } elsif ($cfg::type eq 'filelist') { 2788 2789 $::use_file = 1; 2790 chomp($cfg::device = `pwd`); 2791 $cfg::device =~ s:/$::; 2792 $cfg::indexes = 'false'; 2793 2794 # Can we write to cwd? 2795 if (! -w $cfg::device) { 2796 push(@::errors,"Can't write to $cfg::device"); 2797 } 2798 2799 } else { 2800 2801 # Chase device links 2802 my $realdev = $cfg::device; 2803 while (-l "$realdev") { 2804 2805 my @pathname = split('/',$realdev); 2806 $realdev = readlink("$realdev"); 2807 2808 # If a relative link we'll need the dir from the link 2809 if ($realdev !~ m:^/:) { 2810 pop(@pathname); 2811 $realdev = join('/',@pathname) . "/$realdev"; 2812 } 2813 } 2814 2815 if (-c $realdev) { 2816 2817 # Check for ftape driver 2818 if ($realdev =~ /n?z?[qr]ft(\d+)/) { 2819 $::ftape = 1; 2820 } 2821 $::tapedevice = 1; 2822 2823 } elsif (-b $realdev) { 2824 2825 # In case of floppy or similar. 2826 # Can't do multiple files this way; turn indexing off 2827 $::use_blockdevice = 1; 2828 $cfg::indexes = 'false'; 2829 2830 } elsif (-d "$cfg::device") { 2831 if ($cfg::device !~ m:^/:) { 2832 push(@::errors,"Please give full path, not relative (\$device=$cfg::device)"); 2833 } else { 2834 $::use_file = 1; 2835 $cfg::device =~ s:/$::; # nuke trailing slash if any 2836 } 2837 2838 } elsif ($cfg::device =~ m%(\S+):(/dev/.*)%) { 2839 2840 $::remotetapehost = $1; 2841 $cfg::device = $2; 2842 $::tapedevice = 1; 2843 2844 } else { 2845 push(@::errors,"\$device must be set to a directory, a local device, or a remote device"); 2846 } 2847 2848 # Can we write to it? 2849 if ((! -w $cfg::device) and 2850 !defined($::remotetapehost) and 2851 ($::mode =~ m/^(set|dir|newtape)$/)) { 2852 push(@::errors,"Can't write to $cfg::device"); 2853 } 2854 2855 } 2856 2857 $::device = $cfg::device; 2858 2859 2860 # Set mt type 2861 if (defined($::tapedevice)) { 2862 if ($::ftape == 1) { 2863 $::path{'mt'} = &checkinpath('ftmt'); 2864 } else { 2865 $::path{'mt'} = &checkinpath('mt'); 2866 } 2867 } 2868 2869 # Exclude regexp for find 2870 $::exclude_expr = ''; 2871 if (defined($cfg::exclude_expr[0])) { 2872 my @excl_array; 2873 my $expr; 2874 foreach $expr (@cfg::exclude_expr) { 2875 2876 # People just don't grok regex's. 2877 # 2878 # If the first character is a *, they obviously got it wrong, 2879 # we can try to assume what they meant. 2880 # 2881 # If the user put "*.whatever" as an expression, turn this 2882 # "glob" into a regex for them 2883 # If the user put "*whatever" as an expression, turn this 2884 # "glob" into a regex for them 2885 if ($expr =~ m/^\*\./) { 2886 $expr =~ s/^\*\./.\*\\./; 2887 } 2888 if ($expr =~ m/^\*/) { 2889 $expr =~ s/^\*/.*/; 2890 } 2891 2892 # AAAH! Csh should be banned from the face of the earth! 2893 # 2894 # If an expression contains $ at the end we need to be careful 2895 # and leave it out of the quotes, or csh will yack if doing a 2896 # remote backup. This happens only if the user's shell is 2897 # csh/tcsh. Then the string is doublequoted inside single 2898 # quotes and there is _no way_ for csh do deal with $ in that 2899 # situation. This took a LONG time to figure out. 2900 if ($expr =~ m/^(.+)\$$/) { 2901 $expr = '"' . $1 . '"' . '$'; #' (comment to fool emacs 20.7 2902 } else { 2903 $expr = '"' . $expr . '"'; 2904 } 2905 2906 $::exclude_expr .= "! -regex $expr "; 2907 } 2908 } 2909 2910 # Traverse mountpoints? 2911 &checkvar(\$cfg::traverse_fs,'traverse_fs','false local all','false'); 2912 if ($cfg::traverse_fs eq "local") { 2913 $::mountpoint_flag = "! -fstype nfs ! -fstype smbfs ! -fstype bind ! -fstype proc ! -fstype devpts ! -fstype devfs ! -fstype tmpfs"; 2914 } elsif ($cfg::traverse_fs eq "all") { 2915 $::mountpoint_flag = "! -fstype proc ! -fstype devpts ! -fstype devfs ! -fstype tmpfs"; 2916 } else { 2917 $::mountpoint_flag = "-xdev"; 2918 } 2919 2920 # Block size 2921 &checkvar(\$cfg::blksize,'blksize','exist','10'); 2922 # Isn't required; if commented out in config we use same as $blksize 2923 #&checkvar(\$cfg::mt_blksize,'mt_blksize','exist'); 2924 if ($cfg::blksize !~ m/^\d+$/) { 2925 push(@::errors,"\$blksize must be set to an integer"); 2926 } 2927 if ($cfg::blksize ne '0') { 2928 # buffer blocksize needs k appended 2929 $buffer_blk_flag = "-s " . $cfg::blksize . "k"; 2930 # mbuffer blocksize in bytes 2931 $mbuffer_blk_flag = "-s " . $cfg::blksize * 1024; 2932 # dd blocksize needs k appended 2933 $::dd_blk_flag = "ibs=" . $cfg::blksize . "k obs=" . $cfg::blksize . "k"; 2934 # dump blocksize just in k like the config file 2935 $::dump_blk_flag = "-b $cfg::blksize"; 2936 # afio blocksize needs k appended 2937 $::afio_blk_flag = "-b " . $cfg::blksize . "k"; 2938 # cpio blocks are in bytes 2939 $::cpio_blk_flag = "-C " . $cfg::blksize * 1024; 2940 # tar blocks are in 512-byte units 2941 # long name is really --blocking-factor but changed from --block-size 2942 # only in recent versions. just use the short flag. 2943 $::tar_blk_flag = "-b " . $cfg::blksize * 2; 2944 # star blocks are in 512-byte units 2945 $::star_blk_flag = "blocks=" . $cfg::blksize * 2; 2946 # pax blocksize needs k appended 2947 $::pax_blk_flag = "-b " . $cfg::blksize . "k"; 2948 } else { 2949 $buffer_blk_flag = ""; 2950 $mbuffer_blk_flag = ""; 2951 $::dd_blk_flag = ""; 2952 $::dump_blk_flag = ""; 2953 $::afio_blk_flag = ""; 2954 $::cpio_blk_flag = ""; 2955 $::tar_blk_flag = ""; 2956 $::star_blk_flag = ""; 2957 $::pax_blk_flag = ""; 2958 } 2959 2960 # mt block size (in bytes not k) 2961 if (!defined($cfg::mt_blksize)) { 2962 $cfg::mt_blksize = $cfg::blksize * 1024; 2963 $::mt_blksize = $cfg::mt_blksize; 2964 } 2965 if ($cfg::mt_blksize !~ m/^\d+$/) { 2966 push(@::errors,"\$mt_blksize must be set to an integer"); 2967 } else { 2968 if ($cfg::mt_blksize != 0) { 2969 my $tmp = $cfg::blksize * 1024; 2970 if ($tmp%$cfg::mt_blksize != 0) { 2971 push(@::errors,"\$mt_blksize ($cfg::mt_blksize) should be a factor of \$blksize ($tmp)"); 2972 } 2973 } 2974 $::mt_blksize = $cfg::mt_blksize; 2975 } 2976 2977 # Generic compression (afio archives will do their own flags) 2978 if ($cfg::compress eq "gzip") { 2979 $::path{'gzip'} = &checkinpath($cfg::compress); 2980 push(@::remoteprogs, $::path{$cfg::compress}); 2981 if ($cfg::compr_level !~ m/^[123456789]$/) { 2982 push(@::errors,"\$compr_level must be set to 1-9"); 2983 } else { 2984 $::z = " | $::path{$cfg::compress} -$cfg::compr_level"; 2985 } 2986 $::unz = "$::path{$cfg::compress} -dq | "; 2987 2988 } elsif ($cfg::compress eq "bzip2") { 2989 $::path{'bzip2'} = &checkinpath($cfg::compress); 2990 push(@::remoteprogs, $::path{$cfg::compress}); 2991 if ($cfg::compr_level !~ m/^[123456789]$/) { 2992 push(@::errors,"\$compr_level must be set to 1-9"); 2993 } else { 2994 $::z = " | $::path{$cfg::compress} -$cfg::compr_level"; 2995 } 2996 $::unz = "$::path{$cfg::compress} -d | "; 2997 2998 } elsif ($cfg::compress eq "lzop") { 2999 $::path{'lzop'} = &checkinpath($cfg::compress); 3000 push(@::remoteprogs, $::path{$cfg::compress}); 3001 if ($cfg::compr_level !~ m/^[123456789]$/) { 3002 push(@::errors,"\$compr_level must be set to 1-9"); 3003 } else { 3004 $::z = " | $::path{$cfg::compress} -$cfg::compr_level"; 3005 } 3006 $::unz = "$::path{$cfg::compress} -d | "; 3007 3008 } elsif ($cfg::compress eq "compress") { 3009 $::path{'compress'} = &checkinpath($cfg::compress); 3010 push(@::remoteprogs, $::path{$cfg::compress}); 3011 $::z = " | $::path{$cfg::compress} -c"; 3012 $::unz = "$::path{$cfg::compress} -dc | "; 3013 3014 } elsif ($cfg::compress eq "zip") { 3015 $::path{'zip'} = &checkinpath('zip'); 3016 push(@::remoteprogs, $::path{'zip'}); 3017 $::path{'funzip'} = &checkinpath('funzip'); 3018 if ($cfg::compr_level !~ m/^[123456789]$/) { 3019 push(@::errors,"\$compr_level must be set to 1-9"); 3020 } else { 3021 $::z = " | $::path{zip} -$cfg::compr_level - -"; 3022 $::unz = "$::path{funzip} | "; 3023 } 3024 } elsif ($cfg::compress eq "lzma") { 3025 $::path{'lzma'} = &checkinpath($cfg::compress); 3026 push(@::remoteprogs, $::path{$cfg::compress}); 3027 if ($cfg::compr_level !~ m/^[0123456789]$/) { 3028 push(@::errors,"\$compr_level must be set to 1-9"); 3029 } else { 3030 $::z = " | $::path{$cfg::compress} -$cfg::compr_level "; 3031 } 3032 $::unz = "$::path{$cfg::compress} -d | "; 3033 3034 } else { 3035 $::z = ""; 3036 $::unz = ""; 3037 } 3038 3039 # Block padding 3040 if (($cfg::pad_blocks eq "true") and defined($::tapedevice)) { 3041 $::dd_write_pad_flag = "conv=noerror,sync"; 3042 $::dd_read_pad_flag = "conv=noerror"; 3043 $buffer_write_pad_flag = "-B"; 3044 $buffer_read_pad_flag = ""; 3045 $mbuffer_write_pad_flag = ""; 3046 $mbuffer_read_pad_flag = ""; 3047 } else { 3048 $::dd_write_pad_flag = "conv=noerror"; 3049 $::dd_read_pad_flag = "conv=noerror"; 3050 $buffer_write_pad_flag = ""; 3051 $buffer_read_pad_flag = ""; 3052 $mbuffer_write_pad_flag = ""; 3053 $mbuffer_read_pad_flag = ""; 3054 } 3055 3056 # Buffer setup 3057 if ($cfg::buffer ne 'false') { 3058 &checkvar(\$cfg::buffer_megs,'buffer_megs','exist'); 3059 &checkvar(\$cfg::buffer_fill_pct,'buffer_fill_pct','exist','75'); 3060 &checkvar(\$cfg::buffer_pause_usec,'buffer_pause_usec','exist','100'); 3061 if ($cfg::buffer_megs !~ m/^\d+$/) { 3062 push(@::errors,"\$buffer_megs must be set to integer number of megabytes"); 3063 } 3064 if ($cfg::buffer_fill_pct !~ m/^\d+$/) { 3065 push(@::errors,"\$buffer_fill_pct must be set to an integer"); 3066 } 3067 if ($cfg::buffer_pause_usec !~ m/^\d+$/) { 3068 push(@::errors,"\$buffer_pause_usec must be set to an integer"); 3069 } 3070 if ($cfg::buffer eq "buffer") { 3071 3072 $::path{'buffer'} = &checkinpath('buffer'); 3073 push(@::remoteprogs, $::path{'buffer'}); 3074 3075 my $write_flags; 3076 my $read_flags; 3077 my $megs = $cfg::buffer_megs . "m"; 3078 my $bufcmd = "$::path{buffer} -m $megs -p $cfg::buffer_fill_pct $buffer_blk_flag -t "; 3079 3080 if (defined($::tapedevice)) { 3081 $write_flags = "-u $cfg::buffer_pause_usec $buffer_write_pad_flag -o "; 3082 $read_flags = "-u $cfg::buffer_pause_usec $buffer_read_pad_flag -i "; 3083 } else { 3084 $write_flags = "$buffer_write_pad_flag -o "; 3085 $read_flags = "$buffer_read_pad_flag -i "; 3086 } 3087 $::buffer_cmd = " | $bufcmd"; 3088 $::write_cmd = "$bufcmd $write_flags"; 3089 $::read_cmd = "$bufcmd $read_flags"; 3090 3091 } elsif ($cfg::buffer eq "mbuffer") { 3092 $::path{'mbuffer'} = &checkinpath('mbuffer'); 3093 push(@::remoteprogs, $::path{'mbuffer'}); 3094 3095 my $megs = $cfg::buffer_megs . "M"; 3096 my $bufcmd = "$::path{mbuffer} -q -m $megs -P $cfg::buffer_fill_pct $mbuffer_blk_flag "; 3097 3098 $::buffer_cmd = " | $bufcmd"; 3099 $::write_cmd = "$bufcmd -f -o "; 3100 if (defined($::opt{'volumes'})) { 3101 $::read_cmd = "$bufcmd -f -n $::opt{volumes} -i "; 3102 } else { 3103 $::read_cmd = "$bufcmd -f -i "; 3104 } 3105 } 3106 } else { 3107 # If buffering disabled, use dd or cat depending on if blocking turned off on not 3108 if ($cfg::blksize eq '0') { 3109 $::buffer_cmd = ""; 3110 $::write_cmd = "$::path{cat} > "; 3111 $::read_cmd = "$::path{cat} "; 3112 } else { 3113 $::buffer_cmd = ""; 3114 $::write_cmd = "$::path{dd} $::dd_blk_flag $::dd_write_pad_flag of="; 3115 $::read_cmd = "$::path{dd} $::dd_blk_flag $::dd_read_pad_flag if="; 3116 } 3117 } 3118 3119 # Sets / filesystems 3120 if (defined($::opt{'dir'})) { 3121 3122 # Single directory 3123 if ($::opt{'dir'} =~ /^(\S+):/) { 3124 $::remotehosts{$1} = 1; 3125 } else { 3126 $::local = 1; 3127 } 3128 3129 # Get rid of trailing / 3130 $::opt{'dir'} = &nuke_trailing_slash($::opt{'dir'}); 3131 3132 } elsif (defined($::opt{'set'})) { 3133 3134 if (defined($::use_pipe)) { 3135 push(@::errors,"can't use -set with -pipe option"); 3136 } 3137 3138 foreach my $set (keys %cfg::set) { 3139 if ($set eq 'all') { 3140 push(@::errors,"can't define a set named 'all'"); 3141 } 3142 } 3143 3144 my @do_sets; 3145 if ($::opt{'set'} eq 'all') { 3146 @do_sets = keys(%cfg::set); 3147 if (scalar(@do_sets) == 0) { 3148 push(@::errors,"no backup sets defined"); 3149 } 3150 } else { 3151 @do_sets = ($::opt{'set'}); 3152 } 3153 3154 foreach my $this_set (@do_sets) { 3155 if (!defined($cfg::set{$this_set})) { 3156 push(@::errors,"set $this_set is not defined"); 3157 } else { 3158 foreach my $dir (&split_list($cfg::set{$this_set})) { 3159 if ($dir =~ /^(\S+):/g) { 3160 $::remotehosts{$1} = 1; 3161 } else { 3162 $::local = 1; 3163 } 3164 } 3165 } 3166 } 3167 } 3168 3169 # Subtree pruning 3170 foreach my $fs (keys %cfg::prune) { 3171 $fs = &nuke_trailing_slash($fs); 3172 foreach my $expr (&split_list($cfg::prune{$fs})) { 3173 $::prune{$fs}{$expr} = 1; 3174 } 3175 } 3176 3177 # Verbose flag 3178 if ($cfg::verbose eq "true") { 3179 $::dump_verb_flag = "-v"; 3180 $::afio_verb_flag = "-v"; 3181 $::cpio_verb_flag = "-v"; 3182 $::tar_verb_flag = "--verbose"; 3183 $::star_verb_flag = "-v"; 3184 $::pax_verb_flag = "-v"; 3185 $::zip_verb_flag = "-v"; 3186 $::ar_verb_flag = "v"; 3187 $::shar_verb_flag = ""; 3188 $::lha_verb_flag = ""; 3189 $::rsync_verb_flag = "--verbose"; 3190 } else { 3191 $::dump_verb_flag = ""; 3192 $::afio_verb_flag = ""; 3193 $::cpio_verb_flag = ""; 3194 $::tar_verb_flag = ""; 3195 $::star_verb_flag = "-silent"; 3196 $::pax_verb_flag = ""; 3197 $::zip_verb_flag = "-q"; 3198 $::ar_verb_flag = ""; 3199 $::shar_verb_flag = "-q"; 3200 $::lha_verb_flag = "q"; 3201 $::rsync_verb_flag = ""; 3202 } 3203 3204 # Sparse flag 3205 if ($cfg::sparse eq "true") { 3206 $::afio_sparse_flag = ""; 3207 $::cpio_sparse_flag = ""; 3208 $::tar_sparse_flag = "--sparse"; 3209 $::star_sparse_flag = "-sparse"; 3210 } else { 3211 $::afio_sparse_flag = "-j"; 3212 $::cpio_sparse_flag = ""; 3213 $::tar_sparse_flag = ""; 3214 $::star_sparse_flag = ""; 3215 } 3216 3217 # atime preserve flag 3218 if ($cfg::atime_preserve eq "true") { 3219 $::afio_atime_flag = "-a"; 3220 $::tar_atime_flag = "--atime-preserve"; 3221 $::star_atime_flag = "-atime"; 3222 } else { 3223 $::afio_atime_flag = ""; 3224 $::tar_atime_flag = ""; 3225 $::star_atime_flag = ""; 3226 } 3227 3228 # Type-specific setup 3229 if ($cfg::type eq 'dump') { 3230 3231 &checkvar(\$cfg::dump_length,'dump_length','exist','0'); 3232 &checkvar(\$cfg::dump_use_dumpdates,'dump_use_dumpdates','bool','false'); 3233 3234 $::path{'dump'} = &checkinpath('dump'); 3235 $::path{'restore'} = &checkinpath('restore'); 3236 push(@::remoteprogs, $::path{'dump'}); 3237 3238 # Length of tape 3239 if ($cfg::dump_length !~ m/^\d+$/) { 3240 push(@::errors,"\$dump_length must be set to integer number of kilobytes"); 3241 } 3242 3243 # If length set to 0 will will try autosize 3244 if ($cfg::dump_length == 0) { 3245 $::dump_len_flag = "-a"; 3246 } else { 3247 $::dump_len_flag = "-B $cfg::dump_length"; 3248 } 3249 3250 } elsif ($cfg::type eq 'afio') { 3251 3252 &checkvar(\$cfg::afio_echo_block,'afio_echo_block','bool','false'); 3253 &checkvar(\$cfg::afio_compress_cache_size,'afio_compress_cache_size','exist','2'); 3254 &checkvar(\$cfg::afio_compress_threshold,'afio_compress_threshold','exist','3'); 3255 &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'); 3256 3257 $::path{'afio'} = &checkinpath('afio'); 3258 push(@::remoteprogs, $::path{'afio'}); 3259 3260 # Compress flag for afio must be handled differently 3261 if ($cfg::compress =~ m/^(gzip|bzip2|lzop|compress|zip|lzma)$/) { 3262 3263 if ($cfg::compress eq "gzip") { 3264 $::afio_z_flag = "-P $::path{$cfg::compress} -Q -$cfg::compr_level -Z"; 3265 $::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Q -q -Z"; 3266 3267 } elsif ($cfg::compress eq "bzip2") { 3268 $::afio_z_flag = "-P $::path{$cfg::compress} -Q -$cfg::compr_level -Z"; 3269 $::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Z"; 3270 3271 } elsif ($cfg::compress eq "lzop") { 3272 $::afio_z_flag = "-P $::path{$cfg::compress} -Q -$cfg::compr_level -Z"; 3273 $::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Z"; 3274 3275 } elsif ($cfg::compress eq "zip") { 3276 $::afio_z_flag = "-P $::path{zip} -Q -$cfg::compr_level -Q - -Q - -Z"; 3277 $::afio_unz_flag = "-P $::path{funzip} -Q \"\" -Z"; 3278 3279 } elsif ($cfg::compress eq "compress") { 3280 $::afio_z_flag = "-P $::path{$cfg::compress} -Q -c -Z"; 3281 $::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Q -c -Z"; 3282 3283 } elsif ($cfg::compress eq "lzma") { 3284 $::afio_z_flag = "-P $::path{$cfg::compress} -Q -$cfg::compr_level -Z"; 3285 $::afio_unz_flag = "-P $::path{$cfg::compress} -Q -d -Z"; 3286 3287 } 3288 $::unz = ""; # Reset & just use this for reading the archive file. 3289 3290 # Compression cache size 3291 if ($cfg::afio_compress_cache_size !~ m/^\d+$/) { 3292 push(@::errors,"\$afio_compress_cache_size must be set to an integer"); 3293 } else { 3294 if ($cfg::afio_compress_cache_size != 0) { 3295 $::afio_z_flag .= " -M " . $cfg::afio_compress_cache_size . "m"; 3296 } 3297 } 3298 3299 # Compression threshold 3300 if ($cfg::afio_compress_threshold !~ m/^\d+$/) { 3301 push(@::errors,"\$afio_compress_threshold must be set to an integer"); 3302 } else { 3303 if ($cfg::afio_compress_threshold != 0) { 3304 $::afio_z_flag .= " -T " . $cfg::afio_compress_threshold . "k"; 3305 } 3306 } 3307 3308 } else { 3309 $::afio_z_flag = ""; 3310 $::afio_unz_flag = ""; 3311 } 3312 3313 # Echo block number 3314 $::afio_bnum_flag = ""; 3315 if ($cfg::verbose eq "true") { 3316 if ($cfg::afio_echo_block eq "true") { 3317 $::afio_bnum_flag = "-B"; 3318 } 3319 } 3320 3321 } elsif (($cfg::type eq 'cpio') or ($cfg::type eq 'copy')) { 3322 3323 &checkvar(\$cfg::cpio_format,'cpio_format','bin odc newc crc tar ustar hpbin hpodc','newc'); 3324 3325 $::path{'cpio'} = &checkinpath('cpio'); 3326 push(@::remoteprogs, $::path{'cpio'}); 3327 3328 if ($cfg::type eq 'copy') { 3329 if (!defined($::use_file)) { 3330 push(@::errors,"Can't use type \"copy\" unless archiving to disk!"); 3331 } 3332 if (defined($::use_pipe)) { 3333 push(@::errors,"Can't use type \"copy\" with -pipe!"); 3334 } 3335 } 3336 3337 } elsif ($cfg::type eq 'rsync') { 3338 3339 $::path{'rsync'} = &checkinpath('rsync'); 3340 $::path{'sed'} = &checkinpath('sed'); 3341 push(@::remoteprogs, $::path{'rsync'}); 3342 3343 if (!defined($::use_file)) { 3344 push(@::errors,"Can't use type \"rsync\" unless archiving to disk!"); 3345 } 3346 if (defined($::use_pipe)) { 3347 push(@::errors,"Can't use type \"rsync\" with -pipe!"); 3348 } 3349 3350 } elsif ($cfg::type eq 'tar') { 3351 3352 &checkvar(\$cfg::tar_echo_record_num,'tar_echo_record_num','bool','false'); 3353 3354 $::path{'tar'} = &checkinpath('tar'); 3355 push(@::remoteprogs, $::path{'tar'}); 3356 3357 # Echo record number 3358 $::tar_recnum_flag = ""; 3359 if ($cfg::verbose eq "true") { 3360 if ($cfg::tar_echo_record_num eq "true") { 3361 $::tar_recnum_flag = "-R"; 3362 } 3363 } 3364 3365 } elsif ($cfg::type eq 'star') { 3366 3367 &checkvar(\$cfg::star_acl,'star_acl','bool','true'); 3368 &checkvar(\$cfg::star_fifo,'star_fifo','bool','true'); 3369 &checkvar(\$cfg::star_format,'star_format','tar star gnutar ustar pax xstar xustar exustar suntar','exustar'); 3370 &checkvar(\$cfg::star_echo_block_num,'star_echo_block_num','bool','false'); 3371 3372 $::path{'star'} = &checkinpath('star'); 3373 push(@::remoteprogs, $::path{'star'}); 3374 3375 # Echo block number 3376 $::star_blocknum_flag = ""; 3377 if ($cfg::verbose eq "true") { 3378 if ($cfg::star_echo_block_num eq "true") { 3379 $::star_blocknum_flag = "-block-number"; 3380 } 3381 } 3382 3383 # ACL flag 3384 if ($cfg::star_acl eq "true") { 3385 $::star_acl_flag = "-acl"; 3386 } else { 3387 $::star_acl_flag = ""; 3388 } 3389 3390 # fifo 3391 if ($cfg::star_fifo eq "true") { 3392 $::star_fifo_flag = "-fifo"; 3393 if ($cfg::verbose eq "true") { 3394 $::star_fifo_flag .= " -fifostats"; 3395 } 3396 } else { 3397 $::star_fifo_flag = ""; 3398 } 3399 3400 } elsif ($cfg::type eq 'pax') { 3401 3402 &checkvar(\$cfg::pax_format,'pax_format','cpio bcpio sv4cpio sv4crc tar ustar'); 3403 3404 $::path{'pax'} = &checkinpath('pax'); 3405 push(@::remoteprogs, $::path{'pax'}); 3406 3407 } elsif ($cfg::type eq 'zip') { 3408 3409 &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'); 3410 3411 $::path{'zip'} = &checkinpath('zip'); 3412 push(@::remoteprogs, $::path{'zip'}); 3413 $::path{'unzip'} = &checkinpath('unzip'); 3414 3415 $::zip_compr_flag = "-$cfg::compr_level"; 3416 3417 if ($cfg::compress =~ /^(gzip|bzip2|lzop|compress|zip)$/) { 3418 warn("Using type \"zip\" with compress=$cfg::compress makes no sense"); 3419 warn("Setting compression to false"); 3420 $::unz = ""; 3421 $::z = ""; 3422 $cfg::compress = "false"; 3423 } 3424 3425 $::zip_noz_flag = ""; 3426 if (defined($cfg::zip_nocompress_types) and $cfg::zip_nocompress_types ne "") { 3427 # Add dots to file extensions, make -n flag 3428 @_ = split(" ",$cfg::zip_nocompress_types); 3429 foreach (@_) { 3430 $_ = "." . $_; 3431 } 3432 $::zip_noz_flag = " -n " . join(":",@_); 3433 } 3434 3435 } elsif ($cfg::type eq 'ar') { 3436 3437 $::path{'ar'} = &checkinpath('ar'); 3438 push(@::remoteprogs, $::path{'ar'}); 3439 3440 } elsif ($cfg::type eq 'shar') { 3441 3442 $::path{'shar'} = &checkinpath('shar'); 3443 push(@::remoteprogs, $::path{'shar'}); 3444 3445 } elsif ($cfg::type eq 'lha') { 3446 3447 $::path{'lha'} = &checkinpath('lha'); 3448 push(@::remoteprogs, $::path{'lha'}); 3449 3450 if ($cfg::compress =~ /^(gzip|bzip2|lzop|compress|zip|lzma)$/) { 3451 warn("Using type \"lha\" with compress=$cfg::compress makes no sense"); 3452 warn("Setting compression to false"); 3453 $::unz = ""; 3454 $::z = ""; 3455 $cfg::compress = "false"; 3456 } 3457 3458 } elsif ($cfg::type eq 'filelist') { 3459 3460 # Nothing specific to check 3461 3462 } # type-specific 3463 3464 3465 # Tmp dir 3466 $cfg::tmpdir = &nuke_trailing_slash($cfg::tmpdir); 3467 if ($cfg::tmpdir !~ m:^/:) { 3468 push(@::errors,"\$tmpdir must be absolute path: $cfg::tmpdir"); 3469 } 3470 if (! -d "$cfg::tmpdir") { 3471 push(@::errors,"\$tmpdir $cfg::tmpdir is not a directory"); 3472 } 3473 if (! -w "$cfg::tmpdir") { 3474 push(@::errors,"\$tmpdir $cfg::tmpdir is not writable"); 3475 } 3476 3477 $cfg::hostname = `hostname`; 3478 chomp($cfg::hostname); 3479 3480 # Use a subdirectory of the user-specified directory as our tmpdir 3481 # Also note that we make it closer to globally unique as we sometimes 3482 # use this variable for remote systems, so PID isn't enough 3483 $cfg::tmpdir = $cfg::tmpdir .'/flexbackup.'.$$.'.'.$cfg::hostname; 3484 mkdir ($cfg::tmpdir) || die "Can't create temporary directory, $!"; 3485 3486 # Levels 3487 if (defined($::opt{'level'}) and 3488 (defined($::opt{'incremental'}) or 3489 defined($::opt{'differential'}) or 3490 defined($::opt{'full'}))) { 3491 push(@::errors,"Can't use -level AND -incremental/-differential/-full"); 3492 } 3493 3494 if (!defined($::opt{'level'})) { 3495 if (defined($::opt{'incremental'})) { 3496 $::opt{'level'} = 'incremental'; 3497 } elsif (defined($::opt{'differential'})) { 3498 $::opt{'level'} = 'differential'; 3499 } elsif (defined($::opt{'full'})) { 3500 $::opt{'level'} = 'full'; 3501 } else { 3502 $::opt{'level'} = 0; 3503 } 3504 } 3505 3506 if (($::opt{'level'} !~ m/^\d+$/) and 3507 ($::opt{'level'} !~ m/^(full|differential|incremental)$/)) { 3508 push(@::errors,"-level must be numeric, or full/differential/incremental"); 3509 } 3510 3511 # Check for digits or change full/diff to level number 3512 # Incremental + fs=all we have to handle later since it might be 3513 # different for each fs 3514 if ($::opt{'level'} =~ m/^\d+$/) { 3515 # Make string variable numeric 3516 $::level = POSIX::strtod($::opt{'level'}); 3517 if (($cfg::type eq 'dump') and ($::level > 9)) { 3518 push(@::errors,"can't use level > 9 and type=dump"); 3519 } 3520 } elsif ($::opt{'level'} eq "full") { 3521 $::level = 0; 3522 } elsif ($::opt{'level'} eq "differential") { 3523 $::level = 1; 3524 } elsif ($::opt{'level'} eq "incremental") { 3525 # If incremental + one fs, we can find the level now. 3526 if (defined($::opt{'dir'})) { 3527 $::level = &get_incremental_level($::opt{'dir'}); 3528 if (($cfg::type eq 'dump') and ($::level > 9)) { 3529 push(@::errors,"can't use level > 9 and type=dump"); 3530 } 3531 } else { 3532 # If we are doing a set have to postpone till later; each 3533 # fs might have a different level... 3534 undef $::level; 3535 $::set_incremental = 1; 3536 } 3537 } 3538 3539 # Package delta option 3540 if (defined($::opt{'pkgdelta'})) { 3541 3542 &checkvar(\$cfg::pkgdelta_archive_list,'pkgdelta_archive_list','true false rootonly','rootonly'); 3543 &checkvar(\$cfg::pkgdelta_archive_unowned,'pkgdelta_archive_unowned','bool','true'); 3544 &checkvar(\$cfg::pkgdelta_archive_changed,'pkgdelta_archive_changed','bool','true'); 3545 3546 if ($::opt{'pkgdelta'} eq 'rpm') { 3547 $::pkgdelta = 'rpm'; 3548 $::path{'rpm'} = &checkinpath('rpm'); 3549 3550 } elsif ($::opt{'pkgdelta'} =~ /freebsd/i) { 3551 $::pkgdelta = 'freebsd'; 3552 $::path{'pkg_info'} = &checkinpath('pkg_info'); 3553 3554 } else { 3555 push(@::errors,"$::opt{pkgdelta} not a valid option for -pkgdelta"); 3556 } 3557 } 3558 3559 # Check toc/rmindex/rmfile flags 3560 if (defined($::opt{'toc'}) or defined($::opt{'rmindex'})) { 3561 if ($cfg::indexes eq "false") { 3562 push(@::errors,"Can't do -toc/rmindex with \$indexes set to false"); 3563 } 3564 } 3565 if (defined($::opt{'rmindex'}) and (${$::opt{'rmindex'}}[0] eq '')) { 3566 push(@::errors,"-rmindex requires 'key:filenum', 'key' or 'all'"); 3567 } 3568 if (defined($::opt{'rmfile'}) and (${$::opt{'rmfile'}}[0] eq '')) { 3569 push(@::errors,"-rmfile requires a filename or 'all'"); 3570 } 3571 3572 # Check log/stamp dirs (only if we are in a 'write' mode) 3573 if ($::mode =~ m/^(set|dir|newtape)$/) { 3574 $::path{$cfg::comp_log} = &checkinpath($cfg::comp_log) if ($cfg::comp_log ne "false"); 3575 $cfg::logdir = &nuke_trailing_slash($cfg::logdir); 3576 $cfg::stampdir = &nuke_trailing_slash($cfg::stampdir); 3577 if ($cfg::logdir !~ m:^/:) { 3578 push(@::errors,"\$logdir must be absolute path: $cfg::logdir"); 3579 } 3580 if ($cfg::stampdir !~ m:^/:) { 3581 push(@::errors,"\$stampdir must be absolute path: $cfg::stampdir"); 3582 } 3583 if (! -d "$cfg::logdir") { 3584 mkdir("$cfg::logdir",0755) or push(@::errors,"Can't mkdir $cfg::logdir: $OS_ERROR"); 3585 } 3586 if (! -w "$cfg::logdir") { 3587 push(@::errors,"Can't write to $cfg::logdir"); 3588 } 3589 if (! -d "$cfg::stampdir") { 3590 mkdir("$cfg::stampdir",0755) or push(@::errors,"Can't mkdir $cfg::stampdir: $OS_ERROR"); 3591 } 3592 if (! -w "$cfg::stampdir") { 3593 push(@::errors,"Can't write to $cfg::stampdir: $OS_ERROR"); 3594 } 3595 } 3596 3597 # Tie index database 3598 if (($::mode !~ m/^(list|extract|restore|compare|test-tape-drive)$/) and 3599 ($cfg::indexes eq "true")) { 3600 tie(%::index,"AnyDBM_File",$cfg::index,O_CREAT|O_RDWR,0640) or 3601 push(@::errors,"Can't tie DB $cfg::index"); 3602 } 3603 3604 # Sanity check some accessory tape flags 3605 if (($::mode =~ m/^(list|extract|restore|compare)$/) and defined($::opt{'erase'})) { 3606 push(@::errors,"-erase can't be used in -$::mode mode"); 3607 } 3608 if (($::mode =~ m/^(set|dir|newtape)$/) and defined($::opt{'num'})) { 3609 push(@::errors,"-num Can't be used in -$::mode mode"); 3610 } 3611 if (defined($::use_file) or defined($::use_blockdevice)) { 3612 if (defined($::opt{'num'})) { 3613 push(@::errors,"Can't use -num unless reading from tape"); 3614 } 3615 if (defined($::opt{'erase'}) or defined($::opt{'rewind'}) or defined($::opt{'reten'})) { 3616 push(@::errors,"Can't use -erase/-rewind/-reten unless using a tape"); 3617 } 3618 } 3619 3620 # Testing 3621 if (defined($::debug)) { 3622 &log('(debug) no backup or mt commands will be executed'); 3623 &log('(debug) no old stamps or old log files will be removed'); 3624 } 3625 3626 # Check extract list 3627 if (defined($::opt{'flist'})) { 3628 if (defined($::opt{'extract'})) { 3629 if (! -r $::opt{'flist'}) { 3630 push(@::errors,"list of files $::opt{flist} not readable: $OS_ERROR"); 3631 } 3632 } else { 3633 push(@::errors,"-flist can only be used with -extract"); 3634 } 3635 } 3636 if (defined($::opt{'onefile'}) and !defined($::opt{'extract'})) { 3637 push(@::errors,"-onefile can only be used with -extract"); 3638 } 3639 3640 # Requirements for testing 3641 if (defined($::opt{'test-tape-drive'})) { 3642 if (defined($::use_file)) { 3643 push(@::errors,"No use trying tape drive tests on directories!"); 3644 } elsif (defined($::use_blockdevice)) { 3645 push(@::errors,"No use trying tape drive tests on block devices!"); 3646 } 3647 $::path{'diff'} = &checkinpath('diff'); 3648 $::path{'tr'} = &checkinpath('tr'); 3649 } 3650 3651 if (@::errors) { 3652 print $::msg "\nErrors:\n"; 3653 while(@::errors) { 3654 print $::msg " " . shift(@::errors) . "\n"; 3655 } 3656 exit(1); 3657 } 3658 3659} 3660 3661###################################################################### 3662# Check buffer, shelltype, and any remote hosts for required programs 3663###################################################################### 3664sub test_before_run { 3665 3666 if ($cfg::buffer ne 'false') { 3667 &test_bufferprog($::buffer_cmd, 'localhost'); 3668 } 3669 3670 &check_shell('localhost'); 3671 3672 &check_remote_progs(\%::remotehosts, \@::remoteprogs); 3673 3674 if (@::errors) { 3675 print $::msg "\nErrors:\n"; 3676 while(@::errors) { 3677 print $::msg " " . shift(@::errors) . "\n"; 3678 } 3679 exit(1); 3680 } 3681 3682} 3683 3684###################################################################### 3685# Print usage summary from the header 3686###################################################################### 3687sub usage { 3688 3689 open(FILE,"$0") or die "Can't open $0: $OS_ERROR"; 3690 while(<FILE>) { 3691 last if (m/^\#\s+USAGE:/); 3692 } 3693 while(<FILE>) { 3694 last if (m/^\#\#\#\#\#\#\#/); 3695 s/^\#//; 3696 print; 3697 } 3698 close(FILE); 3699 3700} 3701 3702###################################################################### 3703# Return version string from CVS tag 3704###################################################################### 3705sub versionstring { 3706 3707 my $ver = ' $Name: v1_2_1 $ '; 3708 $ver =~ s/Name//g; 3709 $ver =~ s/[:\$]//g; 3710 $ver =~ s/\s+//g; 3711 $ver =~ s/^v//g; 3712 $ver =~ s/_/\./g; 3713 if ($ver eq '') { 3714 $ver = "devel"; 3715 } 3716 return($ver . " (http://flexbackup.sourceforge.net)"); 3717 3718} 3719 3720###################################################################### 3721# Return current time in ctime format if normal 3722# in YYYYMMDDHHMM.SS format if 'numeric' is given 3723###################################################################### 3724sub current_time { 3725 3726 my $format = shift(@_); 3727 my $string; 3728 my $current_time = time; 3729 3730 if (defined($format) and ($format eq 'numeric')) { 3731 $string = strftime("%Y%m%d%H%M", localtime($current_time)); 3732 } elsif (defined($format) and ($format eq 'ctime')) { 3733 $string = strftime("%a %b %d %H:%M:%S %Y", localtime($current_time)); 3734 } else { 3735 $string = strftime("%a %b %d %H:%M:%S %Y", localtime($current_time)); 3736 } 3737 3738 return($string); 3739 3740} 3741 3742###################################################################### 3743# Possibly return a filename to use 3744# if running list/extract/compare/restore 3745###################################################################### 3746sub maybe_get_filename { 3747 3748 my @modes = qw(list extract compare restore); 3749 my $arg; 3750 my $file; 3751 my $ftype; 3752 3753 # grab filename from option argument 3754 # optionscheck already guarantees only one is set 3755 foreach my $mode (@modes) { 3756 if (defined($::opt{$mode})) { 3757 $arg = $::opt{$mode}; 3758 } 3759 } 3760 3761 # If reading from stdin 3762 if (defined($::use_pipe)) { 3763 # -pipe and file arg doesn't make sense, yell 3764 if ($arg ne '') { 3765 print STDERR "Error: when using -pipe, don't specify file name.\n"; 3766 die(); 3767 } else { 3768 # Set file to "-" for stdin 3769 return('-'); 3770 } 3771 } 3772 3773 # If the flag given but null, and $device was not set to a dir, just return 3774 if (($arg eq '') and (!defined($::use_file))) { 3775 return($::device); 3776 } 3777 3778 # If the flag given but null, and $device is a dir, spew 3779 if (($arg eq '') and (defined($::use_file))) { 3780 print STDERR "Error: when extracting from a file, you must specify file name.\n"; 3781 print STDERR "(like \"-list file.tar.bz2\")\n"; 3782 die(); 3783 } 3784 3785 # Look for file in current dir first (or full path given) 3786 # Then in $device dir (if conf file set to backup to files) 3787 if (-f "$arg") { 3788 $file = $arg; 3789 $::use_file = 1; 3790 $cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape 3791 undef $::tapedevice; 3792 undef $::remotetapehost; 3793 3794 } elsif (defined($::use_file) and (-f "$cfg::device/$arg")) { 3795 $file = $cfg::device . "/" . $arg; 3796 $cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape 3797 undef $::tapedevice; 3798 undef $::remotetapehost; 3799 3800 } elsif (-d "$arg") { 3801 $file = $arg; 3802 $::use_file = 1; 3803 $cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape 3804 undef $::tapedevice; 3805 undef $::remotetapehost; 3806 3807 } elsif (defined($::use_file) and (-d "$cfg::device/$arg")) { 3808 $file = $cfg::device . "/" . $arg; 3809 $cfg::device = $cfg::tmpdir; # Just so optioncheck doesn't assume tape 3810 undef $::tapedevice; 3811 undef $::remotetapehost; 3812 3813 } else { 3814 if (defined($::use_file)) { 3815 print STDERR "Error: file \"$arg\" or \"$cfg::device/$arg\" not found\n"; 3816 print STDERR "(like \"-list file.tar.bz2\")\n"; 3817 die(); 3818 } else { 3819 die("Error: file \"$arg\" not found"); 3820 } 3821 } 3822 3823 # Try and guess file types and commpression scheme 3824 # might as well since we are reading from a file in this case 3825 if ($file =~ m/\.(dump|cpio|tar|star|pax|a|shar|filelist)\.(gz|bz2|lzo|Z|zip|lzma)$/) { 3826 $cfg::type = $1; 3827 $cfg::compress = $2; 3828 $cfg::type =~ s/^a$/ar/; 3829 $cfg::compress =~ s/gz/gzip/; 3830 $cfg::compress =~ s/bz2/bzip2/; 3831 $cfg::compress =~ s/lzo/lzop/; 3832 $cfg::compress =~ s/Z/compress/; 3833 $cfg::compress =~ s/lzma/lzma/; 3834 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3835 &optioncheck(); # redo to set a few variables over 3836 3837 } elsif ($file =~ m/\.afio-(gz|bz2|lzo|Z|zip|lzma)$/) { 3838 $cfg::type = "afio"; 3839 $cfg::compress = $1; 3840 $cfg::compress =~ s/gz/gzip/; 3841 $cfg::compress =~ s/bz2/bzip2/; 3842 $cfg::compress =~ s/lzo/lzop/; 3843 $cfg::compress =~ s/Z/compress/; 3844 $cfg::compress =~ s/lzma/lzma/; 3845 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3846 &optioncheck(); # redo to set a few variables over 3847 3848 } elsif ($file =~ m/\.(dump|afio|cpio|tar|star|pax|zip|a|shar|lha|filelist)$/) { 3849 $cfg::type = $1; 3850 $cfg::type =~ s/^a$/ar/; 3851 $cfg::compress = "false"; 3852 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3853 &optioncheck(); # redo to set a few variables over 3854 3855 } elsif (-d "$file") { 3856 $cfg::type = "copy"; 3857 $cfg::compress = "false"; 3858 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3859 &optioncheck(); # redo to set a few variables over 3860 3861 } elsif ($file =~ m/\.tgz$/) { 3862 $cfg::type = "tar"; 3863 $cfg::compress = "gzip"; 3864 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3865 &optioncheck(); # redo to set a few variables over 3866 3867 } elsif ($file =~ m/\.tbz2?$/) { 3868 $cfg::type = "tar"; 3869 $cfg::compress = "bzip2"; 3870 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3871 &optioncheck(); # redo to set a few variables over 3872 3873 } elsif ($file =~ m/\.taz$/) { 3874 $cfg::type = "tar"; 3875 $cfg::compress = "compress"; 3876 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3877 &optioncheck(); # redo to set a few variables over 3878 3879 } elsif ($file =~ m/\.rpm$/) { 3880 $cfg::type = "cpio"; 3881 $cfg::compress = "false"; 3882 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3883 &optioncheck(); # redo to set a few variables over 3884 3885 } elsif ($file =~ m/\.deb$/) { 3886 $cfg::type = "ar"; 3887 $cfg::compress = "false"; 3888 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3889 &optioncheck(); # redo to set a few variables over 3890 3891 } elsif ($file =~ m/\.jar$/i) { 3892 $cfg::type = "zip"; 3893 $cfg::compress = "false"; 3894 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3895 &optioncheck(); # redo to set a few variables over 3896 3897 } elsif ($file =~ m/\.lzh$/i) { 3898 $cfg::type = "lha"; 3899 $cfg::compress = "false"; 3900 &log("| Auto-set to type=$cfg::type compress=$cfg::compress"); 3901 &optioncheck(); # redo to set a few variables over 3902 3903 } 3904 3905 return($file); 3906 3907} 3908 3909###################################################################### 3910# Check validity of a config option 3911###################################################################### 3912sub checkvar { 3913 3914 my $ref = shift(@_); # ref to variable 3915 my $varname = shift(@_); # name of variable 3916 my $ok = shift(@_); # list of ok values, "bool", "exists" 3917 my $default = shift(@_); # default to use if not set 3918 my @ok; 3919 my $found = 0; 3920 3921 if (!defined($ok)) { 3922 die("checkvar called incorrectly"); 3923 } 3924 3925 if ($ok eq 'bool') { 3926 @ok = ('true','false'); 3927 } else { 3928 @ok = split(" ",$ok); 3929 } 3930 3931 if (!defined($$ref)) { 3932 if (!defined($::opt{'nodefaults'}) and defined($default)) { 3933 print $::msg " \$$varname not found in config: default=$default\n"; 3934 $$ref = $default; 3935 } else { 3936 push(@::errors,"\$$varname not defined"); 3937 } 3938 } else { 3939 if ($ok[0] ne "exist") { 3940 foreach (@ok) { 3941 if ($_ eq $$ref) { 3942 $found = 1; 3943 } 3944 } 3945 if ($found == 0 ) { 3946 $_ = join(", ",@ok); 3947 push(@::errors,"\$$varname must be one of $_"); 3948 } 3949 } 3950 } 3951 3952} 3953 3954###################################################################### 3955# Check to see if a program is found in $PATH 3956###################################################################### 3957sub checkinpath { 3958 3959 my $file = shift(@_); 3960 3961 if (defined($cfg::path{$file})) { 3962 3963 # Override in config file 3964 3965 if ($cfg::path{$file} =~ m:^/:) { 3966 3967 # Starts with /; full path override 3968 if (-e $cfg::path{$file} && -x _) { 3969 print $::msg "path $file = $cfg::path{$file}\n"; 3970 return "$cfg::path{$file}"; 3971 } else { 3972 push(@::errors,"$cfg::path{$file} not found"); 3973 return(0); 3974 } 3975 3976 } elsif (($cfg::path{$file} =~ m:^\s*sudo\s+-u\s+\S+\s+(\S+):) or 3977 ($cfg::path{$file} =~ m:^\s*sudo\s+(\S+):)) { 3978 3979 # some sort of sudo... 3980 my $prog = $1; 3981 3982 &checkinpath('sudo'); 3983 3984 # sudo with full pathname 3985 if (($prog =~ m:^/:) and (-e $prog) and (-x _)) { 3986 print $::msg "path $file = $cfg::path{$file}\n"; 3987 return "$cfg::path{$file}"; 3988 } 3989 # sudo with just command name 3990 my @path = split(/:/,$ENV{'PATH'}); 3991 foreach my $dir (@path) { 3992 if (-e "${dir}/$prog" && -x _) { 3993 return "$cfg::path{$file}"; 3994 } 3995 } 3996 3997 push(@::errors,"sudo $prog not found in \$PATH"); 3998 return(0); 3999 4000 } else { 4001 4002 # Didn't start with /; just overriding name of command 4003 # search PATH for it 4004 my @path = split(/:/,$ENV{'PATH'}); 4005 foreach my $dir (@path) { 4006 if (-e "${dir}/$cfg::path{$file}" && -x _) { 4007 return "$cfg::path{$file}"; 4008 } 4009 } 4010 4011 push(@::errors,"$cfg::path{$file} not found in \$PATH"); 4012 return(0); 4013 4014 } 4015 4016 } else { 4017 4018 # Not spec'ed as an override in config file; search PATH 4019 my @path = split(/:/,$ENV{'PATH'}); 4020 foreach my $dir (@path) { 4021 if (-e "${dir}/$file" && -x _) { 4022 return "$file"; 4023 } 4024 } 4025 4026 push(@::errors,"$file not found in \$PATH"); 4027 return(0); 4028 } 4029 4030} 4031 4032###################################################################### 4033# Run a command, or echo it depending on the -n flag 4034# Then show tape drive position 4035###################################################################### 4036sub run_or_echo_then_query { 4037 4038 my $cmd = shift(@_); 4039 4040 &split_and_echo($cmd); 4041 &line(); 4042 4043 if (!defined($::debug)) { 4044 system("($cmd) 2>&1 | $::path{tee} -a $::log"); 4045 } else { 4046 &log("(debug) command output would be here"); 4047 } 4048 4049 if (!defined($::use_file)) { 4050 &line(); 4051 &mt('generic-query'); 4052 } 4053 4054 &line(); 4055 4056 # Maybe rewind (usually false for reads) 4057 if (($::do_rewind_after == 1) and !defined($::use_file)) { 4058 &log("| Rewinding..."); 4059 &mt('rewind'); 4060 &line(); 4061 } 4062 4063} 4064 4065###################################################################### 4066# Return a command possibly wrapped in ssh/rsh 4067###################################################################### 4068sub maybe_remote_cmd { 4069 4070 my $cmd = shift(@_); 4071 my $host = shift(@_); 4072 my $quote = shift(@_); 4073 my $is_pipeline = 0; 4074 4075 if (!defined($quote)) { 4076 $quote = "'"; 4077 } 4078 4079 if ($cmd =~ m:\s+(\||&&)\s+:) { 4080 $is_pipeline = 1; 4081 } 4082 4083 if (defined($host) and ($host ne '')) { 4084 4085 # If remote shell is smart enough use pipeline exit detectors 4086 if (($is_pipeline == 1) and ($::shelltype{$host} eq 'bash2')) { 4087 $cmd = "$::remoteshell $host " . $quote . $cmd . $::bash_pipe_exit . $quote; 4088 } elsif (($is_pipeline == 1) and ($::shelltype{$host} eq 'zsh')) { 4089 $cmd = "$::remoteshell $host " . $quote . $cmd . $::zsh_pipe_exit . $quote; 4090 } else { 4091 $cmd = "$::remoteshell $host " . $quote . $cmd . $quote; 4092 } 4093 4094 } else { 4095 $cmd = "$cmd"; 4096 } 4097 return($cmd); 4098 4099} 4100 4101###################################################################### 4102# Append to the pipelins string appropriate commands to write archive 4103###################################################################### 4104sub append_writer_cmd { 4105 4106 my $cmd = shift(@_); 4107 my $dev = shift(@_); 4108 4109 # Possibly override device 4110 if (!defined($dev)) { 4111 $dev = $::device; 4112 } 4113 4114 if (defined($::use_pipe)) { 4115 4116 $cmd .= $::buffer_cmd; 4117 4118 } elsif (!defined($::remotetapehost)) { 4119 4120 $cmd .= " | " . $::write_cmd . '"' . $dev . '"' ; 4121 4122 } else { 4123 4124 $cmd .= "$::buffer_cmd | "; 4125 $cmd .= &maybe_remote_cmd($::write_cmd . '"' . $dev . '"', $::remotetapehost); 4126 } 4127 4128 return($cmd); 4129} 4130 4131###################################################################### 4132# Stuff to do before list/restore/extract/compare 4133# return command to get archive on stdout 4134###################################################################### 4135sub setup_before_read { 4136 4137 my $op = shift(@_); 4138 my $cmd; 4139 4140 &line(); 4141 4142 if (($cfg::staticlogs eq 'false') and ($cfg::staticfiles eq 'false')) { 4143 $::log = "flexbackup.$op." . ¤t_time('numeric') . ".log"; 4144 } else { 4145 $::log = "flexbackup.$op.log"; 4146 } 4147 4148 if (! open(LOG,">$::log")) { 4149 $::log = "$cfg::tmpdir/$::log"; 4150 if (! open(LOG,">$::log")) { 4151 die "Can't write to $::log: $OS_ERROR"; 4152 } 4153 } 4154 close(LOG); 4155 4156 &log("| Logging output to \"$::log\""); 4157 4158 $::device = &maybe_get_filename(); 4159 4160 &mt("generic-blocksize $::mt_blksize"); 4161 4162 # Maybe retension 4163 if (($::do_reten == 1) and !defined($::use_file)) { 4164 &log('| Retensioning tape...'); 4165 &mt('retension'); 4166 } 4167 4168 if (defined($::opt{'num'})) { 4169 &log("| Positioning tape at file number $::opt{num}"); 4170 &mt("rewind","fsf $::opt{num}"); 4171 } else { 4172 if (defined($::use_pipe)) { 4173 &log("| Reading from stdin (type=$cfg::type compress=$cfg::compress)"); 4174 } elsif (defined($::use_file)) { 4175 &log("| Reading from on-disk file $::device"); 4176 } elsif (defined($::use_blockdevice)) { 4177 &log("| Reading from block device $::device"); 4178 } else { 4179 &log("| Reading from CURRENT TAPE POSITION"); 4180 } 4181 } 4182 4183 &line(); 4184 4185 if (!defined($::use_file)) { 4186 &mt('generic-query'); 4187 &line(); 4188 } 4189 4190 $cmd = &read_function($::device); 4191 4192 if (defined($::remotetapehost)) { 4193 $cmd = &maybe_remote_cmd($cmd, $::remotetapehost); 4194 # Buffer both sides if remote 4195 $cmd .= $::buffer_cmd; 4196 } 4197 4198 $cmd .= " | $::unz "; 4199 4200 if ($::device =~ m/\.rpm$/) { 4201 $cmd .= "rpm2cpio | "; 4202 } 4203 4204 $cmd =~ s/\s+/ /g; 4205 4206 return($cmd); 4207 4208} 4209 4210###################################################################### 4211# Read from file/device - in future buffer cmds might need a blocking 4212# dd read ahead of them 4213###################################################################### 4214sub read_function { 4215 4216 my $file = shift(@_); 4217 my $cmd; 4218 4219 # If reading from stdin arg is '-' 4220 if ($file eq '-') { 4221 4222 $cmd = $::buffer_cmd; 4223 $cmd =~ s/^\s*\|\s*//; # Nuke leading " | " we normally use 4224 4225 } else { 4226 4227 $cmd = $::read_cmd . '"' . $file . '"'; 4228 4229 } 4230 4231 return($cmd); 4232 4233} 4234 4235###################################################################### 4236# Get rid of trailing slash on path or host:/path specs 4237###################################################################### 4238sub nuke_trailing_slash { 4239 4240 my $spec = shift(@_); 4241 my $host; 4242 my $path; 4243 4244 if ($spec =~ s/(\S+:)//) { 4245 $host = $1; 4246 $path = $spec; 4247 } else { 4248 $host = ''; 4249 $path = $spec; 4250 } 4251 4252 if ($path ne "/") { 4253 $path =~ s%/$%%; 4254 } 4255 4256 return($host . $path); 4257 4258} 4259 4260###################################################################### 4261# Print the volume label from an afio control file 4262###################################################################### 4263sub print_afio_volume_header { 4264 # for now just echo our stdin 4265 print STDOUT "\n"; 4266 while(<STDIN>) { 4267 print; 4268 } 4269 exit(0); 4270} 4271 4272###################################################################### 4273# Figure out which of rewind/erase/reten we are going to assume 4274###################################################################### 4275sub set_tape_operation_defaults { 4276 4277 # Assume stuff based on how we are called first 4278 if (defined($::opt{'set'})) { 4279 if (!defined($::set_incremental) and 4280 ($::level == 0) and 4281 !defined($::use_file)) { 4282 # Set level zero, using device. Retension & erase a new tape 4283 # (config file may tell us not to erase) 4284 if ($cfg::erase_tape_set_level_zero eq "true") { 4285 $::do_reten = 1; 4286 $::do_erase = 1; 4287 } else { 4288 $::do_reten = 0; 4289 $::do_erase = 0; 4290 } 4291 $::do_rewind_after = 1; 4292 } else { 4293 # Using files, set incremental backup, or set non-zero 4294 # don't erase + go to end of tape 4295 $::do_reten = 0; 4296 $::do_erase = 0; 4297 $::do_rewind_after = 1; 4298 } 4299 } elsif (defined($::opt{'dir'})) { 4300 # Just one filesystem - assume we append to tape 4301 $::do_reten = 0; 4302 $::do_erase = 0; 4303 $::do_rewind_after = 1; 4304 } else { 4305 # We're doing a read of some sort 4306 $::do_reten = 0; 4307 $::do_erase = 0; # -erase has no effect anyway here 4308 $::do_rewind_after = 0; 4309 } 4310 4311 # Then see if commandline flags override anything 4312 if (defined($::opt{'reten'})) { 4313 $::do_reten = $::opt{'reten'}; 4314 } 4315 if (defined($::opt{'erase'})) { 4316 $::do_erase = $::opt{'erase'}; 4317 } 4318 if (defined($::opt{'rewind'})) { 4319 $::do_rewind_after = $::opt{'rewind'}; 4320 } 4321} 4322 4323###################################################################### 4324# Split long lines for echoing 4325###################################################################### 4326sub split_and_echo { 4327 4328 my $string = shift(@_); 4329 my $initial_tab; 4330 my $subsequent_tab; 4331 4332 local($Text::Wrap::columns) = 76; 4333 4334 # Older perl's don't have this var. Use twice to shut up 4335 # -w in that case. Output almost the same... 4336 local($Text::Wrap::separator) = " \\\n"; 4337 local($Text::Wrap::separator) = " \\\n"; 4338 4339 # This make it easier to cut-n-paste for debugging commands manually 4340 if (defined($::debug)) { 4341 $initial_tab = " "; 4342 $subsequent_tab = " "; 4343 } else { 4344 $initial_tab = "| "; 4345 $subsequent_tab = "| "; 4346 } 4347 4348 my @lines = wrap($initial_tab, $subsequent_tab, ($string)); 4349 foreach (@lines) { 4350 &log($_); 4351 } 4352 4353} 4354 4355###################################################################### 4356# Create new tape "key" and return it (YYYYMMDDHHMMSS) 4357# Also sets ::nextfile 4358###################################################################### 4359sub new_tape_key { 4360 4361 my $key; 4362 my $dev = $cfg::device; 4363 my $old; 4364 my $string; 4365 4366 return('') if $cfg::indexes eq "false"; 4367 4368 $key = ¤t_time('numeric'); 4369 4370 # If writing to a file see if there is already an index key and use it 4371 if (defined($::use_file)) { 4372 $dev .= "/$cfg::keyfile"; 4373 if (-r $dev) { 4374 open(KEY,$dev) or die("Can't open existing key $dev: $OS_ERROR"); 4375 chomp($key = <KEY>); 4376 close(KEY); 4377 4378 &log("| Directory's existing key is $key"); 4379 4380 # Make sure keyfile entry is there 4381 if (!defined($::index{"$key|$cfg::keyfile"})) { 4382 my $label = "<index keyfile, dir=$cfg::device>"; 4383 if (defined($::debug)) { 4384 &log("(debug) \$::index{$key|$cfg::keyfile} = $label"); 4385 } else { 4386 $::index{"$key|$cfg::keyfile"} = $label; 4387 } 4388 } 4389 4390 # Figure out the existing files 4391 foreach (sort keys %::index) { 4392 my ($tape,$filenum) = split(/\|/,$_); 4393 if ($tape eq $key) { 4394 $::nextfile = $filenum; 4395 } 4396 } 4397 # Set for the next file 4398 $::nextfile++; 4399 return($key); 4400 } 4401 } 4402 4403 &log("| Creating index key $key"); 4404 $string = "$::path{printf} \'$key\\nThis is a flexbackup index key\\n\' "; 4405 $string = &append_writer_cmd($string, $dev); 4406 if (defined($::debug)) { 4407 &log("(debug) $string"); 4408 } else { 4409 `$string 2> /dev/null`; 4410 } 4411 4412 $::nextfile = 1; 4413 4414 if (defined($::use_file)) { 4415 my $label = "<index keyfile, dir=$cfg::device>"; 4416 if (defined($::debug)) { 4417 &log("(debug) \$::index{$key|$cfg::keyfile} = $label"); 4418 } else { 4419 $::index{"$key|$cfg::keyfile"} = $label; 4420 } 4421 } else { 4422 my $label = "<tape index key>"; 4423 if (defined($::debug)) { 4424 &log("(debug) \$::index{$key|0} = $label"); 4425 } else { 4426 $::index{"$key|0"} = $label; 4427 } 4428 } 4429 4430 # So that we won't generate duplicate keys... 4431 # (as long as two processes with -newtape aren't run in parallel) 4432 sleep(1); 4433 4434 return($key); 4435} 4436 4437###################################################################### 4438# Get existing index key 4439# Also sets ::nextfile 4440###################################################################### 4441sub get_tape_key { 4442 4443 my $quiet = shift(@_); 4444 my $key; 4445 4446 return('') if $cfg::indexes eq "false"; 4447 4448 # If writing to a file see if there is already an index key and use it 4449 if (defined($::use_file)) { 4450 my $dev = "$cfg::device/$cfg::keyfile"; 4451 if (-r $dev) { 4452 open(KEY,$dev) or die("Can't open existing key $dev: $OS_ERROR"); 4453 chomp($key = <KEY>); 4454 close(KEY); 4455 } else { 4456 return(&new_tape_key()); 4457 } 4458 4459 } else { 4460 4461 my $string = "$::path{dd} $::dd_blk_flag $::dd_write_pad_flag count=1 if=$::device"; 4462 if (defined($::remotetapehost)) { 4463 $string = &maybe_remote_cmd($string, $::remotetapehost); 4464 } 4465 4466 if (defined($::debug)) { 4467 &log("(debug) $string"); 4468 $key = ''; 4469 } else { 4470 $key = `$string 2> /dev/null`; 4471 @_ = split(/\n/,$key); 4472 $key = $_[0]; 4473 } 4474 4475 if (defined($key)) { 4476 chomp($key); 4477 if ($key !~ m/^\d+$/) { 4478 if (!defined($quiet)) { 4479 &log("| ERROR: Tape doesn't have an index! (use -newtape?)"); 4480 } 4481 $::nextfile = 0; 4482 return(''); 4483 } 4484 } else { 4485 if (!defined($quiet)) { 4486 &log("| ERROR: Tape doesn't have an index! (use -newtape?)"); 4487 } 4488 $::nextfile = 0; 4489 return(''); 4490 } 4491 4492 } 4493 4494 # Find the number of existing files 4495 $::nextfile = 0; 4496 4497 unless (defined($::use_file)) { 4498 foreach (sort keys %::index) { 4499 my ($tape,$filenum) = split(/\|/,$_); 4500 if ($tape eq $key) { 4501 if ($filenum > $::nextfile) { 4502 $::nextfile = $filenum; 4503 } 4504 } 4505 } 4506 # Set for the next file 4507 $::nextfile++; 4508 &log("| Found index key $key, next file is $::nextfile"); 4509 } else { 4510 &log("| Found directory index key $key"); 4511 } 4512 4513 return($key); 4514 4515} 4516 4517###################################################################### 4518# Print table of contents 4519# Can give a specific key as argument 4520# Or uses command flag (specific key, current tape/dir, or "all") 4521###################################################################### 4522sub toc_routine { 4523 4524 my $arg = shift(@_); 4525 my %desired_keys; 4526 my $tape; 4527 my $desired; 4528 my $label; 4529 my $dir; 4530 my $file; 4531 my %tape_files; 4532 my %disk_files; 4533 4534 return if $cfg::indexes eq "false"; 4535 4536 if (defined($arg)) { 4537 4538 # Print toc for current tape if given argument 4539 $desired_keys{$arg} = 1; 4540 4541 } elsif ($::opt{'toc'} =~ m/^\d+$/) { 4542 4543 # Print toc for a specific tape 4544 &log("| Listing specific index"); 4545 $desired_keys{"$::opt{toc}"} = 1; 4546 &line(); 4547 4548 } elsif ($::opt{'toc'} eq '') { 4549 4550 # Print toc for current tape/device 4551 &mt('rewind'); 4552 my $key = &get_tape_key(); 4553 &mt('rewind'); 4554 if ($key ne '') { 4555 $desired_keys{$key} = 1; 4556 } 4557 &line(); 4558 4559 } elsif ($::opt{'toc'} eq "all") { 4560 4561 # Print everything we know about 4562 &log("| Listing all in database"); 4563 foreach (keys %::index) { 4564 ($tape,$file) = split(/\|/,$_); 4565 $desired_keys{$tape} = 1; 4566 } 4567 &line(); 4568 4569 } else { 4570 die("Invalid key spec $::opt{toc}"); 4571 } 4572 4573 # Go through the index and fill hashes 4574 foreach my $key (keys %::index) { 4575 ($tape,$file) = split(/\|/,$key); 4576 if ($file =~ m/^\d+$/) { 4577 $tape_files{$tape}{$file} = $::index{$key}; 4578 } else { 4579 $disk_files{$tape}{$file} = $::index{$key}; 4580 } 4581 } 4582 4583 # Print the toc of each tape in our desired list 4584 foreach $desired (sort bynumber keys %desired_keys) { 4585 4586 my $found = 0; 4587 my $length = 45; 4588 4589 foreach $tape (sort bynumber keys %tape_files) { 4590 if ($tape eq $desired) { 4591 $found = 1; 4592 &log(''); 4593 &log("File Contents (tape index $tape)"); 4594 &log("-" x $length); 4595 foreach $file (sort bynumber keys %{$tape_files{$tape}}) { 4596 $_ = sprintf("%-04s",$file); 4597 &log($_ . " " . $tape_files{$tape}{$file}); 4598 } 4599 } 4600 } 4601 4602 foreach $dir (sort bynumber keys %disk_files) { 4603 if ($dir eq $desired) { 4604 my @array; 4605 $found = 1; 4606 foreach $file (sort keys %{$disk_files{$dir}}) { 4607 if ((! -e "$cfg::device/$file") and 4608 (!defined($::opt{'toc'}) or ($::opt{'toc'} eq ''))) { 4609 &log("| Bogus index entry - $file does not exist"); 4610 &rmindex("$dir:$file"); 4611 delete $disk_files{$dir}{$file}; 4612 } 4613 } 4614 &log(''); 4615 &log("File Contents (dir index $dir)"); 4616 &log("-" x $length); 4617 foreach $file (keys %{$disk_files{$dir}}) { 4618 push(@array, $file . " " . $disk_files{$dir}{$file}); 4619 } 4620 foreach (sort byfilename @array) { 4621 &log($_); 4622 } 4623 } 4624 } 4625 4626 if ($found == 0) { 4627 &log("Key $desired not found in index"); 4628 } 4629 4630 &log(''); 4631 4632 } 4633 4634} 4635 4636###################################################################### 4637# Nuke stuff from DB 4638###################################################################### 4639sub rmindex { 4640 4641 my $arg = shift(@_); 4642 my $key; 4643 my $tape; 4644 my $filenum; 4645 my $file; 4646 my $found = 0; 4647 4648 return if $cfg::indexes eq "false"; 4649 4650 # Figure out if we delete all for one tape, single entry for one tape, 4651 # or the entire db 4652 if ($arg =~ m/^(\d+)(:all)?$/) { 4653 $key = $1; 4654 } elsif ($arg =~ m/^(\d+):(.+)$/) { 4655 $key = $1; 4656 $file = $2; 4657 } elsif ($arg eq "all") { 4658 &log("| Removing all in database!!!"); 4659 &log("| Hit CTRL-C to abort within 5 seconds.."); 4660 &line(); 4661 sleep(5); 4662 foreach (keys %::index) { 4663 delete $::index{$_}; 4664 } 4665 return; 4666 } else { 4667 die("Invalid key or key:fileno spec $arg"); 4668 } 4669 4670 4671 if ($key =~ m/^\d+$/) { 4672 4673 # This section deletes a whole index record, or maybe just 4674 # individual file records 4675 foreach (sort keys %::index) { 4676 ($tape,$filenum) = split(/\|/,$_); 4677 4678 if (defined($file)) { 4679 # One file entry 4680 if (($tape eq $key) 4681 and 4682 (defined($::use_file) or ($filenum != 0)) 4683 and 4684 ($filenum eq $file)) { 4685 &log("| Deleting record for $tape file $filenum"); 4686 $found++; 4687 if (defined($::debug)) { 4688 &log("(debug) delete \$::index{$tape|$filenum}"); 4689 } else { 4690 delete $::index{"$tape|$filenum"}; 4691 } 4692 } 4693 4694 } else { 4695 4696 # Whole tape/dir entry 4697 if ($tape eq $key) { 4698 &log("| Deleting record for $tape file $filenum"); 4699 $found++; 4700 if (defined($::debug)) { 4701 &log("(debug) delete \$::index{$tape|$filenum}"); 4702 } else { 4703 delete $::index{"$tape|$filenum"}; 4704 } 4705 } 4706 } 4707 } 4708 4709 if ($found eq 0) { 4710 &log("| Record for $arg not found"); 4711 } 4712 4713 &line(); 4714 return; 4715 } 4716} 4717 4718###################################################################### 4719# Nuke file from on disk, and stuff from DB 4720###################################################################### 4721sub rmfile { 4722 4723 my $key; 4724 my $tape; 4725 my $filenum; 4726 4727 return if !defined($::use_file); 4728 4729 $key = &get_tape_key('quiet'); 4730 4731 foreach my $arg (@{$::opt{'rmfile'}}) { 4732 4733 my $file = "$cfg::device/$arg"; 4734 4735 if ($arg eq 'all') { 4736 # Nuke all files in this dir 4737 opendir(DIR,$cfg::device) or die ("Can't open dir $cfg::device: $OS_ERROR"); 4738 foreach my $f (readdir(DIR)) { 4739 next if ($f =~ m:^\.\.?$:); 4740 #next if ($f =~ m%^$cfg::keyfile$%); 4741 if ( -f "$cfg::device/$f") { 4742 &log("| Erasing archive $f"); 4743 unlink("$cfg::device/$f") or die ("Can't rm $cfg::device/$f: $OS_ERROR"); 4744 } 4745 if ( -d "$cfg::device/$f") { 4746 &log("| Erasing directory $f"); 4747 system("rm -rf $cfg::device/$f") and die ("Can't rm $cfg::device/$f: $OS_ERROR"); 4748 } 4749 } 4750 closedir(DIR); 4751 # Nuke all db entries for this key 4752 if ($key ne '') { 4753 &rmindex("$key:all"); 4754 } 4755 } elsif (-f $file) { 4756 &log("| Deleting file $file"); 4757 unlink($file) or die ("Can't rm $file: $OS_ERROR"); 4758 if ($key ne '') { 4759 # Nuke db entry for this file 4760 &rmindex("$key:$arg"); 4761 } 4762 } elsif (-d $file) { 4763 &log("| Deleting directory $file"); 4764 system("rm -rf $file") and die ("Can't rm $file: $OS_ERROR"); 4765 if ($key ne '') { 4766 # Nuke db entry for this file 4767 &rmindex("$key:$arg"); 4768 } 4769 } else { 4770 warn("Error: $file doesn't exist"); 4771 } 4772 } 4773} 4774 4775###################################################################### 4776# Remove index records for a tape we are about to erase 4777###################################################################### 4778sub maybe_delete_old_index { 4779 4780 my $key; 4781 4782 return if $cfg::indexes eq "false"; 4783 4784 return if (defined($::use_file)); 4785 4786 $key = &get_tape_key('quiet'); 4787 if ($key ne '') { 4788 &rmindex("$key:all"); 4789 } 4790 4791} 4792 4793###################################################################### 4794# Sort by number 4795###################################################################### 4796sub bynumber { 4797 $a <=> $b; 4798} 4799 4800 4801###################################################################### 4802# Sort by archive filename 4803###################################################################### 4804sub byfilename { 4805 4806 return 0 if ($a =~ m/^$cfg::keyfile/); 4807 return 1 if ($b =~ m/^$cfg::keyfile/); 4808 4809 my $alabel; 4810 my $alevel; 4811 my $blabel; 4812 my $blevel; 4813 4814 if ($a =~ m/^(.+?)\.(\d+)(\.(\d+))?\./) { 4815 $alabel = $1; 4816 $alevel = $2; 4817 if ($b =~ m/^(.+?)\.(\d+)(\.(\d+))?\./) { 4818 $blabel = $1; 4819 $blevel = $2; 4820 4821 if ($alabel eq $blabel) { 4822 return($alevel <=> $blevel); 4823 } 4824 } 4825 } 4826 4827 return($a cmp $b); 4828} 4829 4830 4831###################################################################### 4832# Figure out numeric level for '-level incremental', for a certain fs. 4833# Try to find last the stamp file, then add one to the level 4834###################################################################### 4835sub get_incremental_level { 4836 4837 my $fs = shift(@_); 4838 4839 my $label = &get_label($fs); 4840 my $highestlevel = 0; 4841 4842 opendir(DIR,"$cfg::stampdir") or die("Can't open $cfg::stampdir: $OS_ERROR"); 4843 foreach my $file (readdir(DIR)) { 4844 next if ($file !~ m/^$cfg::sprefix$label\.(\d+)$/); 4845 if ($1 > $highestlevel) { 4846 $highestlevel = $1; 4847 } 4848 } 4849 close(DIR); 4850 4851 $highestlevel++; 4852 4853 return($highestlevel); 4854 4855} 4856 4857###################################################################### 4858# Common commands to invoke 'find' & get a desired file list on stdout 4859###################################################################### 4860sub file_list_cmd { 4861 4862 my $dir = shift(@_); 4863 my $timestampfile = shift(@_); 4864 my $separator = shift(@_); 4865 my $level = shift(@_); 4866 my $remote = shift(@_); 4867 my $otherarg = shift(@_); 4868 4869 if (!defined($separator) or ($separator !~ m/^(null|newline)$/)) { 4870 $separator = 'null'; 4871 } 4872 4873 my $cmd = ''; 4874 # FreeBSD wants -E to enable extended regex 4875 if ($::uname =~ /FreeBSD/) { 4876 $cmd .= "$::path{find} -E . "; 4877 } else { 4878 $cmd .= "$::path{find} . "; 4879 } 4880 4881 my $prunekey; 4882 if (defined($remote)) { 4883 $prunekey = "$remote:$dir"; 4884 } else { 4885 $prunekey = $dir; 4886 } 4887 if (defined($prune{$prunekey})) { 4888 my $rex; 4889 # FreeBSD needs -E (above) and no backslashes around the (|) chars 4890 if ($::uname =~ /FreeBSD/) { 4891 $rex = '"\./('; 4892 $rex .= join('|', keys %{$::prune{$prunekey}}); 4893 $rex .= ')"'; 4894 } else { 4895 $rex = '"\./\('; 4896 $rex .= join('\|', keys %{$::prune{$prunekey}}); 4897 $rex .= '\)"'; 4898 } 4899 # Show what the darn thing is constructing for prune expressions. 4900 (my $temp = $rex) =~ s/\\([()|])/$1/g; 4901 &log("| \"find\" regex for pruning (shell escaping omitted for clarity) is:"); 4902 &log("| $temp"); 4903 $cmd .= '-regex ' . $rex . ' -prune -o '; 4904 } else { 4905 # Show what the darn thing is constructing for prune expressions. 4906 &log("| No pruning defined for this tree."); 4907 # Can't use find -depth with -prune (see single unix spec etc) 4908 # (not toally required anyway, only if you are archiving dirs you 4909 # don't have permissions on and are running as non-root) 4910 $cmd .= "-depth "; 4911 } 4912 &line(); 4913 4914 $cmd .= "$::mountpoint_flag "; 4915 $cmd .= "! -type s "; 4916 4917 if (defined($otherarg)) { 4918 $cmd .= $otherarg . " "; 4919 } 4920 4921 if ($level != 0) { 4922 4923 # If local, we can use the flexbackup timetamp native and ctime 4924 # checks can be used. Remote, we'll be creating stamp with "touch 4925 # -t"... but ctime can't be touched backwards. Turn it off. 4926 # 4927 # If atime preserve is set, can't use ctime checks anyway since 4928 # preserving atime changes the ctime. 4929 4930 if (($cfg::atime_preserve eq 'false') and !defined($remote)) { 4931 $cmd .= '\( '; 4932 } 4933 4934 $cmd .= "-newer \"$timestampfile\" "; 4935 4936 if (($cfg::atime_preserve eq 'false') and !defined($remote)) { 4937 $cmd .= "-or -cnewer \"$timestampfile\" " . '\) '; 4938 } 4939 } 4940 4941 $cmd .= "$::exclude_expr "; 4942 4943 if (!defined($::pkgdelta)) { 4944 if ($separator eq 'newline') { 4945 $cmd .= "-print "; 4946 } else { 4947 $cmd .= "-print0 "; 4948 } 4949 4950 } else { 4951 4952 # Use the normal level & timestamp mechanism to get a list of files 4953 # Then only keep unowned or owned+changed files 4954 4955 my $host; 4956 my $find = &maybe_remote_cmd("cd \"$dir\"; $cmd -print", $remote); 4957 my $write = "> $::pkgdelta_filelist"; 4958 if(defined($remote)) { 4959 &log("| Listing level $level to-be-archived files for $remote:$dir"); 4960 $write = &maybe_remote_cmd("$::path{cat} $write", $remote); 4961 $write = "| $write"; 4962 $host = $remote; 4963 } else { 4964 &log("| Listing level $level to-be-archived files for $dir"); 4965 $host = 'localhost'; 4966 } 4967 &log("| Finding subset of files based on packaging system delta"); 4968 if (!defined($::debug)) { 4969 open(LIST,"$find |") || die; 4970 open(NEWLIST,"$write") || die; 4971 while(<LIST>) { 4972 4973 my $key; 4974 my $archive = 0; 4975 chomp(my $file = $_); 4976 4977 # Strip leading ./ 4978 $file =~ s:^\./::g; 4979 4980 # Don't care about the backup dir itself 4981 next if ($file eq '.'); 4982 4983 if ($dir eq '/') { 4984 $key = "/$file"; 4985 } else { 4986 $key = "$dir/$file"; 4987 } 4988 4989 if (($cfg::pkgdelta_archive_unowned eq 'true') and 4990 !defined($::packaged{$host}{$key})) { 4991 $archive = 1; 4992 } 4993 4994 if (($cfg::pkgdelta_archive_changed eq 'true') and 4995 defined($::changed{$host}{$key})) { 4996 $archive = 1; 4997 } 4998 4999 if ($archive == 1) { 5000 if ($separator eq 'null') { 5001 print NEWLIST "./$file\0"; 5002 } else { 5003 print NEWLIST "./$file\n"; 5004 } 5005 } 5006 5007 } 5008 close(LIST); 5009 close(NEWLIST); 5010 } 5011 5012 &line(); 5013 5014 $cmd = "$::path{cat} $::pkgdelta_filelist "; 5015 } 5016 5017 return($cmd); 5018 5019} 5020 5021###################################################################### 5022# List installed packages, fills %package_list hash 5023###################################################################### 5024sub list_packages { 5025 5026 my $host = shift (@_); 5027 my $cnt = 0; 5028 5029 if ($::pkgdelta eq 'rpm') { 5030 5031 my $cmd = "$::path{rpm} -q -a --queryformat '%{name}-%{version}-%{release}.%{arch}.rpm\\n'"; 5032 5033 if ($host ne 'localhost') { 5034 &log("| Identifying all RPM packages on host $host..."); 5035 $cmd = &maybe_remote_cmd($cmd, $host); 5036 } else { 5037 &log("| Identifying all RPM packages..."); 5038 } 5039 if (defined($::debug)) { 5040 &log("(debug) $cmd"); 5041 } else { 5042 open(LIST,"$cmd |") || die; 5043 while(<LIST>) { 5044 if (m:^(.*)$:) { 5045 $::package_list{$host}{$1} = 1; 5046 if (&POSIX::isatty($::msg)) { 5047 print $::msg &spinner(++$cnt) . "\r"; 5048 } 5049 } 5050 } 5051 close(LIST); 5052 } 5053 5054 } elsif ($::pkgdelta eq 'freebsd') { 5055 5056 my $cmd = "$::path{pkg_info}"; 5057 5058 if ($host ne 'localhost') { 5059 &log("| Identifying all FreeBSD packages on host $host..."); 5060 $cmd = &maybe_remote_cmd($cmd, $host); 5061 } else { 5062 &log("| Identifying all FreeBSD packages..."); 5063 } 5064 if (defined($::debug)) { 5065 &log("(debug) $cmd"); 5066 } else { 5067 my (@junk, $pkg); 5068 open(LIST,"$cmd |") || die; 5069 while(<LIST>) { 5070 if (&POSIX::isatty($::msg)) { 5071 print $::msg &spinner(++$cnt) . "\r"; 5072 } 5073 ($pkg, @junk) = split (/\s+/, $_); 5074 $::package_list{$host}{$pkg} = 1; 5075 } 5076 close(LIST); 5077 } 5078 5079 } 5080 5081} 5082 5083###################################################################### 5084# Fill %packaged with a list of files on host owned by packages 5085###################################################################### 5086sub find_packaged_files { 5087 5088 my $host = shift (@_); 5089 my $cnt = 0; 5090 5091 return if ($cfg::pkgdelta_archive_unowned eq 'false'); 5092 5093 if ($::pkgdelta eq 'rpm') { 5094 5095 my $cmd = "$::path{rpm} -q -a -l"; 5096 5097 if ($host ne 'localhost') { 5098 &log("| Finding all files owned by RPM packages on host $host..."); 5099 $cmd = &maybe_remote_cmd($cmd, $host); 5100 } else { 5101 &log("| Finding all files owned by RPM packages..."); 5102 } 5103 if (defined($::debug)) { 5104 &log("(debug) $cmd"); 5105 } else { 5106 open(LIST,"$cmd |") || die; 5107 while(<LIST>) { 5108 if (m:^(/.*)$:) { 5109 $::packaged{$host}{$1} = 1; 5110 if (&POSIX::isatty($::msg)) { 5111 print $::msg &spinner(++$cnt) . "\r"; 5112 } 5113 } 5114 } 5115 close(LIST); 5116 } 5117 5118 } elsif ($::pkgdelta eq 'freebsd') { 5119 5120 my $cmd = "$::path{pkg_info} -f -q -a"; 5121 my ($fullpath, $localbase, $alt_localbase); 5122 $localbase = '/usr/local'; 5123 $alt_localbase = ''; 5124 $fullpath = ''; 5125 5126 if ($host ne 'localhost') { 5127 &log("| Finding all files owned by FreeBSD packages on host $host..."); 5128 $cmd = &maybe_remote_cmd($cmd, $host); 5129 } else { 5130 &log("| Finding all files owned by FreeBSD packages..."); 5131 } 5132 if (defined($::debug)) { 5133 &log("(debug) $cmd"); 5134 } else { 5135 open(LIST,"$cmd 2> /dev/null |") || die; 5136 while(<LIST>) { 5137 # If it starts with '@' then it's a pkg directive, 5138 # else it's a (relative) path 5139 # 5140 if (/^\@/) { 5141 if (/\@cwd\s+(\S+)/) { 5142 my ($name, $path, $suffix); 5143 5144 $localbase = $1; 5145 $alt_localbase = ''; 5146 ($name,$path,$suffix) = fileparse($localbase,'\.\S+'); 5147 $path =~ s/\/$//; 5148 # In some (default) situations there are some packages which are 5149 # installed relative to a PREFIX which is actually a link in the / 5150 # filesystem. The following hack gets around that and creates an 5151 # entry in $packaged twice--once for the full path that would be seen via 5152 # pkg_info -L and one for the "unlinked" version. In this manner 5153 # no matter which FS is being dumped, the code to filter out 5154 # packaged files will always work. 5155 # 5156 if (-l $path) { 5157 my $link; 5158 $link = readlink ($path); 5159 $link = '/' . $link . '/' . $name; 5160 $alt_localbase = $link; 5161 } 5162 } 5163 if (/\@dirrm\s+(\S+)/) { 5164 $fullpath = $localbase . '/' . $1; 5165 $::packaged{$host}{$fullpath} = 1; 5166 if ($alt_localbase ne '') { 5167 $fullpath = $alt_localbase . '/' . $1; 5168 $::packaged{$host}{$fullpath} = 1; 5169 } 5170 if (&POSIX::isatty($::msg)) { 5171 print $::msg &spinner(++$cnt) . "\r"; 5172 } 5173 } 5174 } 5175 else { 5176 $fullpath = $localbase . '/' . $_; 5177 chomp ($fullpath); 5178 $::packaged{$host}{$fullpath} = 1; 5179 if ($alt_localbase ne '') { 5180 $fullpath = $alt_localbase . '/' . $_; 5181 chomp ($fullpath); 5182 $::packaged{$host}{$fullpath} = 1; 5183 } 5184 if (&POSIX::isatty($::msg)) { 5185 print $::msg &spinner(++$cnt) . "\r"; 5186 } 5187 } 5188 } 5189 close(LIST); 5190 } 5191 } 5192} 5193 5194 5195###################################################################### 5196# Fill %changed with a list of packaged files on host that have been 5197# modified 5198###################################################################### 5199sub find_changed_files { 5200 5201 my $host = shift (@_); 5202 my $cnt = 0; 5203 5204 return if ($cfg::pkgdelta_archive_changed eq 'false'); 5205 5206 if ($::pkgdelta eq 'rpm') { 5207 5208 my $cmd = "$::path{rpm} -V -a"; 5209 my ($num); 5210 5211 if ($host ne 'localhost') { 5212 &log("| Finding changed package files on host $host..."); 5213 $cmd = &maybe_remote_cmd($cmd, $host); 5214 } else { 5215 &log("| Finding changed package files..."); 5216 } 5217 5218 $num = scalar (keys %{$::package_list{$host}}); 5219 5220 &log("| Analyzing $num packages may take quite a while, please be patient"); 5221 if (defined($::debug)) { 5222 &log("(debug) $cmd"); 5223 } else { 5224 open(LIST,"$cmd |") || die; 5225 while(<LIST>) { 5226 if (&POSIX::isatty($::msg)) { 5227 print $::msg &spinner(++$cnt) . "\r"; 5228 } 5229 # ex: if size, md5sum, and timestamp changed on a config file 5230 # S.5....T c /etc/ntp.conf 5231 if (m:^([\.S][\.M][\.5][\.D][\.L][\.U][\.G][\.T]) [dgc ] (.*)$:) { 5232 $::changed{$host}{$2} = 1; 5233 } 5234 } 5235 close(LIST); 5236 } 5237 5238 } elsif ($::pkgdelta eq 'freebsd') { 5239 5240 my $cmd = "$::path{pkg_info} -g -a -q"; 5241 my ($num); 5242 5243 if ($host ne 'localhost') { 5244 &log("| Finding changed package files on host $host..."); 5245 $cmd = &maybe_remote_cmd($cmd, $host); 5246 } else { 5247 &log("| Finding changed package files..."); 5248 } 5249 5250 $num = scalar (keys %{$::package_list{$host}}); 5251 5252 &log("| Analyzing $num packages may take quite a while, please be patient"); 5253 if (defined($::debug)) { 5254 &log("(debug) $cmd"); 5255 } else { 5256 open(LIST,"$cmd 2> /dev/null |") || die; 5257 while(<LIST>) { 5258 if (&POSIX::isatty($::msg)) { 5259 print $::msg &spinner(++$cnt) . "\r"; 5260 } 5261 if (/^(\S+)\s+fails.*MD5.*checksum$/) { 5262 $::changed{$host}{$1} = 1; 5263 } 5264 } 5265 close(LIST); 5266 } 5267 5268 } 5269} 5270 5271############################################################################# 5272# Actually test to see if we can run buffer. In situations where SysV shared 5273# memory is low, or buffer can't run, buffer can fail 5274############################################################################# 5275sub test_bufferprog { 5276 5277 my $buffer_cmd = shift(@_); 5278 my $host = shift(@_); 5279 my $tmp_script = "$cfg::tmpdir/buftest.$host.$PROCESS_ID.sh"; 5280 my $retval = 0; 5281 my $pipecmd; 5282 my $explicit_success; 5283 5284 $buffer_cmd =~ s:^\s*\|\s*::; 5285 $buffer_cmd =~ s:\s*\|\s*$::; 5286 5287 # Create a script which tests the buffer program 5288 open(SCR,"> $tmp_script") || die; 5289 print SCR "#!/bin/sh\n"; 5290 print SCR "tmp_data=\$(mktemp $cfg::tmpdir/data.XXXXXXXXXX)\n"; 5291 print SCR "tmp_err=\$(mktemp $cfg::tmpdir/err.XXXXXXXXXX)\n"; 5292 print SCR "echo testme > \$tmp_data\n"; 5293 print SCR "$buffer_cmd > /dev/null 2> \$tmp_err < \$tmp_data\n"; 5294 print SCR "res=\$?\n"; 5295 print SCR "out=\`cat \$tmp_err\`\n"; 5296 print SCR "if [ \$res -eq 0 ]; then\n"; 5297 print SCR " echo \"successful\"\n"; 5298 print SCR "else\n"; 5299 print SCR " echo \"unsuccessful: exit code \$res: \$out\" \n"; 5300 print SCR "fi\n"; 5301 print SCR "rm -f \$tmp_data \$tmp_err\n"; 5302 close(SCR); 5303 5304 if ($host eq 'localhost') { 5305 print $::msg "| Checking '$cfg::buffer' on this machine... "; 5306 $pipecmd = "sh $tmp_script "; 5307 } else { 5308 $pipecmd = 5309 "$::remoteshell $host '$::path{mkdir} -p $cfg::tmpdir'; " . 5310 "cat $tmp_script | ($::remoteshell $host 'cat > $tmp_script; " . 5311 "sh $tmp_script; rm -rf $cfg::tmpdir')"; 5312 print $::msg "| Checking '$cfg::buffer' on host $host... "; 5313 } 5314 5315 if (!defined($::debug)) { 5316 open(PIPE,"$pipecmd |") || die; 5317 5318 $explicit_success = 0; 5319 while (<PIPE>) { 5320 if (/^successful$/) { 5321 $explicit_success = 1; 5322 last; 5323 } 5324 if (/^unsuccessful: exit code (\d+): (.*)/) { 5325 $retval = $1; 5326 my $out = $2; 5327 if ($retval != 0) { 5328 push(@::errors, "Problems encountered testing '$cfg::buffer' on host '$host':"); 5329 5330 if ($out ne '') { 5331 push(@::errors, " --> " . $out); 5332 } 5333 5334 if (($cfg::buffer eq 'buffer') and ($retval == 255)) { 5335 push(@::errors, " You don't have enough shared memory to run '$cfg::buffer' on $host, or"); 5336 push(@::errors, " have exceeded buffering limits. Try lowering the amount specified in"); 5337 push(@::errors, " \$buffer_megs in your flexbackup.conf file, or reconfigure your"); 5338 push(@::errors, " kernel to include more SysV shared memory pages if using *BSD."); 5339 } else { 5340 push(@::errors, " Unknown problem trying to run '$cfg::buffer' (exit code $retval). Try disabling it"); 5341 push(@::errors, " or lowering \$buffer_megs."); 5342 } 5343 } 5344 } 5345 } 5346 close (PIPE); 5347 5348 } else { 5349 print $::msg "\n(debug) $pipecmd\n"; 5350 } 5351 5352 if ($explicit_success) { 5353 print $::msg "Ok\n"; 5354 } else { 5355 if ($retval == 0) { 5356 push(@::errors, "Unanticipated problems encountered testing '$cfg::buffer' on host '$host'."); 5357 } else { 5358 print $::msg "Failed!\n"; 5359 } 5360 } 5361 unlink("$tmp_script"); 5362 5363 return($retval); 5364} 5365 5366 5367############################################################################# 5368# Check that programs exist on remote systems 5369# Check buffer execution on them too 5370############################################################################# 5371sub check_remote_progs { 5372 5373 my $remotehost_ref = shift(@_); 5374 my $remoteprogs_ref = shift(@_); 5375 my $err = 0; 5376 my @progs; 5377 5378 foreach my $host (keys %$remotehost_ref) { 5379 &check_shell($host); 5380 } 5381 5382 foreach (@$remoteprogs_ref) { 5383 # Could be '0' if original checkinpath failed on localhost 5384 if ($_ ne '0') { 5385 push(@progs,"type $_ 2>&1"); 5386 } else { 5387 $err++; 5388 } 5389 } 5390 my $string = join ('; ',@progs); 5391 foreach my $host (keys %$remotehost_ref) { 5392 print $::msg "| Checking for required programs on host $host... "; 5393 my $cmd = "$::remoteshell $host \"sh -c '$string'\""; 5394 if (defined($::debug)) { 5395 print $::msg "\n(debug) $cmd\n"; 5396 next; 5397 } 5398 if (!(open(PIPE,"$cmd |"))) { 5399 push (@::errors, "Could not open pipe to remote shell - $!"); 5400 $err++; 5401 last; 5402 } 5403 5404 while (<PIPE>) { 5405 if (m/(\S+) not found/) { 5406 push(@::errors, "Could not find program '$1' on remote machine '$host'"); 5407 $err++; 5408 } 5409 } 5410 close (PIPE); 5411 5412 if ($err == 0) { 5413 print $::msg "Ok\n"; 5414 } else { 5415 print $::msg "Failed!\n"; 5416 } 5417 5418 } 5419 5420 if ($cfg::buffer ne 'false') { 5421 foreach my $host (keys %$remotehost_ref) { 5422 &test_bufferprog($::buffer_cmd, $host); 5423 } 5424 } 5425 5426} 5427 5428############################################################################# 5429# Check shell on remote systems 5430# (Mainly to see if we should use bash pipe exit trick at this point) 5431############################################################################# 5432sub check_shell { 5433 5434 my $host = shift(@_); 5435 my $pipecmd; 5436 5437 $pipecmd = 'set x = 1 && test $x && echo csh:yes; echo tcsh:$tcsh; echo bash:$BASH_VERSION; echo zsh:$ZSH_VERSION; echo ksh:$KSH_VERSION'; 5438 5439 if ($host eq 'localhost') { 5440 print $::msg "| Checking /bin/sh on this machine... "; 5441 } else { 5442 print $::msg "| Checking shell on $host... "; 5443 $pipecmd = "$::remoteshell $host '" . $pipecmd . "'"; 5444 } 5445 5446 $::shelltype{$host} = 'unknown'; 5447 5448 if (defined($::debug)) { 5449 print $::msg "\n(debug) $pipecmd\n"; 5450 } 5451 5452 if (!(open(PIPE,"$pipecmd 2>&1 |"))) { 5453 return; 5454 } 5455 5456 while (<PIPE>) { 5457 5458 if (m/^(\S+):(\S.+)$/) { 5459 my $shell = $1; 5460 my $ver = $2; 5461 if ($shell eq 'bash') { 5462 if ($ver =~ m/^1/) { 5463 $::shelltype{$host} = 'bash1'; 5464 } else { 5465 $::shelltype{$host} = 'bash2'; 5466 } 5467 } else { 5468 $::shelltype{$host} = $shell; 5469 } 5470 } 5471 } 5472 close (PIPE); 5473 5474 if (($::shelltype{$host} eq 'unknown') and ($::uname !~ m/Linux/)) { 5475 print $::msg "$::shelltype{$host} (probably Bourne Shell)\n"; 5476 } else { 5477 print $::msg "$::shelltype{$host}\n"; 5478 } 5479} 5480 5481 5482############################################################################# 5483# Wipe a tape for use. 5484############################################################################# 5485sub newtape () { 5486 5487 my $retval; 5488 5489 if (defined($::tapedevice)) { 5490 &log('| Rewinding & erasing tape...'); 5491 } 5492 &mt('rewind'); 5493 &maybe_delete_old_index(); 5494 &mt('rewind'); 5495 &mt('generic-erase'); 5496 $retval = &new_tape_key(); 5497 5498 return($retval); 5499} 5500 5501 5502############################################################################# 5503# Test writing a couple files to tape, then read & diff. To help make 5504# sure filemarks, blocks, padding, are working as we need. 5505############################################################################# 5506sub test_tape_drive { 5507 5508 my $cmd; 5509 my $tmp1 = "$cfg::tmpdir/test1.$PROCESS_ID"; 5510 my $tmp2 = "$cfg::tmpdir/test2.$PROCESS_ID"; 5511 my $tmp3 = "$cfg::tmpdir/test3.$PROCESS_ID"; 5512 my $fail = 0; 5513 my $configfile; 5514 5515 if (defined($::opt{'c'})) { 5516 $configfile = $::opt{'c'}; 5517 } else { 5518 $configfile = $::CONFFILE; 5519 } 5520 5521 &mt("generic-blocksize $::mt_blksize"); 5522 5523 &log("| Testing will *erase* the tape currently in the drive!"); 5524 &log("| Hit CTRL-C to abort within 10 seconds..."); 5525 &line(); 5526 sleep(10); 5527 &log("| If for some reason this program does not exit within a few minutes,"); 5528 &log("| Hit CTRL-C, and try adjusting \$blksize, \$pad_blocks, or \$mt_blksize."); 5529 &line(); 5530 5531 &newtape(); 5532 &line(); 5533 5534 &mt('generic-query'); 5535 &log(''); 5536 &log("Writing test file \#1"); 5537 $cmd = "$::path{cat} $0"; 5538 $cmd = &append_writer_cmd($cmd); 5539 if (!defined($::debug)) { 5540 system($cmd); 5541 if ($CHILD_ERROR) { 5542 $fail++; 5543 } 5544 } else { 5545 &log($cmd); 5546 } 5547 5548 &mt('generic-query'); 5549 &log("Writing test file \#2"); 5550 $cmd = "$::path{cat} $configfile"; 5551 $cmd = &append_writer_cmd($cmd); 5552 if (!defined($::debug)) { 5553 system($cmd); 5554 if ($CHILD_ERROR) { 5555 $fail++; 5556 } 5557 } else { 5558 &log($cmd); 5559 } 5560 5561 &mt('generic-query'); 5562 &log("Writing test file \#3"); 5563 $cmd = "$::path{cat} $0"; 5564 $cmd = &append_writer_cmd($cmd); 5565 if (!defined($::debug)) { 5566 system($cmd); 5567 if ($CHILD_ERROR) { 5568 $fail++; 5569 } 5570 } else { 5571 &log($cmd); 5572 } 5573 5574 &mt('generic-query'); 5575 &log(''); 5576 &log('Rewinding...'); 5577 &mt('rewind'); 5578 if ($cfg::indexes eq 'true') { 5579 &log('Skipping index label...'); 5580 &mt('fsf 1'); 5581 } 5582 &mt('generic-query'); 5583 &log(''); 5584 5585 &log("Reading test file \#1"); 5586 $cmd = &read_function($::device); 5587 if (defined($::remotetapehost)) { 5588 $cmd = &maybe_remote_cmd($cmd, $::remotetapehost); 5589 # Buffer both sides if remote 5590 $cmd .= $::buffer_cmd; 5591 } 5592 # if pad blocks was true we have nulls at the end (won't be in this script otherwise) 5593 if ($cfg::pad_blocks eq 'true') { 5594 $cmd .= " | $::path{tr} -d '\\0' > $tmp1"; 5595 } else { 5596 $cmd .= "> $tmp1"; 5597 } 5598 if (!defined($::debug)) { 5599 system($cmd); 5600 if ($CHILD_ERROR) { 5601 $fail++; 5602 } 5603 } else { 5604 &log("(debug) $cmd"); 5605 } 5606 5607 &mt('generic-query'); 5608 &log("Reading test file \#2"); 5609 $cmd = &read_function($::device); 5610 if (defined($::remotetapehost)) { 5611 $cmd = &maybe_remote_cmd($cmd, $::remotetapehost); 5612 # Buffer both sides if remote 5613 $cmd .= $::buffer_cmd; 5614 } 5615 # if pad blocks was true we have nulls at the end (won't be in config file otherwise) 5616 if ($cfg::pad_blocks eq 'true') { 5617 $cmd .= " | $::path{tr} -d '\\0' > $tmp2"; 5618 } else { 5619 $cmd .= "> $tmp2"; 5620 } 5621 if (!defined($::debug)) { 5622 system($cmd); 5623 if ($CHILD_ERROR) { 5624 $fail++; 5625 } 5626 } else { 5627 &log("(debug) $cmd"); 5628 } 5629 5630 &mt('generic-query'); 5631 &log("Reading test file \#3"); 5632 $cmd = &read_function($::device); 5633 if (defined($::remotetapehost)) { 5634 $cmd = &maybe_remote_cmd($cmd, $::remotetapehost); 5635 # Buffer both sides if remote 5636 $cmd .= $::buffer_cmd; 5637 } 5638 # if pad blocks was true we have nulls at the end (won't be in this script otherwise) 5639 if ($cfg::pad_blocks eq 'true') { 5640 $cmd .= " | $::path{tr} -d '\\0' > $tmp3"; 5641 } else { 5642 $cmd .= "> $tmp3"; 5643 } 5644 if (!defined($::debug)) { 5645 system($cmd); 5646 if ($CHILD_ERROR) { 5647 $fail++; 5648 } 5649 } else { 5650 &log("(debug) $cmd"); 5651 } 5652 5653 &mt('generic-query'); 5654 &log(''); 5655 &mt('rewind'); 5656 &log("Comparing..."); 5657 if (!defined($::debug)) { 5658 system("$::path{diff} -q $0 $tmp1"); 5659 if ($CHILD_ERROR) { 5660 $fail++; 5661 } 5662 system("$::path{diff} -q $configfile $tmp2"); 5663 if ($CHILD_ERROR) { 5664 $fail++; 5665 } 5666 system("$::path{diff} -q $0 $tmp3"); 5667 if ($CHILD_ERROR) { 5668 $fail++; 5669 } 5670 } else { 5671 &log("(debug) $::path{diff} -q $0 $tmp1"); 5672 &log("(debug) $::path{diff} -q $configfile $tmp2"); 5673 &log("(debug) $::path{diff} -q $0 $tmp3"); 5674 } 5675 5676 unlink $tmp1; 5677 unlink $tmp2; 5678 unlink $tmp3; 5679 5680 if ($fail != 0) { 5681 print $::msg "\nFAILURE! Problem with tape driver or parameters. Please see the FAQ\n"; 5682 print $::msg "or try changing the \$blksize, \$pad_blocks, or \$mt_blksize settings.\n"; 5683 exit(1); 5684 } else { 5685 print $::msg "SUCCESS! Tape drive parameters seem to work just fine\n"; 5686 } 5687 5688} 5689 5690 5691###################################################################### 5692# Check if the week day is as specified before backup (for complex cron setups) 5693###################################################################### 5694sub check_wday { 5695 5696 if (defined($::opt{'wday'})) { 5697 my @now = localtime; 5698 my $wday_now = $now[6]; 5699 5700 # Just silently hard-limit these to valid set 5701 if ($::opt{'wday'} >= 7) { 5702 $::opt{'wday'} = 0; 5703 } 5704 if ($::opt{'wday'} < 0) { 5705 $::opt{'wday'} = 0; 5706 } 5707 5708 if ($wday_now != $::opt{'wday'}) { 5709 exit(0); 5710 } 5711 } 5712} 5713 5714###################################################################### 5715# Split whitespace-separated list. 5716# If it contains quotes, do a bit differently so we can have 5717# items containing whitespace, as long as all elements are quoted. 5718###################################################################### 5719sub split_list { 5720 5721 my $string = shift(@_); 5722 my @array; 5723 5724 if ($string =~ m/\"/) { 5725 $string =~ s/^\s*\"//; 5726 $string =~ s/\"\s*$//; 5727 @array = split(/\"\s+\"/,$string); 5728 } elsif ($string =~ m/\'/) { 5729 $string =~ s/^\s*\'//; 5730 $string =~ s/\'\s*$//; 5731 @array = split(/\'\s+\'/,$string); 5732 } else { 5733 @array = split(/\s+/,$string); 5734 } 5735 5736 return(@array); 5737} 5738 5739 5740###################################################################### 5741# To show activity.... 5742###################################################################### 5743sub spinner { 5744 5745 my $index = shift(@_); 5746 my (@spinner) = ('|','/','-','\\','|','/','-','\\'); 5747 5748 $index = $index % $#spinner; 5749 5750 return($spinner[$index]); 5751} 5752 5753 5754