[Libguestfs] [PATCH 1/3] daemon: Allow parts of the daemon to be written in OCaml.

Richard W.M. Jones rjones at redhat.com
Sat Jun 3 08:23:00 UTC 2017


This change allows parts of the daemon to be written in the OCaml
programming language.  I am using the ‘Main Program in C’ method along
with ‘-output-obj’ to create an object file from the OCaml code /
runtime, as described here:
https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html

This change doesn't make any functional changes yet.  There is simply
an empty ‘daemon.ml’ file.

Note that the OCaml compiler (either ocamlc or ocamlopt) is now
required even for building from tarballs.
---
 .gitignore                |  9 ++++-
 daemon/Makefile.am        | 89 +++++++++++++++++++++++++++++++++++++++++++++--
 daemon/daemon.ml          | 17 +++++++++
 daemon/guestfsd.c         |  5 +++
 docs/guestfs-building.pod | 10 +++---
 mllib/Makefile.am         |  2 +-
 6 files changed, 124 insertions(+), 8 deletions(-)
 create mode 100644 daemon/daemon.ml

diff --git a/.gitignore b/.gitignore
index 69e1ae160..08d6e1863 100644
--- a/.gitignore
+++ b/.gitignore
@@ -154,22 +154,29 @@ Makefile.in
 /customize/test-settings-*.sh
 /customize/virt-customize
 /customize/virt-customize.1
+/daemon/.depend
 /daemon/actions.h
+/daemon/common_utils.ml
+/daemon/common_utils.mli
 /daemon/dispatch.c
+/daemon/guestfs_config.ml
 /daemon/guestfsd
 /daemon/guestfsd.8
 /daemon/guestfsd.exe
 /daemon/install-sh
+/daemon/lvm-tokenization.c
 /daemon/missing
 /daemon/names.c
 /daemon/optgroups.c
 /daemon/optgroups.h
-/daemon/lvm-tokenization.c
 /daemon/stamp-guestfsd.pod
 /daemon/structs-cleanups.c
 /daemon/structs-cleanups.h
 /daemon/stubs-?.c
 /daemon/stubs.h
+/daemon/unix_utils-c.c
+/daemon/unix_utils.ml
+/daemon/unix_utils.mli
 /depcomp
 /df/stamp-virt-df.pod
 /df/virt-df
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 0d3dde516..1647b1c46 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -38,6 +38,7 @@ BUILT_SOURCES = \
 
 EXTRA_DIST = \
 	$(BUILT_SOURCES) \
+	$(SOURCES_MLI) $(SOURCES_ML) \
 	guestfsd.pod
 
 if INSTALL_DAEMON
@@ -165,6 +166,7 @@ guestfsd_SOURCES = \
 	truncate.c \
 	umask.c \
 	upload.c \
+	unix_utils-c.c \
 	utimens.c \
 	utsname.c \
 	uuids.c \
@@ -175,9 +177,11 @@ guestfsd_SOURCES = \
 	zero.c \
 	zerofree.c
 
+guestfsd_LDFLAGS = $(ocaml_ldflags)
 guestfsd_LDADD = \
 	../common/errnostring/liberrnostring.la \
 	../common/protocol/libprotocol.la \
+	camldaemon.o \
 	$(ACL_LIBS) \
 	$(CAP_LIBS) \
 	$(YAJL_LIBS) \
@@ -196,9 +200,11 @@ guestfsd_LDADD = \
 	$(PCRE_LIBS) \
 	$(TSK_LIBS) \
 	$(RPC_LIBS) \
-	$(YARA_LIBS)
+	$(YARA_LIBS) \
+	$(OCAML_LIBS)
 
 guestfsd_CPPFLAGS = \
+	$(ocaml_cppflags) \
 	-I$(top_srcdir)/gnulib/lib \
 	-I$(top_builddir)/gnulib/lib \
 	-I$(top_srcdir)/lib \
@@ -216,6 +222,85 @@ guestfsd_CFLAGS = \
 	$(YAJL_CFLAGS) \
 	$(PCRE_CFLAGS)
 
