Fix parser for root (only) dataset names - investigate (#619)

* contrib/test-splitHostDataSet.sh: add test cases for root dataset of a pool [#585] Signed-off-by: Jim Klimov <jimklimov@gmail.com> * lib/ZnapZend/ZFS.pm: destroySnapshots(): sanity-check for undef $dataSet [#585] Signed-off-by: Jim Klimov <jimklimov@gmail.com> * t/znapzend-lib-splitter.t: add a pure-perl test for splitHostDataSet() and splitDataSetSnapshot() [#585] Signed-off-by: Jim Klimov <jimklimov@gmail.com> * lib/ZnapZend/ZFS.pm: splitDataSetSnapshot(): refine to check if argument is actually a "dataset@snapname", return an undef snapname in the array if not [#585] Signed-off-by: Jim Klimov <jimklimov@gmail.com> * test.sh: call t/znapzend-lib-splitter.t (but ignore faults for now) [#585] Signed-off-by: Jim Klimov <jimklimov@gmail.com> --------- Signed-off-by: Jim Klimov <jimklimov@gmail.com> Co-authored-by: Tobias Oetiker <tobi@oetiker.ch>
oetiker · Jan 9, 2024 · 64f26ce · 64f26ce · github-actions · Jan 9, 2024
1 parent 8d64694
commit 64f26ce
Show file tree

Hide file tree

Showing 4 changed files with 168 additions and 6 deletions.
diff --git a/contrib/test-splitHostDataSet.sh b/contrib/test-splitHostDataSet.sh
@@ -31,6 +31,15 @@ for S in \
     "user@remotehost:pond/data/set/openindiana-2022:03:15-backup-1" \
     "user@remotehost:pond/data/set/openindiana-2022:03:15-backup-1@snap" \
     "user@remotehost:pond/data/set/openindiana-2022:03:15-backup-1@snaptime-12:34:56" \
+    "rpool" \
+    "rpool@snap" \
+    "rpool@snaptime-12:34:56" \
+    "remotehost:rpool" \
+    "remotehost:rpool@snap" \
+    "remotehost:rpool@snaptime-12:34:56" \
+    "user@remotehost:rpool" \
+    "user@remotehost:rpool@snap" \
+    "user@remotehost:rpool@snaptime-12:34:56" \
 ; do
     perl -e 'print STDERR "[D] Split \"" . $ARGV[0] . "\" into:\n\t[\"" . join("\", \"", ($ARGV[0] =~ '"$RE"')) . "\"]\n";' "$S"
 done

diff --git a/lib/ZnapZend/ZFS.pm b/lib/ZnapZend/ZFS.pm
@@ -54,7 +54,12 @@ my $splitHostDataSet = sub {
 };
 
 my $splitDataSetSnapshot = sub {
-    return ($_[0] =~ /^([^\@]+)\@([^\@]+)$/);
+    my $count = ($_[0] =~ tr/@//);
+    if ($count > 0) {
+        return ($_[0] =~ /^([^\@]+)\@([^\@]+)$/);
+    } else {
+        return ($_[0], undef);
+    }
 };
 
 my $shellQuote = sub {
@@ -368,11 +373,16 @@ sub destroySnapshots {
         for my $task (@toDestroy){
             my ($remote, $dataSetPathAndSnap) = $splitHostDataSet->($task);
             my ($dataSet, $snapshot) = $splitDataSetSnapshot->($dataSetPathAndSnap);
-            my @ssh = $self->$buildRemote($remote, [@{$self->priv}, qw(zfs destroy), @recursive, "$dataSet\@$snapshot"]);
+            if (defined ($dataSet)) {
+                my @ssh = $self->$buildRemote($remote, [@{$self->priv}, qw(zfs destroy), @recursive, "$dataSet\@$snapshot"]);
 
-            print STDERR '# ' . (($self->noaction || $self->nodestroy) ? "WOULD # " : "") . join(' ', @ssh) . "\n" if $self->debug;
-            system(@ssh) and $destroyError .= "ERROR: cannot destroy snapshot $dataSet\@$snapshot\n"
-                if !($self->noaction || $self->nodestroy);
+                print STDERR '# ' . (($self->noaction || $self->nodestroy) ? "WOULD # " : "") . join(' ', @ssh) . "\n" if $self->debug;
+                system(@ssh) and $destroyError .= "ERROR: cannot destroy snapshot $dataSet\@$snapshot\n"
+                    if !($self->noaction || $self->nodestroy);
+            } else {
+                print STDERR "[D] task='$task' => remote='$remote' dataSetPathAndSnap='$dataSetPathAndSnap' => dataSet='$dataSet' snapshot='$snapshot'\n";
+                Mojo::Exception->throw("ERROR: oracleMode destroy: failed to parse task='$task', got undefined dataSet and/or snapshot");
+            }
         }
         #remove trailing \n
         chomp $destroyError;

diff --git a/t/znapzend-lib-splitter.t b/t/znapzend-lib-splitter.t
@@ -0,0 +1,139 @@
+#!/usr/bin/env perl
+
+# Test library methods around [[user@]host:]dataset[@snap] splitting
+# 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
+# method.
+#
+# Copyright (C) 2024 by Jim Klimov <jimklimov@gmail.com>
+
+use strict;
+use warnings;
+
+# Avoid issues if we monkey-patch included sources in a wrong way
+use warnings FATAL => 'recursion';
+
+use FindBin;
+$ENV{PATH} = $FindBin::RealBin.':'.$ENV{PATH};
+my $buildDir;
+
+BEGIN {
+    $buildDir = shift @ARGV // $FindBin::RealBin."/../";
+}
+
+# PERL5LIB
+use lib "$FindBin::RealBin/../lib";
+use lib "$buildDir/thirdparty/lib/perl5";
+#place bin path to lib so it is stored in @INC
+use lib "$FindBin::RealBin/../bin";
+
+unshift @INC, sub {
+    my (undef, $filename) = @_;
+    return () if $filename !~ /ZnapZend|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");
+        my $module_text = <$fh>;
+        close $fh;
+
+        # define everything in a sub, so Devel::Cover will DTRT
+        # NB this introduces no extra linefeeds so D::C's line numbers
+        # in reports match the file on disk
+        $module_text =~ s/(.*?package\s+\S+)(.*)__END__/$1sub classWrapper {$2} classWrapper();/s;
+
+        # unhide private methods to avoid "Variable will not stay shared"
+        # warnings that appear due to change of applicable scoping rules
+        # Note: not '\s*' in the start of string, to avoid matching and
+        # removing blank lines before the private sub definitions.
+        $module_text =~ s/^[ \t]*my\s+(\S+\s*=\s*sub.*)$/our $1/gm;
+
+        # For this test, also strip dollars from tested private method
+        # 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;
+        }
+
+        if(defined($ENV{DEBUG_ZNAPZEND_SELFTEST_REWRITE})) {
+            open(my $fhp, '>', $found . '.selftest-rewritten') or warn "Could not open " . $found . '.selftest-rewritten';
+            if ($fhp) { print $fhp $module_text ; close $fhp; }
+        }
+
+        # filehandle on the scalar
+        open $fh, '<', \$module_text;
+
+        # and put it into %INC too so that it looks like we loaded the code
+        # from the file directly
+        $INC{$filename} = $found;
+
+        warn ("Imported '$found'");
+        return $fh;
+    }
+    else {
+        return ();
+    }
+};
+
+sub stringify {
+    my $s = shift;
+    return $s if defined($s);
+    return "<undef>";
+}
+
+sub printTaskReport {
+    print STDERR "[D] task='" . stringify($_[0]) .
+        "' => remote='" . stringify($_[1]) .
+        "' dataSetPathAndSnap='" . stringify($_[2]) .
+        "' => dataSet='" . stringify($_[3]) .
+        "' snapshot='" . stringify($_[4]) . "'\n";
+}
+
+use Test::More;
+
+use_ok 'ZnapZend::ZFS';
+
+my $zZFS  = ZnapZend::ZFS->new();
+
+is (ref $zZFS,'ZnapZend::ZFS', 'instantiation of ZFS');
+
+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)) {
+            #EXAMPLE# my $task = 'user@host:dataset@snapname';
+
+            my $task = '';
+            if ($r ne "undef") { $task .= $r . ':'; }
+            $task .= $d;
+            if ($s ne "undef") { $task .= '@' . $s; }
+
+            # Decode it back, see if we can
+            # 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);
+
+            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");
+            }
+
+            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");
+            }
+        }
+    }
+}
+
+done_testing;
+
+1;
diff --git a/test.sh b/test.sh
@@ -8,9 +8,13 @@ perl -I./thirdparty/lib/perl5 \
 perl -I./thirdparty/lib/perl5 \
   -MDevel::Cover=+ignore,thirdparty ./t/znapzend-daemonize.t
 perl -I./thirdparty/lib/perl5 \
-  -MDevel::Cover=+ignore,thirdparty ./t/znapzendzetup.t 
+  -MDevel::Cover=+ignore,thirdparty ./t/znapzendzetup.t
 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"
Dictionary	Entries	Covers	Uniquely
cspell:software-terms/dict/softwareTerms.txt	1288	81	17
cspell:php/dict/php.txt	1689	58	6
cspell:python/src/python/python-lib.txt	2417	53	6
cspell:node/dict/node.txt	891	55	5
cspell:filetypes/filetypes.txt	264	19	4