WebSVN – zfs_utils – Diff – /trunk/ZFS_Utils.pm

 # currently used for sneakernet scripts, but plans to expand to other ZFS related tasks
 # functions include:
 #   runCmd: execute a command and return its output (captures exit status in $lastRunError;
 #           supports optional stderr merge via $merge_stderr)
 #   shredFile: securely delete a file using gshred (note: not effective on ZFS due to COW)
-#   logMsg: timestamped logging to a file and optionally to console
+#   logMsg: timestamped logging to a file and optionally to console; respects $verboseLoggingLevel
 #   loadConfig: load a YAML configuration file into a hashref; will create the file from a
 #           provided default hashref if the file does not exist (uses YAML::XS or YAML::Tiny)
 #   mountDriveByLabel: find and mount a drive by its GPT label (supports ufs/msdos; waits
 #           for device and creates mountpoint)
 #   unmountDriveByLabel: unmount a drive found by GPT label and remove the mountpoint if empty
 #   decryptAndMountGeli: attach GELI devices, optionally build a combined key, import the pool
 #           and mount ZFS datasets
 #   makeGeliKey: create a GELI key by XOR'ing a remote binary keyfile and a local 256-bit hex key;
 #           writes a 32-byte binary key file with mode 0600
 #   findGeliDisks: discover candidate disks suitable for GELI on the host
-#   makeReplicateCommands: build zfs send/receive command lists from snapshot lists and prior status
+#   makeReplicateCommands: build zfs send/receive command lists from snapshot lists and prior status;
+#           intelligently determines recursive vs per-filesystem sends and incremental vs full sends
+#           based on snapshot availability; filters snapshots by matching parent path + dataset name
+#           to avoid false matches with similarly-named datasets in different locations
 #   sendReport: helper to deliver replication reports (email/file) — exported for scripts to implement
 #   fatalError: helper to log a fatal condition and die (convenience wrapper)
 #   getDirectoryList: utility to list directory contents with optional filters
 #   cleanDirectory: safe directory cleaning utility used by snapshot pruning helpers
 #   exported package variables: $logFileName, $displayLogsOnConsole, $lastRunError, $verboseLoggingLevel
 # v1.0 RWR 20251215
 # This is the initial, tested release
+#
 # v1.0.1 RWR 20251215
 # Added verbose logging control to logMsg calls, controlled by $verboseLoggingLevel
+#
+# v1.1.0 RWR 20251217
+# Added added version variable $VERSION
+# Added more logging of source/target snapshots in doSourceReplication for debugging.
+# max verbosity is now 5 instead of 3.
+# optimized makeReplicateCommands to avoid unnecessary copies of large arrays and increase reliability
+# when processing snapshots with inconsistent naming in child datasets.
 # Exported functions and variables
 our @EXPORT_OK = qw(loadConfig shredFile mountDriveByLabel unmountDriveByLabel mountGeli logMsg runCmd makeReplicateCommands sendReport fatalError getDirectoryList cleanDirectory $logFileName $displayLogsOnConsole $lastRunError $verboseLoggingLevel);