+# Parts of the daemon are written in OCaml.  These are linked into a
+# library and then linked to the daemon.  See
+# https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html
+SOURCES_MLI = \
+	common_utils.mli \
+	unix_utils.mli
+
+SOURCES_ML = \
+	guestfs_config.ml \
+	unix_utils.ml \
+	common_utils.ml \
+	daemon.ml
+
+BOBJECTS = $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+OCAMLPACKAGES = -package str,unix,hivex
+
+ocaml_cppflags = \
+	-I$(shell $(OCAMLC) -where) \
+	-I$(shell $(OCAMLC) -where)/hivex
+ocaml_ldflags = \
+	-L$(shell $(OCAMLC) -where) \
+	-L$(shell $(OCAMLC) -where)/hivex
+
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_FLAGS)
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+OCAML_LIBS = -lmlhivex -lcamlstr -lunix -lcamlrun -ldl -lm
+else
+OBJECTS = $(XOBJECTS)
+OCAML_LIBS = -lmlhivex -lcamlstr -lunix -lasmrun -ldl -lm
+endif
+
+CLEANFILES += camldaemon.o
+
+camldaemon.o: $(OBJECTS)
+	$(OCAMLFIND) $(BEST) -output-obj -o $@ \
+	    $(OCAMLFLAGS) $(OCAMLPACKAGES) -linkpkg $(OBJECTS)
+
+# We share common_utils.ml{,i}, guestfs_config.ml and unix_utils*
+# with the mllib directory.
+#
+# For common_utils we have to remove functions which depend on any
+# modules which are not part of the OCaml stdlib.
+common_utils.ml: $(top_srcdir)/mllib/common_utils.ml
+	rm -f $@ $@-t
+	echo '(* This file is generated from mllib/common_utils.ml *)' > $@-t
+	sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $< >> $@-t
+	mv $@-t $@
+common_utils.mli: $(top_srcdir)/mllib/common_utils.mli
+	rm -f $@ $@-t
+	echo '(* This file is generated from mllib/common_utils.mli *)' > $@-t
+	sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $< >> $@-t
+	mv $@-t $@
+guestfs_config.ml: ../mllib/guestfs_config.ml
+	cp $< $@
+unix_utils-c.c: ../mllib/unix_utils-c.c
+	cp $< $@
+unix_utils.ml: ../mllib/unix_utils.ml
+	cp $< $@
+unix_utils.mli: ../mllib/unix_utils.mli
+	cp $< $@
+
+# OCaml dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) common_utils.ml common_utils.mli guestfs_config.ml
+	rm -f $@ $@-t
+	$(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \
+	  $(SED) 's/ *$$//' | \
+	  $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+	  $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+	  sort > $@-t
+	mv $@-t $@
+
+-include .depend
+
 # Manual pages and HTML files for the website.
 if INSTALL_DAEMON
 man_MANS = guestfsd.8
@@ -237,4 +322,4 @@ stamp-guestfsd.pod: guestfsd.pod
 	  $<
 	touch $@
 
-.PHONY: force
+.PHONY: depend force
diff --git a/daemon/daemon.ml b/daemon/daemon.ml
new file mode 100644
index 000000000..27d77a161
--- /dev/null
+++ b/daemon/daemon.ml
@@ -0,0 +1,17 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-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.
+ *)
diff --git a/daemon/guestfsd.c b/daemon/guestfsd.c
index db2bb702f..02fc27d32 100644
--- a/daemon/guestfsd.c
+++ b/daemon/guestfsd.c
@@ -56,6 +56,8 @@
 
 #include <augeas.h>
 
+#include <caml/callback.h>
+
 #include "sockets.h"
 #include "c-ctype.h"
 #include "ignore-value.h"
@@ -348,6 +350,9 @@ main (int argc, char *argv[])
    */
   udev_settle ();
 
+  /* Initialize the OCaml stubs. */
+  caml_startup (argv);
+
   /* Send the magic length message which indicates that
    * userspace is up inside the guest.
    */
diff --git a/docs/guestfs-building.pod b/docs/guestfs-building.pod
index 0f9ed2893..4e1ff7df4 100644
--- a/docs/guestfs-building.pod
+++ b/docs/guestfs-building.pod
@@ -120,8 +120,7 @@ I<Required>.  Part of Perl core.
 
 =item OCaml findlib
 
-I<Required> if compiling from git.
-Optional (but recommended) if compiling from tarball.
+I<Required>.
 
 =item autoconf
 
@@ -594,8 +593,11 @@ See L</USING A PREBUILT BINARY APPLIANCE> below.
 Disable specific language bindings, even if C<./configure> finds all
 the necessary libraries are installed so that they could be compiled.
 
-Note that disabling OCaml or Perl will have the knock-on effect of
-disabling large numbers of virt tools and parts of the test suite.
+Note that disabling Perl will have the knock-on effect of disabling
+parts of the test suite and some tools.
+
+Disabling OCaml only disables the bindings and several virt tools.
+OCaml is required to build libguestfs.
 
 =item B<--disable-fuse>
 
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index ee2f1a7a8..8e2d3a8a0 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -49,9 +49,9 @@ SOURCES_ML = \
 	$(OCAML_BYTES_COMPAT_ML) \
 	libdir.ml \
 	stringMap.ml \
+	unix_utils.ml \
 	common_gettext.ml \
 	getopt.ml \
-	unix_utils.ml \
 	common_utils.ml \
 	progress.ml \
 	URI.ml \
-- 
2.13.0




More information about the Libguestfs mailing list