#!/usr/bin/perl
#============================================================= -*-perl-*-
#
# BackupPC_dump: Dump a single client.
#
# DESCRIPTION
#
#   Usage: BackupPC_dump [-i] [-f] [-F] [-I] [-d] [-e] [-v] <client>
#
#   Flags:
#
#     -i   Do an incremental dump, overriding any scheduling (but a full
#          dump will be done if no dumps have yet succeeded)
#
#     -f   Do a full dump, overriding any scheduling.
#
#     -I   Do an increment dump if the regular schedule requires a
#          full or incremental, otherwise do nothing (a full is done
#          if no dumps have yet succeeded)
#
#     -F   Do a full dump if the regular schedule requires a
#          full or incremental, otherwise do nothing
#
#     -d   Host is a DHCP pool address, and the client argument
#          just an IP address.  We lookup the NetBios name from
#          the IP address.
#
#     -e   Just do an dump expiry check for the client.  Don't do anything
#          else.  This is used periodically by BackupPC to make sure that
#          dhcp hosts have correctly expired old backups.  Without this,
#          dhcp hosts that are no longer on the network will not expire
#          old backups.
#
#     -p   don't show progress
#
#     -v   verbose.  for manual usage: prints failure reasons in more detail.
#
#     -m   run even if a backup on this host is running
#          (specifically, don't take the server host mutex)
#
#   BackupPC_dump is run periodically by BackupPC to backup $client.
#   The file $TopDir/pc/$client/backups is read to decide whether a
#   full or incremental backup needs to be run.  If no backup is
#   scheduled, or a ping to $client fails, then BackupPC_dump quits.
#
#   Starting in 4.x, the most recent backup is always filled and the prior
#   backups are stored as reverse-time deltas.  So before the backup
#   starts, the last prior backup numbered $M in $TopDir/pc/$client/$M
#   is renamed to $TopDir/pc/$client/{$M+1}, and a new empty directory
#   $TopDir/pc/$client/$M is created to stored the deltas.
#
#   The backup is done using the selected XferMethod (smb, tar, rsync,
#   backuppcd etc), extracting the dump into $TopDir/pc/$client/{$M+1}.
#   The xfer output is put into $TopDir/pc/$client/XferLOG.{$M+1}.z.
#
#   If the dump succeeds (based on parsing the output of the XferMethod)
#   $TopDir/pc/$client/backups is updated.
#
#   If the dump fails with no files backed up, then $TopDir/pc/$client/{$M+1}
#   is renamed back to $TopDir/pc/$client/$M and
#   $TopDir/pc/$client/XferLOG{$M+1}.z is renamed to
#   $TopDir/pc/$client/XferLOG.bad.z for later viewing.
#
#   In 4.x the concept of a partial backup has been modified.  While it
#   still means the last backup was incomplete in some way, the storage
#   still represents the most complete, up-to-date backup.  So a partial
#   is never deleted, and it is intended to be used for browsing and
#   restores.
#
#   BackupPC_dump communicates to BackupPC via printing to STDOUT.
#
# AUTHOR
#   Craig Barratt  <cbarratt@users.sourceforge.net>
#
# COPYRIGHT
#   Copyright (C) 2001-2020  Craig Barratt
#
#   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 3 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, see <http://www.gnu.org/licenses/>.
#
#========================================================================
#
# Version 4.4.0, released 20 Jun 2020.
#
# See http://backuppc.sourceforge.net.
#
#========================================================================

use strict;
no utf8;

use lib "/usr/share/backuppc/lib";
use BackupPC::DirOps;
use BackupPC::Lib;
use BackupPC::Storage;
use BackupPC::Xfer;
use BackupPC::XS;
use Data::Dumper;
use Encode;
use Errno qw(EINTR);
use Socket;
use File::Path;
use File::Find;
use Getopt::Std;

###########################################################################
# Initialize
###########################################################################

die("BackupPC::Lib->new failed\n") if ( !(my $bpc = BackupPC::Lib->new) );

my $TopDir = $bpc->TopDir();
my $BinDir = $bpc->BinDir();
my %Conf   = $bpc->Conf();
my $NeedPostCmd;
my $Hosts;
my $SigName;
my $Abort = 0;
my $LockFd;

$bpc->ChildInit();

