The following functions were previously reimplemented in OCaml. This
commit replaces them with calls to the C functions:
- is_root_device
- prog_exists
- udev_settle
plus the internal get_verbose_flag function.
However note that we cannot do this for every utility function. In
particular the C function must not call any reply* functions.
---
daemon/Makefile.am | 25 ++++++++++---
daemon/daemon-c.c | 7 ----
daemon/daemon-c.h | 1 -
daemon/daemon-utils-tests-stubs.c | 32 +++++++++++++++++
daemon/daemon.ml | 5 +--
daemon/dummy.c | 2 --
daemon/utils-c.c | 75 +++++++++++++++++++++++++++++++++++++++
daemon/utils.ml | 39 +++-----------------
daemon/utils.mli | 7 ++--
docs/C_SOURCE_FILES | 4 ++-
10 files changed, 139 insertions(+), 58 deletions(-)
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 5bfe409a4..63b28f52d 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -174,6 +174,7 @@ guestfsd_SOURCES = \
umask.c \
upload.c \
utils.c \
+ utils-c.c \
utimens.c \
utsname.c \
uuids.c \
@@ -297,7 +298,8 @@ OCAMLPACKAGES = \
-I $(top_srcdir)/common/mlutils \
-I $(top_builddir)/common/utils/.libs \
-I $(top_srcdir)/common/mlpcre \
- -I $(top_builddir)/common/mlpcre/.libs
+ -I $(top_builddir)/common/mlpcre/.libs \
+ -I $(top_builddir)/gnulib/lib/.libs
OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_FLAGS)
@@ -350,12 +352,25 @@ TESTS = \
check-valgrind:
$(MAKE) VG="@VG@" check
-daemon_utils_tests_SOURCES = dummy.c
+daemon_utils_tests_SOURCES = \
+ command.c \
+ daemon-utils-tests-stubs.c \
+ utils.c \
+ utils-c.c
daemon_utils_tests_CPPFLAGS = \
-I. \
-I$(top_builddir) \
-I$(shell $(OCAMLC) -where) \
- -I$(top_srcdir)/lib
+ -I$(top_srcdir)/gnulib/lib \
+ -I$(top_builddir)/gnulib/lib \
+ -I$(top_srcdir)/common/errnostring \
+ -I$(top_builddir)/common/errnostring \
+ -I$(top_srcdir)/common/protocol \
+ -I$(top_builddir)/common/protocol \
+ -I$(top_srcdir)/common/utils \
+ -I$(top_builddir)/common/utils \
+ -I$(top_srcdir)/lib \
+ -I$(top_builddir)/lib
daemon_utils_tests_BOBJECTS = \
utils.cmo \
daemon_utils_tests.cmo
@@ -377,7 +392,9 @@ daemon_utils_tests_DEPENDENCIES = \
$(daemon_utils_tests_THEOBJECTS) \
$(top_srcdir)/ocaml-link.sh
daemon_utils_tests_LINK = \
- $(top_srcdir)/ocaml-link.sh -- \
+ $(top_srcdir)/ocaml-link.sh \
+ -cclib '-lutils -lgnu' \
+ -- \
$(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \
$(OCAMLPACKAGES) \
$(daemon_utils_tests_THEOBJECTS) -o $@
diff --git a/daemon/daemon-c.c b/daemon/daemon-c.c
index 3ecaed4ca..3bfa06393 100644
--- a/daemon/daemon-c.c
+++ b/daemon/daemon-c.c
@@ -76,13 +76,6 @@ guestfs_int_daemon_exn_to_reply_with_error (const char *func, value
exn)
func, exn_name);
}
-/* NB: This is a "noalloc" call. */
-value
-guestfs_int_daemon_get_verbose_flag (value unitv)
-{
- return Val_bool (verbose);
-}
-
/* Implement String (Mountable, _) parameter. */
value
guestfs_int_daemon_copy_mountable (const mountable_t *mountable)
diff --git a/daemon/daemon-c.h b/daemon/daemon-c.h
index 1b9f102ff..1fcfd707c 100644
--- a/daemon/daemon-c.h
+++ b/daemon/daemon-c.h
@@ -27,7 +27,6 @@
#include <caml/mlvalues.h>
-extern value guestfs_int_daemon_get_verbose_flag (value unitv);
extern void guestfs_int_daemon_exn_to_reply_with_error (const char *func, value exn);
extern value guestfs_int_daemon_copy_mountable (const mountable_t *mountable);
extern char **guestfs_int_daemon_return_string_list (value retv);
diff --git a/daemon/daemon-utils-tests-stubs.c b/daemon/daemon-utils-tests-stubs.c
new file mode 100644
index 000000000..47329a976
--- /dev/null
+++ b/daemon/daemon-utils-tests-stubs.c
@@ -0,0 +1,32 @@
+/* guestfsd
+ * Copyright (C) 2017 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.
+ */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "daemon.h"
+
+/* This stubs out some functions that we want to link to the unit
+ * tests, but don't want to actually pull in plus dependencies.
+ */
+
+char *device_name_translation (const char *device) { abort (); }
+void reply_with_error_errno (int err, const char *fs, ...) { abort (); }
+void reply_with_perror_errno (int err, const char *fs, ...) { abort (); }
diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index bf486344f..1f8a6d87d 100644
--- a/daemon/daemon.ml
+++ b/daemon/daemon.ml
@@ -18,9 +18,6 @@
open Printf
-external get_verbose_flag : unit -> bool =
- "guestfs_int_daemon_get_verbose_flag" "noalloc"
-
(* 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.
@@ -32,7 +29,7 @@ let () =
(* Connect the guestfsd [-v] (verbose) flag into 'verbose ()'
* used in OCaml code to print debugging messages.
*)
- if get_verbose_flag () then (
+ if Utils.get_verbose_flag () then (
Std_utils.set_verbose ();
eprintf "OCaml daemon loaded\n%!"
);
diff --git a/daemon/dummy.c b/daemon/dummy.c
deleted file mode 100644
index ebab6198c..000000000
--- a/daemon/dummy.c
+++ /dev/null
@@ -1,2 +0,0 @@
-/* Dummy source, to be used for OCaml-based tools with no C sources. */
-enum { foo = 1 };
diff --git a/daemon/utils-c.c b/daemon/utils-c.c
new file mode 100644
index 000000000..22b0d57c6
--- /dev/null
+++ b/daemon/utils-c.c
@@ -0,0 +1,75 @@
+/* guestfsd
+ * Copyright (C) 2017 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.
+ */
+
+/**
+ * Bindings for utility functions.
+ *
+ * Note that functions called from OCaml code B<must never> call
+ * any of the C<reply*> functions.
+ */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <caml/alloc.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/unixsupport.h>
+
+#include "daemon.h"
+
+#pragma GCC diagnostic ignored "-Wmissing-prototypes"
+
+/* NB: This is a "noalloc" call. */
+value
+guestfs_int_daemon_get_verbose_flag (value unitv)
+{
+ return Val_bool (verbose);
+}
+
+/* NB: This is a "noalloc" call. */
+value
+guestfs_int_daemon_is_root_device (value device)
+{
+ return Val_bool (is_root_device (String_val (device)));
+}
+
+/* NB: This is a "noalloc" call. */
+value
+guestfs_int_daemon_prog_exists (value prog)
+{
+ return Val_bool (prog_exists (String_val (prog)));
+}
+
+/* NB: This is a "noalloc" call. */
+value
+guestfs_int_daemon_udev_settle (value optfilenamev, value unitv)
+{
+ const char *file;
+
+ if (optfilenamev == Val_int (0))
+ file = NULL;
+ else
+ file = String_val (Field (optfilenamev, 0));
+
+ udev_settle_file (file);
+
+ return Val_unit;
+}
diff --git a/daemon/utils.ml b/daemon/utils.ml
index b459a2314..9e9e68ab4 100644
--- a/daemon/utils.ml
+++ b/daemon/utils.ml
@@ -21,9 +21,10 @@ open Printf
open Std_utils
-let prog_exists prog =
- try ignore (which prog); true
- with Executable_not_found _ -> false
+external get_verbose_flag : unit -> bool =
"guestfs_int_daemon_get_verbose_flag" "noalloc"
+external is_root_device : string -> bool =
"guestfs_int_daemon_is_root_device" "noalloc"
+external prog_exists : string -> bool = "guestfs_int_daemon_prog_exists"
"noalloc"
+external udev_settle : ?filename:string -> unit -> unit =
"guestfs_int_daemon_udev_settle" "noalloc"
let commandr ?(fold_stdout_on_stderr = false) prog args =
if verbose () then
@@ -99,38 +100,6 @@ let command ?fold_stdout_on_stderr prog args =
failwithf "%s exited with status %d: %s" prog r stderr;
stdout
-let udev_settle ?filename () =
- let args = ref [] in
- if verbose () then
- push_back args "--debug";
- push_back args "settle";
- (match filename with
- | None -> ()
- | Some filename ->
- push_back args "-E";
- push_back args filename
- );
- let args = !args in
- let r, _, err = commandr "udevadm" args in
- if r <> 0 then
- eprintf "udevadm settle: %s\n" err
-
-let root_device = lazy ((stat "/").st_dev)
-
-let is_root_device_stat statbuf =
- statbuf.st_rdev = Lazy.force root_device
-
-let is_root_device device =
- udev_settle ~filename:device ();
- try
- let statbuf = stat device in
- is_root_device_stat statbuf
- with
- Unix_error (err, func, arg) ->
- eprintf "is_root_device: %s: %s: %s: %s\n"
- device func arg (error_message err);
- false
-
(* XXX This function is copied from C, but is misconceived. It
* cannot by design work for devices like /dev/md0. It would be
* better if it checked for the existence of devices and partitions
diff --git a/daemon/utils.mli b/daemon/utils.mli
index 16569f018..8807b864b 100644
--- a/daemon/utils.mli
+++ b/daemon/utils.mli
@@ -37,10 +37,6 @@ val udev_settle : ?filename:string -> unit -> unit
val is_root_device : string -> bool
(** Return true if this is the root (appliance) device. *)
-val is_root_device_stat : Unix.stats -> bool
-(** As for {!is_root_device} but operates on a statbuf instead of
- a device name. *)
-
val split_device_partition : string -> string * int
(** Split a device name like [/dev/sda1] into a device name and
partition number, eg. ["sda", 1].
@@ -85,3 +81,6 @@ val commandr : ?fold_stdout_on_stderr:bool -> string -> string
list -> (int * st
val is_small_file : string -> bool
(** Return true if the path is a small regular file. *)
+
+(**/**)
+val get_verbose_flag : unit -> bool
diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index e47469a6a..d02c0bcf7 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -85,6 +85,7 @@ daemon/cpio.c
daemon/cpmv.c
daemon/daemon-c.c
daemon/daemon-c.h
+daemon/daemon-utils-tests-stubs.c
daemon/daemon.h
daemon/dd.c
daemon/debug-bmap.c
@@ -97,7 +98,6 @@ daemon/dispatch.c
daemon/dmesg.c
daemon/dropcaches.c
daemon/du.c
-daemon/dummy.c
daemon/echo-daemon.c
daemon/ext2.c
daemon/fallocate.c
@@ -180,6 +180,8 @@ daemon/truncate.c
daemon/tsk.c
daemon/umask.c
daemon/upload.c
+daemon/utils-c.c
+daemon/utils.c
daemon/utimens.c
daemon/utsname.c
daemon/uuids.c
--
2.13.1