btrbk: add action "ls": list all btrfs subvolumes below path

btrbk

@@ -216,6 +216,11 @@ my %table_formats = (
                    long  => [ qw( tree uuid parent_uuid received_uuid recursion ) ],
                    raw   => [ qw( tree uuid parent_uuid received_uuid recursion ) ],
                  },
+
+  fs_list     => { table => [ qw( device id path ) ],
+                   long  => [ qw( device id top_level cgen gen uuid parent_uuid received_uuid flags path ) ],
+                   raw   => [ qw( device id top_level cgen gen uuid parent_uuid received_uuid readonly path ) ],
+                 },
 );
 
 my %backend_cmd_map = (
@@ -353,6 +358,7 @@ commands:
    usage                 print filesystem usage
    origin <subvol>       print origin information for subvolume
    diff <from> <to>      shows new files between related subvolumes
+   ls <path>             list all btrfs subvolumes below path
 
 For additional information, see $PROJECT_HOME
 END_HELP
@@ -4842,7 +4848,7 @@ MAIN:
     WARN 'Found option "--progress", but required executable "pv" does not exist on your system. Please install "pv".';
     $show_progress = 0;
   }
-  my ($action_run, $action_usage, $action_resolve, $action_diff, $action_origin, $action_config_print, $action_list, $action_clean, $action_archive);
+  my ($action_run, $action_usage, $action_resolve, $action_diff, $action_origin, $action_config_print, $action_list, $action_clean, $action_archive, $action_ls);
   my @filter_args;
   my @subvol_args;
   my $args_expected_min = 0;
@@ -4913,6 +4919,11 @@ MAIN:
     }
     @filter_args = @ARGV;
   }
+  elsif ($command eq "ls") {
+    $action_ls = 1;
+    $args_expected_min = $args_expected_max = 1;
+    @filter_args = @ARGV;
+  }
   elsif($command eq "stats") {
     $action_resolve = "stats";
     @filter_args = @ARGV;
@@ -5101,6 +5112,83 @@ MAIN:
     exit 2;
   }
 
+
+  if($action_ls)
+  {
+    #
+    # print accessible subvolumes for local path
+    #
+    my $url = $filter_args[0] || die;
+    my $root_vol = vinfo($url, $config);
+    if($root_vol->{URL_PREFIX}) {
+      ERROR 'ssh URLs are not supported by action "ls"';
+      exit 1;
+    }
+
+    # map url to real path (we need to match against mount points below)
+    my $root_path = system_realpath($root_vol);
+    unless($root_path) {
+      ERROR "Cannot find real path for: $root_vol->{PATH}";
+      exit 1;
+    }
+    $root_vol = vinfo($root_path, $config);
+    $root_path .= '/' unless($root_path =~ /\/$/);  # append trailing slash
+
+    my $mountinfo = system_list_mountinfo($root_vol) || die;
+    $mountinfo_cache{$root_vol->{MACHINE_ID}} = $mountinfo;
+
+    my @data;
+    my @path_hidden;
+    foreach my $mnt (reverse @$mountinfo) {
+      my $mnt_path = $mnt->{mount_point};
+      $mnt_path .= '/' unless($mnt_path =~ /\/$/);  # append trailing slash
+
+      if(($mnt->{fs_type} eq "btrfs") &&
+         (($root_path =~ /^\Q$mnt_path\E/) || ($mnt_path =~ /^\Q$root_path\E/)))
+      {
+        $realpath_cache{$mnt->{mount_point}} = $mnt->{mount_point}; # we know those are real paths, prevents calling readlink in btrfs_mountpoint
+        my $vol = vinfo($mnt->{mount_point}, $config);
+        unless(vinfo_init_root($vol)) {
+          ERROR "Failed to fetch subvolume detail for: $vol->{PRINT}" . ($err ? ": $err" : "");
+          exit 1;
+        }
+
+        my $subvol_list = vinfo_subvol_list($vol);
+        foreach my $svol ($vol, @$subvol_list) {
+          my $node = $svol->{node};
+          my $svol_path = $svol->{PATH};
+          $svol_path .= '/' unless($svol_path =~ /\/$/);  # append trailing slash
+
+          next unless($svol_path =~ /^\Q$root_path\E/);
+
+          if(grep { $svol_path =~ /^\Q$_\E/ } @path_hidden) {
+            DEBUG "subvolume is hidden by another mount point: $svol->{PRINT}";
+            next;
+          }
+
+          push @data, {
+            %{$svol->{node}}, # copy node
+            device => $svol->{node}{TREE_ROOT}{host_mount_source},
+            path => $svol->{PATH},
+            flags => ($svol->{node}{readonly} ? "readonly" : undef),
+          };
+        }
+      }
+      last if($root_path =~ /^\Q$mnt_path\E/);
+      push @path_hidden, ($mnt->{mount_point} . '/');
+    }
+
+    my @sorted = sort { $a->{path} cmp $b->{path} } @data;
+    if($output_format) {
+      print_formatted("fs_list", \@sorted);
+    } else {
+      print join("\n", map { $_->{path} } @sorted) . "\n";
+    }
+
+    exit 0;
+  }
+
+
   #
   # try exclusive lock if set in config or command-line option
   #