[Libguestfs] [nbdkit PATCH v3 2/3] perl: Expose nbdkit_set_error to perl script

[Eric Blake]

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