[Libguestfs] [PATCH API PROPOSAL 1/2] daemon: Allow OCaml code to raise Not_supported exception.

[Richard W.M. Jones]

It would be possible to implement this as:

  raise (Unix_error (ENOTSUP, fn, arg))

except that Unix.ENOTSUP is not defined (OCaml 4.07).  Instead of
working around this let's have a special exception, and anyway this
works like the C code.

The only tricky part of this patch is that I wanted to use the
‘Daemon’ module name for daemonic things, such as this exception.  So
I had to rename the existing Daemon module (which contains
initialization code) to ‘Daemon_init’.
---
 daemon/Makefile.am     |  4 +++-
 daemon/daemon-c.c      |  2 ++
 daemon/daemon.ml       | 21 ++++-----------------
 daemon/daemon.mli      |  3 ++-
 daemon/daemon_init.ml  | 38 ++++++++++++++++++++++++++++++++++++++
 daemon/daemon_init.mli | 19 +++++++++++++++++++
 6 files changed, 68 insertions(+), 19 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 5d1c222db..d3adcb53e 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -270,6 +270,7 @@ SOURCES_MLI = \
 	chroot.mli \
 	daemon.mli \
 	daemon_config.mli \
+	daemon_init.mli \
 	devsparts.mli \
 	file.mli \
 	filearch.mli \
@@ -301,6 +302,7 @@ SOURCES_MLI = \
 
 SOURCES_ML = \
 	daemon_config.ml \
+	daemon.ml \
 	utils.ml \
 	structs.ml \
 	optgroups.ml \
@@ -333,7 +335,7 @@ SOURCES_ML = \
 	inspect_fs.ml \
 	inspect.ml \
 	callbacks.ml \
-	daemon.ml
+	daemon_init.ml
 
 BOBJECTS = $(SOURCES_ML:.ml=.cmo)
 XOBJECTS = $(BOBJECTS:.cmo=.cmx)
diff --git a/daemon/daemon-c.c b/daemon/daemon-c.c
index 533bf7ce7..b347ade81 100644
--- a/daemon/daemon-c.c
+++ b/daemon/daemon-c.c
@@ -59,6 +59,8 @@ guestfs_int_daemon_exn_to_reply_with_error (const char *func, value exn)
                              String_val (Field (exn, 2)),
                              String_val (Field (exn, 3)));
   }
+  else if (STREQ (exn_name, "Not_supported"))
+    reply_with_error_errno (ENOTSUP, "%s", String_val (Field (exn, 1)));
   else if (STREQ (exn_name, "Failure"))
     reply_with_error ("%s", String_val (Field (exn, 1)));
   else if (STREQ (exn_name, "Sys_error"))
diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index f24d64a13..132bc6a21 100644
--- a/daemon/daemon.ml
+++ b/daemon/daemon.ml
@@ -18,21 +18,8 @@
 
 open Printf
 
-(* When guestfsd starts up, early on (after parsing the command line
- * but not much else), it calls 'caml_startup' which runs all
- * initialization code in the OCaml modules, including this one.
- *
- * Therefore this is where we can place OCaml initialization code
- * for the daemon.
- *)
+exception Not_supported of string
+
 let () =
-  (* Connect the guestfsd [-v] (verbose) flag into 'verbose ()'
-   * used in OCaml code to print debugging messages.
-   *)
-  if Utils.get_verbose_flag () then (
-    Std_utils.set_verbose ();
-    eprintf "OCaml daemon loaded\n%!"
-  );
-
-  (* Register the callbacks which are used to call OCaml code from C. *)
-  Callbacks.init_callbacks ()
+  (* Register exceptions. *)
+  Callback.register_exception "Not_supported" (Not_supported "")
diff --git a/daemon/daemon.mli b/daemon/daemon.mli
index c893b4a1e..856364a78 100644
--- a/daemon/daemon.mli
+++ b/daemon/daemon.mli
@@ -16,4 +16,5 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-(* Nothing is exported. *)
+exception Not_supported of string
+(** Like the [NOT_SUPPORTED] macro in [daemon.h]. *)
diff --git a/daemon/daemon_init.ml b/daemon/daemon_init.ml
new file mode 100644
index 000000000..f24d64a13
--- /dev/null
+++ b/daemon/daemon_init.ml
@@ -0,0 +1,38 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2018 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Printf
+
+(* When guestfsd starts up, early on (after parsing the command line
+ * but not much else), it calls 'caml_startup' which runs all
+ * initialization code in the OCaml modules, including this one.
+ *
+ * Therefore this is where we can place OCaml initialization code
+ * for the daemon.
+ *)
+let () =
+  (* Connect the guestfsd [-v] (verbose) flag into 'verbose ()'
+   * used in OCaml code to print debugging messages.
+   *)
+  if Utils.get_verbose_flag () then (
+    Std_utils.set_verbose ();
+    eprintf "OCaml daemon loaded\n%!"
+  );
+
+  (* Register the callbacks which are used to call OCaml code from C. *)
+  Callbacks.init_callbacks ()
diff --git a/daemon/daemon_init.mli b/daemon/daemon_init.mli
new file mode 100644
index 000000000..c893b4a1e
--- /dev/null
+++ b/daemon/daemon_init.mli
@@ -0,0 +1,19 @@
+(* guestfsd
+ * Copyright (C) 2009-2018 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Nothing is exported. *)
-- 
2.19.0.rc0