Libguestfs - Jan 2017 - [nbdkit PATCH v3 0/3] bind .zero to Perl

Requires patch 1 and 2 of the python series:
https://www.redhat.com/archives/libguestfs/2017-January/msg00126.html

This is the perl implementation along the same lines.

We still haven't decided if patch 1 of the python series should
change OCaml to report errno as reliable or not, but perhaps we
can commit that patch as-is now and then touch things up further
when we actually get set_error and zero working in OCaml.

Eric Blake (3):
  perl: Allow use of modules
  perl: Expose nbdkit_set_error to perl script
  perl: Support zero callback

 plugins/perl/example.pl             | 16 +++++++++
 plugins/perl/nbdkit-perl-plugin.pod | 56 +++++++++++++++++++++++++++++---
 plugins/perl/perl.c                 | 65 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 131 insertions(+), 6 deletions(-)

-- 
2.9.3

Trying something as simple as 'use POSIX ();' causes the perl
plugin to croak:

$ ./src/nbdkit -e foo -fv plugins/perl/.libs/nbdkit-perl-plugin.so \
  script=plugins/perl/example.pl
nbdkit: debug: registering plugins/perl/.libs/nbdkit-perl-plugin.so
nbdkit: debug: registered plugins/perl/.libs/nbdkit-perl-plugin.so (name perl)
nbdkit: debug: plugins/perl/.libs/nbdkit-perl-plugin.so: load
nbdkit: debug: plugins/perl/.libs/nbdkit-perl-plugin.so: config key=script,
value=plugins/perl/example.pl
Can't load module Fcntl, dynamic loading not available in this perl.
  (You may need to build a new perl executable which either supports
  dynamic loading or has the Fcntl module statically linked into it.)
 at /usr/lib64/perl5/POSIX.pm line 17.
Compilation failed in require at /usr/lib64/perl5/POSIX.pm line 17.
BEGIN failed--compilation aborted at /usr/lib64/perl5/POSIX.pm line 17.
Compilation failed in require at plugins/perl/example.pl line 2.
BEGIN failed--compilation aborted at plugins/perl/example.pl line 2.
nbdkit: error: plugins/perl/example.pl: one of the required callbacks
'open', 'get_size' or 'pread' is not defined by this
Perl script.  nbdkit requires these callbacks.

Per 'perldoc perlembed', the solution is simple: statically incorporate
the DynaLoader module into the embedded interpreter.

Signed-off-by: Eric Blake <eblake@redhat.com>
---
 plugins/perl/perl.c | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/plugins/perl/perl.c b/plugins/perl/perl.c
index ec82ecb..64d9d17 100644
--- a/plugins/perl/perl.c
+++ b/plugins/perl/perl.c
@@ -140,6 +140,16 @@ check_perl_failure (void)
   return 0;
 }

