Sorry for the high volume, people.
The error below is with perl 5.10.1 (Ubuntu Lucid). On 5.14.2 (Ubuntu
precise), it seems work just fine. At least, it spits out the usual help
message. I think you need a perl version dependency, Jeff.
Regards,
Tyler
On 2013-03-05 11:29, Tyler J. Wagner wrote:
> Jeffrey,
>
> After updating $VERSION to 0.4.2 in jLib, I found this error:
>
> root@backup:/usr/local/bin# ./BackupPC_copyPcPool.pl
>
> Type of arg 1 to keys must be hash (not hash element) at
> ./BackupPC_copyPcPool.pl line 375, near "})"
> Type of arg 1 to keys must be hash (not hash element) at
> ./BackupPC_copyPcPool.pl line 379, near "})"
> Execution of ./BackupPC_copyPcPool.pl aborted due to compilation errors
>
> Regards,
> Tyler
>
> On 2013-03-05 11:20, Tyler J. Wagner wrote:
>> Jeffrey,
>>
>> As always, thanks.
>>
>> Did you forget to increment jLib.pm to 0.4.2? There's a comment in the
>> library but "$VERSION = '0.4.1';" in the code.
>>
>> Would you mind including these as attachments, rather than inline? It would
>> save us some cut-and-paste.
>>
>> Regards,
>> Tyler
>>
>> On 2013-03-01 23:30, backuppc AT kosowsky DOT org wrote:
>>> Here is the latest (updated) version of BackupPC_copyPcPool along with
>>> the jLib.pm library which it uses.
>>>
>>> It is much, much better than my initial version(s) released in 2011 as
>>> pointed out in my email from yesterday. However, it does not yet
>>> include the "incremental" backup/transfer option that I referred to
>>> yesterday. Also, it currently requires ~190 bytes/pool entry (for
>>> o(million) pool elements) to cache the pool inodes. If the -P (pack)
>>> flage, this is reduced to about ~140 bytes/pool entry. I intend to implement
>>> a tighter packing of about 30 bytes/pool entry at the expense of
>>> lookup speed in a future version.
>>>
>>> If anyone has trouble with line wrapping errors caused by my emailing
>>> the plain text, I can send it as an attached file..
>>>
>>> I am very interested in hearing people's feedback and experiences with
>>> this program...
>>>
>>> ------------------------------------------------------------------------
>>> BackupPC_copyPcPool.pl
>>>
>>> #!/usr/bin/perl
>>> #============================================================= -*-perl-*-
>>> #
>>> # BackupPC_copyPcPool.pl: Reliably & efficiently copy pool and pc tree
>>> #
>>> # DESCRIPTION
>>> # See below for detailed description of what it does and how it works
>>> #
>>> # AUTHOR
>>> # Jeff Kosowsky
>>> #
>>> # COPYRIGHT
>>> # Copyright (C) 2011-2013 Jeff Kosowsky
>>> #
>>> # This program is free software; you can redistribute it and/or modify
>>> # it under the terms of the GNU General Public License as published by
>>> # the Free Software Foundation; either version 2 of the License, or
>>> # (at your option) any later version.
>>> #
>>> # This program is distributed in the hope that it will be useful,
>>> # but WITHOUT ANY WARRANTY; without even the implied warranty of
>>> # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
>>> # GNU General Public License for more details.
>>> #
>>> # You should have received a copy of the GNU General Public License
>>> # along with this program; if not, write to the Free Software
>>> # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
>>> USA
>>> #
>>> #========================================================================
>>> #
>>> # Version 0.2.1, February 2013
>>> #
>>> # CHANGELOG:
>>> # 0.1.1 (Feb 2011)
>>> # 0.1.2 (May 2011)
>>> # 0.1.3 (Sep 2011)
>>> # 0.1.4 (Jan 2013) Added options & error checking to set backuppc uid & guid
>>> # when not available from passwd & group files,
>>> respectively
>>> # 0.2.0 (Feb 2013) Initial release of new version using full in-memory
>>> I-node
>>> # (hash) caching rather than I-node pooling via file system
>>> # tree
>>> # 0.2.1 (Feb 2013) Added packed option for I-node cache hash index & values
>>> # Added md5sum output option
>>> #========================================================================
>>> #
>>> # DESCRIPTION
>>> #
>>> # 1. The program first recurses through the pool/cpool to create a
>>> # perl hash cache (%InodeCache) indexed by inode of all the pool
>>> # entries. This subsequently allow for rapid lookup and association of
>>> # each linked pc file with the corresponding stored pool
>>> # file. Optionally, the cache can be written out to a file as a list
>>> # of "<inode> <pool mdsum>" pairs. This inode chache file can then be
>>> # read in rapidly to populate the chache on subsequent runs, assuming
>>> # the pool hasn't changed in the interim.
>>> #
>>> # 2. The program then runs through the pc tree (or a designated
>>> # subtree thereof) to create a single long list of all of the
>>> # directories, hard links, and zero-length files
>>> # For hard links, the entry is:
>>> # <path-to-pool-file> <path-to-pc-file>
>>> # For directories, the entry is:
>>> # D <owner> <group> <mode> <mtime> <path-to-directory>
>>> # For zero-length files, the entry is:
>>> # Z <owner> <group> <mode> <mtime> <path-to-file>
>>> # For 'errors' (e.g., non-linked, non-zero length files), the entry is:
>>> # X <owner> <group> <mode> <mtime> <path-to-file>
>>> # Comments can be indicated by:
>>> # #
>>>
>>> # Note: all paths are relative to TopDir
>>>
>>> # Any (non-zero length) pc files that are not linked (i.e. only one
>>> # hard link) or that are not found in the InodeCache may optionally be
>>> # corrected and linked to the pool and if this results in a new pool
>>> # entry then that entry is added to the InoceCache too. Files that are
>>> # not corrected are listed for separate examination and manual
>>> # correction or backup.
>>>
>>> # The output consists of 3 files:
>>>
>>> # <outfile>.links is the file consisting of the list of links,
>>> # directories and zero-length files described above
>>>
>>> # <outfile>.nopool is a listing of the normal top-level log and info
>>> # files that are not linked and need to be copied
>>> # over directly
>>>
>>> # <outfile>.nolinks is a listing of the non-linked, non-zero length
>>> # files that either couldn't be linked or that you
>>> # decided not to link
>>> #
>>>
>>> # If the --Writecache|-W option is set, a 4th output file is generated:
>>>
>>> # <outfile>.icache is a 2 column listing consisting of
>>> # <inode number> <pool file name> pairs.
>>> # If the --writecache|-W option is repeated, then a
>>> # 3rd column is added consisting of the md5sum of
>>> # the (uncompressed) contents of the pool file.
>>> # One can then check for pool dups by running:
>>> # sort -k 3 <outfile>.icache | uniq -f 2 -D
>>>
>>> # NOTE: Backuppc on the source machine should be disabled (or a
>>> # static snapshot used) during the entire backup process
>>>
>>> # 3. Restoring then consists of the following steps:
>>>
>>> # A. Copy over the pool/cpool any way you like, including
>>> # rsync but without having to worry about hard links
>>>
>>> # B. Copy over the non-pooled files (<outfile>.nopool) any way you want,
>>> # e.g., rsync, tar, etc.
>>>
>>> # C. Run this program again using the -r|--restore flag and the
>>> # <outfile>.nolinks as the input
>>>
>>> # D. Optionally copy over the non-linked files in <outfile>.nolinks
>>>
>>> # NOTE: Backuppc on the target machine should be disabled (or a
>>> # snapshot used) during the entire restore process
>>>
>>> # Selected features:
>>> # --gzip|-g flag creates compressed output/input
>>> # --stdio writes/reads to stdio allowing you to pipe the backup
>>> # stage directly into the restore stage
>>> # --fixlinks|-f fixes any missing/broken pc links
>>> # --topdir|-t allows setting of alternative topdir
>>> # --dryrun|-d doesn't make any changes to pool or pc tree
>>> # --verbose|-v verbosity (repeat for higher verbosity)
>>> #
>>> #========================================================================
>>>
>>> use strict;
>>> use warnings;
>>> use File::Path;
>>> use File::Glob ':glob';
>>> use Getopt::Long qw(:config no_ignore_case bundling);
>>> use Fcntl; #Required for RW I/O masks
>>> use Switch;
>>>
>>> use lib "/usr/share/BackupPC/lib";
>>> use BackupPC::FileZIO;
>>> use BackupPC::Lib;
>>> use BackupPC::jLib v0.4.2; # Requires version >= 0.4.2
>>> use BackupPC::Attrib qw(:all);
>>>
>>> no utf8;
>>>
>>> #use Data::Dumper; #JJK-DEBUG
>>> #use Devel::Size qw(size total_size); #JJK-DEBUG
>>>
>>> select(STDERR); #Auto-flush (i.e., unbuffer) STDERR
>>> $| = 1;
>>> select(STDOUT);
>>>
>>> #Variables
>>> my $bpc = BackupPC::Lib->new or die "BackupPC::Lib->new failed\n";
>>> my $md5 = Digest::MD5->new;
>>> my $attr; #Re-bless for each backup since may have different compress level
>>> my $MaxLinks = $bpc->{Conf}{HardLinkMax};
>>> my $CREATMASK = O_WRONLY|O_CREAT|O_TRUNC;
>>> my %InodeCache=(); #Cache for saving pool/cpool inodes
>>> my @nonpooled = ();
>>> my @backups = ();
>>> my @compresslvls=(); #Pool to use for each backup;
>>> my ($compresslvl, $ptype);
>>>
>>> my $backuppcuser = $bpc->{Conf}{BackupPCUser}; #User name
>>> my $backuppcgroup = $bpc->{Conf}{BackupPCUser}; #Assumed to be same as user
>>>
>>> my $directories = 0;
>>> my $totfiles = 0; #Total of next 6 variables
>>> my $zerolengthfiles = 0;
>>> my $existinglink_pcfiles = 0;
>>> my $fixedlink_pcfiles = 0;
>>> my $unlinkable_pcfiles = 0;
>>> my $unlinked_pcfiles = 0;
>>> my $unlinked_nonpcfiles = 0;
>>> my $unlinked_files = 0; #Total of above three
>>> my $missing_attribs = 0;
>>>
>>> #GetOptions defaults:
>>> my $cleanpool;
>>> $dryrun=0; #Global variable defined in jLib.pm (do not use 'my') #JJK-DEBUG
>>> #$dryrun=1; #Set to 1 to make dry run only
>>> my $fixlinks=0;
>>> my $Force;
>>> my $gzip;
>>> my $giddef = my $giddef_def = getgrnam($backuppcuser); #GID
>>> $giddef_def = "<unavailable>" unless defined $giddef_def;
>>> my $outfile;
>>> my $Overwrite;
>>> my $Pack;
>>> my $pool = my $pool_def = 'both';
>>> my $restore;
>>> my $Readcache;
>>> my $Skip;
>>> my $stdio;
>>> my $TopDir = my $TopDir_def = $bpc->{TopDir};
>>> my $uiddef = my $uiddef_def = getpwnam($backuppcgroup); #UID
>>> $uiddef_def = "<unavailable>" unless defined $uiddef_def;
>>> my $verbose = my $verbose_def = 2;
>>> my $noverbose;
>>> my $Writecache;
>>>
>>> usage() unless(
>>> GetOptions(
>>> "cleanpool|c" => \$cleanpool, #Remove orphan pool entries
>>> "dryrun|d!" => \$dryrun, #1=dry run
>>> "fixlinks|f" => \$fixlinks, #Fix unlinked/broken pc files
>>> "Force|F" => \$Force, #Override stuff...
>>> "gid|G=i" => \$giddef, #default gid if not in group
>>> file
>>> "gzip|g" => \$gzip, #Compress files
>>> "outfile|o=s" => \$outfile, #Output file (required)
>>> "Overwrite|O" => \$Overwrite, #OVERWRITES existing files/dirs
>>> (restore)
>>> "pool|p=s" => \$pool, #Pool (pool|cpool|both)
>>> "Pack|P" => \$Pack, #Pack the InodeCache hash
>>> "restore|r" => \$restore, #Restore rather than backup
>>> "Readcache|R=s" => \$Readcache, #Read InodeCache from file
>>> "Skip|S" => \$Skip, #Skip existing backups (restore)
>>> "stdio|s" => \$stdio, #Print/read to/from stdout/stdin
>>> "topdir|t=s" => \$TopDir, #Location of TopDir
>>> "uid|U=i" => \$uiddef, #default gid if not in group
>>> file
>>> "verbose|v+" => \$verbose, #Verbosity (repeats allowed)
>>> "noverbose" => \$noverbose, #Shut off all verbosity
>>> "Writecache|W+" => \$Writecache,#Write InodeCache out to file
>>> "help|h" => \&usage,
>>> ));
>>>
>>> if($restore) {
>>> usage() if $cleanpool || $fixlinks || $outfile ||
>>> $Readcache || $Writecache ||
>>> (!$stdio && @ARGV < 1);
>>> } else {
>>> usage() if ! defined($outfile) || ($pool !~ /^(pool|cpool|both)$/) ||
>>> ($Readcache && $Writecache) || $Overwrite;
>>> }
>>>
>>> $verbose = 0 if $noverbose;
>>> my $DRYRUN = $dryrun ? "**DRY-RUN** " : "";
>>>
>>> die "Error: 'backuppc' not found in password file, so must enter default
>>> UID on commandline (--uid|-U option)...\n" unless defined $uiddef;
>>> die "Error: 'backuppc' not found in group file, so must enter default GID
>>> on commandline (--gid|-G option)...\n" unless defined $giddef;
>>> my (%USERcache, %GROUPcache, %UIDcache, %GIDcache);
>>> $UIDcache{$uiddef} = $backuppcuser;
>>> $GIDcache{$uiddef} = $backuppcgroup;
>>> $USERcache{$backuppcuser} = $uiddef;
>>> $GROUPcache{$backuppcgroup} = $giddef;
>>>
>>> ############################################################################
>>> if($TopDir ne $TopDir_def) {
>>> #NOTE: if we are not using the TopDir in the config file, then we
>>> # need to manually override the settings of BackupPC::Lib->new
>>> # which *doesn't* allow you to set TopDir (even though it seems so
>>> # from the function definition, it gets overwritten later when the
>>> # config file is read)
>>> $TopDir =~ s|//*|/|g; #Remove any lurking double slashes
>>> $TopDir =~ s|/*$||g; #Remove trailing slash
>>> $bpc->{TopDir} = $TopDir;
>>> $bpc->{Conf}{TopDir} = $TopDir;
>>>
>>> $bpc->{storage}->setPaths({TopDir => $TopDir});
>>> $bpc->{PoolDir} = "$bpc->{TopDir}/pool";
>>> $bpc->{CPoolDir} = "$bpc->{TopDir}/cpool";
>>> }
>>>
>>> %Conf = $bpc->Conf(); #Global variable defined in jLib.pm (do not use
>>> 'my')
>>> #############################################################################
>>> #By convention for the rest of this program, we will assume that all
>>> #directory variables have a trailing "/". This should save us some
>>> #efficiency in terms of not having to always add back the slash.
>>> $TopDir .= "/"; $TopDir =~ s|//*|/|g;
>>> my $pcdir = 'pc/';
>>>
>>> die "TopDir = '$TopDir' doesn't exist!\n" unless -d $TopDir;
>>> die "TopDir = '$TopDir' doesn't look like a valid TopDir!\n"
>>> unless -d "$TopDir/pool" && -d "$TopDir/cpool" && -d "$TopDir/${pcdir}";
>>>
>>> system("$bpc->{InstallDir}/bin/BackupPC_serverMesg status jobs >/dev/null
>>> 2>&1");
>>> unless(($? >>8) == 1) {
>>> die "Dangerous to run when BackupPC is running!!! (use '--Force' to
>>> override)\n"
>>> unless $Force ||
>>> (stat("$TopDir/"))[0] . "." . (stat(_))[1] !=
>>> (stat("$TopDir_def/"))[0] . "." . (stat(_))[1]; #different fs &
>>> inode
>>> warn "WARNING: May be dangerous to run when BackupPC is running!!!\n";
>>> #Warn but don't die if *appear* to be in different TopDir
>>> }
>>>
>>> ############################################################################
>>> if(defined $restore) {
>>> do_restore(@ARGV);
>>> exit; #DONE
>>> }
>>> ############################################################################
>>> #Open files for reading/writing
>>> #NOTE: do before chdir to TopDir
>>> my $sfx = $gzip ? ".gz" : "";
>>> my $linksfile = "${outfile}.links${sfx}";
>>> my $nopoolfile = "${outfile}.nopool${sfx}";
>>> my $nolinksfile = "${outfile}.nolinks${sfx}";
>>>
>>> die "ERROR: '$linksfile' already exists!\n" if !$stdio && -e $linksfile;
>>> die "ERROR: '$nopoolfile' already exists!\n" if -e $nopoolfile;
>>> die "ERROR: '$nolinksfile' already exists!\n" if -e $nolinksfile;
>>>
>>> my $outpipe = $gzip ? "| gzip > " : "> ";
>>>
>>> if($stdio) {
>>> open(LINKS, $gzip ? "| gzip -f" : ">&STDOUT"); #Redirect LINKS to STDOUT
>>> } else {
>>> open(LINKS, $outpipe . $linksfile)
>>> or die "ERROR: Can't open '$linksfile' for writing!($!)\n";
>>> }
>>>
>>> open(NOPOOL, $outpipe . $nopoolfile)
>>> or die "ERROR: Can't open '$nopoolfile' for writing!($!)\n";
>>> open(NOLINKS, $outpipe . $nolinksfile)
>>> or die "ERROR: Can't open '$nolinksfile' for writing!($!)\n";
>>>
>>> my ($read_Icache, $write_Icache);
>>> if($Pack) { #Pack InodeCache entries
>>> $read_Icache = \&read_Icache_pack;
>>> $write_Icache = \&write_Icache_pack;
>>> } else { #Don't pack InodeCache entries
>>> $read_Icache = \&read_Icache_nopack;
>>> $write_Icache = \&write_Icache_nopack;
>>> }
>>>
>>> if($Readcache) { #Read in existing InodeCache from file
>>> open(RCACHE, $gzip ? "/bin/zcat $Readcache |" : "< $Readcache") or
>>> die "ERROR: Can't open '$Readcache' for reading!($!)\n";
>>> } elsif($Writecache) {
>>> my $wcachefile = "${outfile}.icache${sfx}";
>>> die "ERROR: '$wcachefile' already exists!\n" if -e $wcachefile;
>>> open(WCACHE, $outpipe . $wcachefile)
>>> or die "ERROR: Can't open '$wcachefile' for writing!($!)\n";
>>> }
>>>
>>> ############################################################################
>>> chdir($TopDir); #Do this so we don't need to worry about distinguishing
>>> #between absolute and relative (to TopDir) pathnames
>>> #Everything following opening the files occurs in TopDir
>>> ############################################################################
>>> initialize_backups();
>>>
>>> warn "**Populating Icache...\n" if $verbose>=1;
>>> my $toticache=0;
>>> if($Readcache) { #Read in existing InodeCache from file
>>> $ptype = $Conf{CompressLevel} ? "cpool" : "pool";
>>> while(<RCACHE>) {
>>> if(/^(\d+)\s+(\S+)/) {
>>> &$write_Icache($ptype, $1, $2);
>>> $toticache++;
>>> } elsif(/^#(c?pool)\s*$/) {
>>> $ptype = $1;
>>> } else {
>>> warn "'$_' is not a valid cache entry\n" unless /^#/;
>>> }
>>> }
>>> close RCACHE;
>>> } else { # Create InodeCache
>>> if($pool eq "both") {
>>> $toticache += populate_icache("pool");
>>> $toticache += populate_icache("cpool");
>>> } else {
>>> $toticache += populate_icache($pool);
>>> }
>>> close WCACHE if $Writecache;
>>> }
>>> warn "*Icache entries created=$toticache\n" if $verbose >=2;
>>> if(defined(&total_size)){ #JJK-DEBUG: Print out sizes used by InodeCache
>>> warn sprintf("InodeCache total size: %d\n",total_size(\%InodeCache));
>>> warn sprintf("Cpool cache entries: %d\tSize: %d\tTotal_size: %d\n",
>>> (scalar keys $InodeCache{"pool"}),
>>> size($InodeCache{"pool"}),
>>> total_size($InodeCache{"pool"}))
>>> if defined $InodeCache{"pool"};
>>> warn sprintf("Cpool cache entries: %d\tSize: %d\tTotal_size: %d\n",
>>> (scalar keys
>>> $InodeCache{"cpool"}),size($InodeCache{"cpool"}),
>>> total_size($InodeCache{"cpool"}))
>>> if defined $InodeCache{"cpool"};
>>> }
>>>
>>> exit unless @backups;
>>>
>>> warn "**Recording nonpooled top level files...\n" if $verbose>=1;
>>> foreach (@nonpooled) { #Print out the nonpooled files
>>> printf NOPOOL "%s\n", $_;
>>> }
>>> close(NOPOOL);
>>>
>>> warn "**Recording linked & non-linked pc files...\n" if $verbose>=1;
>>> my $lastmachine = '';
>>> foreach (@backups) {
>>> m|$pcdir([^/]*)|;
>>> $lastmachine = $1 if $1 ne $lastmachine;
>>>
>>> warn "* Recursing through backup: $_\n" if $verbose>=1;
>>> $compresslvl = shift(@compresslvls);
>>> $attr = BackupPC::Attrib->new({ compress => $compresslvl });
>>> #Reinitialize this jLib global variable in case new compress level
>>> $ptype = ($compresslvl > 0 ? "cpool" : "pool");
>>> m|(.*/)(.*)|;
>>> find_pool_links($1, $2);
>>> }
>>> close(LINKS);
>>> close(NOLINKS);
>>>
>>> ##############################################################################
>>> #Print summary & concluding message:
>>> printf STDERR "\nDirectories=%d\tTotal Files=%d\n",
>>> $directories, ($totfiles + $#nonpooled);
>>> printf STDERR "Link files=%d\t [Zero-length=%d, Hardlinks=%d
>>> (Fixed=%d)]\n",
>>> ($zerolengthfiles+$existinglink_pcfiles+$fixedlink_pcfiles),
>>> $zerolengthfiles, ($existinglink_pcfiles+$fixedlink_pcfiles),
>>> $fixedlink_pcfiles;
>>> printf STDERR "Non-pooled Toplevel=%d\n", $#nonpooled;
>>> printf STDERR "Non-pooled Other=%d [Valid-pc=%d (Failed-fixes=%d),
>>> Invalid-pc=%d]\n",
>>> $unlinked_files, ($unlinked_pcfiles+$unlinkable_pcfiles),
>>> $unlinkable_pcfiles, $unlinked_nonpcfiles;
>>> printf STDERR "PC files missing attrib entry=%d\n", $missing_attribs;
>>>
>>> my ($rsyncnopool, $rsyncnolinks);
>>> if($gzip) {
>>> $gzip = "-g ";
>>> $rsyncnopool = "zcat $nopoolfile | rsync -aOH --files-from=- $TopDir
>>> <newTopDir>";
>>> $rsyncnolinks = "zcat $nolinksfile | rsync -aOH --files-from=- $TopDir
>>> <newTopDir>";
>>> } else {
>>> $gzip = "";
>>> $rsyncnopool = "rsync -aOH --files-from=$nopoolfile $TopDir
>>> <newTopDir>";
>>> $rsyncnolinks = "rsync -aOH --files-from=$nolinksfile $TopDir
>>> <newTopDir>";
>>> }
>>>
>>> print STDERR <<EOF;
>>> ------------------------------------------------------------------------------
>>> To complete copy, do the following as user 'root' or 'backuppc':
>>> 1. Copy/rsync over the pool & cpool directories to the new TopDir
>>> (note this must be done *before* restoring '$linksfile')
>>> For rsync:
>>> rsync -aO $TopDir\{pool,cpool\} <newTopDir>
>>>
>>> 2. Copy/rsync over the non-pooled top level files ($nopoolfile)
>>> For rsync:
>>> $rsyncnopool
>>>
>>> 3. Restore the pc directory tree, hard links and zero-sized files:
>>> $0 -r ${gzip}[-t <newTopDir>] $linksfile
>>>
>>> 4. Optionally, copy/rsync over the non-linked pc files ($nolinksfile)
>>> For rsync:
>>> $rsyncnolinks
>>>
>>> ------------------------------------------------------------------------------
>>>
>>> EOF
>>> exit;
>>>
>>> ##############################################################################
>>> ##############################################################################
>>> #SUBROUTINES:
>>>
>>> sub usage
>>> {
>>> print STDERR <<EOF;
>>>
>>> usage: $0 [options] -o <outfile> [<relpath-to-pcdir> <relpath-to-pcdir>...]
>>> $0 [options] -r <restorefile> [<relpath-to-pcdir>
>>> <relpath-to-pcdir>...]
>>>
>>> where the optional <relpath-to-pcdir> arguments are paths relative to the
>>> pc
>>> tree of form: 'host' or 'host/share' or 'host/share/n' or
>>> 'host/share/n/.../'
>>> If no optional <relpath-to-pcdir> arguments are given then the entire pc
>>> tree
>>> is backed up or restored.
>>>
>>> Options: [Common to copy & restore]
>>> --dryrun|-d Dry-run - doesn\'t change pool or pc trees
>>> Negate with: --nodryrun
>>> --Force|-F Overrides various checks (e.g., if BackupPC
>>> running
>>> or if directories present)
>>> --gid|-G <gid> Set group id for backuppc user
>>> [Default = $giddef_def]
>>> --gzip|-g Pipe files to/from gzip compression
>>> --topdir|-t Location of TopDir.
>>> [Default = $TopDir_def]
>>> Note you may want to change from default for
>>> example
>>> if you are working on a shadow copy.
>>> --uid|-U <uid> Set user id for backuppc user
>>> [Default = $uiddef_def]
>>> --verbose|-v Verbose (repeat for more verbosity)
>>> [Default level = $verbose_def]
>>> Use --noverbose to turn off all verbosity
>>> --help|-h This help message
>>>
>>> Options: [Copy only]
>>> --cleanpool|-c If orphaned files (nlinks=1) found when populating
>>> Icache, remove them (and renumber chain as needed)
>>> NOTE: Orphans shouldn\'t exist if you have just
>>> run
>>> BackupPC_nightly
>>> --fixlinks|-f Attempt to link valid pc files back to the pool
>>> if not already hard-linked
>>> NOTE: this changes files in the pc and\/or pool
>>> of your source too!
>>> --outfile|-o [outfile] Required stem name for the 3 output files
>>> <outfile>.nopools
>>> <outfile>.links
>>> <outfile>.nolinks
>>> --pool|-p [pool|cpool|both] Pools to include in Icache tree
>>> [Default = $pool_def]
>>> --Pack|-P Pack both the indices and values of the
>>> InodeCache.
>>> This saves approximately 52 bytes per pool entry.
>>> For o(1 million) entries, this reduces usage from
>>> ~190 bytes/entry to ~140 bytes/entry
>>> --Readcache|-R [file] Read in previously written inode pool cache from
>>> file. This allows resuming previously started
>>> backups
>>> Only use this option if the pool has not changed.
>>> Note: can\'t be used with --Writecache|-W
>>> --stdio|-s Print the directory tree, links and zero-sized
>>> files
>>> to stdout so it can be piped directly to another
>>> copy
>>> of the program running --restore
>>> NOTE: Status, Warnings, and Errors are printed to
>>> stdout.
>>> --WriteCache|-W Write inode pool cache to file <outfile>.icache
>>> as a 2 column list consisting of:
>>> <inode number> <pool entry>
>>> If repeated, include md5sums of the (uncompressed)
>>> pool file contents as a 3rd column (this is slow)
>>> If argument path is '-', then quit after writing
>>> cache.
>>> Note: can\'t be used with --Readcache|-R
>>> Options: [Restore only]
>>> --Overwrite|-O OVERWRITE existing files & directories (Dangerous)
>>> --Skip|-S SKIP existing backups
>>> --stdio Read the directory tree, links and zero-sized
>>> files
>>> from stdin so it can be piped directly from
>>> another
>>> copy of the program running in the create mode.
>>> Note <restorefile> should not be used in this case
>>> For example, the following pipe works:
>>> $0 -t <source TopDir> [-g] --stdio | $0 -t <dest
>>> TopDir> [-g] -r --stdio
>>>
>>> OVERVIEW:
>>> First create an inode-indexed cache (hash) of all pool entries.
>>> Note the cache may optionaly be written out to a file for later re-use
>>> with the --Readcache|-R flag.
>>>
>>> Then, recurse through the paths specified relative to the pc tree or if no
>>> paths specified then the entire pc tree.
>>> - If the file is a (non-pooled) top-level log file, then write its path
>>> relative to pcdir out to <outfile>.nopool
>>> Note this includes all non-directories above the share level plus the
>>> backInfo files that are covered by the input paths
>>> - If the file is a directory, zero length file, or an existing hard link
>>> to
>>> the tree, then write it out to <outfile>.links
>>> - If the file is not hard-linked but is a valid non-zero length pc file
>>> (f-mangled and present in the attrib file) and --fixlinks is selected,
>>> then try to link it properly to the appropriate pool.
>>> - Otherwise, add it to <outfile>.nolinks
>>>
>>> NOTE: TO ENSURE INTEGRITY OF RESULTS IT IS IMPORTANT THAT BACKUPPC IS NOT
>>> RUNNING (use --Force to override)
>>>
>>> NOTE: you should run BackupPC_nightly before running this program so that
>>> no unnecessary links are backed up; alternatively, set the --cleanpool
>>> option which will remove orphan pool entries.
>>>
>>> EOF
>>> exit(1);
>>> }
>>>
>>> #Glob to determine what is being backed up.
>>> #Make sure each backup seems valid and determine it's compress level
>>> #Collect top-level non-pooled files
>>> sub initialize_backups
>>> {
>>> if (!@ARGV) { # All backups at backup number level
>>> # TopDir/pc/<host>/<nn>
>>> @backups = bsd_glob("${pcdir}*/*"); #2 levels down;
>>> @nonpooled = grep(! -d , bsd_glob("${pcdir}*")); #All
>>> non-directories
>>> } else { # Subset of backups
>>> return if($Writecache && $ARGV[0] eq '-'); #Don't copy pc tree
>>> foreach(@ARGV) {
>>> my $backupdir = $pcdir . $_ . '/';
>>> $backupdir =~ s|//*|/|g; #Remove redundant slashes
>>> $backupdir =~ s|/\.(?=/)||g; #Replace /./ with /
>>> die "ERROR: '$backupdir' is not a valid pc tree
>>> subdirectory\n" if $pcdir eq $backupdir || !-d $backupdir;
>>> if($backupdir =~ m|^\Q${pcdir}\E[^/]+/$|) { #Hostname
>>> only
>>> push(@backups, bsd_glob("${backupdir}*"));
>>> } else { # At share level or below #Backup number or
>>> below
>>> push(@backups, ${backupdir});
>>> }
>>> }
>>> @backups = keys %{{map {$_ => 1} @backups}}; #Eliminate dups
>>> @nonpooled = keys %{{map {$_ => 1} @nonpooled}}; #Eliminate dups
>>> }
>>>
>>> push(@nonpooled, grep(! -d, @backups)); #Non-directories
>>> @backups = grep(-d , @backups); #Directories
>>> push(@nonpooled, grep(m|/backupInfo$|, @backups)); # backupInfo not
>>> pooled
>>> #Note everything else *should* be pooled - if not, we will catch it
>>> later as an error
>>> @backups = grep(!m|/backupInfo$|, @backups);
>>>
>>> foreach(@backups) {
>>> s|/*$||; #Remove trailing slash
>>> m|^(\Q${pcdir}\E[^/]+/[^/]+)(/)?|;
>>> die "Backup '$1' does not contain a 'backupInfo' file\n"
>>> unless -f "$1/backupInfo";
>>> push(@nonpooled, "$1/backupInfo") unless $2; #Don't include if
>>> share level or below
>>> my $compress = get_bakinfo("$1","compress");
>>> push(@compresslvls, $compress);
>>> my $thepool = $compress > 0 ? 'cpool' : 'pool';
>>> die "Backup '$1' links to non-included '$thepool'\n"
>>> if $pool ne 'both' && $pool ne $thepool;
>>> }
>>> }
>>>
>>> #Iterate through the 'pooldir' tree and populate the InodeCache hash
>>> sub populate_icache
>>> {
>>> my ($fpool) = @_;
>>> my (@fstat, $dh, @dirlist);
>>> my $icachesize = 0;
>>>
>>> return 0 unless bsd_glob("$fpool/[0-9a-f]"); #No entries in pool
>>> print WCACHE "#$fpool\n" if $Writecache;
>>> my @hexlist = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a',
>>> 'b', 'c', 'd', 'e', 'f');
>>> my ($idir,$jdir,$kdir);
>>> print STDERR "\n* Populating Icache with '$fpool' branch:[0-f] " if
>>> $verbose >=2;
>>> foreach my $i (@hexlist) {
>>> print STDERR "$i " if $verbose >=2;
>>> $idir = $fpool . "/" . $i . "/";
>>> foreach my $j (@hexlist) {
>>> $jdir = $idir . $j . "/";
>>> foreach my $k (@hexlist) {
>>> $kdir = $jdir . $k . "/";
>>> unless(opendir($dh, $kdir)) {
>>> warn "Can't open pool directory:
>>> $kdir\n" if $verbose>=4;
>>> next;
>>> }
>>> my @entries = grep(!/^\.\.?$/, readdir ($dh));
>>> #Exclude dot files
>>> closedir($dh);
>>> warn "POOLDIR: $kdir (" . ($#entries+1) ."
>>> files)\n"
>>> if $verbose >=3;
>>>
>>> if($cleanpool) { #Remove orphans & renumber
>>> first and then
>>> #create the Icache after orphan deletion &
>>> chain renumbering
>>> #NOTE: we need to do this before populating the
>>> InodeCache
>>> #since pool deletions & renumbering would
>>> change the cache
>>> my @poolorphans =
>>> grep(-f $kdir . $_ &&
>>> (stat(_))[3] < 2, @entries);
>>> foreach (sort {poolname2number($b) cmp
>>> poolname2number($a)}
>>> @poolorphans) { #Reverse sort to minimize moves
>>> my $pfile = $kdir . $_;
>>> my $result
>>> =delete_pool_file($pfile);
>>> if($verbose >=1) {
>>> $result == 1 ?
>>> warn "WARN:
>>> Deleted orphan pool entry: $pfile\n":
>>> warn "ERROR:
>>> Couldn't properly delete orphan pool entry: $pfile\n"
>>> }
>>> }
>>> @entries = grep(!/^\.\.?$/, readdir
>>> ($dh))
>>> if(@poolorphans); #Reload if
>>> orphans renumbered/removed
>>> }
>>> foreach (@entries) {
>>> # Go through all entries in terminal
>>> cpool branch
>>> @fstat = stat($kdir . $_);
>>> #Note: 0=dev, 1=ino, 2=mode, 3=nlink,
>>> 4=uid, 5=gid, 6=rdev
>>> #7=size, 8=atime, 9=mtime, 10=ctime,
>>> 11=blksize, 12=blocks
>>> if($fstat[3] >= 2) { # Valid
>>> (non-orphan) pool entry
>>> #Note: No sense in creating icache entries for
>>> orphans
>>> &$write_Icache($fpool,
>>> $fstat[1], $_);
>>> if($Writecache >= 2) {
>>> printf WCACHE "%d %s
>>> %s\n", $fstat[1], $_,
>>> zFile2FullMD5($bpc,
>>> $md5, $kdir . $_);
>>> }elsif($Writecache) {
>>> printf WCACHE "%d
>>> %s\n", $fstat[1], $_;
>>> }
>>> $icachesize++;
>>> } else { #Orphan pool entry
>>> warn "WARN: Orphan pool entry:
>>> $_\n"
>>> if $verbose>=1;
>>> }
>>> warn "WARN: Zero-size pool entry: $_\n"
>>> if $fstat[7] == 0 &&
>>> $verbose>=1;
>>> }
>>> } # kdir
>>> } # jdir
>>> } # idir
>>> print STDERR "\n" if $verbose >=2;
>>> return $icachesize;
>>> }
>>>
>>> #Recursively go through pc tree
>>> sub find_pool_links
>>> {
>>> my ($dir, $filename) = @_;
>>>
>>> my $dh;
>>> my $file = $dir . $filename;
>>> if(-d $file) {
>>> my @fstat = stat(_); #Note last stat was -d $file
>>> #Print info to signal & re-create directory:
>>> #D <user> <group> <mod> <atime> <mtime> <file name>
>>> print_file_reference("D", $file, \@fstat);
>>> $directories++;
>>> opendir($dh,$file);
>>> my @contents = readdir($dh);
>>> closedir($dh);
>>> foreach (@contents) {
>>> next if /^\.\.?$/; # skip dot files (. and ..)
>>> find_pool_links($file . '/', $_); #Recurse
>>> }
>>> }
>>> else { #Not a directory
>>> my @fstat = stat(_); #Note last stat was -d $file
>>> $totfiles++;
>>> if($fstat[7] == 0) { #Zero size file
>>> print_file_reference("Z", $file, \@fstat);
>>> $zerolengthfiles++;
>>> return;
>>> } elsif($fstat[3] > 1) { #More than one link
>>> if(defined(my $pooltarget = &$read_Icache($ptype,
>>> $fstat[1]))) {
>>> #Valid hit: hard link found in InodeCache
>>> $existinglink_pcfiles++;
>>> $pooltarget =~ /(.)(.)(.)/;
>>>
>>> print_hardlink_reference("$ptype/$1/$2/$3/$pooltarget", $file);
>>> return;
>>> }
>>> }
>>>
>>> if($file =~ m|^\Q${pcdir}\E[^/]+/[^/]+/backupInfo$|) {
>>> $totfiles--;
>>> return; #BackupInfo already taken care of in
>>> 'nonpooled'
>>> }
>>>
>>> #Non-zero sized file not in InodeCache that is not 'backupInfo'
>>> if($filename =~ /^f|^attrib$/ && -f $file) {
>>> #VALID pc file if f-mangled or attrib file
>>> if( $filename =~ /^f/ &&
>>> !( -f "$dir/attrib" &&
>>> $attr->read($dir,"attrib") == 1 &&
>>>
>>> defined($attr->get($bpc->fileNameUnmangle($filename))))) {
>>> #Attrib file error if attrib file missing or
>>> #unmangled name not an element of the attrib
>>> file
>>> warn "ERROR: $file (inode=$fstat[1],
>>> nlinks=$fstat[3]) VALID pc file with MISSING attrib entry\n";
>>> $missing_attribs++;
>>> }
>>> if($fixlinks) {
>>> if(fix_link($file, \@fstat) == 1) {
>>> $fixedlink_pcfiles++;
>>> return;
>>> } else {$unlinkable_pcfiles++;}
>>> } else{
>>> warn "ERROR: $file (inode=$fstat[1],
>>> nlinks=$fstat[3]) VALID pc file NOT LINKED to pool\n";
>>> $unlinked_pcfiles++;
>>> }
>>> } else {
>>> warn "ERROR: $file (inode=$fstat[1], nlinks=$fstat[3])
>>> INVALID pc file and UNLINKED to pool\n";
>>> $unlinked_nonpcfiles++
>>> }
>>> #ERROR: Not linked/linkable to pool (and not zero length file
>>> or directory
>>> print_file_reference("X", $file, \@fstat);
>>> printf NOLINKS "%s\n", $file;
>>> $unlinked_files++
>>> }
>>> }
>>>
>>> #Try to fix link by finding/creating new pool-link
>>> sub fix_link
>>> {
>>> my ($filename, $fstatptr) = @_;
>>>
>>> my ($plink, @pstat);
>>> my ($md5sum, $result) = zFile2MD5($bpc, $md5, $filename, 0,
>>> $compresslvl);
>>> $result = jMakeFileLink($bpc, $filename, $md5sum, 2, $compresslvl,
>>> \$plink)
>>> if $result > 0;
>>> #Note we choose NewFile=2 since if we are fixing, we always want to
>>> make the link
>>> if($result > 0) { #(true if both above calls succeed)
>>> $plink =~ m|.*(\Q${ptype}\E.*/(.*))|;
>>> $plink = $1; #Path relative to TopDir
>>> if($dryrun) {
>>> @pstat = @$fstatptr;
>>> } else {
>>> @pstat = stat($plink);
>>> &$write_Icache($ptype, $pstat[1], $2);
>>> }
>>> print_hardlink_reference($plink, $filename);
>>> if($verbose >=2) {
>>> warn "${DRYRUN}NOTICE: pool entry '$plink'
>>> (inode=$fstatptr->[1]) missing from Icache and added back\n" if $result ==
>>> 3;
>>> warn sprintf("${DRYRUN}NOTICE: %s (inode=%d, nlinks=%d)
>>> was fixed by linking to *%s* pool entry: %s (inode=%d, nlinks=%d)\n",
>>> $filename, $fstatptr->[1],
>>> $fstatptr->[3],
>>> ($result == 1 ? "existing" :
>>> "new"),
>>> $plink, $pstat[1], $pstat[3])
>>> if $result !=3;
>>> }
>>> return 1;
>>> }
>>> warn "ERROR: $filename (inode $fstatptr->[1]); fstatptr->[3] links;
>>> md5sum=$md5sum) VALID pc file FAILED FIXING by linking to pool\n";
>>> return 0;
>>> }
>>>
>>> sub print_hardlink_reference
>>> {
>>> my ($poolname, $filename) = @_;
>>>
>>> #<poolname> <filename>
>>> printf LINKS "%s %s\n", $poolname, $filename; #Print hard link
>>> }
>>>
>>> sub print_file_reference
>>> {
>>> my ($firstcol, $filename, $fstatptr) = @_;
>>>
>>> #<firstcol> <user> <group> <mod> <mtime> <filename>
>>> printf(LINKS "%s %s %s %04o %u %s\n",
>>> $firstcol, UID($fstatptr->[4]), GID($fstatptr->[5]),
>>> $fstatptr->[2] & 07777, $fstatptr->[9], $filename);
>>> }
>>>
>>> ###############################################################################
>>> ##Read/write InodeCache
>>>
>>> #Note that without packing, InodeCache hash requireas about 186
>>> #bytes/entry ('total_size') to store each entry with about 74 bytes
>>> #required to store the hash structure ('size') alone and an additional
>>> #exactly 112 byte to store the 32-char hex string (this assumes chains
>>> #are sparse enough not to affect the average storage). The 74 bytes
>>> #for the hash structure consists of about 8 bytes for the inode data
>>> #plus 48 bytes for the overhead of the scalar variable storing the
>>> #index plus ~22 bytes for the magic of hash storage and the pointer to
>>> #the hash value. The additional 112 bytes consists of 64 bytes to
>>> #store the unpacked 32-char hex string plus 48 bytes of overhead for
>>> #the scalar variable storing the hash value.
>>>
>>> #If we pack the value, we can reduce the hex string storage from 64
>>> #bytes to 16 bytes by storing 2 hex chars per byte. This reduces the
>>> #total storage by 48 bytes/entry from 186 to 138 bytes/entry.
>>>
>>> #If we pack the index as an unsigned 32-bit long (V), then we can
>>> #save an additional 4 bytes, reducing the average storage to about 134
>>> #bytes/entry. But, we need to make sure that the highest inode number
>>> #is less than 2^32 (~4.3 billion). If we pack the index as an unsigned
>>> #64-bit quad (Q), then we use 8 bytes for the index data and we are
>>> #back to a total 138 bytes/entry.
>>>
>>> #Note these averages are based on a hash size (i.e. pool size) of 1
>>> #million entries. The 74 bytes/entry for the hash structure alone will
>>> #increase (slowly) as the size of the hash increases but the storage
>>> #size for the hash vaue (112 bytes unpacked, 64 packed) does not
>>> #increase.
>>>
>>> sub read_Icache_nopack
>>> {
>>> $InodeCache{$_[0]}{$_[1]}; #No packing of values & indices
>>> }
>>>
>>> sub read_Icache_pack
>>> {
>>> # join("_", unpack("H32V", $InodeCache{$_[0]}{$_[1]})); #Pack values only
>>>
>>> #Also pack indices:
>>> join("_", unpack("H32V", $InodeCache{$_[0]}{pack("V",$_[1])}));#32-bit
>>> indices
>>> # join("_", unpack("H32V", $InodeCache{$_[0]}{pack("Q",$_[1])}));#64-bit
>>> indices
>>> #Note: shouldn't need 64 bits for inodes since they are ino_t
>>> #which are typdef'd as longs
>>> }
>>>
>>> sub write_Icache_nopack
>>> {
>>> $InodeCache{$_[0]}{$_[1]} = $_[2]; #No packing of values & indices
>>> }
>>>
>>> sub write_Icache_pack
>>> {
>>> my ($pool, $index, $value) = @_;
>>>
>>> $value =~ m|(.{32})(.(.*))?|;
>>> #Pack values only
>>> # $InodeCache{$pool}{$index}= defined($3) ? pack("H32V", $1, $3) :
>>> pack("H32", $1);
>>>
>>> #Also pack indices:
>>> $InodeCache{$pool}{pack("V",$index)} = defined($3) ? pack("H32V", $1,
>>> $3) : pack("H32", $1); #32-bit indices
>>>
>>> # $InodeCache{$pool}{pack("Q",$index)} = defined($3) ? pack("H32V", $1,
>>> $3) : pack("H32", $1); #64-bit indices
>>> #Note shouldn't need 64 bits for inodes since they are ino_t which
>>> #are typdef'd as longs
>>> }
>>>
>>> ###############################################################################
>>> # Return user name corresponding to numerical UID with caching
>>> sub UID
>>> {
>>> unless(exists($UIDcache{$_[0]})) {
>>> unless(defined($UIDcache{$_[0]} = getpwuid($_[0]))) {
>>> printf STDERR "Warning: '%d' not found in password
>>> file, writing numerical UID instead...\n", $_[0];
>>> $UIDcache{$_[0]} = $_[0];
>>> }
>>> }
>>> return $UIDcache{$_[0]};
>>> }
>>>
>>> # Return group name corresponding to numerical GID with caching
>>> sub GID
>>> {
>>> unless(exists($GIDcache{$_[0]})) {
>>> unless(defined($GIDcache{$_[0]} = getgrgid($_[0]))) {
>>> printf STDERR "Warning: '%d' not found in group file,
>>> writing numerical GID instead...\n", $_[0];
>>> $GIDcache{$_[0]} = $_[0];
>>> }
>>> }
>>> return $GIDcache{$_[0]};
>>> }
>>>
>>> # Return numerical UID corresponding to user name with caching
>>> sub USER
>>> {
>>> unless(exists($USERcache{$_[0]})) {
>>> unless(defined($USERcache{$_[0]} = getpwnam($_[0]))) {
>>> printf STDERR "Warning: '%s' not found in password
>>> file, writing default backuppc UID (%d) instead...\n", $_[0], $uiddef;
>>> $USERcache{$_[0]} = $uiddef;
>>> }
>>> }
>>> return $USERcache{$_[0]};
>>> }
>>>
>>> # Return numerical GUID coresponding to group name with caching
>>> sub GROUP
>>> {
>>> unless(exists($GROUPcache{$_[0]})) {
>>> unless(defined($GROUPcache{$_[0]} = getgrnam($_[0]))) {
>>> printf STDERR "Warning: '%s' not found in group file,
>>> writing default backuppc GID (%d) instead...\n", $_[0], $giddef;
>>> $GROUPcache{$_[0]} = $giddef;
>>> }
>>> }
>>> return $GROUPcache{$_[0]};
>>> }
>>> ###############################################################################
>>> ###############################################################################
>>> sub do_restore
>>> {
>>> my $currbackup = "";
>>> my $formaterr = 0;
>>> my $ownererr = 0;
>>> my $permserr = 0;
>>> my $mkdirerr = 0;
>>> my $mkzeroerr = 0;
>>> my $mklinkerr = 0;
>>> my $filexsterr = 0;
>>> my $utimerr = 0;
>>> my $newdir = 0;
>>> my $newzero = 0;
>>> my $newlink = 0;
>>> my $skipped = 0;
>>>
>>> ###############################################################################
>>> if($stdio) {
>>> open(LINKS, $gzip ? "/bin/zcat - |" : "<& STDIN");
>>> } else {
>>> my $restorefile = shift @_;
>>> open(LINKS, $gzip ? "/bin/zcat $restorefile |" : "<
>>> $restorefile") or
>>> die "ERROR: Can't open '$restorefile' for
>>> reading!($!)\n";
>>> }
>>> my @backuplist = @_;
>>> ###############################################################################
>>> chdir($TopDir); #Do this so we don't need to worry about distinguishing
>>> #between absolute and relative (to TopDir) pathnames
>>> ###############################################################################
>>> die "ERROR: pool directories empty!\n"
>>> unless $Force || bsd_glob("{cpool,pool}/*");
>>>
>>> my(@skiplist, $skiplist); #Backups to skip...
>>> if($Skip) {
>>> @skiplist = grep(@{[bsd_glob("$_/f*")]},
>>> bsd_glob("${pcdir}*/[0-9]*"));
>>> #NOTE: glob must be evaulated in list context because
>>> stateful...
>>> } elsif(!$Overwrite && grep(-d, bsd_glob("${pcdir}*/[0-9]*/f*"))) {
>>> die "ERROR: pc directory contains existing backups!\n(use
>>> --Skip to skip or --Overwrite to OVERWRITE)\n"
>>> }
>>> $skiplist = "\Q" . join("\E|\Q", @skiplist) . "\E" if @skiplist;
>>>
>>> my $backuplist; #Backups to selectively backup...
>>> $backuplist = "\Q" . join("\E|\Q", @backuplist) . "\E" if @backuplist;
>>>
>>> umask 0000; #No permission bits disabled
>>> my $time = time; #We will use this for setting atimes.
>>> my @dirmtimes =(); #Stack consisting of paired "dir, mtime" entries
>>> my $matchback = 1;
>>> my ($line);
>>>
>>> LINE: while($line = <LINKS>) {
>>> chomp $line;
>>>
>>> unless($line =~ m|^[a-f0-9DZX#]|) { #First character test
>>> print STDOUT "ERR_CHAR1: $line\n";
>>> warn sprintf("ERROR: Illegal first line character:
>>> %s\n",
>>> substr($line,0,1))
>>> if $verbose >=1;
>>> next LINE; #NOTE: next without line would go to next
>>> switch case
>>> }
>>>
>>> switch ($&) { #Go through cases...
>>> case 'D' {
>>> unless($line =~ m|^D +([^ ]+) +([^ ]+) +([^ ]+)
>>> +([^ ]+) +(\Q${pcdir}\E.*)|) {
>>> print STDOUT "ERR_DFRMT $line\n";
>>> $formaterr++;
>>> next LINE;
>>> }
>>> #NOTE: 1=uname 2=group 3=mode 4=mtime 5=dirpath
>>> print STDERR "$1|$2|$3|$4|$5|\n" if $verbose
>>> >=4;
>>> my $user = USER($1);
>>> my $group = GROUP($2);
>>> my $mode = oct($3);
>>> my $mtime = $4;
>>> my $dir = $5; $dir =~ s|/*$||; #Remove
>>> trailing slash
>>> $dir =~ m|(.*)/|;
>>> my $pdir = $1; #parent dir
>>>
>>> #Don't restore if on skiplist or if not on
>>> backuplist
>>> if(($skiplist && $dir =~ m|^($skiplist)|) ||
>>> ($backuplist && $dir !~
>>> m|^pc/($backuplist)|)) {
>>> $matchback = 0;
>>> next LINE;
>>> } else {
>>> $matchback = 1;
>>> }
>>>
>>> if($verbose >= 1) {
>>> $dir =~ m|pc/([^/]*/[^/]*)|;
>>> if($1 ne $currbackup) {
>>> $currbackup = $1;
>>> warn "RESTORING: $currbackup\n";
>>> }
>>> }
>>>
>>> #Look at @dirmtimes stack to see if we have
>>> backed out of
>>> #top directory(ies) on stack and can now set
>>> mtime
>>> my $lastdir; #If in new part of tree, set
>>> mtimes for past dirs
>>> while(defined($lastdir = shift(@dirmtimes)) &&
>>> $dir !~ m|^\Q$lastdir\E|) {
>>> jutime($time, shift(@dirmtimes),
>>> $lastdir);
>>> }
>>> unshift(@dirmtimes, $lastdir) if $lastdir; #Put
>>> back last one
>>>
>>> if(! -e $dir) { #Make directory (nothing in the
>>> way)
>>> unless( -d $pdir || jmake_path $pdir){
>>> #Make parent directory if
>>> doesn't exist
>>> #NOTE: typically shouldn't be
>>> necesary since list is
>>> #created with directories along
>>> the way
>>> print STDOUT "ERR_MKDIR
>>> $line\n";
>>> $mkdirerr++;
>>> next LINE;
>>> }
>>> #Make directory & set perms
>>> unless(mkdir $dir, $mode) {
>>> print STDOUT "ERR_MKDIR
>>> $line\n";
>>> $mkdirerr++;
>>> next LINE;
>>> }
>>> } elsif(-d $dir) { #Directory already exists
>>> #Set perms
>>> unless(jchmod $mode, $dir) {
>>> print STDOUT "ERR_PERMS
>>> $line\n";
>>> $permserr++;
>>> next LINE;
>>> }
>>> } else { #Non-directory in the way, abort line
>>> print STDOUT "ERR_DEXST $line\n";
>>> $filexsterr++;
>>> next LINE;
>>> }
>>>
>>> #Set ownership
>>> unless(jchown $user, $group, $dir){
>>> print STDOUT "ERR_OWNER
>>> $line\n";
>>> $ownererr++;
>>> next LINE;
>>> }
>>> #Put dir mtime on stack
>>> unshift(@dirmtimes, $mtime); #We need to set
>>> dir mtime
>>> unshift(@dirmtimes, $dir); #when done adding
>>> files to dir
>>>
>>> $newdir++;
>>> }
>>>
>>> case 'Z' {
>>> next LINE unless $matchback;
>>> unless($line =~ m|^Z +([^ ]+) +([^ ]+) +([^ ]+)
>>> +([^ ]+) +((\Q${pcdir}\E.*/)(.*))|) {
>>> print STDOUT "ERR_ZFRMT $line\n";
>>> $formaterr++;
>>> next LINE;
>>> }
>>> #NOTE: 1=uname 2=group 3=mode 4=mtime
>>> 5=fullpath 6=dir 7=file
>>> print STDERR "$1|$2|$3|$4|$5|$6|$7\n" if
>>> $verbose >=4;
>>> my $user = USER($1);
>>> my $group = GROUP($2);
>>> my $mode = oct($3);
>>> my $mtime = $4;
>>> my $file = $5;
>>> my $dir = $6;
>>> my $name = $7;
>>>
>>> #Check if file exists and not overwritable
>>> if(-e $file && !($Overwrite && -f $file &&
>>> unlink($file))) {
>>> print STDOUT "ERR_ZEXST $line\n";
>>> $filexsterr++;
>>> next LINE;
>>> }
>>>
>>> unless( -d $dir || jmake_path $dir){ #Make dir
>>> if doesn't exist
>>> #NOTE: typically shouldn't be necesary
>>> since list is
>>> #created with directories along the way
>>> print STDOUT "ERR_MKDIR $line\n";
>>> $mkdirerr++;
>>> next LINE;
>>> }
>>> #Create zero-length file with desired perms
>>> unless(sysopen(ZERO, $file, $CREATMASK, $mode)
>>> && close(ZERO)){
>>> print STDOUT "ERR_MKZER $line\n";
>>> $mkzeroerr++;
>>> next LINE;
>>> }
>>> unless(jchown $user, $group, $file){ #Set
>>> ownership
>>> print STDOUT "ERR_OWNER $line\n";
>>> $ownererr++;
>>> next LINE;
>>> }
>>> unless(jutime $time, $mtime, $file) { #Set
>>> timestamps
>>> $utimerr++;
>>> next LINE;
>>> }
>>> $newzero++;
>>> }
>>>
>>> case 'X' {$skipped++; next LINE; } #Error line
>>>
>>> case '#' {next LINE; } #Comment line
>>>
>>> else { #Hard link is default switch case
>>> next LINE unless $matchback;
>>> unless($line =~
>>> m|(c?pool/[0-9a-f]/[0-9a-f]/[0-9a-f]/[^/]+) +((\Q${pcdir}\E.*/).*)|) {
>>> print STDOUT "ERR_LFRMT $line\n";
>>> $formaterr++;
>>> next LINE;
>>> }
>>> print STDERR "$1|$2|$3\n" if $verbose >=4; #
>>> 1=source 2=target 3=targetdir
>>> my $source = $1;
>>> my $target = $2;
>>> my $targetdir = $3;
>>>
>>> if(-e $target &&
>>> !($Overwrite && -f $target &&
>>> unlink($target))){
>>> print STDOUT "ERR_LEXST $line\n";
>>> $filexsterr++; #Target exists and not
>>> overwritable
>>> next LINE;
>>> }
>>>
>>> unless(-d $targetdir || jmake_path $targetdir){
>>> #Make targetdir if doesn't exist
>>> #NOTE: typically shouldn't be necesary
>>> since list is
>>> #created with directories along the way
>>> print STDOUT "ERR_MKDIR $line\n";
>>> $mkdirerr++;
>>> next LINE;
>>> }
>>>
>>> unless(jlink $source, $target) { #Make link
>>> print STDOUT "ERR_MKLNK $line\n";
>>> $mklinkerr++;
>>> next LINE;
>>> }
>>> $newlink++
>>> }
>>> } #SWITCH end
>>> } # WHILE reading lines
>>>
>>> #Set mtimes for any remaining directories in @dirmtimes stack
>>> while(my $dir = shift(@dirmtimes)){
>>> jutime($time, shift(@dirmtimes), $dir);
>>> }
>>>
>>> ###############################################################################
>>> #Print results:
>>>
>>>
>>> printf("\nSUCCESSES: Restores=%d [Dirs=%d Zeros=%d Links=%d]
>>> Skipped=%d\n",
>>> ($newdir+$newzero+$newlink), $newdir, $newzero, $newlink,
>>> $skipped);
>>> printf("ERRORS: TOTAL=%d Format=%d Mkdir=%d Mkzero=%d Mklink=%d\n",
>>> ($formaterr + $mkdirerr + $mkzeroerr + $mklinkerr +
>>> $filexsterr + $ownererr + $permserr + $utimerr),
>>> $formaterr, $mkdirerr, $mkzeroerr, $mklinkerr);
>>> printf(" File_exists=%d Owner=%d Perms=%d Mtime=%d\n\n",
>>> $filexsterr, $ownererr, $permserr, $utimerr);
>>>
>>> exit; #RESTORE done
>>> }
>>> ###############################################################################
>>>
>>> ------------------------------------------------------------------------
>>> jLib.pm
>>>
>>> #============================================================= -*-perl-*-
>>> #
>>> # BackupPC::jLib package
>>> #
>>> # DESCRIPTION
>>> #
>>> # This library includes various supporting subroutines for use with
>>> BackupPC
>>> # functions used by BackupPC.
>>> # Some of the routines are variants/extensions of routines originally
>>> written
>>> # by Craig Barratt as part of the main BackupPC release.
>>> #
>>> # AUTHOR
>>> # Jeff Kosowsky
>>> #
>>> # COPYRIGHT
>>> # Copyright (C) 2008-2013 Jeff Kosowsky
>>> #
>>> # This program is free software; you can redistribute it and/or modify
>>> # it under the terms of the GNU General Public License as published by
>>> # the Free Software Foundation; either version 2 of the License, or
>>> # (at your option) any later version.
>>> #
>>> # This program is distributed in the hope that it will be useful,
>>> # but WITHOUT ANY WARRANTY; without even the implied warranty of
>>> # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
>>> # GNU General Public License for more details.
>>> #
>>> # You should have received a copy of the GNU General Public License
>>> # along with this program; if not, write to the Free Software
>>> # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
>>> USA
>>> #
>>> #========================================================================
>>> #
>>> # Version 0.4.1, released January 2013
>>>
>>> # CHANGELOG
>>> # 0.4.0 (Jan 2011)
>>> # 0.4.1 (Jan 2013) Added MD52RPath, is_poollink
>>> # Added jchmod, jchown
>>> # 0.4.2 (Feb 2013) Made write_attrib more robust
>>> #
>>> #========================================================================
>>>
>>> package BackupPC::jLib;
>>>
>>> use strict;
>>> use vars qw($VERSION);
>>> $VERSION = '0.4.1';
>>>
>>> use warnings;
>>> use File::Copy;
>>> use File::Glob ':glob';
>>> use File::Path;
>>> use File::Temp;
>>> use Fcntl; #Required for RW I/O masks
>>>
>>> use BackupPC::Lib;
>>> use BackupPC::Attrib;
>>> use BackupPC::FileZIO;
>>> use Data::Dumper; #Just used for debugging...
>>>
>>> no utf8;
>>>
>>> use constant _128KB => 131072;
>>> use constant _1MB => 1048576;
>>> use constant LINUX_BLOCK_SIZE => 4096;
>>> use constant TOO_BIG => 2097152; # 1024*1024*2 (2MB)
>>>
>>> require Exporter;
>>> our @ISA = qw(Exporter);
>>> our @EXPORT = qw(
>>> %Conf $dryrun $errorcount
>>> LINUX_BLOCK_SIZE TOO_BIG
>>> printerr warnerr firstbyte
>>> zFile2MD5 zFile2FullMD5
>>> link_recursively_topool
>>> jfileNameUnmangle
>>> getattr read_attrib count_file_attribs
>>> get_bakinfo get_file_attrib get_attrib_value get_attrib_type
>>> write_attrib write_file_attrib
>>> attrib
>>> MD52RPath
>>> is_poollink GetPoolLink jMakeFileLink
>>> poolname2number renumber_pool_chain delete_pool_file
>>> run_nightly
>>> jcompare zcompare zcompare2
>>> delete_files jtouch
>>> jchmod jchown jcopy jlink junlink jmkdir jmkpath jmake_path
>>> jrename jrmtree jutime
>>> );
>>>
>>> #Global variables
>>> our %Conf;
>>> our $errorcount=0;
>>> our $dryrun=1; #global variable - set to 1 to be safe -- should be set to
>>> #0 in actual program files if you don't want a
>>> dry-run
>>> #None of the routines below will change/delete/write actual
>>> #file data if this flag is set. The goal is to do
>>> everything but
>>> #the final write to assist with debugging or cold feet :)
>>>
>>> sub printerr
>>> {
>>> print "ERROR: " . $_[0];
>>> $errorcount++;
>>> }
>>>
>>> sub warnerr
>>> {
>>> $|++; # flush printbuffer first
>>> warn "ERROR: " . $_[0];
>>> $errorcount++;
>>> }
>>>
>>> # Returns the firstbyte of a file.
>>> # If coding $coding undefined or 0, return as unpacked 2 char hexadecimal
>>> # string. Otherwise, return as binary byte.
>>> # Return -1 on error.
>>> # Useful for checking the type of compressed file/checksum coding.
>>> sub firstbyte {
>>> my ($file, $coding) = @_;
>>> my $fbyte='';
>>> sysopen(my $fh, $file, O_RDONLY) || return -1;
>>> $fbyte = -1 unless sysread($fh, $fbyte, 1) == 1;
>>> close($fh);
>>> if (! defined($coding) || $coding == 0) {
>>> $fbyte = unpack('H*',$fbyte); # Unpack as 2 char hexadecimal
>>> string
>>> }
>>> else {
>>> $fbyte = vec($fbyte, 0, 8); # Return as binary byte
>>> }
>>> return $fbyte;
>>> }
>>>
>>> # Compute the MD5 digest of a compressed file. This is the compressed
>>> # file version of the Lib.pm function File2MD5.
>>> # For efficiency we don't use the whole file for big files
>>> # - for files <= 256K we use the file size and the whole file.
>>> # - for files <= 1M we use the file size, the first 128K and
>>> # the last 128K.
>>> # - for files > 1M, we use the file size, the first 128K and
>>> # the 8th 128K (ie: the 128K up to 1MB).
>>> # See the documentation for a discussion of the tradeoffs in
>>> # how much data we use and how many collisions we get.
>>> #
>>> # Returns the MD5 digest (a hex string) and the file size if suceeeds.
>>> # (or "" and error code if fails).
>>> # Note return for a zero size file is ("", 0).
>>> #
>>> # If $size < 0 then calculate size of file by fully decompressing
>>> # If $size = 0 then first try to read corresponding attrib file
>>> # (if it exists), if doesn't work then calculate by fully decompressing
>>> # IF $size >0 then use that as the size of the file
>>> #
>>> # If compreslvl is undefined then use the default compress level from
>>> # the config file
>>>
>>> sub zFile2MD5
>>> {
>>> my($bpc, $md5, $name, $size, $compresslvl) = @_;
>>>
>>> my ($fh, $rsize, $filesize, $md5size);
>>>
>>> return ("", -1) unless -f $name;
>>> return ("", 0) if (stat(_))[7] == 0; #Zero size file
>>> $compresslvl = $Conf{CompressLevel} unless defined $compresslvl;
>>> unless (defined ($fh = BackupPC::FileZIO->open($name, 0,
>>> $compresslvl))) {
>>> printerr "Can't open $name\n";
>>> return ("", -1);
>>> }
>>>
>>> my ($datafirst, $datalast);
>>> my @data;
>>> #First try to read up to the first 128K (131072 bytes)
>>> if ( ($md5size = $fh->read(\$datafirst, _128KB)) < 0 ) { #Fist 128K
>>> printerr "Can't read & decompress $name\n";
>>> return ("", -1);
>>> }
>>>
>>> if ($md5size == _128KB) { # If full read, continue reading up to 1st MB
>>> my $i=0;
>>> #Read in up to 1MB (_1MB), 128K at a time and alternate between
>>> 2 data buffers
>>> while ( ($rsize = $fh->read(\$data[(++$i)%2], _128KB)) == _128KB
>>> && ($md5size += $rsize) < _1MB ) {}
>>> $md5size +=$rsize if $rsize < _128KB; # Add back in partial read
>>> $datalast = ($i > 1 ?
>>> substr($data[($i-1)%2], $rsize,
>>> _128KB-$rsize) : '')
>>> . substr($data[$i%2], 0 ,$rsize); #Last 128KB (up to
>>> 1MB)
>>> }
>>>
>>> $size = 0 unless defined $size;
>>> if($size > 0) { #Use given size
>>> $filesize = $size;
>>> }elsif($md5size < _1MB) { #Already know the size because read it all
>>> (note don't do <=)
>>> $filesize = $md5size;
>>> } elsif($compresslvl == 0) { #Not compressed, so: size = actual size
>>> $filesize = -s $name;
>>> }elsif($size == 0) { # Try to find size from attrib file
>>> $filesize = get_attrib_value($name, "size");
>>> if(!defined($filesize)) {
>>> warn "Can't read size of $name from attrib file so
>>> calculating manually\n";
>>> }
>>> }
>>> if(!defined($filesize)) { #No choice but continue reading to find size
>>> $filesize = $md5size;
>>> while (($rsize = $fh->read(\($data[0]), _128KB)) > 0) {
>>> $filesize +=$rsize;
>>> }
>>> }
>>> $fh->close();
>>>
>>> $md5->reset();
>>> $md5->add($filesize);
>>> $md5->add($datafirst);
>>> $md5->add($datalast) if defined($datalast);
>>> return ($md5->hexdigest, $filesize);
>>> }
>>>
>>> #Compute md5sum of the full data contents of a file.
>>> #If the file is compressed, calculate the md5sum of the inflated
>>> #version (using the zlib routines to uncompress the stream). Note this
>>> #gives the md5sum of the FULL file -- not just the partial file md5sum
>>> #above.
>>> sub zFile2FullMD5
>>> {
>>> my($bpc, $md5, $name, $compresslvl) = @_;
>>>
>>> my $fh;
>>> my $data;
>>>
>>> $compresslvl = $Conf{CompressLevel} unless defined $compresslvl;
>>> unless (defined ($fh = BackupPC::FileZIO->open($name, 0,
>>> $compresslvl))) {
>>> printerr "Can't open $name\n";
>>> return -1;
>>> }
>>>
>>> $md5->reset();
>>> while ($fh->read(\$data, 65536) > 0) {
>>> $md5->add($data);
>>> }
>>>
>>> return $md5->hexdigest;
>>> }
>>>
>>> # Like MakeFileLink but for existing files where we don't have the
>>> # digest available. So compute digest and call MakeFileLink after
>>> # For each file, check if the file exists in $bpc->{TopDir}/pool.
>>> # If so, remove the file and make a hardlink to the file in
>>> # the pool. Otherwise, if the newFile flag is set, make a
>>> # hardlink in the pool to the new file.
>>> #
>>> # Returns 0 if a link should be made to a new file (ie: when the file
>>> # is a new file but the newFile flag is 0).
>>> # Returns 1 if a link to an existing file is made,
>>> # Returns 2 if a link to a new file is made (only if $newFile is set)
>>> # Returns negative on error.
>>> sub zMakeFileLink
>>> {
>>> my($bpc, $md5, $name, $newFile, $compress) = @_;
>>>
>>> $compress = $Conf{CompressLevel} unless defined $compress;
>>>
>>> my ($d,$ret) = zFile2MD5($bpc, $md5, $name, 0, $compress);
>>> return -5 if $ret < 0;
>>> $bpc->MakeFileLink($name, $d, $newFile, $compress);
>>> }
>>>
>>>
>>> # Use the following to create a new file link ($copy) that links to
>>> # the same pool file as the original ($orig) file does (or
>>> # should). i.e. this doesn't assume that $orig is properly linked to
>>> # the pool. This is computationally more costly than just making the
>>> # link, but will avoid further corruption whereby you get archive
>>> # files with multiple links to each other but no link to pool.
>>>
>>> # First, check if $orig links to the pool and if not create a link
>>> # via MakeFileLink. Don't create a new pool entry if newFile is zero.
>>> # If a link either already exists from the original to the pool or if
>>> # one was successfully created, then simply link $copy to the same
>>> # pool entry. Otherwise, just copy (don't link) $orig to $copy
>>> # and leave it unlinked to the pool.
>>>
>>> # Note that checking whether $orig is linked to the pool is
>>> # cheaper than running MakeFileLink since we only need the md5sum
>>> # checksum.
>>> # Note we assume that the attrib entry for $orig (if it exists) is
>>> # correct, since we use that as a shortcut to determine the filesize
>>> # (via zFile2MD5)
>>> # Returns 1 if a link to an existing file is made,
>>> # Returns 2 if a link to a new file is made (only if $newFile is set)
>>> # Returns 0 if file was copied (either because MakeFileLink failed or
>>> # because newFile=0 and no existing pool match
>>> # Returns negative on error.
>>> sub zCopyFileLink
>>> {
>>> my ($bpc, $orig, $copy, $newFile, $compress) = @_;
>>> my $ret=1;
>>> $compress = $Conf{CompressLevel} unless defined $compress;
>>> my $md5 = Digest::MD5->new;
>>> my ($md5sum, $md5ret) = zFile2MD5($bpc, $md5, $orig, 0, $compress);
>>>
>>> #If $orig is already properly linked to the pool (or linkable to pool
>>> after running
>>> #MakeFileLink on $orig) and HardLinkMax is not exceeded, then just link
>>> to $orig.
>>> if($md5ret > 0) { #If valid md5sum and non-zero length file (so should
>>> be linked to pool)...
>>> if((GetPoolLinkMD5($bpc, $orig, $md5sum, $compress, 0) == 1 ||
>>> #If pool link already exists
>>> ($ret = $bpc->MakeFileLink($orig, $md5sum, $newFile,
>>> $compress))> 0) #or creatable by MakeFileLink
>>> && (stat($orig))[3] < $bpc->{Conf}{HardLinkMax}) { # AND
>>> (still) less than max links
>>> return $ret if link($orig, $copy); # Then link from
>>> copy to orig
>>> }
>>> }
>>> if(copy($orig, $copy) == 1) { #Otherwise first copy file then try to
>>> link the copy to pool
>>> if($md5ret > 0 && ($ret = $bpc->MakeFileLink($copy, $md5sum,
>>> $newFile, $compress))> 0) {
>>> return 2; #Link is to a new copy
>>> }
>>> printerr "Failed to link copied file to pool: $copy\n";
>>> return 0; #Copy but not linked
>>> }
>>> die "Failed to link or copy file: $copy\n";
>>> return -1;
>>> }
>>>
>>> # Copy $source to $target, recursing down directory trees as
>>> # needed. The 4th argument if non-zero, means (for files) use
>>> # zCopyFileLink to make sure that everything is linked properly to the
>>> # pool; otherwise, just do a simple link. The 5th argument $force,
>>> # will erase a target directory if already present, otherwise an error
>>> # is signalled. The final 6th argument is the CompressionLevel which
>>> # can be left out and will the be calculated from
>>> # bpc->Conf{CompressLevel}
>>>
>>> # Note the recursion is set up so that the return is negative if
>>> # error, positive if consistent with a valid pool link (i.e. zero
>>> # length file or directories are consistent too), and zero if
>>> # successful but not consistent with a valid pool. The overall result
>>> # is -1 if there is any error and otherwise the AND'ed result of the
>>> # operations. That means if the overall result is positive then the
>>> # whole tree is successfully linked to the pool, so the next time
>>> # around we can use a simple linking (i.e $linkcheck=0). Note $source
>>> # and $target must be full paths from root. Note: if files are not
>>> # compressed properly then you won't be able to link them to pool.
>>> sub link_recursively_topool
>>> {
>>> my ($bpc, $source, $target, $linkcheck, $force, $compress) = @_;
>>> my $ret=1;
>>> die "Error: '$source' doesn't exist" unless -e $source;
>>> if (-e $target) {
>>> die "Error can't overwrite: $target (unless 'force' set)\n"
>>> unless $force;
>>> die "Error can't remove: $target ($!)\n" unless
>>> rmtree($target, 0, 0);
>>> }
>>> if (-d $source) {
>>> die "Error: mkdir failed to create new directory: $target
>>> ($!)\n"
>>> unless jmkdir($target);
>>> opendir( my $dh, $source) || die "Error: Could not open dir
>>> $source ($!)\n";
>>> foreach my $elem (readdir($dh)) {
>>> next if /^\.\.?$/; # skip dot files (. and ..)
>>> my $newsource = "$source/$elem";
>>> my $newtarget = "$target/$elem";
>>> my $newret = link_recursively_topool($bpc, $newsource,
>>> $newtarget, $linkcheck, $force, $compress);
>>> if ($newret < 0) { #Error so break out of loop & return
>>> closedir $dh;
>>> return -1
>>> }
>>> $ret = 0 if $newret == 0; #note $ret stays at 1 only if
>>> no elements return -1 or 0
>>> }
>>> closedir $dh;
>>> return $ret;
>>> }
>>> elsif ($dryrun) {return 1} # Return before making changes to filesystem
>>> elsif ( ! -s $source) { # zero size
>>> copy($source, $target); #No link since zero size
>>> }
>>> elsif ($linkcheck) { #Makes sure first that source properly linked to
>>> pool
>>> return(zCopyFileLink($bpc, $source, $target, 1, $compress));
>>> }
>>> else {#Otherwise, OK to perform simple link to source
>>> return (link($source, $target) == 1 ? 1 : -1)
>>> }
>>> }
>>>
>>> sub get_bakinfo
>>> {
>>> my ($bakinfofile, $entry) = @_;
>>> our %backupInfo = ();
>>>
>>> $bakinfofile .= "/backupInfo";
>>> warn "Can't read $bakinfofile\n" unless -f $bakinfofile;
>>>
>>> unless (my $ret = do $bakinfofile) { # Load the backupInfo file
>>> if ($@) {
>>> warn "couldn't parse $bakinfofile: $@\n";
>>> }
>>> elsif (!defined $ret) {
>>> warn "couldn't do $bakinfofile: $!\n";
>>> }
>>> elsif (! $ret) {
>>> warn "couldn't run $bakinfofile\n";
>>> }
>>> }
>>> my $value = $backupInfo{$entry};
>>> warn "$bakinfofile is empty or missing entry for '$entry'\n"
>>> unless defined $value;
>>> return $value;
>>> }
>>>
>>> # Note: getattr($attr) =$attr->{files}
>>> # getattr($attr, $file) =$attr->{files}{$file}
>>> # getattr($attr, $file, $attribute)
>>> =$attr->{files}{$file}{$attribute}
>>>
>>> sub getattr
>>> {
>>> my($attr, $fileName, $Attribute) = @_;
>>> return $attr->{files}{$fileName}{$Attribute} if ( defined($Attribute) );
>>> return $attr->{files}{$fileName} if ( defined($fileName) );
>>> return $attr->{files};
>>> }
>>>
>>>
>>> #Reads in the attrib file for directory $_[1] and (optional alternative
>>> #attrib file name $_[2]) and #stores it in the hashref $_[0] passed to
>>> #the function
>>> #Returns -1 and a blank $_[0] hash ref if attrib file doesn't exist
>>> #already (not necessarily an error)
>>> #Dies if attrib file exists but can't be read in.
>>> sub read_attrib
>>> {
>>> #Note: $_[0] = hash reference to attrib object
>>> #SO DO NOT USE LOCAL VARIABLE FOR IT (i.e. don't do my $attr=$_[0]
>>> $_[0] = BackupPC::Attrib->new({ compress => $Conf{CompressLevel} });
>>>
>>> # unless (defined $_[1]) { #JJK: DEBUGGING
>>> # print "read_attrib: \$_[1] undefined\n";
>>> # print Dumper @_;
>>> # }
>>> return -1 unless -f attrib($_[1], $_[2]);
>>> #This is not necessarily an error because dir may be empty
>>>
>>> $_[0]->read($_[1],$_[2]) or
>>> die "Error: Cannot read attrib file: " . attrib($_[1],$_[2]) .
>>> "\n";
>>>
>>> return 1;
>>> }
>>>
>>> #Same as Lib.pm fileNameUnmangle but doesn't require
>>> #unneccessary '$bpc'
>>> sub jfileNameUnmangle {
>>> my($name) = @_;
>>>
>>> $name =~ s{/f}{/}g;
>>> $name =~ s{^f}{};
>>> $name =~ s{%(..)}{chr(hex($1))}eg;
>>> return $name;
>>> }
>>>
>>> sub count_file_attribs
>>> {
>>> my ($attrib) = @_;
>>> return( scalar (keys (%{$attrib->get()})));
>>> }
>>>
>>> # Get attrib entry for $fullfilname. The corresponding hash is both
>>> returned and
>>> # also fills the hash reference (optionally) passed via $fileattrib.
>>> # If attrib file not present, return -1 (which may not be an error)
>>> # Returns -2 if not a mangled file
>>> # Dies if error
>>> sub get_file_attrib
>>> {
>>> my ($fullfilename, $fileattrib) = @_;
>>> $fullfilename =~ m{(.+)/(.+)}; #1=dir; $2=file
>>> return -2 unless defined $2;
>>>
>>> return -1 if read_attrib(my $attr, $1) < 0;
>>>
>>> %{$fileattrib} = %{$attr->{files}{jfileNameUnmangle($2)}};
>>> #Note unmangling removes initial 'f' AND undoes char mapping
>>> }
>>>
>>> # Returns value of attrib $key for $fullfilename (full path)
>>> # If not a mangled file or attrib file not present or there is not an
>>> # entry for the specificed key for the given file, then return 'undef'
>>> sub get_attrib_value
>>> {
>>> my ($fullfilename, $key) = @_;
>>> $fullfilename =~ m{(.+)/(.+)}; #1=dir; $2=file
>>>
>>> return undef unless defined $2;
>>> return undef if read_attrib(my $attr, $1) < 0;
>>> return $attr->{files}{jfileNameUnmangle($2)}{$key};
>>> #Note this returns undefined if key not present
>>> #Note unmangling removes initial 'f' AND undoes char mapping
>>> }
>>>
>>> # Returns value of attrib type key for $fullfilename (full path)
>>> # If attrib file present but filename not an entry, return -1 [not an error
>>> if file nonexistent]
>>> # If no attrib file (but directory exists), return -2 [not an error if
>>> directory empty]
>>> # If directory non-existent, return -3
>>> # If attrib file present but not readble, return -4 [true error]
>>> # Note there may an entry even if file non-existent (e.g. type 10 = delete)
>>> sub get_attrib_type
>>> {
>>> my ($fullfilename) = @_;
>>> $fullfilename =~ m{(.+)/(.+)}; #1=dir; $2=file
>>>
>>> # unless (defined $1) { #JJK: DEBUGGING
>>> # print "get_attrib_type: \$1 undefined\n";
>>> # print Dumper @_;
>>> # }
>>>
>>> return -3 unless -d $1;
>>> return -2 unless -f attrib($1);
>>> return -4 unless read_attrib(my $attr, $1) >= 0;
>>> my $type = $attr->{files}{jfileNameUnmangle($2)}{type};
>>> #Note unmangling removes initial 'f' AND undoes char mapping
>>> return (defined($type) ? $type : -1);
>>> }
>>>
>>> # Write out $attrib hash to $dir/attrib (or $dir/$attfilename) and
>>> # link appropriately to pool.
>>> # Non-zero 4th argument $poollink creates link to pool (using MakeFileLink)
>>> # after writing the attrib file.
>>> # 5th argument tells what to do if no files in $attrib
>>> # (0=return error, 1=delete attrib file and return success)
>>> # 6th argument is an optional alternative name for the attrib file itself
>>> # Note does an unlink first since if there are hard links, we don't want
>>> # to modify them
>>> # Returns positive if successful, 0 if not
>>> # Specifically, 1 if linked to existing, 2 if linked to new,
>>> # 3 if written without linking, 4 if (empty) attrib file deleted
>>>
>>> sub write_attrib
>>> {
>>> my ($bpc, $attrib, $dir, $poollink, $delempty, $attfilename) = @_;
>>> die "Error: Cannot write to directory: $dir\n" unless -w $dir;
>>>
>>> # unless (defined $dir) { #JJK: DEBUGGING
>>> # print "write_attrib: \$dir undefined";
>>> # print Dumper @_;
>>> # }
>>>
>>> my $attfilepath = attrib($dir, $attfilename);
>>>
>>> if(count_file_attribs($attrib) == 0 && -e $attfilepath && $delempty) {
>>> #Delete existing empty attrib file
>>> die "Error: could not unlink empty attrib file: $attfilepath\n"
>>>
>>> unless(junlink($attfilepath));
>>> return 4;
>>> }
>>>
>>> #First (safely) write out new attrib file to directory
>>> my $tempname = mktemp("attrib.XXXXXXXXXXXXXXXX");
>>> unless($attrib->write($dir, $tempname) == 1 &&
>>> (! -e $attfilepath || junlink($attfilepath)) &&
>>> jrename("$dir/$tempname", $attfilepath)) {
>>> unlink("$dir/$tempname") if -e "$dir/$tempname";
>>> die "Error: could not write attrib file: $attfilepath\n";
>>> }
>>> unlink("$dir/$tempname") if $dryrun;
>>>
>>> my $ret=3;
>>> if ($poollink) {
>>> my $data = $attrib->writeData;
>>> my $md5 = Digest::MD5->new;
>>> my $digest;
>>> if(($digest = $bpc->Buffer2MD5($md5, length($data), \$data)) eq
>>> -1
>>> || ($ret = jMakeFileLink($bpc, $attfilepath, $digest, 2,
>>>
>>> $Conf{CompressLevel})) <= 0) {
>>> printerr "Can't link attrib file to pool: $attfilepath
>>> ($ret)\n";
>>> }
>>> }
>>> return $ret;
>>> }
>>>
>>> # Write out $fileattrib for $file (without the mangle) to $dir/$attfilename
>>> (or
>>> # to the default attribute file for $dir if $attfilename is undef)
>>> # Reads in existing attrib file if pre-existing
>>> # 4th argument $poollink says whether to write to file (0) or link to
>>> # pool (using MakeFileLink).
>>> # Returns positive if successful, 0 if not
>>> # Specifically, 1 if linked to existing, 2 if linked to new,
>>> # 3 if written without linking
>>> sub write_file_attrib
>>> {
>>> my ($bpc, $dir, $file, $fileattrib, $poollink, $attfilename) = @_;
>>> #Note $fileattrib is a hashref
>>> my $ret=0;
>>>
>>> read_attrib(my $attr, $dir, $attfilename); #Read in existing attrib
>>> file if it exists
>>> $ret = write_attrib($bpc, $attr, $dir, $poollink, 0, $attfilename)
>>> if $attr->set($file, $fileattrib) > 0;
>>>
>>> # unless (defined $dir) { #JJK: DEBUGGING
>>> # print "write_file_attrib: \$dir undefined\n";
>>> # print Dumper @_;
>>> # }
>>>
>>> die "Error writing to '$file' entry to attrib file: " . attrib($dir,
>>> $attfilename) . "\n" unless $ret > 0;
>>> return $ret;
>>> }
>>>
>>> sub attrib
>>> {
>>> return (defined($_[1]) ? "$_[0]/$_[1]" : "$_[0]/attrib");
>>> }
>>>
>>> #
>>> # Given an MD5 digest $d and a compress flag, return the relative
>>> # path (to TopDir)
>>> #
>>> sub MD52RPath
>>> {
>>> my($bpc, $d, $compress, $poolDir) = @_;
>>>
>>> return if ( $d !~ m{(.)(.)(.)(.*)} );
>>> $poolDir = ($compress ? "cpool" : "pool")
>>> if ( !defined($poolDir) );
>>> return "$poolDir/$1/$2/$3/$1$2$3$4";
>>> }
>>>
>>> # Modified version of MakeFileLink including:
>>> # 1. Efficiency/clarity improvements
>>> # 2. Calls GetPoolLink to find candidate link targets.
>>> # 2. For non-compressed files, uses my improved jcompare comparison
>>> algorithm
>>> # 3. For compressed files, uses zcompare2 which compares only the compressed
>>> # data sans first-byte header & potential rsync digest trailer. This
>>> allows
>>> # for matches even if one file has rsync digest and other does not
>>> # 4. Moves file before unlinking in case subsequent link fails and needs to
>>> be
>>> # undone
>>> # 5. Added 6th input parameter to return pointer to the pool link name
>>> # 6. Extended meaning of newFile flag
>>> # 0 = Don't creat new pool file (as before)
>>> # 1 = Create new pool file IF no other links to source file
>>> # (this was the previous behavior for whenever newFile was set)
>>> # >2 = Create new pool file EVEN if source file has more than one link
>>> # (this will by extension link other things linked to the source
>>> # also to the pool -- which means that the pool might not clean
>>> # if it links to things outside of the pc directory -- so
>>> # use carefully
>>> # 7. Includes 'j' versions of file routines to allow dryrun
>>> # 8. Added check to see if already in pool and if so returns 3
>>>
>>> # For each file, check if the file exists in $bpc->{TopDir}/pool.
>>> # If so, remove the file and make a hardlink to the file in
>>> # the pool. Otherwise, if the newFile flag is set, make a
>>> # hardlink in the pool to the new file.
>>> #
>>> # Returns 0 if a link should be made to a new file (ie: when the file
>>> # is a new file but the newFile flag is 0).
>>> # JJK: of if newFlag =1 and $name has nlinks >1
>>> # Returns 1 if a link to an existing file is made,
>>> # Returns 2 if a link to a new file is made (only if $newFile is set)
>>> # Return 3 if first finds that already linked to the appropriate pool chain
>>> # Returns negative on error.
>>>
>>> sub jMakeFileLink
>>> {
>>> my($bpc, $name, $d, $newFile, $compress, $linkptr) = @_;
>>>
>>> my $poollink;
>>> my $result=GetPoolLinkMD5($bpc, $name, $d, $compress, 1, \$poollink);
>>> $$linkptr = $poollink if defined($linkptr) && $result > 0;
>>>
>>> if($result == 1){ #Already linked to the $d pool chain
>>> return 3;
>>> }elsif($result == 2) { #Matches existing, linkable pool file
>>> my $tempname = mktemp("$name.XXXXXXXXXXXXXXXX");
>>> return -5 unless jrename($name, $tempname); #Temorarily save
>>> if(!jlink($poollink, $name)) { #Link pool to source
>>> jrename($tempname, $name); #Restore if can't link
>>> return -3;
>>> }
>>> junlink($tempname); #Safe to remove the original
>>> return 1;
>>> }elsif($result == 3) { #No link or match
>>> if(defined($newFile) &&
>>> ($newFile > 1 || ($newFile == 1 && (stat($name))[3] == 1 )))
>>> {
>>> $poollink =~ m|(.*)/|;
>>> jmkpath($1, 0, 0777) unless -d $1 ;
>>> return -4 unless jlink($name, $poollink);
>>> return 2;
>>> } else { #New link should have been made but told not to
>>> my $dog = (stat($name))[3];
>>> print "$dog\n";
>>> return 0;
>>> }
>>> }else {
>>> return -6; #Error from GetPoolLink call
>>> }
>>> }
>>>
>>> # GetPoolLink
>>> # GetPoolLinkMD5
>>> #Find the pool/cpool file corresponding to file $name.
>>> #1. First iterates entire chain to see if *same inode* is present. I.e. if
>>> # already linked to the chain. If so, it returns the first instance.
>>> # Return = 1 and $Poolpathptr = name of the hard-linked match
>>> #2. If $compareflg is set, then iterate through again this time looking for
>>> # file *content* matches (this is much slower).
>>> # If so, it returns the first instance with Nlinks < HardLinkMax
>>> # Return = 2 and $Poolpathptr = name of the content match
>>> #3. Finally, if not linked (and also not matched if $compareflg set)
>>> # Return=3 and $$poolpathptr = first empty chain
>>> #Note: Return zero if zero size file
>>> # Return negative if error.
>>> #Note: if chain has multiple copies of the file, then it returns the first
>>> linked
>>> #match if present and if none and $compareflag set then the first content
>>> match
>>> sub GetPoolLink
>>> {
>>> my($bpc, $md5, $name, $compress, $compareflg, $poolpathptr) = @_;
>>>
>>> $compress = $bpc->{Conf}{CompressLevel} unless defined $compress;
>>>
>>> my ($md5sum , $ret) = defined($compress) && $compress > 0 ?
>>> zFile2MD5($bpc, $md5, $name, 0, $compress) :
>>> $bpc->File2MD5($md5, $name);
>>>
>>> return 0 if $ret == 0; #Zero-sized file
>>> return -3 unless $ret >0;
>>>
>>> GetPoolLinkMD5($bpc, $name, $md5sum, $compress, $compareflg,
>>> $poolpathptr);
>>> }
>>>
>>> sub GetPoolLinkMD5
>>> {
>>> my($bpc, $name, $md5sum, $compress, $compareflg, $poolpathptr) = @_;
>>> my($poolbase, $i);
>>>
>>> return -1 unless -f $name;
>>> my $inode = (stat(_))[1]; #Uses stat from -f
>>> return 0 if (stat(_))[7] == 0; #Zero-size (though shouldn't really
>>> happen since
>>> #md5sum input not defined for zero sized
>>> files
>>>
>>> $compress = $bpc->{Conf}{CompressLevel} unless defined $compress;
>>>
>>> return -2 unless
>>> defined($poolbase = $bpc->MD52Path($md5sum, $compress));
>>>
>>> #1st iteration looking for matching inode
>>> $$poolpathptr = $poolbase;
>>> for($i=0; -f $$poolpathptr; $i++) { #Look for linked copy (inode match)
>>> return 1 if ((stat(_))[1] == $inode);
>>> $$poolpathptr = $poolbase . '_' . $i; #Iterate
>>> }
>>>
>>> return 3 unless $compareflg; #No inode match
>>>
>>> #Optional 2nd iteration looking for matching content
>>> my $compare = defined($compress) && $compress > 0 ? \&zcompare2 :
>>> \&jcompare;
>>> $$poolpathptr = $poolbase;
>>> for(my $j=0; $j<$i; $j++ ) { #Look for content match
>>> return 2 if (stat($$poolpathptr))[3] <
>>> $bpc->{Conf}{HardLinkMax} &&
>>> !$compare->($name, $$poolpathptr);
>>> $$poolpathptr = $poolbase . '_' . $j; #Iterate
>>> }
>>> # No matching existing pool entry - $$poolpathptr is first empty chain
>>> element
>>> return 3;
>>> }
>>>
>>> #Test if $file is a valid link to the pool tree determined by $compresslvl.
>>> #Returns the name of the pool file link if it is valid, 0 otherwise.
>>> #Size is optional and is as described for zFile2MD5
>>> #Note this is similar to GetPoolLink but faster though less powerful
>>> sub is_poollink
>>> {
>>> my ($bpc, $md5, $file, $size, $compresslvl)= @_;
>>>
>>> return 0 unless -f $file;
>>>
>>> $compresslvl = $Conf{CompressLevel} unless defined $compresslvl;
>>> my ($filemd5, $ret) = zFile2MD5($bpc, $md5, $file, $size, $compresslvl);
>>> return 0 unless $ret > 0;
>>>
>>> my $finode = (stat($file))[1];
>>> my $poolpath = $bpc->MD52Path($filemd5, $compresslvl);
>>>
>>> my %poolhash = map {(stat($_))[1] => $_} bsd_glob($poolpath . "_*");
>>> $poolhash{(stat(_))[1]} = $poolpath if -f $poolpath; #Add poolpath
>>> #Note we can't add $poolpath to the glob in case it doesn't exist
>>> #since glob will return a non-existing non-pattern match entry as-is
>>>
>>> foreach (keys %poolhash) {
>>> if($_ == $finode) {
>>> $poolhash{$_} =~ m|.*/(.*)|;
>>> return $1;
>>> }
>>> }
>>> return 0;
>>> }
>>>
>>>
>>> #Convert pool name to constant length string consisting
>>> #of 32 hex digits for the base plus 6 (left) zero padded digits for
>>> #the chain suffix (suffixes are incremented by 1 so that no suffix
>>> #records as 0). Note this accomodates chains up to 10^6 long.
>>> #Use a number bigger than 6 if you have longer chains
>>> #Useful if you want to order (e.g., sort) pool file names numerically
>>> sub poolname2number
>>> {
>>> $_[0] =~ m|(.*/)?([^_]*)(_(.*))?|;
>>> my $suffix = defined($4) ? $4+1 : 0;
>>> return sprintf("%s%06s", $2, $suffix)
>>> }
>>>
>>> # Renumber pool chain holes starting at $firsthole and continue up the
>>> chain
>>> # to fill up # to $maxgap holes (which need not be contiguous).
>>> # If $maxgap is not specified it defaults to 1 (sufficient to cover one
>>> # deletion - i.e. hole -- which may be $file itself)
>>> # If $firsthole exists, it is an error. Use delete_pool_file instead,
>>> # if you want to delete first before renumbering.
>>> # Return 1 on success; Negative on failure
>>> sub renumber_pool_chain
>>> {
>>> my ($firsthole, $maxholes) = @_;
>>>
>>> $maxholes = 1 unless defined $maxholes;
>>>
>>> my ($base, $sufx);
>>> if($firsthole =~ m|(.*_)([0-9]+)|) {
>>> $base = $1;
>>> $sufx = $2;
>>> }else{
>>> $base = $firsthole . "_";
>>> $sufx = -1; #Corresponds to no suffix
>>> }
>>>
>>> my $nextsufx = $sufx+1;
>>> my $nextfile = $base . $nextsufx;
>>> while($nextsufx - $sufx <= $maxholes) {
>>> if(-e $nextfile) { #Non-hole so move/renumber
>>> if(-e $firsthole || ! jrename($nextfile, $firsthole)) {
>>> warn "Error: Couldn't renumber pool file:
>>> $nextfile --> $firsthole\n";
>>> return -2;
>>> }
>>> # print "Renumbering: $nextfile --> $firsthole\n";
>>> $firsthole = $base . (++$sufx); #Move hole up the chain
>>> }
>>> $nextfile = $base . (++$nextsufx);
>>> }
>>> return 1;
>>> }
>>>
>>> # Delete pool file (if it exists) and regardless renumber
>>> # chain to fill hole left by file. Fill up to $maxholes
>>> # above $file (including the hole left by $file) where
>>> # $maxholes defaults to 1.
>>> # If $file doesn't exist, then it just fills the hole
>>> # left by $file.
>>> # Return 1 on success; Negative on failure
>>> sub delete_pool_file
>>> {
>>> my ($file, $maxholes) = @_;
>>>
>>> if(-e $file && !junlink($file)) { #Try to delete if exists
>>> warn "Error: Couldn't unlink pool file: $file\n";
>>> return -3;
>>> }
>>> return(renumber_pool_chain($file,$maxholes)); #Returns -1/-2 on fail
>>> }
>>>
>>> # Run BackupPC_nightly
>>> sub run_nightly
>>> {
>>> my ($bpc) = @_;
>>> my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort});
>>> if ($err) {
>>> printerr "BackupPC_nightly: can't connect to server ($err)...\n";
>>> return($err);
>>> }
>>> if ((my $reply = $bpc->ServerMesg("BackupPC_nightly run")) eq "ok\n" ) {
>>> $bpc->ServerMesg("log $0: called for BackupPC_nightly run...");
>>> print "BackupPC_nightly scheduled to run...\n";
>>> return 0;
>>> }
>>> else {
>>> printerr "BackupPC_nightly ($reply)...\n";
>>> return $reply;
>>> }
>>> }
>>>
>>>
>>> # Rewrite of compare function (in File::Compare) since it messes up on
>>> # weird filenames with spaces and things (since it combines the "<"
>>> # and the filename in a single string). Also streamline the code by
>>> # getting rid of of extra fluff and removing code for comparing text
>>> # files while we are at. The basic algorithm remains the classic one
>>> # for comparing 2 raw files.
>>> # Returns 0 if equal, 1 if not equal. And negative if error.
>>> sub jcompare {
>>> my ($file1,$file2,$size) = @_;
>>> my ($fh1open, $fh2open, $fh1size);
>>> my $ret=0;
>>>
>>> local (*FH1, *FH2);
>>> unless (($fh1open = open(FH1, "<", $file1)) &&
>>> ($fh2open = open(FH2, "<", $file2))) {
>>> $ret = -1;
>>> goto compare_return;
>>> }
>>> binmode FH1;
>>> binmode FH2;
>>> if (($fh1size = -s FH1) != (-s FH2)) {
>>> $ret=1;
>>> goto compare_return;
>>> }
>>>
>>> unless (defined($size) && $size > 0) {
>>> $size = $fh1size;
>>> $size = LINUX_BLOCK_SIZE if $size < LINUX_BLOCK_SIZE;
>>> $size = TOO_BIG if $size > TOO_BIG;
>>> }
>>>
>>> my $data1 = my $data2 = '';
>>> my ($r1,$r2);
>>> while(defined($r1 = read(FH1,$data1,$size)) && $r1 > 0) {
>>> unless (defined($r2 = read(FH2,$data2,$r1)) && $r2 == $r1
>>> && $data2 eq $data1) {
>>> $ret=1;
>>> goto compare_return;
>>> }
>>> }
>>> $ret=1 if defined($r2 = read(FH2,$data2,LINUX_BLOCK_SIZE)) && $r2 > 0;
>>> $ret =-2 if $r1 < 0 || $r2 < 0; # Error on read
>>>
>>> compare_return:
>>> close(FH1) if $fh1open;
>>> close(FH2) if $fh2open;
>>> return $ret;
>>> }
>>>
>>> # Version of compare for BackupPC compressed files. Compares inflated
>>> # (uncompressed) versions of files. The BackupPC::FileZIO subroutine
>>> # is used to read in the files instead of just raw open & read. Note
>>> # this version of compare is relatively slow since you must use zlib
>>> # to decompress the streams that are being compared. Also, there is no
>>> # shortcut to just first compare the filesize since the size is not
>>> # known until you finish reading the file.
>>> sub zcompare {
>>> my ($file1, $file2, $compress)=@_;
>>> my ($fh1, $fh2);
>>> my $ret=0;
>>>
>>> $compress =1 unless defined $compress;
>>> unless ((defined ($fh1 = BackupPC::FileZIO->open($file1, 0,
>>> $compress))) &&
>>> (defined ($fh2 = BackupPC::FileZIO->open($file2, 0,
>>> $compress)))) {
>>> $ret = -1;
>>> goto zcompare_return;
>>> }
>>> my $data1 = my $data2 = '';
>>> my ($r1, $r2);
>>> while ( ($r1 = $fh1->read(\$data1, 65536)) > 0 ) {
>>> unless ((($r2 = $fh2->read(\$data2, $r1)) == $r1)
>>> && $data1 eq $data2) {
>>> $ret=1;
>>> goto zcompare_return;
>>> }
>>> }
>>> $ret =1 if ($r2 = $fh2->read(\$data2, LINUX_BLOCK_SIZE)) > 0; #see if
>>> anything left...
>>> $ret =-1 if $r1 < 0 || $r2 < 0; # Error on read
>>>
>>> zcompare_return:
>>> $fh1->close() if defined $fh1;
>>> $fh2->close() if defined $fh2;
>>> return $ret;
>>> }
>>>
>>> # Second alternative version that combines the raw speed of jcompare
>>> # with the ability to compare compressed files in zcompare. This
>>> # routine effectively should compare two compressed files just as fast
>>> # as the raw jcompare. The compare algorithm strips off the first byte
>>> # header and the appended rsync checksum digest info and then does a
>>> # raw compare on the intervening raw compressed data. Since no zlib
>>> # inflation (decompression) is done it should be faster than the
>>> # zcompare algorithm which requires inflation. Also since zlib
>>> # compression is well-defined and lossless for any given compression
>>> # level and block size, the inflated versions are identical if and
>>> # only if the deflated (compressed) versions are identical, once the
>>> # header (first byte) and trailers (rsync digest) are stripped
>>> # off. Note that only the data between the header and trailers have
>>> # this uniqe mapping. Indeed, since BackupPC only adds the checksum
>>> # the second time a file is needed, it is possible that the compressed
>>> # value will change with time (even though the underlying data is
>>> # unchanged) due to differences in the envelope. Note, to some extent
>>> # this approach assumes that the appended digest info is correct (at
>>> # least to the extent of properly indicating the block count and hence
>>> # compressed data size that will be compared)
>>> sub zcompare2 {
>>> my ($file1,$file2,$size) = @_;
>>> my ($fh1, $fh2, $fh1open, $fh2open);
>>> my $Too_Big = 1024 * 1024 * 2;
>>> my $ret=0;
>>>
>>> unless (($fh1open = open($fh1, "<", $file1)) &&
>>> ($fh2open = open($fh2, "<", $file2))) {
>>> $ret = -1;
>>> goto zcompare2_return;
>>> }
>>> binmode $fh1;
>>> binmode $fh2;
>>>
>>> my $fh1size = -s $fh1;
>>> my $fh2size = -s $fh2;
>>>
>>> my $data1 = my $data2 = '';
>>> unless (read($fh1, $data1, 1) == 1 && # Read first byte
>>> read($fh2, $data2, 1) == 1) {
>>> $ret = -1;
>>> goto zcompare2_return;
>>> }
>>> if (vec($data1, 0, 8) == 0xd6 || vec($data1, 0, 8) == 0xd7) {
>>> return -2 unless ( defined(seek($fh1, -8, 2)) );
>>> return -3 unless ( read($fh1, $data1, 4) == 4 );
>>> $fh1size -= 20 * unpack("V", $data1) + 49;
>>> # [0xb3 separator byte] + 20 * NUM_BLOCKS + DIGEST_FILE(32) +
>>> DIGEST_INFO (16)
>>> # where each of NUM_BLOCKS is a 20 byte Block digest consisting
>>> of 4 bytes of
>>> # Adler32 and the full 16 byte (128bit) MD4 file digest
>>> (checksum).
>>> # DIGEST_FILE is 2 copies of the full 16 byte (128bit) MD4
>>> digest
>>> # (one for protocol <=26 and the second for protocol >=27)
>>> # DIGEST_INFO is metadata consisting of a pack("VVVV") encoding
>>> of the
>>> # block size (should be 2048), the checksum seed, length of the
>>> # block digest (NUM_BLOCKS), and the magic number (0x5fe3c289).
>>> # Each is a 4 byte integer.
>>> }
>>>
>>> if (vec($data2, 0, 8) == 0xd6 || vec($data2, 0, 8) == 0xd7) {
>>> return -2 unless ( defined(seek($fh2, -8, 2)) );
>>> return -3 unless ( read($fh2, $data2, 4) == 4 );
>>> $fh2size -= 20 * unpack("V", $data2) + 49;
>>> }
>>>
>>> if ($fh1size != $fh2size) {
>>> $ret=1;
>>> goto zcompare2_return;
>>> }
>>>
>>> seek($fh1,1,0) ; #skip first byte
>>> seek($fh2,1,0) ; #skip first byte
>>>
>>>
>>> my $bytesleft=--$fh1size; #Reduce by one since skipping first byte
>>> $size = $fh1size unless defined($size) && $size > 0 && $size < $fh1size;
>>> $size = $Too_Big if $size > $Too_Big;
>>>
>>> my ($r1,$r2);
>>> while(defined($r1 = read($fh1,$data1,$size))
>>> && $r1 > 0) {
>>> unless (defined($r2 = read($fh2,$data2,$r1))
>>> && $data2 eq $data1) { #No need to test if
>>> $r1==$r2 since should be same size
>>> $ret=1; #Plus if it doesn't, it will be picked
>>> up in the $data2 eq $data1 line
>>> goto zcompare2_return;
>>> }
>>> $bytesleft -=$r1;
>>> $size = $bytesleft if $bytesleft < $size;
>>> }
>>> $ret=1 if defined($r2 = read($fh2,$data2,$size)) && $r2 > 0;
>>> #Note: The above line should rarely be executed since both files same
>>> size
>>> $ret =-2 if $r1 < 0 || $r2 < 0; # Error on read
>>>
>>> zcompare2_return:
>>> close($fh1) if $fh1open;
>>> close($fh2) if $fh2open;
>>> return $ret;
>>> }
>>>
>>> #Routine to remove files (unlink) or directories (rmtree)
>>> # $fullfilename is full path name to file or directory
>>> # Returns number of files deleted in the listref $dirfileref if defined;
>>> sub delete_files
>>> {
>>> my ($fullfilename, $dirfileref) = @_;
>>> my $listdeleted = defined($dirfileref);
>>> my $ret = -1;
>>> my $output;
>>> die "Error: '$fullfilename' doesn't exist or not writeable\n"
>>> unless -w $fullfilename;
>>> if(-f $fullfilename) {
>>> $ret = junlink($fullfilename);
>>> }
>>> elsif(-d $fullfilename) {
>>> $$dirfileref = "" if $listdeleted;
>>> open(local *STDOUT, '>', $dirfileref) #redirect standard out to
>>> capture output of rmtree
>>> if $listdeleted;
>>> $ret = jrmtree($fullfilename, $listdeleted, 1);
>>> }
>>> return $ret;
>>> }
>>>
>>> #Touch command (modified version of Unix notion)
>>> #First argument is the (full)filepath.
>>> #Zero-length file is created if non-existent.
>>> #If existent and second argument zero or not defined then access
>>> # and modification times are updated.
>>> #Returns 1 on success, -1 on error;
>>> sub jtouch
>>> {
>>> return 1 if $dryrun;
>>> if(! -e $_[0]) { #Create if non-existent
>>> return -1 unless defined(sysopen(my $fh, $_[0], O_CREAT));
>>> close $fh;
>>> }elsif(!$_[1]) {
>>> my $time = time();
>>> utime($time, $time, $_[0]);
>>> }
>>> return 1;
>>> }
>>>
>>> #Simple wrappers to protect filesystem when just doing dry runs
>>> sub jchmod
>>> {
>>> return 1 if $dryrun;
>>> chmod @_;
>>> }
>>>
>>> sub jchown
>>> {
>>> return 1 if $dryrun;
>>> chown @_;
>>> }
>>>
>>> sub jcopy
>>> {
>>> return 1 if $dryrun;
>>> copy @_;
>>> }
>>>
>>> sub jlink
>>> {
>>> return 1 if $dryrun;
>>> link $_[0], $_[1];
>>> }
>>>
>>> sub junlink
>>> {
>>> return 1 if $dryrun;
>>> unlink @_;
>>> }
>>>
>>> sub jmkdir
>>> {
>>> return 1 if $dryrun;
>>> mkdir @_;
>>> }
>>>
>>> sub jmkpath
>>> {
>>> return 1 if $dryrun;
>>> mkpath @_;
>>> }
>>>
>>> sub jmake_path
>>> {
>>> return 1 if $dryrun;
>>> mkpath @_;
>>> }
>>>
>>> sub jrename
>>> {
>>> return 1 if $dryrun;
>>> rename $_[0], $_[1];
>>> }
>>>
>>> sub jrmtree
>>> {
>>> return 1 if $dryrun;
>>> rmtree @_;
>>> }
>>>
>>> sub jutime
>>> {
>>> return 1 if $dryrun;
>>> utime @_;
>>> }
>>>
>>> 1;
>>>
>>>
>>> ------------------------------------------------------------------------------
>>> Everyone hates slow websites. So do we.
>>> Make your web apps faster with AppDynamics
>>> Download AppDynamics Lite for free today:
>>> http://p.sf.net/sfu/appdyn_d2d_feb
>>> _______________________________________________
>>> BackupPC-users mailing list
>>> BackupPC-users AT lists.sourceforge DOT net
>>> List: https://lists.sourceforge.net/lists/listinfo/backuppc-users
>>> Wiki: http://backuppc.wiki.sourceforge.net
>>> Project: http://backuppc.sourceforge.net/
>>>
>>
>
--
"There is no 'eastern' and 'western' medicine. There's 'medicine' and
then there's 'stuff that has not been proven to work.'"
-- Maki Naro, "The Red Flags of Quackery, v2.0", Sci-ence.org
------------------------------------------------------------------------------
Everyone hates slow websites. So do we.
Make your web apps faster with AppDynamics
Download AppDynamics Lite for free today:
http://p.sf.net/sfu/appdyn_d2d_feb
_______________________________________________
BackupPC-users mailing list
BackupPC-users AT lists.sourceforge DOT net
List: https://lists.sourceforge.net/lists/listinfo/backuppc-users
Wiki: http://backuppc.wiki.sourceforge.net
Project: http://backuppc.sourceforge.net/
|
