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