Fix parser for root (only) dataset names

.github/workflows/spelling/expect.txt

@@ -383,6 +383,7 @@ notest
 NOTMAKE
 nroff
 NSTIPS
+nsub
 nvpool
 nytprof
 OBJC
@@ -419,6 +420,7 @@ plaintar
 plist
 plugin
 png
+poolrootfs
 populat
 posix
 prebuilt
@@ -461,6 +463,7 @@ rmdir
 rmprog
 rmtmp
 ron
+rootds
 rootfs
 rootfs'es
 rpool

lib/ZnapZend/Config.pm

@@ -47,7 +47,9 @@ has backupSets => sub { [] };
 
 ### private functions ###
 my $splitHostDataSet = sub {
-    return ($_[0] =~ /^(?:([^:\/]+):)?([^:]+|[^:@]+\@.+)$/);
+    #return ($_[0] =~ /^(?:([^:\/]+):)?([^:]+|[^:@]+\@.+)$/);
+    # See https://github.com/oetiker/znapzend/pull/585
+    return ($_[0] =~ /^(?:([^:\/]+):)?([^@\s]+|[^@\s]+\@[^@\s]+)$/);
 };
 
 ### private methods ###

lib/ZnapZend/ZFS.pm

@@ -37,19 +37,78 @@
 
 ### private functions ###
 my $splitHostDataSet = sub {
+    # When troubleshooting, set to 1:
+    my $debugHere = 0;
+    #my $debugHere = 1;
+
     # See also https://github.com/oetiker/znapzend/issues/585
     # If there are further bugs in the regex, comment away the
     # next implementation line and fall through to verbosely
-    # debugging code below to try and iterate a fix:
-    return ($_[0] =~ /^(?:([^:\/]+):)?([^@\s]+|[^@\s]+\@[^@\s]+)$/);
+    # debugging code below to try and iterate a fix.
+    # In the "if" clause below we separate the regular expressions
+    # for the use-case where we have two "@" characters:
+    #   user@host:dataset@snap
+    # from having zero or one "@" characters:
+    #   host:dataset
+    #   host:dataset@snap
+    #   user@host:dataset
+    # and note that dataset may lack "/" chars (root dataset
+    # of a pool), and (non-root?) dataset and snapshot names
+    # may have ":" chars of their own, e.g.
+    #   ...@znapzend-auto-2024-01-08T10:22:13Z
+    #   pond/export/vm-1:2
+    # Also note that we can not discern "X@Y:Z" strings by pattern
+    # alone - are they a remote "user@host:rootds" or a local
+    # "rootds@funny:snapname"? For practical purposes, we proclaim
+    # preference for the former: we are more likely to look at funny
+    # local snapshot names, than to back up to (or otherwise care
+    # about) remote pools' ROOT datasets.
+    my $count = ($_[0] =~ tr/@//);
+    if ($count > 1) {
+        #return ($_[0] =~ /^(?:([^:\/]+):)?([^@\s]+|[^@\s]+\@[^@\s]+)$/);
+        print STDERR "[D] splitHostDataSet: use-case: Two or more \@\n" if $debugHere;
+        return ($_[0] =~ /^(?:([^:\/]+):)?([^@\s]+\@[^@\s]+)$/);
+    } else {
+        # Zero or one "@"
+        # Either "[host:]dataset[@snap]" or "[user@]host:dataset"
+        print STDERR "[D] splitHostDataSet: use-case: zero or one \@: " if $debugHere;
+        if ($_[0] =~ /^[^:@\/]+:/) {
+            # Got a colon before any "@" (if at all present):
+            # assume    host:... (no "user@")
+            print STDERR "colon before any frog\n" if $debugHere;
+            return ($_[0] =~ /^(?:([^:@\/]+):)([^@\s]+|[^@\s]+\@[^@\s]+)$/);
+        } elsif ($_[0] =~ /^[^:@\/]+\//) {
+            # Slashes are not anticipated in user or host names, so:
+            # assume    poolroot/...
+            print STDERR "slashes before colon\n" if $debugHere;
+            return (undef, $_[0]);
+        } elsif ($_[0] =~ /^[^:\/@]+@[^:@\/]+$/) {
+            # X@Y without colons or slashes:
+            # assume    poolroot@snap
+            print STDERR "no colon, no slash, with frog\n" if $debugHere;
+            return (undef, $_[0]);
+        } elsif ($_[0] =~ /^[^:@\/]+@[^:@\/]+:.*\//) {
+            # X@Y:Z/W - snapshot names can not have slashes
+            # assume    X@Y = user@host, Z/W = rootds/ds...[@snap]
+            print STDERR "X\@Y:Z/W without slashes in X and Y\n" if $debugHere;
+            return ($_[0] =~ /^([^:\/]+):(.+)$/);
+        } elsif ($_[0] =~ /^[^:@\/]+@[^:@\/]+:/) {
+            # X@Y:Z without slashes in X and Y - may be:
+            # either    user@host:...
+            # or e.g.   rootds@snap-12:34:56
+            print STDERR "X\@Y:Z without slashes in X and Y\n" if $debugHere;
+        }
+        print STDERR "other\n" if $debugHere;
+        return ($_[0] =~ /^(?:([^:@\/]+):)?([^@\s]+|[^@\s]+\@[^@\s]+)$/);
+    }
 
     my @return;
     ###push @return, ($_[0] =~ /^(?:(.+)\s)?([^\s]+)$/);
     ###push @return, ($_[0] =~ /^(?:([^:\/]+):)?([^:]+|[^:@]+\@.+)$/);
     push @return, ($_[0] =~ /^(?:([^:\/]+):)?([^@\s]+|[^@\s]+\@[^@\s]+)$/);
     # Note: Claims `Use of uninitialized value $return[0]...` when there
     # is no remote host portion matched, so using a map to stringify:
-    print STDERR "[D] Split '" . $_[0] . "' into: [" . join(", ", map { defined ? "'$_'" : '<undef>' } @return) . "]\n";# if $self->debug;
+    print STDERR "[D] Split '" . $_[0] . "' into: [" . join(", ", map { defined ? "'$_'" : '<undef>' } @return) . "]\n" if $debugHere;
     return @return;
 };
 
@@ -311,7 +370,7 @@
     return 0 if $self->dataSetExists($dataSet);
 
     #creation failed and dataset does not exist, throw an exception
     Mojo::Exception->throw("ERROR: cannot create dataSet $dataSet");
 }
 
 sub listSubDataSets {

t/znapzend-lib-splitter.t

@@ -4,7 +4,7 @@
 # since there are many use-cases and combinations to take care of.
 # We do so below by constructing "task" strings from components we
 # know to be a dataset name and some defined (or not) remote spec
-# and/or snapshot name, and deconstructing it back with the class
+# and/or snapshot name, and de-constructing it back with the class
 # method.
 #
 # Copyright (C) 2024 by Jim Klimov <jimklimov@gmail.com>
@@ -31,7 +31,7 @@
 
 unshift @INC, sub {
     my (undef, $filename) = @_;
-    return () if $filename !~ /ZnapZend|ZFS|znapzend/;
+    return () if $filename !~ /ZnapZend|ZnapZend.Config|ZFS|znapzend/;
     if (my $found = (grep { -e $_ } map { "$_/$filename" } grep { !ref } @INC)[0] ) {
         local $/ = undef;
         open my $fh, '<', $found or die("Can't read module file $found\n");
@@ -53,6 +53,8 @@
         # names so we can actually call them from the test context.
         if($filename =~ /ZFS/) {
             $module_text =~ s/^1;$/### Quick drop-in\nsub splitDataSetSnapshot {return \$splitDataSetSnapshot->(\$_[1]);}\nsub splitHostDataSet {return \$splitHostDataSet->(\$_[1]);}\n\n1;\n/gm;
+        } elsif($filename =~ /Config/) {
+            $module_text =~ s/^1;$/### Quick drop-in\nsub splitHostDataSet {return \$splitHostDataSet->(\$_[1]);}\n\n1;\n/gm;
         }
 
         if(defined($ENV{DEBUG_ZNAPZEND_SELFTEST_REWRITE})) {
@@ -67,7 +69,7 @@
         # from the file directly
         $INC{$filename} = $found;
 
         warn ("Imported '$found'");
         return $fh;
     }
     else {
@@ -81,8 +83,14 @@
     return "<undef>";
 }
 
-sub printTaskReport {
-    print STDERR "[D] task='" . stringify($_[0]) .
+sub printTaskReportCFG {
+    print STDERR "[D:zCFG] task='" . stringify($_[0]) .
+        "' => remote='" . stringify($_[1]) .
+        "' dataSet='" . stringify($_[2]) . "'\n";
+}
+
+sub printTaskReportZFS {
+    print STDERR "[D:zZFS] task='" . stringify($_[0]) .
         "' => remote='" . stringify($_[1]) .
         "' dataSetPathAndSnap='" . stringify($_[2]) .
         "' => dataSet='" . stringify($_[3]) .
@@ -97,6 +105,16 @@
 
 is (ref $zZFS,'ZnapZend::ZFS', 'instantiation of ZFS');
 
+# NOTE: In absence of any hints we can not reliably discern below
+# a     task='poolrootfs@snap-2:3'
+# vs.   task='username@hostname:poolrootfs'
+# which one is a local pool's root dataset with a funny but legal
+# snapshot name, and which one is a remote user@host spec with a
+# remote pool's root dataset. For practical purposes, we proclaim
+# preference for the former: we are more likely to look at funny
+# local snapshot names, than to back up to (or otherwise care about)
+# remote pools' ROOT datasets.
+
 for my $r (qw(undef hostname username@hostname)) {
     for my $d (qw(poolrootfs rpool/dataset rpool/dataset:with-colon)) {
         for my $s (qw(undef snapname snap-1 snap-2:3 snap-12:35:00)) {
@@ -111,25 +129,65 @@
             # Note the methods are externalized from the module for the test by patcher above
             my ($remote, $dataSetPathAndSnap) = $zZFS->splitHostDataSet($task);
             my ($dataSet, $snapshot) = $zZFS->splitDataSetSnapshot($dataSetPathAndSnap);
-            #print STDERR "[D] task='$task' => remote='$remote' dataSetPathAndSnap='$dataSetPathAndSnap' => dataSet='$dataSet' snapshot='$snapshot'\n";
-            printTaskReport($task, $remote, $dataSetPathAndSnap, $dataSet, $snapshot);
+            printTaskReportZFS($task, $remote, $dataSetPathAndSnap, $dataSet, $snapshot);
 
             is (defined ($dataSet), 1, "dataSet should always be defined after parsing");
-            is (($dataSet eq $d), 1, "dataSet has expected value after parsing");
 
-            if ($r ne "undef") {
-                is (defined ($remote), 1, "remote should be defined after parsing this test case");
-                is (($remote eq $r), 1, "remote has expected value after parsing");
+            # See big comment above:
+            if ($task eq 'username@hostname:poolrootfs') {
+                isnt (defined ($remote), 1, "BOGUS exceptional test case: remote should be not defined after parsing for this exceptional test case");
+                is (($dataSet eq "username"), 1, "BOGUS exceptional test case: dataSet has expected BOGUS value after parsing for this exceptional test case");
+                is (($snapshot eq "hostname:poolrootfs"), 1, "BOGUS exceptional test case: snapshot has expected BOGUS value after parsing for this exceptional test case");
             } else {
-                isnt (defined ($remote), 1, "remote should not be defined after parsing this test case");
+                is (($dataSet eq $d), 1, "dataSet has expected value after parsing");
+
+                if ($r ne "undef") {
+                    is (defined ($remote), 1, "remote should be defined after parsing this test case");
+                    is (($remote eq $r), 1, "remote has expected value after parsing");
+                } else {
+                    isnt (defined ($remote), 1, "remote should not be defined after parsing this test case");
+                }
+
+                if ($s ne "undef") {
+                    is (defined ($snapshot), 1, "snapshot should be defined after parsing this test case");
+                    is (($snapshot eq $s), 1, "snapshot has expected value after parsing");
+                } else {
+                    isnt (defined ($snapshot), 1, "snapshot should not be defined after parsing this test case");
+                }
             }
+        }
+    }
+}
 
-            if ($s ne "undef") {
-                is (defined ($snapshot), 1, "snapshot should be defined after parsing this test case");
-                is (($snapshot eq $s), 1, "snapshot has expected value after parsing");
-            } else {
-                isnt (defined ($snapshot), 1, "snapshot should not be defined after parsing this test case");
-            }
+# This module has its own definition of splitHostDataSet for
+# znapzendzetup property parsing - without snapshot parts
+use_ok 'ZnapZend::Config';
+
+my $zCFG  = ZnapZend::Config->new();
+
+is (ref $zCFG,'ZnapZend::Config', 'instantiation of Config');
+
+for my $r (qw(undef hostname username@hostname)) {
+    for my $d (qw(poolrootfs rpool/dataset rpool/dataset:with-colon)) {
+        #EXAMPLE# my $task = 'user@host:dataset';
+
+        my $task = '';
+        if ($r ne "undef") { $task .= $r . ':'; }
+        $task .= $d;
+
+        # Decode it back, see if we can
+        # Note the methods are externalized from the module for the test by patcher above
+        my ($remote, $dataSet) = $zCFG->splitHostDataSet($task);
+        printTaskReportCFG($task, $remote, $dataSet);
+
+        is (defined ($dataSet), 1, "dataSet should always be defined after parsing");
+        is (($dataSet eq $d), 1, "dataSet has expected value after parsing");
+
+        if ($r ne "undef") {
+            is (defined ($remote), 1, "remote should be defined after parsing this test case");
+            is (($remote eq $r), 1, "remote has expected value after parsing");
+        } else {
+            isnt (defined ($remote), 1, "remote should not be defined after parsing this test case");
         }
     }
 }

test.sh

@@ -13,8 +13,5 @@ perl -I./thirdparty/lib/perl5 \
   -MDevel::Cover=+ignore,thirdparty ./t/znapzendztatz.t
 perl -I./thirdparty/lib/perl5 \
   -MDevel::Cover=+ignore,thirdparty ./t/autoscrub.t
-
-# Currently prone to failure with certain edge cases,
-# so ignoring the result (fixes are investigated):
 perl -I./thirdparty/lib/perl5 \
-  -MDevel::Cover=+ignore,thirdparty ./t/znapzend-lib-splitter.t || echo "FAILURE Currently ignored"
+  -MDevel::Cover=+ignore,thirdparty ./t/znapzend-lib-splitter.t