+
+EXTERN_C void boot_DynaLoader (pTHX_ CV *cv);
+
+static void
+xs_init(pTHX)
+{
+  char *file = __FILE__;
+  newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
 static int
 perl_config (const char *key, const char *value)
 {
@@ -158,7 +168,7 @@ perl_config (const char *key, const char *value)

     /* Load the Perl script. */
     argv[1] = (char *) script;
-    if (perl_parse (my_perl, NULL, argc, argv, NULL) == -1) {
+    if (perl_parse (my_perl, xs_init, argc, argv, NULL) == -1) {
       nbdkit_error ("%s: error parsing this script", script);
       return -1;
     }
-- 
2.9.3

In addition to calling Perl functions from C, we want to make
script writing easier by exposing C functions to perl.  For
now, just wrap nbdkit_set_error(), as that will be needed for
an optimal implementation of a zero() callback.

I intentionally decided to go with a hand-rolled XSUB statically
compiled in, rather than a full-blown dynamically loadable Nbdkit
module compatible with CPAN, in part because the machinery to hook
in a call to xsubcc would be lots of code, and in part because we
already document that the user's script is not executable as a
stand-alone perl script anyways.

Perl is very picky: I found that including <XSUB.h> after
<EXTERN.h>,
even with no other changes in the file, caused the embedded
interpreter to segfault during perl_open(); but listing <XSUB.h>
first worked for me (tested on Fedora 25).

Signed-off-by: Eric Blake <eblake@redhat.com>
---
 plugins/perl/nbdkit-perl-plugin.pod | 30 +++++++++++++++++++++++++-----
 plugins/perl/perl.c                 | 10 ++++++++++
 2 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/plugins/perl/nbdkit-perl-plugin.pod
b/plugins/perl/nbdkit-perl-plugin.pod
index c02f8ef..82766d0 100644
--- a/plugins/perl/nbdkit-perl-plugin.pod
+++ b/plugins/perl/nbdkit-perl-plugin.pod
@@ -60,11 +60,26 @@ and does I<not> need to be executable.  In fact
it's a good idea
 I<not> to do that, because running the plugin directly as a Perl
 script won't work.

+=head2 METHODS
+
+Your script has access to the following methods in the C<Nbdkit>
+package (in fact, attempting to C<use Nbdkit;> will fail, the methods
+are already available):
+
+ Nbdkit::set_error(I<$err>)
+
+Record C<$err> as the reason you are about to throw an exception.
C<$err>
+should correspond to usual errno values, where it may help to
+C<use POSIX();>.
+
 =head2 EXCEPTIONS

 Instead of returning error codes as in C, Perl callbacks should
 indicate problems by throwing Perl exceptions (ie. C<die>, C<croak>
 etc).  The Perl error message is captured and printed by nbdkit.
+Remember to use C<Nbdkit::set_error> if you need to control which
+error is sent back to the client; if omitted, the client will see an
+error of C<EIO>.

 =head2 32 vs 64 BIT

@@ -216,7 +231,8 @@ disk starting at C<$offset>.

 NBD only supports whole reads, so your function should try to read the
 whole region (perhaps requiring a loop).  If the read fails or is
-partial, your function should C<die>.
+partial, your function should C<die>, optionally using
+C<Nbdkit::set_error> first.

 =item C<pwrite>

@@ -237,7 +253,8 @@ C<$offset>.

 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>.
+partial, your function should C<die>, optionally using
+C<Nbdkit::set_error> first.

 =item C<flush>

@@ -252,7 +269,8 @@ partial, your function should C<die>.
 The body of your C<flush> function should do a L<sync(2)> or
 L<fdatasync(2)> or equivalent on the backing store.

-If there is an error, the function should call C<die>.
+If there is an error, the function should call C<die>, optionally using
+C<Nbdkit::set_error> first.

 =item C<trim>

@@ -269,7 +287,8 @@ If there is an error, the function should call C<die>.
 The body of your C<trim> function should "punch a hole" in the
backing
 store.

-If there is an error, the function should call C<die>.
+If there is an error, the function should call C<die>, optionally using
+C<Nbdkit::set_error> first.

 =back

@@ -285,7 +304,8 @@ and C<END> constructs.
 =item Missing: C<errno_is_reliable>

 This is not needed because the process of gluing Perl code into C cannot
-reliably use C<errno>.
+reliably use C<errno>.  Instead, call C<Nbdkit::set_error> when
reporting
+a failure.

 =item Missing: C<name>, C<version>, C<longname>,
C<description>, C<config_help>

diff --git a/plugins/perl/perl.c b/plugins/perl/perl.c
index 64d9d17..9fb189c 100644
--- a/plugins/perl/perl.c
+++ b/plugins/perl/perl.c
@@ -43,6 +43,7 @@
 #include <assert.h>
 #include <errno.h>

+#include <XSUB.h>
 #include <EXTERN.h>
 #include <perl.h>

@@ -140,6 +141,14 @@ check_perl_failure (void)
   return 0;
 }

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

 EXTERN_C void boot_DynaLoader (pTHX_ CV *cv);

@@ -148,6 +157,7 @@ xs_init(pTHX)
 {
   char *file = __FILE__;
   newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+  newXS("Nbdkit::set_error", set_error, file);
 }

 static int
-- 
2.9.3

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@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

On Mon, Jan 30, 2017 at 10:24:44PM -0600, Eric Blake
wrote:
> Requires patch 1 and 2 of the python series:
> https://www.redhat.com/archives/libguestfs/2017-January/msg00126.html
> 
> This is the perl implementation along the same lines.
> 
> We still haven't decided if patch 1 of the python series should
> change OCaml to report errno as reliable or not, but perhaps we
> can commit that patch as-is now and then touch things up further
> when we actually get set_error and zero working in OCaml.
Agreed - I pushed the previous series and this one.

Thanks,

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-df lists disk usage of guests without needing to install any
software inside the virtual machine.  Supports Linux and Windows.
http://people.redhat.com/~rjones/virt-df/