[Libguestfs] [nbdkit PATCH v3 3/3] perl: Support zero callback

[Eric Blake]

Add a perl language binding for the .zero callback, used for
implementing NBD_CMD_WRITE_ZEROES.  The caller doesn't have to
return anything, but should use Nbdkit::set_error(POSIX::EOPNOTSUPP)
to get an automatic fallback to pwrite.

Enhance the example to show the use of the fallback mechanism,
and to serve as a test of Nbdkit::set_error().

Signed-off-by: Eric Blake <eblake at redhat.com>
---
 plugins/perl/example.pl             | 16 +++++++++++++
 plugins/perl/nbdkit-perl-plugin.pod | 26 +++++++++++++++++++++
 plugins/perl/perl.c                 | 45 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 86 insertions(+), 1 deletion(-)

diff --git a/plugins/perl/example.pl b/plugins/perl/example.pl
index fcdac33..7ea24ff 100644
--- a/plugins/perl/example.pl
+++ b/plugins/perl/example.pl
@@ -1,4 +1,5 @@
 use strict;
+use POSIX ();

 # Example Perl plugin.
 #
@@ -83,3 +84,18 @@ sub pwrite

     substr ($disk, $offset, $count) = $buf;
 }
+
+sub zero
+{
+    my $h = shift;
+    my $count = shift;
+    my $offset = shift;
+    my $may_trim = shift;
+
+    if ($may_trim) {
+	substr ($disk, $offset, $count) = "\0" x $count;
+    } else {
+	Nbdkit::set_error(POSIX::EOPNOTSUPP);
+	die "fall back to pwrite";
+    }
+}
diff --git a/plugins/perl/nbdkit-perl-plugin.pod b/plugins/perl/nbdkit-perl-plugin.pod
index 82766d0..920bdef 100644
--- a/plugins/perl/nbdkit-perl-plugin.pod
+++ b/plugins/perl/nbdkit-perl-plugin.pod
@@ -290,6 +290,32 @@ store.
 If there is an error, the function should call C<die>, optionally using
 C<Nbdkit::set_error> first.

+=item C<zero>
+
+(Optional)
+
+ sub zero
+ {
+    my $handle = shift;
+    my $count = shift;
+    my $offset = shift;
+    my $may_trim = shift;
+    # No return value
+ }
+
+The body of your C<zero> function should ensure that C<$count> bytes
+of the disk, starting at C<$offset>, will read back as zero.  If
+C<$may_trim> is true, the operation may be optimized as a trim as long
+as subsequent reads see zeroes.
+
+NBD only supports whole writes, so your function should try to write
+the whole region (perhaps requiring a loop).  If the write fails or is
+partial, your function should C<die>, optionally using
+C<Nbdkit::set_error> first.  In particular, if you would like to
+automatically fall back to C<pwrite> (perhaps because there is nothing
+to optimize if C<$may_trim> is false), use
+C<Nbdkit::set_error(POSIX::EOPNOTSUPP)>.
+
 =back

 =head2 MISSING CALLBACKS
diff --git a/plugins/perl/perl.c b/plugins/perl/perl.c
index 9fb189c..52694d9 100644
--- a/plugins/perl/perl.c
+++ b/plugins/perl/perl.c
@@ -141,12 +141,15 @@ check_perl_failure (void)
   return 0;
 }

+static int last_error;
+
 XS(set_error)
 {
   dXSARGS;
   /* Is it worth adding error checking for bad arguments? */
   if (items >= 1)
-    nbdkit_set_error (SvIV (ST (0)));
+    last_error = SvIV (ST (0));
+  nbdkit_set_error (last_error);
   XSRETURN_EMPTY;
 }

@@ -514,6 +517,45 @@ perl_can_trim (void *handle)
 }

 static int
+perl_zero (void *handle, uint32_t count, uint64_t offset, int may_trim)
+{
+  dSP;
+
+  if (callback_defined ("zero")) {
+    last_error = 0;
+    ENTER;
+    SAVETMPS;
+    PUSHMARK (SP);
+    XPUSHs (handle);
+    XPUSHs (sv_2mortal (newSViv (count)));
+    XPUSHs (sv_2mortal (newSViv (offset)));
+    XPUSHs (sv_2mortal (newSViv (may_trim)));
+    PUTBACK;
+    call_pv ("zero", G_EVAL|G_SCALAR);
+    SPAGAIN;
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+
+    if (last_error == EOPNOTSUPP) {
+      /* When user requests this particular error, we want to
+	 gracefully fall back, and to accomodate both a normal return
+	 and an exception. */
+      nbdkit_debug ("zero requested falling back to pwrite");
+      return -1;
+    }
+    if (check_perl_failure () == -1)
+      return -1;
+
+    return 0;
+  }
+
+  nbdkit_debug ("zero falling back to pwrite");
+  nbdkit_set_error (EOPNOTSUPP);
+  return -1;
+}
+
+static int
 perl_is_rotational (void *handle)
 {
   dSP;
@@ -644,6 +686,7 @@ static struct nbdkit_plugin plugin = {
   .pwrite            = perl_pwrite,
   .flush             = perl_flush,
   .trim              = perl_trim,
+  .zero              = perl_zero,

   .errno_is_reliable = perl_errno_is_reliable,
 };
-- 
2.9.3