my %opts;
if ( !getopts("defimvpFI", \%opts) || @ARGV != 1 ) {
    print STDERR <<EOF;
usage: $0 [options] <client>
  Options:
     -i   Do an incremental dump, overriding any scheduling (but a full
          dump will be done if no dumps have yet succeeded)
     -f   Do a full dump, overriding any scheduling.
     -I   Do an increment dump if the regular schedule requires a
          full or incremental, otherwise do nothing (a full is done
          if no dumps have yet succeeded)
     -F   Do a full dump if the regular schedule requires a
          full or incremental, otherwise do nothing
     -d   Host is a DHCP pool address, and the client argument
          just an IP address.  We lookup the NetBios name from
          the IP address.
     -e   Just do an dump expiry check for the client.  Don't do anything
          else.  This is used periodically by BackupPC to make sure that
          dhcp hosts have correctly expired old backups.  Without this,
          dhcp hosts that are no longer on the network will not expire
          old backups.
     -p   don't show progress
     -v   verbose.  for manual usage: prints failure reasons in more detail.
     -m   run even if a backup on this host is running
          (specifically, don't take the server host mutex)
EOF
    exit(1);
}
if ( $ARGV[0] !~ /^([\w\.\s-]+)$/ ) {
    print("$0: bad client name '$ARGV[0]'\n");
    exit(1);
}
if ( (defined($opts{f}) + defined($opts{i}) + defined($opts{F}) + defined($opts{I})) > 1 ) {
    print("$0: exiting because you can only use one of -f, -i, -F, and -I\n");
    exit(1);
}

my $client = $1;    # BackupPC's client name (might not be real host name)
my $hostIP;         # this is the IP address
my $host;           # this is the real host name

my($clientURI, $user);

$bpc->verbose(1) if ( $opts{v} );

if ( $opts{d} ) {
    #
    # The client name $client is simply a DHCP address.  We need to check
    # if there is any machine at this address, and if so, get the actual
    # host name via NetBios using nmblookup.
    #
    $hostIP = $client;
    if ( $bpc->CheckHostAlive($hostIP) < 0 ) {
        print("Exiting because CheckHostAlive($hostIP) failed\n")
          if ( $opts{v} );
        exit(1);
    }
    if ( $Conf{NmbLookupCmd} eq "" ) {
        print("Exiting because \$Conf{NmbLookupCmd} is empty\n")
          if ( $opts{v} );
        exit(1);
    }
    ($client, $user) = $bpc->NetBiosInfoGet($hostIP);
    if ( $client !~ /^([\w\.\s-]+)$/ ) {
        print("Exiting because NetBiosInfoGet($hostIP) returned '$client', an invalid host name\n")
          if ( $opts{v} );
        exit(1);
    }
    $Hosts = $bpc->HostInfoRead($client);
    $host  = $client;
} else {
    $Hosts = $bpc->HostInfoRead($client);
}
if ( !defined($Hosts->{$client}) ) {
    print("Exiting because host $client does not exist in the hosts file\n") if ( $opts{v} );
    exit(1);
}

my $Dir     = "$TopDir/pc/$client";
my @xferPid = ();
my $tarPid  = -1;

#
# Re-read config file, so we can include the PC-specific config
#
$clientURI = $bpc->uriEsc($client);
if ( defined(my $error = $bpc->ConfigRead($client)) ) {
    print("dump failed: Can't read PC's config file: $error\n");
    exit(1);
}
%Conf = $bpc->Conf();
BackupPC::XS::Lib::logLevelSet($Conf{XferLogLevel});

#
# Write new-style attrib files (<= 4.0.0beta3 uses old-style), which are 0-length
# files with the digest encoded in the file name (eg: attrib_md5HexDigest). We
# can still read the old-style files, and we upgrade them as we go.
#
BackupPC::XS::Attrib::backwardCompat(0, 0);

#
# Catch various signals
#
$SIG{INT}  = \&catch_signal;
$SIG{ALRM} = \&catch_signal;
$SIG{TERM} = \&catch_signal;
$SIG{PIPE} = \&catch_signal;
$SIG{STOP} = \&catch_signal;
$SIG{TSTP} = \&catch_signal;
$SIG{TTIN} = \&catch_signal;
my $Pid = $$;

mkpath($Dir, 0, 0777) if ( !-d $Dir );

my($LogFd, $LogPath) = $bpc->openPCLogFile($client);
if ( !defined($LogFd) ) {
    print("Unable to open/create $LogPath; exiting\n");
    exit(1);
}
select($LogFd); $| = 1; select(STDOUT);
flushLibMessages();

#
# For the -e option we just expire backups and quit
#
if ( $opts{e} ) {
    BackupExpire($client);
    exit(0);
}

#
# For archive hosts we don't bother any further
#
if ( $Conf{XferMethod} eq "archive" ) {
    print("Exiting because the XferMethod is set to archive\n")
      if ( $opts{v} );
    exit(0);
}

###########################################################################
# Figure out what to do and do it
###########################################################################

#
# See if we should skip this host during a certain range
# of times.
#
my $err = $bpc->ServerConnect($Conf{ServerHost}, $Conf{ServerPort});
if ( $err ne "" ) {
    print("Can't connect to server ($err)\n");
    print($LogFd $bpc->timeStamp, "Can't connect to server ($err)\n");
    exit(1);
}
my $reply = $bpc->ServerMesg("status host($clientURI)");
$reply = $1 if ( $reply =~ /(.*)/s );
my(%StatusHost);
eval($reply);

#
# For DHCP tell BackupPC which host this is
#
if ( $opts{d} ) {
    if ( $StatusHost{activeJob} ) {
        print(STDERR "$0: exiting because backup is already running for $client\n");
        exit(1);
    }
    if ( (my $status = $bpc->ServerMesg("DHCP $hostIP $clientURI")) =~ /fail/ ) {
        print(STDERR "$0: $status; exiting\n");
        exit(1);
    }
}

if ( !$opts{m} && (my $status = $bpc->ServerMesg("hostMutex $client -1 BackupPC_dump")) =~ /fail/ ) {
    print(STDERR "$0: $status (use -m option to force running)\n");
    exit(1);
}

my(@Backups, $type);
my $lastFullTime = 0;
my $lastIncrTime = 0;
my($incrBaseTime, $incrBaseBkupNum);
my($lastBkupIdx, $lastBkupNum, $lastBkupType, $lastBkupCompressLevel, $prevBkupIdx);
my($newBkupNum, $newBkupIdx, $preV4, $noFillCnt);
my $inodeLast = 1;

#
# Maintain backward compatibility with $Conf{FullPeriod} == -1 or -2
# meaning disable backups
#
$Conf{BackupsDisable} = -$Conf{FullPeriod}
  if ( !$Conf{BackupsDisable} && $Conf{FullPeriod} < 0 );

if (   $Conf{BackupsDisable} == 1 && !$opts{f} && !$opts{i}
    || $Conf{BackupsDisable} == 2 ) {
    print("Exiting because backups are disabled with \$Conf{BackupsDisable} = $Conf{BackupsDisable}\n")
      if ( $opts{v} );
    #
    # Tell BackupPC to ignore old failed backups on hosts that
    # have backups disabled.
    #
    print("backups disabled\n")
      if ( defined($StatusHost{errorTime})
        && $StatusHost{reason} ne "Reason_backup_done"
        && time - $StatusHost{errorTime} > 4 * 24 * 3600 );
    NothingToDo();
}

if (   !$opts{i}
    && !$opts{f}
    && $Conf{BlackoutGoodCnt} >= 0
    && $StatusHost{aliveCnt} >= $Conf{BlackoutGoodCnt} ) {
    my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
    my($currHours) = $hour + $min / 60 + $sec / 3600;
    my $blackout;

    foreach my $p ( @{$Conf{BlackoutPeriods}} ) {
        #
        # Allow blackout to span midnight (specified by hourBegin
        # being greater than hourEnd)
        #
        next if ( ref($p->{weekDays}) ne "ARRAY" || !defined($p->{hourBegin}) || !defined($p->{hourEnd}) );
        my $matchWday = $wday;
        if ( $p->{hourBegin} > $p->{hourEnd} ) {
            $blackout = $p->{hourBegin} <= $currHours
              || $currHours <= $p->{hourEnd};
            if ( $currHours <= $p->{hourEnd} ) {
                #
                # This is after midnight, so decrement the weekday for the
                # weekday check (eg: Monday 11pm-1am means Monday 2300 to
                # Tuesday 0100, not Monday 2300-2400 plus Monday 0000-0100).
                #
                $matchWday--;
                $matchWday += 7 if ( $matchWday < 0 );
            }
        } else {
            $blackout = $p->{hourBegin} <= $currHours
              && $currHours <= $p->{hourEnd};
        }
        if ( $blackout && grep($_ == $matchWday, @{$p->{weekDays}}) ) {

            #           print($LogFd $bpc->timeStamp, "skipping because of blackout"
            #                      . " (alive $StatusHost{aliveCnt} times)\n");
            print("Skipping $client because of blackout\n")
              if ( $opts{v} );
            NothingToDo();
        }
    }
}

if ( !$opts{i} && !$opts{f} && $StatusHost{backoffTime} > time ) {
    printf($LogFd "%sskipping because of user requested delay (%.1f hours left)\n",
        $bpc->timeStamp, ($StatusHost{backoffTime} - time) / 3600);
    NothingToDo();
}

#
# Now see if there are any old backups we should delete
#
BackupExpire($client);

#
# Read Backup information, and if the most recent backup is v4, check
# that it is filled and it exists.
#
@Backups = $bpc->BackupInfoRead($client);
if (   @Backups
    && ($Backups[-1]{version} ne "" && $Backups[-1]{version} !~ /^[23]\./)
    && ($Backups[-1]{noFill} || !-d "$Dir/$Backups[-1]{num}") ) {
    my $i;
    if ( $Backups[-1]{noFill} ) {
        printf($LogFd "%sSerious error: last backup %d is not filled!  Need to remove back to last filled backup\n",
            $bpc->timeStamp, $Backups[-1]{num});
        printf("Serious error: last backup %d is not filled!  Need to remove back to last filled backup\n",
            $Backups[-1]{num})
          if ( $opts{v} );
    } else {
        printf($LogFd
              "%sSerious error: last backup %s directory doesn't exist!!!  Need to remove back to last filled backup\n",
            $bpc->timeStamp, "$Dir/$Backups[-1]{num}");
        printf(
            "%sSerious error: last backup %s directory doesn't exist!!!  Need to remove back to last filled backup\n",
            $bpc->timeStamp, "$Dir/$Backups[-1]{num}")
          if ( $opts{v} );
    }
    for ( $i = @Backups - 1 ; $i >= 0 ; $i-- ) {
        last if ( $Backups[$i]{version} eq "" || $Backups[$i]{version} =~ /^[23]\./ );
        last if ( !$Backups[$i]{noFill} && -d "$Dir/$Backups[$i]{num}" );
    }
    $i++;
    while ( $i < @Backups ) {
        printf($LogFd "%sDeleting backup %d\n", $bpc->timeStamp, $Backups[$i]{num});
        printf("%sDeleting backup %d\n",        $bpc->timeStamp, $Backups[$i]{num}) if ( $opts{v} );
        BackupRemove($client, $i, 1);
        $bpc->BackupInfoWrite($client, @Backups);
    }
    exit(0);
}

#
# Find the most recent backup, times of the most recent full and incremental backups,
# and check if the most recent backup is V4+ or prior to V4 (ie: preV4).
#
my $thisNoFillCnt;
for ( my $i = 0 ; $i < @Backups ; $i++ ) {
    $Backups[$i]{preV4} = ($Backups[$i]{version} eq "" || $Backups[$i]{version} =~ /^[23]\./) ? 1 : 0;
    $thisNoFillCnt++ if ( $Backups[$i]{noFill} );
    $inodeLast = $Backups[$i]{inodeLast} if ( $inodeLast < $Backups[$i]{inodeLast} );
    if ( !defined($lastBkupNum) || $Backups[$i]{num} > $lastBkupNum ) {
        $lastBkupNum           = $Backups[$i]{num};
        $prevBkupIdx           = $lastBkupIdx;
        $lastBkupIdx           = $i;
        $incrBaseBkupNum       = $Backups[$i]{num};
        $incrBaseTime          = $Backups[$i]{startTime};
        $lastBkupType          = $Backups[$i]{type};
        $lastBkupCompressLevel = $Backups[$i]{compress};
        $preV4                 = $Backups[$i]{preV4};
        $noFillCnt             = $thisNoFillCnt;
    }
    $thisNoFillCnt = 0 if ( !$Backups[$i]{noFill} );
    if ( $Backups[$i]{type} eq "full" ) {
        if ( $lastFullTime < $Backups[$i]{startTime} ) {
            $lastFullTime = $Backups[$i]{startTime};
        }
    } elsif ( $Backups[$i]{type} eq "incr" ) {
        $lastIncrTime = $Backups[$i]{startTime}
          if ( $lastIncrTime < $Backups[$i]{startTime} );
    }
}

#
# Decide whether we do nothing, or a full or incremental backup.
#
my $needs_full =
  (time - $lastFullTime > $Conf{FullPeriod} * 24 * 3600 && time - $lastIncrTime > $Conf{IncrPeriod} * 24 * 3600);
my $needs_incr =
  (time - $lastIncrTime > $Conf{IncrPeriod} * 24 * 3600 && time - $lastFullTime > $Conf{IncrPeriod} * 24 * 3600);

$needs_full = 0 if ( $Conf{FullPeriod} == 0 );

if ( $opts{f} || (!$opts{i} && !$opts{I} && $needs_full) || ($opts{F} && $needs_incr) ) {
    $type = "full";
} elsif ( $opts{i} || $needs_incr || ($opts{I} && $needs_full) ) {
    $type = "incr";
} else {
    NothingToDo();
}

print(  "Backup type: type = $type, needs_full = $needs_full, needs_incr = $needs_incr, lastFullTime = $lastFullTime,"
      . " opts{f} = $opts{f}, opts{i} = $opts{i}, opts{F} = $opts{F}\n")
  if ( $opts{v} );

#
# Create top-level directories if they don't exist
#
foreach my $dir ( ("$Conf{TopDir}/pool", "$Conf{TopDir}/cpool", $Dir, "$Dir/refCnt") ) {
    next if ( -d $dir );
    mkpath($dir, 0, 0777);
    if ( !-d $dir ) {
        print("Failed to create $dir\n");
        printf($LogFd "%sFailed to create directory %s\n", $bpc->timeStamp, $dir);
        exit(1);
    } else {
        printf($LogFd "%sCreated directory %s\n", $bpc->timeStamp, $dir);
    }
}

#
# Build the list of hosts to check
#
my @validHosts = ();

if ( !$opts{d} ) {
    #
    # In the non-DHCP case, make sure the host can be looked up
    # via NS, or otherwise find the IP address via NetBios.
    #
    my @hostsToCheck = ();
    if ( ref($Conf{ClientNameAlias}) eq "ARRAY" ) {
        push(@hostsToCheck, @{$Conf{ClientNameAlias}});
    } elsif ( $Conf{ClientNameAlias} ne "" ) {
        push(@hostsToCheck, $Conf{ClientNameAlias});
    } else {
        push(@hostsToCheck, $client);
    }
    foreach my $hostToCheck ( @hostsToCheck ) {
        $hostIP = HostLookupCheck($hostToCheck);
        push(@validHosts, [$hostToCheck, $hostIP]) if ( defined($hostIP) );
    }
} else {

    # In DHCP case we've already found $hostIP
    push(@validHosts, [$host, $hostIP]);
}

#
# Find the first entry in @validHosts that we can ping
#
foreach my $h ( @validHosts ) {
    ($host, $hostIP) = @$h;
    my $delay = $bpc->CheckHostAlive($hostIP);
    if ( $delay < 0 ) {
        print($LogFd $bpc->timeStamp, "no ping response from $hostIP\n");
        print("no ping response from $hostIP\n");
        $hostIP = undef;
        next;
    } elsif ( $delay > $Conf{PingMaxMsec} ) {
        printf($LogFd "%sping too slow on $hostIP %.4gmsec\n",              $bpc->timeStamp, $delay);
        printf("ping too slow on $hostIP %.4gmsec (threshold is %gmsec)\n", $delay,          $Conf{PingMaxMsec});
        $hostIP = undef;
        next;
    }
    last;
}

if ( !defined($hostIP) ) {
    print($LogFd $bpc->timeStamp, "can't ping $host (client = $client); exiting\n");
    print("can't ping $host (client = $client); exiting\n") if ( $opts{v} );
    exit(1);
}

#
# Make sure it is really the machine we expect (only for fixed addresses,
# since we got the DHCP address above).
#
if ( !$opts{d} && (my $errMsg = CorrectHostCheck($hostIP, $host)) ) {
    print($LogFd $bpc->timeStamp, "dump failed: $errMsg\n");
    print("dump failed: $errMsg\n");
    exit(1);
} elsif ( $opts{d} ) {
    print($LogFd $bpc->timeStamp, "$host is dhcp $hostIP, user is $user\n");
}

#
# There are six cases:
#
#  1) No backups at all: create a new backup #0 and do inPlace.
#                        do a full backup.
#
#  2) V3 backups, no V4: duplicate last V3 backup, and do inPlace.
#                        do a full backup.
#
#  3) V4 backups: last is a full, or more than $Conf{FillCycle}
#     since last filled: duplicate last backup and do inPlace.
#
#  4) V4 backups, less than $Conf{FillCycle} since last filled:
#                        renumber last backup to #n+1, deltas in #n.
#
#  5) CompressLevel has toggled on/off.   Very hard to support
#     efficiently.  We treat this as a brand new (empty) backup
#     inPlace, that is therefore filled.  That way we won't mess
#     up merging backups with compress on/off.
#
#  6) Last backup was a V4 partial.  If prior V4 backup is filled
#     (and not partial), then just do another in-place backup.
#     Otherwise, treat as case 4.  When complete (whether successful
#     or another partial), delete the prior deltas in #n, which
#     merges the cumulative changes into #n-1.
#
# We remember which case it is so we can figure out what to clean
# up on a failed backup.
#
# Note: $Conf{FillCycle} == 0, then the V4 fill cycle matches the
# full/incr cycle.
#

#
# $inPlace means the Xfer method makes all the changes in place, without
# stored any reverse deltas in a prior backup tree.
#
my $inPlace = 0;

#
# doDuplicate means we run BackupPC_backupDuplicate, which duplicates the
# most recent v3 and v4 backup.
#
my $doDuplicate = 0;
my $copyXferLOG;

#
# Remember which case, so we can figure out what to clean up on a failed backup.
#
my $BackupCase;

if ( !defined($lastBkupNum) ) {
    #
    # case 1: no backups.  Create a new empty backup and do inPlace.
    #
    $BackupCase  = 1;
    $inPlace     = 1;
    $doDuplicate = 0;
    $newBkupNum  = 0;
    $newBkupIdx  = 0;
    $lastBkupNum = undef;
    $lastBkupIdx = undef;
    $type        = "full";
} elsif ( ($lastBkupCompressLevel != 0) xor ($Conf{CompressLevel} != 0) ) {
    #
    # case 5: compress on/off toggled.  Do a brand new filled backup starting with an empty tree.
    #
    $BackupCase  = 5;
    $inPlace     = 1;
    $doDuplicate = 0;
    $newBkupNum  = $lastBkupNum + 1;
    $newBkupIdx  = @Backups;
    $lastBkupNum = undef;
    $lastBkupIdx = undef;
} elsif ( defined($lastBkupNum) && $preV4 ) {
    #
    # case 2: last backup is V3, so duplicate and do inPlace.
    #
    $BackupCase  = 2;
    $inPlace     = 1;
    $doDuplicate = 1;
    $newBkupNum  = $lastBkupNum + 1;    # will exist after BackupPC_backupDuplicate
    $newBkupIdx  = @Backups;
    $lastBkupNum = undef;
    $lastBkupIdx = undef;
    $type        = "full";
} else {
    if (   ($lastBkupType eq "partial" || $lastBkupType eq "active")
        && (!defined($prevBkupIdx) || $Backups[$prevBkupIdx]{preV4} || !$Backups[$prevBkupIdx]{noFill}) ) {
        #
        # case 6: partial, and either no previous, V3 previous, or filled previous: simply update in place,
        # with no prior deltas.
        #
        $BackupCase  = 6;
        $inPlace     = 1;
        $doDuplicate = 0;
        #
        # We need to append the current XferLOG file.  Rename it and copy it below.
        #
        my $fileExt = $lastBkupCompressLevel > 0 ? ".z" : "";
        if ( -f "$Dir/XferLOG.$lastBkupNum$fileExt" ) {
            print($LogFd $bpc->timeStamp,
                "Renaming $Dir/XferLOG.$lastBkupNum$fileExt -> $Dir/XferLOG.$lastBkupNum$fileExt.tmp\n");
            rename("$Dir/XferLOG.$lastBkupNum$fileExt", "$Dir/XferLOG.$lastBkupNum$fileExt.tmp");
            $copyXferLOG = ["$Dir/XferLOG.$lastBkupNum$fileExt.tmp", $lastBkupCompressLevel, 1];
        }
        $newBkupNum  = $lastBkupNum;
        $newBkupIdx  = $lastBkupIdx;
        $lastBkupNum = undef;
        $lastBkupIdx = undef;
    } elsif ( $lastBkupType eq "full" || ($Conf{FillCycle} > 0 && $noFillCnt >= $Conf{FillCycle} - 1) ) {
        #
        # case 3: V4; last is filled, so duplicate and do in place
        #
        $BackupCase  = 3;
        $inPlace     = 1;
        $doDuplicate = 1;
        $newBkupNum  = $lastBkupNum + 1;    # will exist after BackupPC_backupDuplicate
        $newBkupIdx  = @Backups;
        $lastBkupNum = undef;
        $lastBkupIdx = undef;
    } else {
        #
        # case 4 or part of case 6: V4; renumber to #n+1 with deltas in #n
        #
        $BackupCase  = 4;
        $inPlace     = 0;
        $doDuplicate = 0;
        $newBkupNum  = $lastBkupNum;
        $newBkupIdx  = @Backups;
        do {
            $newBkupNum++;
        } while ( -d "$Dir/$newBkupNum" );
        if ( !rename("$Dir/$lastBkupNum", "$Dir/$newBkupNum") ) {
            print($LogFd $bpc->timeStamp, "Can't rename $Dir/$lastBkupNum to $Dir/$newBkupNum\n");
            print("Exiting because rename $Dir/$lastBkupNum to $Dir/$newBkupNum failed\n")
              if ( $opts{v} );
            exit(1);
        }
        $Backups[$lastBkupIdx]{noFill} = 1;
        #
        # Create the lastBkupNum and refCnt directory and flag it needing an fsck
        # in case we exit without cleanup. Also add a flag that it's ok not
        # having any current poolCnt files.
        #
        eval { mkpath("$Dir/$lastBkupNum/refCnt", 0, 0777) };
        if ( $@ ) {
            print($LogFd $bpc->timeStamp, "Can't create $Dir/$lastBkupNum/refCnt\n");
            print("Can't create backup directory $Dir/$lastBkupNum/refCnt")
              if ( $opts{v} );
            exit(1);
        }
        my $newFH;
        if ( !(open($newFH, ">", "$Dir/$lastBkupNum/refCnt/needFsck.newDir") && close($newFH)) ) {
            print($LogFd $bpc->timeStamp, "Can't create $Dir/$lastBkupNum/refCnt/needFsck.newDir ($?)\n");
            print("Can't create $Dir/$lastBkupNum/refCnt/needFsck.newDir ($?)\n");
        }
        if ( !(open($newFH, ">", "$Dir/$lastBkupNum/refCnt/noPoolCntOk") && close($newFH)) ) {
            print($LogFd $bpc->timeStamp, "Can't create $Dir/$lastBkupNum/refCnt/noPoolCntOk ($?)\n");
            print("Can't create $Dir/$lastBkupNum/refCnt/noPoolCntOk ($?)\n");
        }
        BackupPC::Storage->backupInfoWrite($Dir, $lastBkupNum, $Backups[$lastBkupIdx]);
        if ( $lastBkupType eq "partial" || $lastBkupType eq "active" ) {
            #
            # need to copy the previous partial XferLOG into this one, since $lastBkupNum will
            # be deleted once the backup finishes.
            #
            my $fileExt = $lastBkupCompressLevel > 0 ? ".z" : "";
            $copyXferLOG = ["$Dir/XferLOG.$lastBkupNum$fileExt", $lastBkupCompressLevel, 0];
        }
    }
}

if ( $doDuplicate ) {
    #
    # make sure the new backup number doesn't have an existing directory
    # (BackupPC_backupDuplicate will do the same thing)
    #
    while ( -d "$Dir/$newBkupNum" ) {
        $newBkupNum++;
    }
}

#
# Setup file extension for compression and open XferLOG output file
#
my $fileExt = $Conf{CompressLevel} > 0 ? ".z" : "";
unlink("$Dir/XferLOG.$newBkupNum$fileExt") if ( -e "$Dir/XferLOG.$newBkupNum$fileExt" );
my $XferLOG = BackupPC::XS::FileZIO::open("$Dir/XferLOG.$newBkupNum$fileExt", 1, $Conf{CompressLevel});
if ( !defined($XferLOG) ) {
    print($LogFd $bpc->timeStamp, "dump failed: unable to open/create $Dir/XferLOG.$newBkupNum$fileExt\n");
    print("dump failed: unable to open/create $Dir/XferLOG.$newBkupNum$fileExt\n");
    exit(1);
}
xferLOGCopyFile(@$copyXferLOG) if ( defined($copyXferLOG) );
$XferLOG->writeTeeStderr(1)    if ( $opts{v} );
my $str = "XferLOG file $Dir/XferLOG.$newBkupNum$fileExt created " . $bpc->timeStamp . "\n";
$XferLOG->write(\$str);

if ( $Conf{XferLogLevel} >= 1 || $opts{v} ) {
    $str =
        "Backup prep: type = $type, case = $BackupCase, inPlace = $inPlace, doDuplicate = $doDuplicate,"
      . " newBkupNum = $newBkupNum, newBkupIdx = $newBkupIdx, lastBkupNum = $lastBkupNum, lastBkupIdx = $lastBkupIdx"
      . " (FillCycle = $Conf{FillCycle}, noFillCnt = $noFillCnt)\n";
    $XferLOG->write(\$str);
}

#
# See if this client needs an fsck.
#
my $needFsck    = 0;
my $refCntFiles = BackupPC::DirOps::dirRead($bpc, "$Dir/$newBkupNum/refCnt");
foreach my $file ( @$refCntFiles ) {
    next if ( $file !~ /^needFsck/ );
    $needFsck = 1;
    last;
}
RefCountUpdate(1, 0) if ( $needFsck );

#
# Duplicate the most recent backup, if required
#
if ( $doDuplicate ) {
    my $t    = time;
    my $pids = {};
    #
    # Run BackupPC_backupDuplicate, then re-read the backups file.
    #
    my $cmd = ["$BinDir/BackupPC_backupDuplicate", "-m", "-h", $client];
    push(@$cmd, "-p") if ( $opts{p} );
    $XferLOG->write(\"Executing @$cmd\n");
    $bpc->cmdSystemOrEval(
        $cmd,
        sub {
            if ( $_[0] =~ /^__bpc_progress_/ ) {
                print($_[0]);
            } elsif ( $_[0] =~ /^__bpc_pidStart__ (\d+)/ ) {
                $pids->{$1} = 1;
                pidHandler(keys(%$pids));
            } elsif ( $_[0] =~ /^__bpc_pidEnd__ (\d+)/ ) {
                delete($pids->{$1});
                pidHandler(keys(%$pids));
            } else {
                if ( defined($XferLOG) ) {
                    $XferLOG->write(\$_[0]);
                } else {
                    print($LogFd $bpc->timeStamp, $_[0]);
                }
            }
        }
    );
    $t = time - $t;
    $XferLOG->write(\"Finished BackupPC_backupDuplicate (running time: $t sec)\n");
    @Backups = $bpc->BackupInfoRead($client);
    pidHandler();
}

#
# Create a placeholder backups entry if needed
#
if ( $newBkupIdx >= @Backups ) {
    $Backups[$newBkupIdx]{num}        = $newBkupNum;
    $Backups[$newBkupIdx]{level}      = $type eq "incr" ? 1 : 0;
    $Backups[$newBkupIdx]{noFill}     = 0;
    $Backups[$newBkupIdx]{mangle}     = 1;                         # name mangling always on for v1.04+
    $Backups[$newBkupIdx]{xferMethod} = $Conf{XferMethod};
    $Backups[$newBkupIdx]{charset}    = $Conf{ClientCharset};
    $Backups[$newBkupIdx]{version}    = $bpc->Version();
    $Backups[$newBkupIdx]{compress}   = $Conf{CompressLevel};
    $Backups[$newBkupIdx]{keep}       = 0;
}
#
# New backup shows as "active" while running
#
$Backups[$newBkupIdx]{type}      = "active";
$Backups[$newBkupIdx]{startTime} = time();

#
# Create new directory
#
if ( defined($newBkupNum) && !-d "$Dir/$newBkupNum" ) {
    #
    # Create the new backup directory
    #
    eval { mkpath("$Dir/$newBkupNum", 0, 0777) };
    if ( $@ ) {
        print($LogFd $bpc->timeStamp, "Can't create $Dir/$newBkupNum\n");
        print("Can't create backup directory $Dir/$newBkupNum")
          if ( $opts{v} );
        exit(1);
    }
}
if ( defined($newBkupNum) && !-d "$Dir/$newBkupNum/refCnt" ) {
    #
    # Create the new refCnt directory and flag it needing an fsck
    # in case we exit without cleanup.
    #
    eval { mkpath("$Dir/$newBkupNum/refCnt", 0, 0777) };
    if ( $@ ) {
        print($LogFd $bpc->timeStamp, "Can't create $Dir/$newBkupNum/refCnt\n");
        print("Can't create backup directory $Dir/$newBkupNum/refCnt")
          if ( $opts{v} );
        exit(1);
    }
    my $needFsckFH;
    if ( !(open($needFsckFH, ">", "$Dir/$newBkupNum/refCnt/needFsck.newDir") && close($needFsckFH)) ) {
        $XferLOG->write(\"Can't create $Dir/$newBkupNum/refCnt/needFsck.newDir ($?)\n");
    }
}

#
# Save backupInfo and backups
#
BackupPC::Storage->backupInfoWrite($Dir, $newBkupNum, $Backups[$newBkupIdx], 1);
$bpc->BackupInfoWrite($client, @Backups);

my $startTime     = time();
my $tarErrs       = 0;
my $nFilesExist   = 0;
my $sizeExist     = 0;
my $sizeExistComp = 0;
my $nFilesNew     = 0;
my $sizeNew       = 0;
my $sizeNewComp   = 0;
my $nFilesTotal   = 0;
my $sizeTotal     = 0;
my($logMsg, %stat, $xfer, $ShareNames, $noFilesErr);

$ShareNames = BackupPC::Xfer::getShareNames(\%Conf);

#
# Run an optional pre-dump command
#
UserCommandRun("DumpPreUserCmd");
if ( $? && $Conf{UserCmdCheckStatus} ) {
    print($LogFd $bpc->timeStamp, "DumpPreUserCmd returned error status $?... exiting\n");
    $XferLOG->write(\"DumpPreUserCmd returned error status $?... exiting\n");
    $stat{hostError} = "DumpPreUserCmd returned error status $?";
    BackupFailCleanup();
}
$NeedPostCmd = 1;

#
# Now backup each of the shares
#
my $shareDuplicate = {};
for my $shareName ( @$ShareNames ) {
    #
    # Make sure we eventually timeout if there is no activity from
    # the data transport program.
    #
    alarm($Conf{ClientTimeout});

    local(*RH, *WH);

    #
    # Convert $shareName to utf8 octets
    #
    $shareName = encode("utf8", $shareName);
    $stat{xferOK}    = $stat{hostAbort}      = undef;
    $stat{hostError} = $stat{lastOutputLine} = undef;
    if ( $shareName eq "" ) {
        print($LogFd $bpc->timeStamp, "unexpected empty share name skipped\n");
        next;
    }
    if ( $shareDuplicate->{$shareName} ) {
        print($LogFd $bpc->timeStamp, "unexpected repeated share name $shareName skipped\n");
        next;
    }
    $shareDuplicate->{$shareName} = 1;

    UserCommandRun("DumpPreShareCmd", $shareName);
    if ( $? && $Conf{UserCmdCheckStatus} ) {
        print($LogFd $bpc->timeStamp, "DumpPreShareCmd returned error status $?... exiting\n");
        UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
        $XferLOG->write(\"DumpPreShareCmd returned error status $?... exiting\n");
        $stat{hostError} = "DumpPreShareCmd returned error status $?";
        BackupFailCleanup();
    }

    print("__bpc_progress_state__ backup share \"$shareName\"\n") if ( !$opts{p} );

    #
    # Update inodeLast for this backup
    #
    @Backups = $bpc->BackupInfoRead($client);
    $Backups[$newBkupIdx]{inodeLast} = $inodeLast;
    BackupPC::Storage->backupInfoWrite($Dir, $newBkupNum, $Backups[$newBkupIdx], 1);
    $bpc->BackupInfoWrite($client, @Backups);

    $xfer = BackupPC::Xfer::create($Conf{XferMethod}, $bpc);
    if ( !defined($xfer) ) {
        my $errStr = BackupPC::Xfer::errStr();
        print($LogFd $bpc->timeStamp, "dump failed: $errStr\n");
        UserCommandRun("DumpPostShareCmd", $shareName) if ( $NeedPostCmd );
        UserCommandRun("DumpPostUserCmd")              if ( $NeedPostCmd );
        $XferLOG->write(\"BackupPC::Xfer::create failed: $errStr\n");
        $stat{hostError} = $errStr;
        BackupFailCleanup();
    }

    my $useTar = $xfer->useTar;

    if ( $useTar ) {
        #
        # This xfer method outputs a tar format file, so we start a
        # BackupPC_tarExtract to extract the data.
        #
        # Create a socketpair to connect the Xfer method to BackupPC_tarExtract
        # WH is the write handle for writing, provided to the transport
        # program, and RH is the other end of the socket for reading,
        # provided to BackupPC_tarExtract.
        #
        if ( socketpair(RH, WH, AF_UNIX, SOCK_STREAM, PF_UNSPEC) ) {
            shutdown(RH, 1);    # no writing to this socket
            shutdown(WH, 0);    # no reading from this socket
            setsockopt(RH, SOL_SOCKET, SO_RCVBUF, 8 * 65536);
            setsockopt(WH, SOL_SOCKET, SO_SNDBUF, 8 * 65536);
        } else {
            #
            # Default to pipe() if socketpair() doesn't work.
            #
            pipe(RH, WH);
        }

        #
        # fork a child for BackupPC_tarExtract.  TAR is a file handle
        # on which we (the parent) read the stdout & stderr from
        # BackupPC_tarExtract.
        #
        if ( !defined($tarPid = open(TAR, "-|")) ) {
            print($LogFd $bpc->timeStamp, "can't fork to run tar\n");
            print("can't fork to run tar\n");
            close(RH);
            close(WH);
            last;
        }
        binmode(TAR);
        if ( !$tarPid ) {
            #
            # This is the tar child.  Close the write end of the pipe,
            # clone STDERR to STDOUT, clone STDIN from RH, and then
            # exec BackupPC_tarExtract.
            #
            setpgrp 0, 0;
            close(WH);
            close(STDERR);
            open(STDERR, ">&STDOUT");
            close(STDIN);
            open(STDIN, "<&RH");
            alarm(0);
            my @tarOpts = ("-h", $client, "-s", $shareName);
            push(@tarOpts, "-f") if ( $type eq "full" );
            push(@tarOpts, "-P") if ( $inPlace );
            push(@tarOpts, "-p") if ( $opts{p} );
            exec("$BinDir/BackupPC_tarExtract", @tarOpts);
            print($LogFd $bpc->timeStamp, "can't exec $BinDir/BackupPC_tarExtract\n");
            exit(0);
        }
    }

    #
    # Run the transport program
    #
    $xfer->args({
        host            => $host,
        client          => $client,
        hostIP          => $hostIP,
        shareName       => $shareName,
        pipeRH          => *RH,
        pipeWH          => *WH,
        XferLOG         => $XferLOG,
        outDir          => $Dir,
        type            => $type,
        backups         => \@Backups,
        compress        => $Conf{CompressLevel},
        XferMethod      => $Conf{XferMethod},
        logLevel        => $Conf{XferLogLevel},
        inPlace         => $inPlace,
        newBkupIdx      => $newBkupIdx,
        lastBkupIdx     => $lastBkupIdx,
        incrBaseBkupNum => $incrBaseBkupNum,
        incrBaseTime    => $incrBaseTime,
        pidHandler      => \&pidHandler,
        noProgressPrint => $opts{p},
    });

    if ( !defined($logMsg = $xfer->start()) ) {
        my $errStr = "xfer start failed: " . $xfer->errStr . "\n";
        print($LogFd $bpc->timeStamp, $errStr);
        #
        # kill off the tar process, first nicely then forcefully
        #
        if ( $tarPid > 0 ) {
            kill($bpc->sigName2num("INT"), $tarPid);
            sleep(1);
            kill($bpc->sigName2num("KILL"), $tarPid);
        }
        if ( @xferPid ) {
            sleep(1);
            kill($bpc->sigName2num("INT"), @xferPid);
            sleep(1);
            kill($bpc->sigName2num("KILL"), @xferPid);
        }
        UserCommandRun("DumpPostShareCmd", $shareName) if ( $NeedPostCmd );
        UserCommandRun("DumpPostUserCmd")              if ( $NeedPostCmd );
        $XferLOG->write(\$errStr);
        $stat{hostError} = $errStr;
        BackupFailCleanup();
    }

    #
    # Create a needFsck file, so if we are killed and can't recover, we can
    # make sure an fsck is run next time.
    #
    my $needFsckFH;
    if ( !(open($needFsckFH, ">", "$Dir/$newBkupNum/refCnt/needFsck.dump") && close($needFsckFH)) ) {
        $XferLOG->write(\"Can't create $Dir/$newBkupNum/refCnt/needFsck.dump ($?)\n");
    }

    #
    # Also grab a lock file, so we can serialize any fsck that might be
    # running.
    #
    $LockFd = BackupPC::XS::DirOps::lockRangeFile("$Dir/refCnt/LOCK", 0, 1, 1);

    @xferPid = $xfer->xferPid;

    if ( $useTar ) {
        #
        # The parent must close both handles on the pipe since the children
        # are using these handles now.
        #
        close(RH);
        close(WH);
    }
    print($LogFd $bpc->timeStamp, $logMsg, "\n");
    $XferLOG->write(\"$logMsg\n");
    print("started $type dump, share=$shareName\n");

    pidHandler(@xferPid);

    if ( $useTar ) {
        #
        # Parse the output of the transfer program and BackupPC_tarExtract
        # while they run.  Since we might be reading from two or more children
        # we use a select.
        #
        my($FDread, $tarOut, $mesg);
        vec($FDread, fileno(TAR), 1) = 1;
        $xfer->setSelectMask(\$FDread);

      SCAN: while ( 1 ) {
            my $ein = $FDread;
            last if ( $FDread =~ /^\0*$/ );
            select(my $rout = $FDread, undef, $ein, undef);
            if ( vec($rout, fileno(TAR), 1) ) {
                if ( sysread(TAR, $mesg, 8192) <= 0 ) {
                    next if ( $!{EINTR} );
                    vec($FDread, fileno(TAR), 1) = 0;
                    close(TAR);
                    if ( $? ) {
                        $XferLOG->write(\"BackupPC_tarExtract exited with fail status $?\n");
                        $stat{hostError} = "BackupPC_tarExtract exited with fail status $?";
                    }
                } else {
                    $tarOut .= $mesg;
                }
            }
            while ( $tarOut =~ /(.*?)[\n\r]+(.*)/s ) {
                $_      = $1;
                $tarOut = $2;
                if ( /^  / ) {
                    $XferLOG->write(\"$_\n");
                } elsif ( /^__bpc_progress_fileCnt__/ ) {
                    print("$_\n");
                } else {
                    $XferLOG->write(\"tarExtract: $_\n");
                }
                if ( /^BackupPC_tarExtact aborting \((.*)\)/ ) {
                    $stat{hostError} = $1;
                }
                if (
                    /^Done: (\d+) errors, (\d+) filesExist, (\d+) sizeExist, (\d+) sizeExistComp, (\d+) filesTotal, (\d+) sizeTotal, (\d+) filesNew, (\d+) sizeNew, (\d+) sizeNewComp, (\d+) inodeLast/
                ) {
                    $tarErrs       += $1;
                    $nFilesExist   += $2;
                    $sizeExist     += $3;
                    $sizeExistComp += $4;
                    $nFilesTotal   += $5;
                    $sizeTotal     += $6;
                    $nFilesNew     += $7;
                    $sizeNew       += $8;
                    $sizeNewComp   += $9;
                    $inodeLast = $10;
                }
            }
            last if ( !$xfer->readOutput(\$FDread, $rout) );
            while ( my $str = $xfer->logMsgGet ) {
                print($LogFd $bpc->timeStamp, "xfer: $str\n");
            }
            if ( $xfer->getStats->{fileCnt} == 1 ) {
                #
                # Make sure it is still the machine we expect.  We do this while
                # the transfer is running to avoid a potential race condition if
                # the ip address was reassigned by dhcp just before we started
                # the transfer.
                #
                if ( my $errMsg = CorrectHostCheck($hostIP, $host) ) {
                    $stat{hostError} = $errMsg if ( $stat{hostError} eq "" );
                    last SCAN;
                }
            }
        }
    } else {
        #
        # otherwise the xfer module does everything for us
        #
        my @results = $xfer->run();
        $tarErrs       += $results[0];
        $nFilesExist   += $results[1];
        $sizeExist     += $results[2];
        $sizeExistComp += $results[3];
        $nFilesTotal   += $results[4];
        $sizeTotal     += $results[5];
        $nFilesNew     += $results[6];
        $sizeNew       += $results[7];
        $sizeNewComp   += $results[8];
        $inodeLast = $results[9];
    }
    alarm(0);

    #
    # Merge the xfer status (need to accumulate counts)
    #
    my $newStat = $xfer->getStats;

    # MAKSYM 14082016: forcing the right file count if some bytes were transferred; ensures compatibility with at least Samba-4.3
    $newStat->{fileCnt} = $nFilesTotal if ( $useTar && $newStat->{fileCnt} == 0 && $xfer->getStats->{byteCnt} > 0 );
    if ( $newStat->{fileCnt} == 0 ) {
        $noFilesErr ||= "No files dumped for share $shareName";
    }
    foreach my $k ( (keys(%stat), keys(%$newStat)) ) {
        next if ( !defined($newStat->{$k}) );
        if ( $k =~ /Cnt$/ ) {
            $stat{$k} += $newStat->{$k};
            delete($newStat->{$k});
            next;
        }
        if ( !defined($stat{$k}) ) {
            $stat{$k} = $newStat->{$k};
            delete($newStat->{$k});
            next;
        }
    }

    if ( $NeedPostCmd ) {
        UserCommandRun("DumpPostShareCmd", $shareName);
        if ( $? && $Conf{UserCmdCheckStatus} ) {
            print($LogFd $bpc->timeStamp, "DumpPostShareCmd returned error status $?... exiting\n");
            $stat{hostError} = "DumpPostShareCmd returned error status $?";
        }
    }

    $stat{xferOK} = 0 if ( $stat{hostError} || $stat{hostAbort} );
    if ( !$stat{xferOK} ) {
        #
        # kill off the transfer program, first nicely then forcefully
        #
        if ( @xferPid ) {
            kill($bpc->sigName2num("INT"), @xferPid);
            sleep(1);
            kill($bpc->sigName2num("KILL"), @xferPid);
        }
        #
        # kill off the tar process, first nicely then forcefully
        #
        if ( $tarPid > 0 ) {
            sleep(1);
            kill($bpc->sigName2num("INT"), $tarPid);
            sleep(1);
            kill($bpc->sigName2num("KILL"), $tarPid);
        }
        #
        # don't do any more shares on this host
        #
        BackupPC::XS::DirOps::unlockRangeFile($LockFd);
        $LockFd = undef;
        last;
    }
    #
    # Wait for any child processes to exit
    #
    1 while ( wait() >= 0 );

    unlink("$Dir/$newBkupNum/refCnt/needFsck.dump");
    BackupPC::XS::DirOps::unlockRangeFile($LockFd);
    $LockFd = undef;
}
$tarPid = 0;
pidHandler();

#
# If this is a full, and any share had zero files then consider the dump bad
#
if (   $type eq "full"
    && $stat{hostError} eq ""
    && length($noFilesErr)
    && $Conf{BackupZeroFilesIsFatal} ) {
    $stat{hostError} = $noFilesErr;
    $stat{xferOK}    = 0;
}

$stat{xferOK} = 0 if ( $Abort );

#
# Do one last check to make sure it is still the machine we expect.
#
if ( $stat{xferOK} && (my $errMsg = CorrectHostCheck($hostIP, $host)) ) {
    $stat{hostError} = $errMsg;
    $stat{xferOK}    = 0;
}

#
# Remove any shares that exist in the backup, but aren't in $ShareNames
#
if ( $stat{xferOK} ) {
    OrphanShareNameClean("$Dir/$newBkupNum", $ShareNames, $Backups[$newBkupIdx]{compress});
}

UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
if ( $? && $Conf{UserCmdCheckStatus} ) {
    print($LogFd $bpc->timeStamp, "DumpPostUserCmd returned error status $?... exiting\n");
    $stat{hostError} = "DumpPostUserCmd returned error status $?";
    $stat{xferOK}    = 0;
}

my $endTime = time();

#
# If the dump failed, clean up
#
if ( !$stat{xferOK} ) {
    $stat{hostError} = $stat{lastOutputLine} if ( $stat{hostError} eq "" );
    if ( $stat{hostError} ) {
        print($LogFd $bpc->timeStamp, "Got fatal error during xfer ($stat{hostError})\n");
        $XferLOG->write(\"Got fatal error during xfer ($stat{hostError})\n");
    }
    if ( !$Abort ) {
        #
        # wait a short while and see if the system is still alive
        #
        sleep(5);
        if ( $bpc->CheckHostAlive($hostIP) < 0 ) {
            $stat{hostAbort} = 1;
        }
        if ( $stat{hostAbort} ) {
            $stat{hostError} = "lost network connection during backup";
        }
        print($LogFd $bpc->timeStamp, "Backup aborted ($stat{hostError})\n");
        $XferLOG->write(\"Backup aborted ($stat{hostError})\n");
    } else {
        if ( $XferLOG ) {
            $XferLOG->write(\"Backup aborted by user signal\n");
        } elsif ( $opts{v} ) {
            print("Backup aborted by user signal\n");
        }
    }

    #
    # Close the log file and call BackupFailCleanup, which exits.
    #
    BackupFailCleanup();
}
if ( $BackupCase == 4 && ($lastBkupType eq "partial" || $lastBkupType eq "active") ) {
    #
    # Delete the prior backup #n, so that its deltas are merged into #n-1
    #
    print($LogFd $bpc->timeStamp, "Removing prior partial backup #$lastBkupNum\n");
    $XferLOG->write(\"Removing prior partial backup #$lastBkupNum\n");
    BackupRemove($client, $lastBkupIdx, 1);
}

my $newNum = BackupSave();

my $otherCount = $stat{xferErrCnt} - $stat{xferBadFileCnt} - $stat{xferBadShareCnt};
$stat{fileCnt}         ||= 0;
$stat{byteCnt}         ||= 0;
$stat{xferErrCnt}      ||= 0;
$stat{xferBadFileCnt}  ||= 0;
$stat{xferBadShareCnt} ||= 0;
my $logStr =
    "$type backup $newNum complete, $stat{fileCnt} files, $stat{byteCnt} bytes,"
  . " $stat{xferErrCnt} xferErrs ($stat{xferBadFileCnt} bad files,"
  . " $stat{xferBadShareCnt} bad shares, $otherCount other)\n";
print($LogFd $bpc->timeStamp, $logStr);
$XferLOG->write(\$logStr) if ( $XferLOG && $Conf{XferLogLevel} >= 1 );

if ( $stat{xferOK} && $BackupCase == 4 && -f "$Dir/$lastBkupNum/refCnt/needFsck.newDir" ) {
    #
    # remove temporary needFsck file on previous backup since backup succeeded ok
    #
    unlink("$Dir/$lastBkupNum/refCnt/needFsck.newDir");
}

BackupExpire($client);

#
# Update reference counts - apply the deltas.
#
RefCountUpdate(0, 0);

if ( $XferLOG ) {
    $XferLOG->close();
    $XferLOG = undef;
}

#
# Touch the new and last backup directories with their backup end times
#
foreach my $idx ( ($lastBkupIdx, $newBkupIdx) ) {
    next if ( !defined($idx) || !defined($Backups[$idx]{endTime}) );
    utime($Backups[$idx]{endTime}, $Backups[$idx]{endTime}, "$Dir/$Backups[$idx]{num}");
}

print("$type backup complete\n");
exit(0);

###########################################################################
# Subroutines
###########################################################################

sub NothingToDo
{
    print("nothing to do\n");
    exit(0);
}

sub catch_signal
{
    my $sigName = shift;

    #
    # The first time we receive a signal we try to gracefully
    # abort the backup.  This allows us to keep a partial dump
    # with the in-progress file deleted and attribute caches
    # flushed to disk etc.
    #
    if ( !length($SigName) ) {
        my $reason;
        if ( $sigName eq "INT" ) {
            $reason = "aborted by user (signal=$sigName)";
        } else {
            $reason = "aborted by signal=$sigName";
        }
        $stat{hostError} = $reason;
        print("Received signal: $reason\n") if ( $opts{v} );
        if ( $Pid == $$ ) {
            #
            # Parent logs a message
            #
            print($LogFd $bpc->timeStamp, "Aborting backup up after signal $sigName\n");
            print("Aborting backup up after signal $sigName\n") if ( $opts{v} );

            #
            # Tell xfer to abort, but only if we actually started one
            #
            $xfer->abort($reason) if ( defined($xfer) );

            #
            # Send ALRMs to BackupPC_tarExtract if we are using it
            #
            if ( $tarPid > 0 ) {
                kill($bpc->sigName2num("ALRM"), $tarPid);
            }

        } else {
            #
            # Children ignore anything other than ALRM and INT
            #
            if ( $sigName ne "ALRM" && $sigName ne "INT" ) {
                return;
            }

            #
            # The child also tells xfer to abort
            #
            $xfer->abort($reason);

        }
        $SigName = $sigName;
        $Abort   = 1;
        return;
    }

    #
    # This is a second signal: time to clean up.
    #
    if ( $Pid != $$ && ($sigName eq "ALRM" || $sigName eq "INT") ) {
        #
        # Children quit quietly on ALRM or INT
        #
        exit(1);
    }

    #
    # Ignore other signals in children
    #
    return if ( $Pid != $$ );

    $SIG{$sigName} = 'IGNORE';
    UserCommandRun("DumpPostUserCmd") if ( $NeedPostCmd );
    if ( $XferLOG ) {
        $XferLOG->write(\"exiting after signal $sigName\n");
    } elsif ( $opts{v} ) {
        print("exiting after signal $sigName\n");
    }
    if ( @xferPid ) {
        printf("killing xfer pids %s\n", join(",", @xferPid)) if ( $opts{v} );
        kill($bpc->sigName2num("INT"), @xferPid);
        sleep(1);
        kill($bpc->sigName2num("KILL"), @xferPid);
    }
    if ( $tarPid > 0 ) {
        printf("killing tar pid $tarPid\n") if ( $opts{v} );
        sleep(1);
        kill($bpc->sigName2num("INT"), $tarPid);
        sleep(1);
        kill($bpc->sigName2num("KILL"), $tarPid);
    }
    if ( $sigName eq "INT" ) {
        $stat{hostError} = "aborted by user (signal=$sigName)";
    } else {
        $stat{hostError} = "received signal=$sigName";
    }
    BackupFailCleanup();
}

sub CheckForAnyFiles
{
    my($name, $path, $compress) = @_;

    return if ( $name !~ /^attrib/ );

    $path =~ s{/attrib[^/]*$}{};

    my $attr = BackupPC::XS::Attrib::new($compress);
    if ( !$attr->read($path, $name) ) {
        print($LogFd $bpc->timeStamp, "CheckForAnyFiles: can't read attribute file in $path\n");
        return;
    }
    my $attrAll = $attr->get();

    foreach my $fileUM ( keys(%$attrAll) ) {
        my $a = $attrAll->{$fileUM};
        next if ( !defined($a->{digest}) );
        $nFilesTotal++;
    }
    $File::Find::prune = 1 if ( $nFilesTotal );
    flushLibMessages();
}

sub BackupFailCleanup
{
    my $fileExt = $Conf{CompressLevel} > 0 ? ".z" : "";
    my @logRenames;
    @Backups = $bpc->BackupInfoRead($client);

    BackupPC::XS::DirOps::unlockRangeFile($LockFd) if ( defined($LockFd) );
    $LockFd = undef;

    print("__bpc_progress_state__ fail cleanup\n") if ( !$opts{p} );
    #
    # There are six cases listed above that we have to clean up,
    # based on whether any files were actually backed up.
    #
    #  1) No backups at all: created a new backup #0 and do inPlace.
    #       Cleanup: remove #0 if empty, otherwise mark partial.
    #
    #  2) V3 backups, no V4: duplicated last V3 backup, and do inPlace.
    #       No cleanup; just keep new duplicated V4 backup, mark partial.
    #
    #  3) V4 backups, and $Conf{FillCycle} since last filled:
    #                        duplicate last backup and do inPlace.
    #       No cleanup; just keep new duplicated V4 backup, mark partial.
    #
    #  4) V4 backups, less than $Conf{FillCycle} since last filled:
    #                        renumber last backup to #n+1, deltas in #n.
    #       If prev backup empty, remove it, but don't renumber.
    #
    #  5) CompressLevel has toggled on/off.   Very hard to support
    #     efficiently.  We treat this as a brand new (empty) backup
    #     inPlace, that is therefore filled.  That way we won't mess
    #     up merging backups with compress on/off.
    #       Cleanup: remove latest backup if empty, otherwise mark partial.
    #
    #  6) Last backup was a V4 partial.  If prior V4 backup is filled
    #     (and not partial), then just do another in-place backup.
    #     This is the labeled case 6.  Otherwise, treat as case 4,
    #     and it's actually labeled case 4.  When complete (whether
    #     successful or another partial), delete the prior deltas in #n,
    #     which merges the cumulative changes into #n-1.
    #
    my($checkDir, $compress, $removeIdx, $removeNum);
    if ( $BackupCase == 1 || $BackupCase == 5 ) {
        $checkDir  = "$Dir/$newBkupNum";
        $compress  = $Backups[$newBkupIdx]{compress};
        $removeIdx = $newBkupIdx;
        $removeNum = $newBkupNum;
    } elsif ( $BackupCase == 4 && $lastBkupType ne "partial" ) {
        $checkDir  = "$Dir/$lastBkupNum";
        $compress  = $Backups[$lastBkupIdx]{compress};
        $removeIdx = $lastBkupIdx;
        $removeNum = $lastBkupNum;
    }
    if ( $nFilesTotal == 0 && $checkDir ne "" ) {
        BackupPC::DirOps::find(
            $bpc,
            {
                wanted => sub {
                    CheckForAnyFiles(@_, $compress);
                }
            },
            $checkDir
        );
    }

    $XferLOG->write(
        \"BackupFailCleanup: nFilesTotal = $nFilesTotal, type = $type, BackupCase = $BackupCase, inPlace = $inPlace, lastBkupNum = $lastBkupNum\n"
    );

    if ( $BackupCase == 4 && ($lastBkupType eq "partial" || $lastBkupType eq "active") ) {
        #
        # Delete the prior backup #n, so that its deltas are merged into #n-1
        #
        print($LogFd $bpc->timeStamp, "Removing prior partial backup #$lastBkupNum\n");
        $XferLOG->write(\"Removing prior partial backup #$lastBkupNum\n");
        BackupRemove($client, $lastBkupIdx, 1);
        $Backups[-1]{type} = "partial" if ( @Backups );
    } elsif ( $BackupCase == 4 ) {
        if ( $nFilesTotal == 0 ) {
            #
            # Remove the empty backup directory.  The new XferLOG file gets renamed
            # to bad.
            #
            $Backups[$newBkupIdx]         = {%{$Backups[$lastBkupIdx]}};
            $Backups[$newBkupIdx]{num}    = $newBkupNum;
            $Backups[$newBkupIdx]{noFill} = 0;
            $Backups[$newBkupIdx]{keep}   = 0;
            print($LogFd $bpc->timeStamp, "Removing empty backup #$removeNum\n");
            $XferLOG->write(\"Removing empty backup #$removeNum\n");
            BackupRemove($client, $removeIdx, 0);
            push(@logRenames,
                {from => "$Dir/XferLOG.$newBkupNum$fileExt",  to => "$Dir/XferLOG.bad$fileExt"},
                {from => "$Dir/XferLOG.$lastBkupNum$fileExt", to => "$Dir/XferLOG.$newBkupNum$fileExt"});
        } else {
            $XferLOG->write(\"Keeping non-empty backup #$removeNum ($checkDir)\n");
            $Backups[-1]{type} = "partial" if ( @Backups );
        }
    } elsif ( $BackupCase == 1 || $BackupCase == 5 ) {
        if ( $nFilesTotal == 0 ) {
            #
            # Remove the empty backup directory.  The new XferLOG file gets renamed
            # to bad.
            #
            print($LogFd $bpc->timeStamp, "Removing empty backup #$removeNum\n");
            $XferLOG->write(\"Removing empty backup #$removeNum\n");
            push(@logRenames, {from => "$Dir/XferLOG.$newBkupNum$fileExt", to => "$Dir/XferLOG.bad$fileExt"});
            BackupRemove($client, $removeIdx, 0);
        } else {
            $XferLOG->write(\"Keeping non-empty backup #$removeNum ($checkDir)\n");
            $Backups[-1]{type} = "partial" if ( @Backups );
        }
    } else {
        if ( $nFilesTotal == 0 ) {
            $XferLOG->write(\"BackupFailCleanup: inPlace with no new files... no cleanup\n");
            if ( $BackupCase == 6 || $BackupCase == 2 || $BackupCase == 3 ) {
                $Backups[-1]{type} = "partial" if ( @Backups );
            } else {
                $Backups[-1]{type} = $type if ( @Backups );
            }
        } else {
            $XferLOG->write(\"BackupFailCleanup: inPlace with some new files... no cleanup and marking partial\n");
            #
            # Update the backups meta data
            #
            BackupSave(1);
            $Backups[-1]{type} = "partial" if ( @Backups );
        }
    }
    BackupPC::Storage->backupInfoWrite($Dir, $Backups[-1]{num}, $Backups[-1], 1) if ( @Backups > 0 );
    $bpc->BackupInfoWrite($client, @Backups);

    #
    # Any kind of abort or failure likely means we need to rebuild the reference
    # count database.
    #
    RefCountUpdate(1, 0);

    if ( $XferLOG ) {
        $XferLOG->close();
        $XferLOG = undef;
    }
    if ( @logRenames ) {
        unlink("$Dir/XferLOG.bad$fileExt") if ( -f "$Dir/XferLOG.bad$fileExt" );
        unlink("$Dir/XferLOG.bad")         if ( -f "$Dir/XferLOG.bad" );
        foreach my $r ( @logRenames ) {
            if ( !rename($r->{from}, $r->{to}) ) {
                print($LogFd $bpc->timeStamp, "Can't rename $r->{from} -> $r->{to}\n");
            }
        }
    }
    print("dump failed: $stat{hostError}\n");
    exit(1);
}

#
# Decide which old backups should be expired.
#
sub BackupExpire
{
    my($client) = @_;
    my($Dir)    = "$TopDir/pc/$client";
    my($cntFull, $cntIncr, $firstFull, $firstIncr, $oldestIncr, $oldestFull, $changes);

    @Backups = $bpc->BackupInfoRead($client);
    if ( (ref($Conf{FullKeepCnt}) eq "ARRAY" ? @{$Conf{FullKeepCnt}} : $Conf{FullKeepCnt}) <= 0 ) {
        print($LogFd $bpc->timeStamp,
            "Invalid value for \$Conf{FullKeepCnt}=$Conf{FullKeepCnt}; not expiring any backups\n");
        print("Invalid value for \$Conf{FullKeepCnt}=$Conf{FullKeepCnt}; not expiring any backups\n")
          if ( $opts{v} );
        return;
    }
    while ( 1 ) {
        $cntFull    = $cntIncr    = 0;
        $oldestIncr = $oldestFull = 0;
        for ( my $i = 0 ; $i < @Backups ; $i++ ) {
            #
            # don't consider any backups marked keep
            #
            next if ( $Backups[$i]{keep} );
            $Backups[$i]{preV4} = ($Backups[$i]{version} eq "" || $Backups[$i]{version} =~ /^[23]\./) ? 1 : 0;
            if ( $Backups[$i]{preV4} ) {
                if ( $Backups[$i]{type} eq "full" ) {
                    $firstFull = $i if ( $cntFull == 0 );
                    $cntFull++;
                } elsif ( $Backups[$i]{type} eq "incr" ) {
                    $firstIncr = $i if ( $cntIncr == 0 );
                    $cntIncr++;
                }
            } else {
                if ( !$Backups[$i]{noFill} ) {
                    $firstFull = $i if ( $cntFull == 0 );
                    $cntFull++;
                } else {
                    $firstIncr = $i if ( $cntIncr == 0 );
                    $cntIncr++;
                }
            }
        }
        $oldestIncr = (time - $Backups[$firstIncr]{startTime}) / (24 * 3600)
          if ( $cntIncr > 0 );
        $oldestFull = (time - $Backups[$firstFull]{startTime}) / (24 * 3600)
          if ( $cntFull > 0 );

        if ( $XferLOG ) {
            my $logStr = "BackupExpire: cntFull = $cntFull, cntIncr = $cntIncr, firstFull = $firstFull,"
              . " firstIncr = $firstIncr, oldestIncr = $oldestIncr, oldestFull = $oldestFull\n";
            $XferLOG->write(\$logStr);
        }

        #
        # In <= 3.x, with multi-level incrementals, several of the
        # following incrementals might depend upon this one, so we
        # have to delete all of the them.  Figure out if that is
        # possible by counting the number of consecutive incrementals
        # that are unfilled and have a level higher than this one.
        #
        # In >= 4.x any backup can be deleted since the changes get
        # merged with the next older deltas, so we just do one at
        # a time.
        #
        my $cntIncrDel   = 1;
        my $earliestIncr = $oldestIncr;

        if ( defined($firstIncr) ) {
            for ( my $i = $firstIncr + 1 ; $i < @Backups ; $i++ ) {
                last
                  if ( !$Backups[$i]{preV4}
                    || $Backups[$i]{level} <= $Backups[$firstIncr]{level}
                    || !$Backups[$i]{noFill} );
                $cntIncrDel++;
                $earliestIncr = (time - $Backups[$i]{startTime}) / (24 * 3600);
            }
        }

        if (
            $cntIncr >= $Conf{IncrKeepCnt} + $cntIncrDel
            || (   $cntIncr >= $Conf{IncrKeepCntMin} + $cntIncrDel
                && $earliestIncr > $Conf{IncrAgeMax})
        ) {
            #
            # Only delete an incr backup if the Conf settings are satisfied
            # for all $cntIncrDel incrementals.  Since BackupRemove() updates
            # the @Backups array we need to do the deletes in the reverse order.
            #
            for ( my $i = $firstIncr + $cntIncrDel - 1 ; $i >= $firstIncr ; $i-- ) {
                print($LogFd $bpc->timeStamp, "Removing unfilled backup $Backups[$i]{num}\n");
                $XferLOG->write(\"Removing unfilled backup $Backups[$i]{num}\n") if ( $XferLOG );
                last                                                             if ( BackupRemove($client, $i, 1) );
                $changes++;
            }
            next;
        }

        #
        # Delete any old full backups, according to $Conf{FullKeepCntMin}
        # and $Conf{FullAgeMax}.
        #
        # First make sure that $Conf{FullAgeMax} is at least bigger
        # than $Conf{FullPeriod} * $Conf{FullKeepCnt}, including
        # the exponential array case.
        #
        my $fullKeepCnt = $Conf{FullKeepCnt};
        $fullKeepCnt = [$fullKeepCnt] if ( ref($fullKeepCnt) ne "ARRAY" );

        #
        # Always save one more than what the user configured to account for the most
        # recent backup which is always filled (whether incr or full); also copy the
        # array so we don't update $Conf{FullKeepCnt}.
        #
        $fullKeepCnt = [@$fullKeepCnt];
        $fullKeepCnt->[0]++;

        my $fullAgeMax;
        my $fullPeriod = int(0.5 + $Conf{FullPeriod});
        $fullPeriod = 7 if ( $fullPeriod <= 0 );
        for ( my $i = 0 ; $i < @$fullKeepCnt ; $i++ ) {
            $fullAgeMax += $fullKeepCnt->[$i] * $fullPeriod;
            $fullPeriod *= 2;
        }
        $fullAgeMax += $fullPeriod;    # add some buffer

        if (   $cntFull > $Conf{FullKeepCntMin} + 1
            && $oldestFull > $Conf{FullAgeMax}
            && $oldestFull > $fullAgeMax
            && $Conf{FullKeepCntMin} >= 0
            && $Conf{FullAgeMax} > 0 ) {
            #
            # Only delete a full backup if the Conf settings are satisfied.
            #
            # For pre-V4 we also must make sure that either this backup is the
            # most recent one, or the next backup is filled.
            # (In pre-V4 we can't deleted a full backup if the next backup is not
            # filled.)
            #
            if (
                !$Backups[$firstFull]{preV4}
                || (@Backups <= $firstFull + 1
                    || !$Backups[$firstFull + 1]{noFill})
            ) {
                print($LogFd $bpc->timeStamp, "Removing filled backup $Backups[$firstFull]{num}\n");
                $XferLOG->write(\"Removing filled backup $Backups[$firstFull]{num}\n") if ( $XferLOG );
                last if ( BackupRemove($client, $firstFull, 1) );
                $changes++;
                next;
            }
        }

        #
        # Do new-style full backup expiry, which includes the the case
        # where $Conf{FullKeepCnt} is an array.
        #
        last if ( !BackupFullExpire($client, \@Backups) );
        $changes++;
    }
    $bpc->BackupInfoWrite($client, @Backups) if ( $changes );
}

#
# Handle full backup expiry, using exponential periods.
#
sub BackupFullExpire
{
    my($client, $Backups) = @_;
    my $fullCnt    = 0;
    my $fullPeriod = $Conf{FillCycle} <= 0 ? $Conf{FullPeriod} : $Conf{FillCycle};
    my $nextFull;
    my $fullKeepCnt = $Conf{FullKeepCnt};
    my $fullKeepIdx = 0;
    my(@delete, @fullList);

    #
    # Don't delete anything if $Conf{FillCycle}, $Conf{FullPeriod} or $Conf{FullKeepCnt}
    # are not defined - possibly a corrupted config.pl file.
    #
    return if ( !defined($Conf{FillCycle})
        || !defined($Conf{FullPeriod})
        || !defined($Conf{FullKeepCnt}) );

    #
    # Always save one more than what the user configured to account for the most
    # recent backup which is always filled (whether incr or full); also copy the
    # array so we don't update $Conf{FullKeepCnt}.
    #
    $fullKeepCnt = [$fullKeepCnt] if ( ref($fullKeepCnt) ne "ARRAY" );
    $fullKeepCnt = [@$fullKeepCnt];
    $fullKeepCnt->[0]++;

    #
    # If regular backups are still disabled with $Conf{FullPeriod} < 0,
    # we still expire backups based on a safe FullPeriod value - daily.
    #
    $fullPeriod = 1 if ( $fullPeriod <= 0 );

    my $startTimeDeviation = $fullPeriod < 1 ? $fullPeriod / 2 : 0.5;
    my $keepPeriod         = ($fullPeriod * ($fullKeepCnt->[0] - 1) - $startTimeDeviation) * 24 * 3600;

    for ( my $i = 0 ; $i < @$Backups ; $i++ ) {
        #
        # don't consider any backups marked keep
        #
        next if ( $Backups[$i]{keep} );
        if ( $Backups[$i]{preV4} ) {
            next if ( $Backups->[$i]{type} ne "full" );
        } else {
            next if ( $Backups->[$i]{noFill} );
        }
        push(@fullList, $i);
    }
    for ( my $k = @fullList - 1 ; $k >= 0 ; $k-- ) {
        my $i        = $fullList[$k];
        my $prevFull = $fullList[$k - 1] if ( $k > 0 );
        #
        # For pre-V4 don't delete any full that is followed by an unfilled backup,
        # since it is needed for restore.
        #
        my $noDelete = $i + 1 < @$Backups ? $Backups->[$i + 1]{noFill} : 0;
        $noDelete = 0 if ( !$Backups[$i]{preV4} );

        if (
            !$noDelete
            && (   $fullKeepIdx >= @$fullKeepCnt
                || $k > 0
                && $fullKeepIdx > 0
                && defined($nextFull)
                && $Backups->[$nextFull]{startTime} - $Backups->[$prevFull]{startTime} <
                ($fullPeriod + $startTimeDeviation) * 24 * 3600)
        ) {
            #
            # Delete the full backup
            #
            #print("Deleting backup $Backups->[$i]{num} (i = $i, k = $k, nextFull = $nextFull, prevFull = $prevFull, fullKeepIdx = $fullKeepIdx, fullCnt = $fullCnt)\n");
            unshift(@delete, $i);
        } else {
            #printf("Keeping backup $Backups->[$i]{num} (i = $i, k = $k, nextFull = $nextFull, prevFull = $prevFull, fullKeepIdx = $fullKeepIdx, fullCnt = $fullCnt, keepPeriod = %.3g, delta = %.3g)\n", $keepPeriod / (24 * 3600), (time - $Backups->[$i]{startTime}) / (24 * 3600));
            $fullCnt++;
            $nextFull = $i;
            while ( $fullKeepIdx < @$fullKeepCnt
                && $k > 0
                && time - $Backups->[$prevFull]{startTime} > $keepPeriod
                && $fullCnt >= $fullKeepCnt->[$fullKeepIdx] ) {
                $fullKeepIdx++;
                $fullCnt    = 0;
                $fullPeriod = 2 * $fullPeriod;
            }
            #print("    (now nextFull = $nextFull, prevFull = $prevFull, fullKeepIdx = $fullKeepIdx, fullCnt = $fullCnt, fullPeriod = $fullPeriod, fullKeepCnt[idx] = $fullKeepCnt->[$fullKeepIdx])\n");
        }
    }
    #
    # Now actually delete the backups
    #
    for ( my $i = @delete - 1 ; $i >= 0 ; $i-- ) {
        print($LogFd $bpc->timeStamp, "Removing filled backup $Backups->[$delete[$i]]{num}\n");
        $XferLOG->write(\"Removing filled backup $Backups->[$delete[$i]]{num}\n") if ( $XferLOG );
        BackupRemove($client, $delete[$i], 1);
    }
    return @delete;
}

sub BackupSave
{
    my($noWrite) = @_;
    #
    # Update the new backup information to the backup file.
    # A new entry in @Backups was created at the start of the backup,
    # so we update the last entry of @Backups.
    #
    @Backups = $bpc->BackupInfoRead($client);
    my $i = @Backups - 1;
    $i                = 0           if ( $i < 0 );
    $Backups[$i]{num} = $newBkupNum if ( !defined($Backups[$i]{num}) );
    my $num = $Backups[$i]{num};
    $Backups[$i]{type}          = $type;
    $Backups[$i]{level}         = $type eq "incr" ? 1 : 0;
    $Backups[$i]{startTime}     = $startTime;
    $Backups[$i]{endTime}       = $endTime;
    $Backups[$i]{size}          = $sizeTotal;
    $Backups[$i]{nFiles}        = $nFilesTotal;
    $Backups[$i]{xferErrs}      = $stat{xferErrCnt} || 0;
    $Backups[$i]{xferBadFile}   = $stat{xferBadFileCnt} || 0;
    $Backups[$i]{xferBadShare}  = $stat{xferBadShareCnt} || 0;
    $Backups[$i]{nFilesExist}   = $nFilesExist;
    $Backups[$i]{sizeExist}     = $sizeExist;
    $Backups[$i]{sizeExistComp} = $sizeExistComp;
    $Backups[$i]{nFilesNew}     = $nFilesNew;
    $Backups[$i]{sizeNew}       = $sizeNew;
    $Backups[$i]{sizeNewComp}   = $sizeNewComp;
    $Backups[$i]{tarErrs}       = $tarErrs;
    $Backups[$i]{compress}      = $Conf{CompressLevel};
    $Backups[$i]{noFill}        = 0;
    $Backups[$i]{mangle}        = 1;                             # name mangling always on for v1.04+
    $Backups[$i]{xferMethod}    = $Conf{XferMethod};
    $Backups[$i]{charset}       = $Conf{ClientCharset};
    $Backups[$i]{version}       = $bpc->Version();
    $Backups[$i]{inodeLast}     = $inodeLast;
    $Backups[$i]{keep}          = 0;
    $Backups[$i]{share2path}    = $Conf{ClientShareName2Path};
    $Backups[$i]{comment}       = "";

    return if ( $noWrite );
    #
    # Save the main backups file
    #
    $bpc->BackupInfoWrite($client, @Backups);
    #
    # Save just this backup's info in case the main backups file
    # gets corrupted
    #
    BackupPC::Storage->backupInfoWrite($Dir, $Backups[$i]{num}, $Backups[$i], 1);

    unlink("$Dir/timeStamp.level0") if ( -f "$Dir/timeStamp.level0" );
    foreach my $ext ( qw(bad bad.z) ) {
        next                            if ( !-f "$Dir/XferLOG.$ext" );
        unlink("$Dir/XferLOG.$ext.old") if ( -f "$Dir/XferLOG.$ext" );
        rename("$Dir/XferLOG.$ext", "$Dir/XferLOG.$ext.old");
    }

    return $num;
}

#
# Removes a specific backup, or a sharename within a backup
#
sub BackupRemove
{
    my($client, $idx, $removeXferLOG, $shareName) = @_;
    my $t    = time;
    my $pids = {};

    my $fileExt = $Backups[$idx]{compress} > 0 ? ".z" : "";
    my $bkupNum = $Backups[$idx]{num};
    my @args    = ("-h", $client, "-n", $Backups[$idx]{num}, "-l", "-m");

    if ( $Backups[$idx]{keep} ) {
        #
        # this shouldn't happen, but report an error if it does
        #
        $XferLOG->write(\"BackupRemove(num = $bkupNum) -> skipping because keep is set\n")
          if ( defined($XferLOG) );
        return 1;
    }

    if ( defined($shareName) ) {
        push(@args, "-s", $shareName, "/");
        print("__bpc_progress_state__ delete share #$bkupNum/$shareName\n") if ( !$opts{p} );
    } else {
        print("__bpc_progress_state__ delete #$bkupNum\n") if ( !$opts{p} );
    }
    push(@args, "-p") if ( $opts{p} );

    unlink("$Dir/XferLOG.$bkupNum$fileExt") if ( !defined($shareName) && $removeXferLOG );

    $bpc->cmdSystemOrEval(
        ["$BinDir/BackupPC_backupDelete", @args],
        sub {
            if ( $_[0] =~ /^__bpc_progress_/ ) {
                print($_[0]);
            } elsif ( $_[0] =~ /^__bpc_pidStart__ (\d+)/ ) {
                $pids->{$1} = 1;
                pidHandler(keys(%$pids));
            } elsif ( $_[0] =~ /^__bpc_pidEnd__ (\d+)/ ) {
                delete($pids->{$1});
                pidHandler(keys(%$pids));
            } else {
                print($LogFd $bpc->timeStamp, $_[0]);
                $XferLOG->write(\$_[0]) if ( defined($XferLOG) );
            }
        }
    );
    my $ret = $?;
    $t = time - $t;
    print($LogFd $bpc->timeStamp, "Finished BackupPC_backupDelete, status = $ret (running time: $t sec)\n");
    $XferLOG->write(\"Finished BackupPC_backupDelete, status = $ret (running time: $t sec)\n")
      if ( defined($XferLOG) );
    pidHandler();
    if ( !defined($shareName) ) {
        splice(@Backups, $idx, 1);
    }
    return $ret;
}

sub CorrectHostCheck
{
    my($hostIP, $host) = @_;
    return if ( $hostIP eq $host || !$Conf{FixedIPNetBiosNameCheck} || $Conf{NmbLookupCmd} eq "" );
    if ( ref($Conf{ClientNameAlias}) eq "ARRAY" ) {
        return if ( grep /^$hostIP$/, @{$Conf{ClientNameAlias}} );
    }
    my($netBiosHost, $netBiosUser) = $bpc->NetBiosInfoGet($hostIP);
    return "host $host has mismatching netbios name $netBiosHost"
      if ( lc($netBiosHost) ne lc(substr($host, 0, 15)) );
    return;
}

#
# Returns $host if $bpc->getHostAddrInfo() knows about it.
# Otherwise tries to find the hostIP via NetBios, and returns
# the hostIP if successful.
#
# Returns undef if both $bpc->getHostAddrInfo() and NetBios fail
#
sub HostLookupCheck
{
    my($host) = @_;
    my $hostIP;

    return $host if ( defined($bpc->getHostAddrInfo($host)) );
    #
    # Ok, NS doesn't know about it.  Maybe it is a NetBios name
    # instead.
    #
    print("Name server doesn't know about $host; trying NetBios\n") if ( $opts{v} );
    if ( !defined($hostIP = $bpc->NetBiosHostIPFind($host)) ) {
        print($LogFd $bpc->timeStamp, "Can't find host $host via NS and netbios\n");
        print("host $host not found\n");
    }
    return $hostIP;
}

#
# Check the top-level directory in backupDir and remove any directory trees
# that aren't in the listref of share names in $shareNames
#
sub OrphanShareNameClean
{
    my($backupDir, $shareNames, $compress) = @_;
    my $goodShares = {};

    foreach my $shareName ( @$shareNames ) {
        $goodShares->{$shareName} = 1;
    }
    my $attr = BackupPC::XS::Attrib::new($compress);
    if ( !$attr->read($backupDir) ) {
        $XferLOG->write(\"OrphanShareNameClean: can't read attribute file in $backupDir\n");
        return;
    }
    my $attrAll = $attr->get();

    foreach my $fileUM ( keys(%$attrAll) ) {
        my $a = $attrAll->{$fileUM};
        next if ( $goodShares->{$fileUM} );
        print($LogFd $bpc->timeStamp, "removing orphan share $fileUM from $backupDir\n");
        $XferLOG->write(\"OrphanShareNameClean: removing orphan share $fileUM from $backupDir\n");
        BackupRemove($client, $newBkupIdx, 0, $fileUM);
    }
}

#
# Run BackupPC_refCountUpdate on this client
#
# With $doFsck = 0 and $doCheck = 0, a regular update based on the
# delta files is done.
#
# With $doFsck = 1 and $doCheck = 0, the pool count files are rebuilt,
# without checking the old one.
#
# With $doFsck = 1 and $doCheck = 1, the pool count files are rebuilt,
# and differences to the current ones are listed.
#
sub RefCountUpdate
{
    my($doFsck, $doCheck) = @_;
    my $t    = time;
    my $pids = {};

    my $args = ["-h", $client];
    push(@$args, "-f") if ( $doFsck );
    push(@$args, "-c") if ( $doCheck );
    push(@$args, "-p") if ( $opts{p} );
    print("__bpc_progress_state__ fsck\n") if ( !$opts{p} );
    $XferLOG->write(\"Running BackupPC_refCountUpdate @$args on $client\n");
    $bpc->cmdSystemOrEval(
        ["$BinDir/BackupPC_refCountUpdate", @$args],
        sub {
            if ( $_[0] =~ /^__bpc_progress_/ ) {
                print($_[0]);
            } elsif ( $_[0] =~ /^__bpc_pidStart__ (\d+)/ ) {
                $pids->{$1} = 1;
                pidHandler(keys(%$pids));
            } elsif ( $_[0] =~ /^__bpc_pidEnd__ (\d+)/ ) {
                delete($pids->{$1});
                pidHandler(keys(%$pids));
            } else {
                $XferLOG->write(\$_[0]);
            }
        }
    );
    $t = time - $t;
    $XferLOG->write(\"Finished BackupPC_refCountUpdate (running time: $t sec)\n");
    pidHandler();
}

#
# The Xfer method might tell us from time to time about processes
# it forks.  We tell BackupPC about this (for status displays) and
# keep track of the pids in case we cancel the backup
#
sub pidHandler
{
    @xferPid = @_;
    @xferPid = grep(/./, @xferPid);
    return if ( !@xferPid && $tarPid < 0 );
    my @pids = @xferPid;
    push(@pids, $tarPid) if ( $tarPid > 0 );
    my $str = join(",", @pids);
    $XferLOG->write(\"Xfer PIDs are now $str\n") if ( defined($XferLOG) );
    print("xferPids $str\n");
}

#
# Run an optional pre- or post-dump command
#
sub UserCommandRun
{
    my($cmdType, $sharename) = @_;

    $? = 0;
    return if ( !defined($Conf{$cmdType}) );
    my $vars = {
        xfer       => $xfer,
        client     => $client,
        host       => $host,
        hostIP     => $hostIP,
        user       => $Hosts->{$client}{user},
        moreUsers  => $Hosts->{$client}{moreUsers},
        share      => $ShareNames->[0],
        shares     => $ShareNames,
        XferMethod => $Conf{XferMethod},
        sshPath    => $Conf{SshPath},
        LOG        => $LogFd,
        XferLOG    => $XferLOG,
        stat       => \%stat,
        xferOK     => $stat{xferOK} || 0,
        hostError  => $stat{hostError},
        type       => $type,
        cmdType    => $cmdType,
    };

    if ( $cmdType eq 'DumpPreShareCmd' || $cmdType eq 'DumpPostShareCmd' ) {
        $vars->{share} = $sharename;
        if ( $cmdType =~ /Post/ ) {
            print("__bpc_progress_state__ post-cmd $sharename\n") if ( !$opts{p} );
        } else {
            print("__bpc_progress_state__ pre-cmd $sharename\n") if ( !$opts{p} );
        }
    } else {
        if ( $cmdType =~ /Post/ ) {
            print("__bpc_progress_state__ post-cmd\n") if ( !$opts{p} );
        } else {
            print("__bpc_progress_state__ pre-cmd\n") if ( !$opts{p} );
        }
    }

    my $cmd = $bpc->cmdVarSubstitute($Conf{$cmdType}, $vars);
    if ( $XferLOG ) {
        $XferLOG->write(\"Executing $cmdType: @$cmd\n");
    } elsif ( $opts{v} ) {
        print("Executing $cmdType: @$cmd\n");
    }
    #
    # Run the user's command, dumping the stdout/stderr into the
    # Xfer log file.  Also supply the optional $vars and %Conf in
    # case the command is really perl code instead of a shell
    # command.
    #
    $bpc->cmdSystemOrEval(
        $cmd,
        sub {
            if ( $XferLOG && length($_[0]) ) {
                $XferLOG->write(\$_[0]);
            } elsif ( $LogFd && length($_[0]) ) {
                print($LogFd $bpc->timeStamp, "Output from $cmdType: ", $_[0]);
            }
        },
        $vars,
        \%Conf
    );
}

sub flushLibMessages()
{
    my $msg = BackupPC::XS::Lib::logMsgGet();
    return if ( !defined($msg) );
    if ( $XferLOG ) {
        foreach my $m ( @$msg ) {
            $XferLOG->write(\$m);
        }
    } elsif ( defined($LogFd) ) {
        foreach my $m ( @$msg ) {
            print($LogFd $m);
        }
    }
}

sub xferLOGCopyFile
{
    my($srcFileName, $compress, $removeSrc) = @_;
    my($f, $data);

    $f = BackupPC::XS::FileZIO::open($srcFileName, 0, $compress);
    return if ( !defined($f) );
    while ( $f->read(\$data, 1 << 20) > 0 ) {
        $XferLOG->write(\$data);
    }
    $f->close();
    unlink($srcFileName) if ( $removeSrc );
}
