btrbk: bugfix: make get_related_readonly_nodes non-recursive

Perl hates recursions, and dies if recursion depth = 100:

    Deep recursion on subroutine "main::_push_related_children"

Unfortunately this happens before the implemented abort condition
(distance=256).

Fixed by re-implementing get_related_readonly_nodes() non-recursive.

Refs: https://github.com/digint/btrbk/issues/279

btrbk

@@ -3126,52 +3126,11 @@ sub get_best_correlated($$;@)
 }
 
 
-sub _push_related_children
+# returns all related readonly nodes (by parent_uuid relationship), unsorted.
-{
+sub get_related_readonly_nodes($;@)
-  my $node = shift; # can be undef, siblings are considered related even if parent is gone
-  my $uuid = shift;
-  my $parent_uuid_hash = shift;
-  my $related = shift;
-  my $prune = shift;
-  my $distance = shift;
-
-  if($distance >= 256) {
-    WARN "Maximum distance reached, aborting related subvolume search";
-    return;
-  }
-  if($node) {
-    if($distance == 0) {
-      # hacky, we want to skip ourself, and $node=$vol->{node} if distance=0
-      TRACE "related_nodes: d=$distance uuid=$uuid : related self: " . _fs_path($node);
-    } elsif($node->{readonly}) {
-      TRACE "related_nodes: d=$distance uuid=$uuid : push related readonly: " . _fs_path($node);
-      push @$related, $node;
-    } else {
-      TRACE "related_nodes: d=$distance uuid=$uuid : related not readonly: " . _fs_path($node);
-    }
-  } else {
-    TRACE "related_nodes: d=$distance uuid=$uuid : missing (deleted)";
-  }
-
-  # recurse into all child subvolumes (even if parent is missing -> siblings)
-  my $children = $parent_uuid_hash->{$uuid} // [];
-  foreach(@$children) {
-    if(defined($prune) && ($_->{id} == $prune->{id})) {
-      TRACE "related_nodes: d=$distance uuid=$uuid : pruning processed uuid=$_->{uuid}";
-      next;
-    }
-    TRACE "related_nodes: d=$distance uuid=$uuid : processing child uuid=$_->{uuid}";
-    _push_related_children($_, $_->{uuid}, $parent_uuid_hash, $related, $prune, $distance + 1);
-  }
-  TRACE "related_nodes: d=$distance uuid=$uuid : processed " . (scalar @$children) . " children";
-}
-
-
-# returns all related readonly nodes (by parent_uuid relationship),
-# sorted by relation distance.
-sub get_related_readonly_nodes($)
 {
   my $vol = shift // die;
+  my %opts = @_;
   TRACE "related_nodes: resolving related subvolumes of: $vol->{PATH}";
 
   # iterate parent chain
@@ -3180,24 +3139,69 @@ sub get_related_readonly_nodes($)
   my $parent_uuid_hash = $vol->{node}{TREE_ROOT}{PARENT_UUID_HASH};
   my $node = $vol->{node};
   my $uuid = $node->{uuid};
-  my $last_node;
+  my $abort_distance = 256;
-  my $distance = 0;
+
-  while($distance < 256) {
+  # climb up parent chain
-    _push_related_children($node, $uuid, $parent_uuid_hash, \@related_nodes, $last_node, $distance);
+  my $distance = 0;  # parent distance
-    last unless $node;
+  while(($distance < $abort_distance) && defined($node) && ($node->{parent_uuid} ne "-")) {
     $uuid = $node->{parent_uuid};
-    if($uuid eq "-") {
-      TRACE "related_nodes: d=$distance uuid=$node->{uuid} : no parent_uuid";
-      last;
-    }
-    $last_node = $node;
     $node = $uuid_hash->{$uuid};
-    TRACE "related_nodes: d=$distance uuid=$last_node->{uuid} : processing parent uuid=$uuid";
+    TRACE "related_nodes: d=$distance uuid=$uuid : parent: " . ($node ? _fs_path($node) : "<deleted>") if($loglevel >= 4);
     $distance++;
   }
-  WARN "Maximum distance reached, related subvolume search aborted" if($distance >= 256);
+  if($distance >= $abort_distance) {
-  TRACE "related_nodes: found total=" . scalar(@related_nodes) . " related readonly subvolumes";
+    my $logmsg = "Parent UUID chain exceeds depth=$abort_distance, ignoring related parents of uuid=$uuid for: $vol->{PATH}";
-  return \@related_nodes;
+    DEBUG $logmsg;
+    WARN_ONCE $logmsg unless($opts{nowarn});
+  }
+  TRACE "related_nodes: d=$distance uuid=$uuid : top of parent chain";
+
+  # push related children (even if parent node is missing -> siblings)
+  my @nn;
+  $abort_distance = $abort_distance;
+  $distance = $distance * (-1);  # child distance (from top parent)
+  while($uuid) {
+    push @related_nodes, $node if($node->{readonly});
+    my $children = $parent_uuid_hash->{$uuid};
+    if($children) {
+      if($distance >= $abort_distance) {
+        my $logmsg = "Parent/child relations exceed depth=$abort_distance, ignoring related children of uuid=$uuid for: $vol->{PATH}";
+        DEBUG $logmsg;
+        WARN_ONCE $logmsg unless($opts{nowarn});
+      } else {
+        push @nn, { MARK_UUID => $uuid, MARK_DISTANCE => ($distance + 1) }, @$children;
+      }
+    }
+
+    if($loglevel >= 4) {
+      if($node) {
+        if($node->{readonly}) {
+          TRACE "related_nodes: d=$distance uuid=$uuid : push related readonly: " . _fs_path($node);
+        } else {
+          TRACE "related_nodes: d=$distance uuid=$uuid : related not readonly: " . _fs_path($node);
+        }
+      } else {
+        TRACE "related_nodes: d=$distance uuid=$uuid : related missing: <deleted>";
+      }
+      if($children && ($distance < $abort_distance)) {
+        TRACE "related_nodes: d=$distance uuid=$uuid : postpone " . scalar(@$children) . " children";
+      }
+    }
+
+    $node = shift @nn;
+    if(exists($node->{MARK_DISTANCE})) {
+      # marker reached, restore distance
+      $distance = $node->{MARK_DISTANCE};
+      TRACE "related_nodes: d=$distance uuid=$node->{MARK_UUID} : processing children" if($loglevel >= 4);
+      $node = shift @nn;
+    }
+    $uuid = $node->{uuid};
+  }
+
+  my $vol_node_id = $vol->{node}{id};
+  my @filtered = grep { $_->{id} != $vol_node_id } @related_nodes;
+  TRACE "related_nodes: found total=" . scalar(@filtered) . " related readonly subvolumes";
+  return \@filtered;
 }
 
 
@@ -3235,10 +3239,13 @@ sub get_best_parent($$$;@)
                    fallback_all_mountpoints => $target_fallback_all_mountpoints,
                  );
 
-  # resolve correlated subvolumes by parent_uuid relationship
+  # resolve correlated subvolumes by parent_uuid relationship.
+  # no warnings on aborted search (due to deep relations), note that
+  # we could limit the search depth here for some performance
+  # improvements, as this only affects extra clones.
   my %c_rel_id;   # map id to c_related
   my @c_related;  # candidates for parent (correlated + related), unsorted
-  foreach (@{get_related_readonly_nodes($svol)}) {
+  foreach (@{get_related_readonly_nodes($svol, nowarn => 1)}) {
     my $vinfo = vinfo_resolved($_, $resolve_sroot);
     if((not $vinfo) && $source_fallback_all_mountpoints) { # related node is not under $resolve_sroot
       $vinfo = vinfo_resolved_all_mountpoints($_, $svol);