-our $VERSION = '1.0';
+our $VERSION = '1.1.0';
 # these are variables which affect the flow of the program and are exported so they can be modified by the caller
 our $logFileName = '/tmp/zfs_utils.log'; # this can be overridden by the caller, and turned off with empty string
 our $displayLogsOnConsole = 1; # if non-zero, log messages are also printed to console
 our $merge_stderr = 0; # if set to 1, stderr is captured in runCmd
 # returns hashref of commands to execute, of form
 #    {$dataset} = "zfs send command"
 # where $dataset above can be a child of $dataset
 sub makeReplicateCommands {
    my ( $sourceSnapsRef, $targetSnapsRef, $dataset, $sourceParent, $targetParent, $newStatusRef ) = @_;
+   # Ensure all array refs are defined (use empty arrays if not provided)
    $sourceSnapsRef ||= [];
    $targetSnapsRef     ||= [];
    $newStatusRef  ||= [];
+   # Normalize parent paths: ensure they end with '/' unless empty
+   # This makes path construction consistent later (e.g., "pool/" + "dataset")
    $sourceParent //= '';
    $sourceParent .= '/' unless $sourceParent eq '' or substr($sourceParent, -1) eq '/';
    $targetParent //= '';
    $targetParent .= '/' unless $targetParent eq '' or substr($targetParent, -1) eq '/';
-   my %commands; # this will hold the commands (and the dataset as key) for return
-   fatalError( "No dataset defined in makeReplicateCommands, can not continue") unless $dataset;
+   logMsg( "makeReplicateCommands: dataset=[$dataset] sourceParent=[$sourceParent] targetParent=[$targetParent]" ) if $verboseLoggingLevel >= 4;
-   # filter only the target and source snapshots which have this dataset in them, then remove
+   logMsg( "makeReplicateCommands: source snapshots count=" . scalar(@$sourceSnapsRef) . ", target snapshots count=" . scalar(@$targetSnapsRef) ) if $verboseLoggingLevel >= 4;
-   # the parent of each.
+   if ($verboseLoggingLevel >= 5) {
-   my $targetSnaps = [ map{ s/^$targetParent//r } grep{ /$dataset/ } @$targetSnapsRef ];
+      logMsg( "makeReplicateCommands: RAW target snapshots BEFORE filtering:" );
-   my $sourceSnaps = [ map{ s/^$sourceParent//r } grep{ /$dataset/ } @$sourceSnapsRef ];
+      foreach my $snap (@$targetSnapsRef) {
+         logMsg( "  [$snap]" );
+      }
-   #print "Dataset => [$dataset]\nSource Parent => [$sourceParent]\nTarget Parent => [$targetParent]\n";
+      logMsg( "makeReplicateCommands: RAW source snapshots BEFORE filtering:" );
+      foreach my $snap (@$sourceSnapsRef) {
+         logMsg( "  [$snap]" );
+      }
+   }
-   #print "Source Snaps\n" . Dumper( $sourceSnapsRef) . "\nTarget Snaps\n" . Dumper( $targetSnapsRef) . "\n";
+   my %commands; # Hash to store generated zfs send commands, keyed by filesystem name
-   #print Dumper( $targetSnaps ) . "\n" . Dumper( $sourceSnaps ) . "\n"; die;
+   fatalError( "No dataset defined in makeReplicateCommands, can not continue") unless $dataset;
-   #return \%commands;
-   # parse snapshots: each line is expected to have snapshot fullname as first token: pool/fs@snap ...
+   # Filter snapshot lists to only include snapshots matching our dataset and its children
+   # The dataset should match as a full path component (not substring)
+   # Then strip the parent path prefix from each snapshot name
+   # Example: "storage/mydata@snap1" becomes "mydata@snap1" when sourceParent="storage/"
+   # This allows us to work with relative paths and handle different parent paths on source/target
+   # Match: storage/mydata@snap, storage/mydata/child@snap
+   # Don't match: storage/mydataset@snap (if dataset is "mydata")
+   # Don't match: storage/otherparent/mydata@snap (different parent path)
+   my $targetSnaps = [ map{ s/^$targetParent//r } grep{ /^\Q$targetParent$dataset\E(?:\/|@)/ } @$targetSnapsRef ];
+   my $sourceSnaps = [ map{ s/^$sourceParent//r } grep{ /^\Q$sourceParent$dataset\E(?:\/|@)/ } @$sourceSnapsRef ];
+   logMsg( "makeReplicateCommands: filtered source snapshots count=" . scalar(@$sourceSnaps) . ", filtered target snapshots count=" . scalar(@$targetSnaps) ) if $verboseLoggingLevel >= 4;
+   logMsg( "makeReplicateCommands: filtered source snapshots: " . join(', ', sort @$sourceSnaps) ) if $verboseLoggingLevel >= 5;
+   logMsg( "makeReplicateCommands: filtered target snapshots: " . join(', ', sort @$targetSnaps) ) if $verboseLoggingLevel >= 5;
+   # Parse source snapshots to build a hash indexed by filesystem
+   # Input lines may have format: "pool/fs@snapshot extra data"
+   # We extract just the first token (pool/fs@snapshot) and split it into filesystem and snapshot name
+   # Result: %snaps_by_fs = { "pool/fs" => ["snap1", "snap2", ...] }
+   # This groups all snapshots by their parent filesystem
    my %snaps_by_fs;
    foreach my $line (@$sourceSnaps) {
-      next unless defined $line && $line =~ /\S/;
+      next unless defined $line && $line =~ /\S/;  # Skip empty lines
-      my ($tok) = split /\s+/, $line;
+      my ($tok) = split /\s+/, $line;              # Get first token
-      next unless $tok && $tok =~ /@/;
+      next unless $tok && $tok =~ /@/;             # Must contain @ separator
-      my ($fs, $snap) = split /@/, $tok, 2;
+      my ($fs, $snap) = split /@/, $tok, 2;        # Split into filesystem and snapshot name
-      push @{ $snaps_by_fs{$fs} }, $snap;
+      push @{ $snaps_by_fs{$fs} }, $snap;          # Add snapshot to this filesystem's list
+   }
+   logMsg( "makeReplicateCommands: parsed filesystems: " . join(', ', sort keys %snaps_by_fs) ) if $verboseLoggingLevel >= 4;
-   # nothing to do
+   # If no snapshots were found, return empty array (nothing to replicate)
    return [] unless keys %snaps_by_fs;
+   # Determine the root filesystem for recursive operations
-   # figure root filesystem: first snapshot line's fs is the requested root
+   # We try to get it from the first non-empty snapshot line, otherwise use first sorted key
+   # The root filesystem is used when we can do a single recursive send instead of multiple sends
    my ($first_line) = grep { defined $_ && $_ =~ /\S/ } @$sourceSnaps;
    my ($root_fs) = $first_line ? (split(/\s+/, $first_line))[0] =~ /@/ ? (split(/@/, (split(/\s+/, $first_line))[0]))[0] : undef : undef;
    $root_fs ||= (sort keys %snaps_by_fs)[0];
+   # Build a hash of the most recent snapshot on target for each filesystem
+   # This tells us what's already been replicated, so we can do incremental sends
+   # If a filesystem isn't in this hash, we need to do a full (non-incremental) send
-   # helper: find last status entry for a filesystem (status lines contain full snapshot names pool/fs@snap)
+   # Note: If multiple snapshots exist for a filesystem, we keep only the last one
+   # (later entries override earlier ones in the hash assignment)
    my %last_status_for;
    for my $s (@$targetSnaps) {
       next unless $s && $s =~ /@/;
       my ($fs, $snap) = split /@/, $s, 2;
       $last_status_for{$fs} = $snap;    # later entries override earlier ones -> last occurrence kept
+   }
+   if ($verboseLoggingLevel >= 4) {
+      logMsg( "makeReplicateCommands: last status snapshots:" );
-   # build per-filesystem "from" and "to"
+      for my $fs (sort keys %last_status_for) {
+         logMsg( "  $fs => $last_status_for{$fs}" );
+      }
+   }
+   # Build "from" and "to" snapshot mappings for each filesystem
+   # "to" = the newest snapshot on source (what we want to send)
+   # "from" = the last replicated snapshot on target (what we're sending from)
+   # If "from" is undef, this filesystem hasn't been replicated before -> full send needed
+   # Example: from="daily-2025-12-15" to="daily-2025-12-17" -> incremental send
+   #          from=undef to="daily-2025-12-17" -> full send
+   # NOTE: The "from" snapshot must exist in the source's snapshot list for incremental send
+   #       If it doesn't exist in source, we need to find a common snapshot or do full send
    my %from_for;
    my %to_for;
    foreach my $fs (keys %snaps_by_fs) {
-      my $arr = $snaps_by_fs{$fs};
+      my $arr = $snaps_by_fs{$fs};              # Get all snapshots for this filesystem
-      next unless @$arr;
+      next unless @$arr;                        # Skip if no snapshots
+      $to_for{$fs} = $arr->[-1];                # Last element = newest snapshot to send
+      # Check if the target's last status snapshot exists in the source list
+      # If it does, we can do incremental send from that point
+      # If it doesn't, the target may have a snapshot the source doesn't have anymore
-      $to_for{$fs} = $arr->[-1];
+      my $target_last = $last_status_for{$fs};
+      if (defined $target_last && grep { $_ eq $target_last } @$arr) {
-      $from_for{$fs} = $last_status_for{$fs};    # may be undef -> full send required
+         $from_for{$fs} = $target_last;         # Use target's last snapshot as "from"
+      } else {
+         # Target's snapshot doesn't exist in source list - need full send
+         $from_for{$fs} = undef;
+      }
+   }
+   if ($verboseLoggingLevel >= 4) {
+      logMsg( "makeReplicateCommands: from/to mapping:" );
+      for my $fs (sort keys %to_for) {
+         my $from = $from_for{$fs} // '(none - full send)';
+         my $send_type = defined $from_for{$fs} ? 'incremental' : 'full';
+         logMsg( "  $fs: from=$from to=$to_for{$fs} [$send_type]" );
+      }
+   }
-   # decide if we can do a single recursive send:
+   # Optimization check: Can we do a single recursive send?
+   # Recursive sends are more efficient when replicating entire filesystem hierarchies
-   # condition: all 'to' snapshot names are identical
+   # Condition: all filesystems must be sending to the same-named snapshot
+   # Example: If pool/data@daily-2025-12-17 and pool/data/child@daily-2025-12-17 exist,
+   #          we can do "zfs send -R pool/data@daily-2025-12-17" instead of two separate sends
-   my %to_names = map { $_ => 1 } values %to_for;
+   my %to_names = map { $_ => 1 } values %to_for;  # Get unique "to" snapshot names
    my $single_to_name = (keys %to_names == 1) ? (keys %to_names)[0] : undef;
+   logMsg( "makeReplicateCommands: single_to_name=" . ($single_to_name // '(none - varied snapshots)') ) if $verboseLoggingLevel >= 4;
    if ($single_to_name) {
-      # check whether any from is missing
+      # All filesystems are targeting the same snapshot name
+      # Now check if we can use incremental recursive send or need full send
       my @from_values = map { $from_for{$_} } sort keys %from_for;
-      my $any_from_missing = grep { !defined $_ } @from_values;
+      my $any_from_missing = grep { !defined $_ } @from_values;  # Any filesystem not yet replicated?
-      my %from_names = map { $_ => 1 } grep { defined $_ } @from_values;
+      my %from_names = map { $_ => 1 } grep { defined $_ } @from_values;  # Unique "from" names
       my $single_from_name = (keys %from_names == 1) ? (keys %from_names)[0] : undef;
+      logMsg( "makeReplicateCommands: single_from_name=" . ($single_from_name // '(none)') . ", any_from_missing=$any_from_missing" ) if $verboseLoggingLevel >= 4;
       if ($any_from_missing) {
+         # At least one filesystem has never been replicated (from=undef)
+         # Check if the ROOT filesystem has been replicated - if not, must do full recursive send
+         # If only children are missing, we can still do per-filesystem sends with incrementals where possible
-         # full recursive send from root
+         if (!defined $from_for{$root_fs}) {
+            # Root filesystem has never been replicated - must do full recursive send
+            # Command: zfs send -R pool/dataset@snapshot
+            logMsg( "makeReplicateCommands: generating full recursive send (root filesystem has no prior snapshot)" ) if $verboseLoggingLevel >= 4;
-         $commands{$root_fs} = sprintf('zfs send -R %s%s@%s', $sourceParent, $root_fs, $single_to_name);
+            $commands{$root_fs} = sprintf('zfs send -R %s%s@%s', $sourceParent, $root_fs, $single_to_name);
+         } else {
+            # Root has been replicated, but some children haven't - do per-filesystem sends
+            # This allows incremental sends for filesystems that have prior snapshots
+            logMsg( "makeReplicateCommands: root replicated but some children missing - using per-filesystem sends" ) if $verboseLoggingLevel >= 4;
+            foreach my $fs (sort keys %to_for) {
+               my $to  = $to_for{$fs};
+               my $from = $from_for{$fs};
+               if ($from) {
+                  # Incremental send for this filesystem
+                  $commands{$fs} = sprintf('zfs send -I %s%s@%s %s%s@%s', $sourceParent, $fs, $from, $sourceParent, $fs, $to)
+                     unless $from eq $to;
+               } else {
+                  # Full send for this filesystem (never replicated before)
+                  logMsg( "makeReplicateCommands: $fs - full send (no prior snapshot)" ) if $verboseLoggingLevel >= 4;
+                  $commands{$fs} = sprintf('zfs send %s%s@%s', $sourceParent, $fs, $to);
+               }
+            }
+         }
+      }
       elsif ($single_from_name) {
+         # All filesystems have been replicated AND they all have the same "from" snapshot
+         # Perfect case for incremental recursive send
+         # Command: zfs send -R -I pool/dataset@old pool/dataset@new
+         if ($single_from_name eq $single_to_name) {
-         # incremental recursive send, but don't do it if they are the same
+            # Source and target are already identical - nothing to send
+            logMsg( "makeReplicateCommands: from and to snapshots are identical ($single_from_name) - no send needed" ) if $verboseLoggingLevel >= 4;
+         } else {
+            logMsg( "makeReplicateCommands: generating incremental recursive send from $single_from_name to $single_to_name" ) if $verboseLoggingLevel >= 4;
-         $commands{$root_fs} = sprintf('zfs send -R -I %s%s@%s %s%s@%s',
+            $commands{$root_fs} = sprintf('zfs send -R -I %s%s@%s %s%s@%s',
-                           $sourceParent, $root_fs, $single_from_name, $sourceParent, $root_fs, $single_to_name)
+                           $sourceParent, $root_fs, $single_from_name, $sourceParent, $root_fs, $single_to_name);
-                           unless $single_from_name eq $single_to_name;
+         }
+      }
       else {
-         # from snapshots differ across children -> fall back to per-filesystem sends
+         # Filesystems have different "from" snapshots - can't use single recursive send
+         # Fall back to individual per-filesystem sends
+         logMsg( "makeReplicateCommands: from snapshots differ across children - using per-filesystem sends" ) if $verboseLoggingLevel >= 4;
          foreach my $fs (sort keys %to_for) {
             my $to  = $to_for{$fs};
             my $from = $from_for{$fs};
             if ($from) {
+               # Incremental send: send all intermediate snapshots from "from" to "to"
-               # if from and to are different, add it
+               # Skip if from and to are identical (already up to date)
                $commands{$fs} = sprintf('zfs send -I %s%s@%s %s%s@%s', $sourceParent, $fs, $from, $sourceParent, $fs, $to)
                   unless $from eq $to;
             } else {
+               # Full send: no prior snapshot on target, send everything
                $commands{$fs} = sprintf('zfs send %s%s@%s', $sourceParent, $fs, $to);
+            }
+         }
+      }
-      # update new status: record newest snap for every filesystem
+      # Update the status array with the new target snapshots
+      # This will be written to the status file for tracking what's been replicated
+      # Format: targetParent/filesystem@snapshot
       foreach my $fs (keys %to_for) {
          push @$newStatusRef, sprintf('%s%s@%s', $targetParent, $fs, $to_for{$fs});
+      }
+      logMsg( "makeReplicateCommands: added " . scalar(keys %to_for) . " entries to new status" ) if $verboseLoggingLevel >= 4;
    } else {
-      # not all children share same newest snap -> per-filesystem sends
+      # Filesystems have different "to" snapshot names - can't use recursive send
+      # Must send each filesystem individually
+      # This handles cases like:
+      #   - Parent: pool/data@daily-2025-12-17
+      #   - Child:  pool/data/child@hourly-2025-12-17-14
+      # Each filesystem can still do incremental sends to its own target snapshot
+      logMsg( "makeReplicateCommands: varied 'to' snapshots - using per-filesystem sends (each may be incremental)" ) if $verboseLoggingLevel >= 4;
       foreach my $fs (sort keys %to_for) {
          my $to  = $to_for{$fs};
          my $from = $from_for{$fs};
          if ($from) {
+            # Incremental send for this filesystem to its specific target snapshot
+            # Command: zfs send -I pool/fs@old pool/fs@new
+            # Note: "old" and "new" are specific to this filesystem, not necessarily matching parent
+            logMsg( "makeReplicateCommands: $fs - incremental send from $from to $to" ) if $verboseLoggingLevel >= 4;
             $commands{$fs} = sprintf('zfs send -I %s%s@%s %s%s@%s', $sourceParent, $fs, $from, $sourceParent, $fs, $to);
          } else {
+            # Full send for this filesystem (never replicated before, or target snap not in source)
+            # Command: zfs send pool/fs@snapshot
+            logMsg( "makeReplicateCommands: $fs - full send to $to (no common snapshot)" ) if $verboseLoggingLevel >= 4;
             $commands{$fs} = sprintf('zfs send %s%s@%s', $sourceParent, $fs, $to);
+         }
+         # Add to status tracking
          push @$newStatusRef, sprintf('%s%s@%s', $targetParent, $fs, $to);
+      }
+      logMsg( "makeReplicateCommands: added " . scalar(keys %to_for) . " entries to new status" ) if $verboseLoggingLevel >= 4;
+   }
+   logMsg( "makeReplicateCommands: generated " . scalar(keys %commands) . " commands" ) if $verboseLoggingLevel >= 4;
-   # return arrayref of commands (caller can iterate or join with pipes)
+   # Return hash reference of commands: { "filesystem" => "zfs send command" }
+   # Caller will typically pipe these to "zfs receive" on target
    return \%commands;
+}
 # Send report via email and/or copy to target drive.
 # $reportConfig is a hashref with optional keys:

Subversion Repositories zfs_utils

(root)/trunk/ZFS_Utils.pm – Rev 51 → 60