[Libguestfs] [PATCH v6 03/41] mllib: Move Xml (libxml2) OCaml bindings to common/mlxml.

Richard W.M. Jones
Thu, 15 Jun 2017 17:05:53 -0000

The ‘Xml’ module is a self-contained library of bindings for libxml2,
with no other dependencies.

Move it to a separate ‘common/mlxml’ directory.

This is not pure refactoring.  For unclear reasons, the previous
version of ‘Xml.parse_file’ read the whole file into memory and then
called ‘xmlReadMemory’.  This was quite inefficient, and unnecessary
because we could use ‘xmlReadFile’ to read and parse the file
efficiently.  Changing the code to use ‘xmlReadFile’ also removes the
unnecessary dependency on ‘Common_utils.read_whole_file’.
---
 .gitignore                      |   1 +
 Makefile.am                     |   1 +
 common/mlxml/Makefile.am        | 107 ++++++++++++++++++++++++++++++++++++++++
 {mllib => common/mlxml}/xml-c.c |  21 ++++++++
 {mllib => common/mlxml}/xml.ml  |   8 +--
 {mllib => common/mlxml}/xml.mli |   0
 configure.ac                    |   1 +
 docs/C_SOURCE_FILES             |   2 +-
 docs/guestfs-hacking.pod        |   4 ++
 mllib/Makefile.am               |  13 +++--
 v2v/Makefile.am                 |  11 ++++-
 v2v/test-harness/Makefile.am    |   3 +-
 12 files changed, 158 insertions(+), 14 deletions(-)

diff --git a/.gitignore b/.gitignore
index ea245c49d..a82a1f674 100644
--- a/.gitignore
+++ b/.gitignore
@@ -127,6 +127,7 @@ Makefile.in
 /common/mlprogress/.depend
 /common/mlvisit/.depend
 /common/mlvisit/visit_tests
+/common/mlxml/.depend
 /common/protocol/guestfs_protocol.c
 /common/protocol/guestfs_protocol.h
 /common/protocol/guestfs_protocol.x
diff --git a/Makefile.am b/Makefile.am
index bd0fc94e7..48f538475 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -156,6 +156,7 @@ if HAVE_OCAML
 SUBDIRS += \
 	common/mlprogress \
 	common/mlvisit \
+	common/mlxml \
 	mllib \
 	customize \
 	builder builder/templates \
diff --git a/common/mlxml/Makefile.am b/common/mlxml/Makefile.am
new file mode 100644
index 000000000..1a989949f
--- /dev/null
+++ b/common/mlxml/Makefile.am
@@ -0,0 +1,107 @@
+# libguestfs OCaml tools common code
+# Copyright (C) 2011-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 $(top_srcdir)/subdir-rules.mk
+
+EXTRA_DIST = \
+	$(SOURCES_MLI) \
+	$(SOURCES_ML) \
+	$(SOURCES_C)
+
+SOURCES_MLI = \
+	xml.mli
+
+SOURCES_ML = \
+	xml.ml
+
+SOURCES_C = \
+	xml-c.c
+
+if HAVE_OCAML
+
+# We pretend that we're building a C library.  automake handles the
+# compilation of the C sources for us.  At the end we take the C
+# objects and OCaml objects and link them into the OCaml library.
+# This C library is never used.
+
+noinst_LIBRARIES = libmlxml.a
+
+if !HAVE_OCAMLOPT
+MLXML_CMA = mlxml.cma
+else
+MLXML_CMA = mlxml.cmxa
+endif
+
+noinst_DATA = $(MLXML_CMA)
+
+libmlxml_a_SOURCES = $(SOURCES_C)
+libmlxml_a_CPPFLAGS = \
+	-I. \
+	-I$(top_builddir) \
+	-I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
+	-I$(shell $(OCAMLC) -where)
+libmlxml_a_CFLAGS = \
+	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
+	$(LIBXML2_CFLAGS) \
+	-fPIC
+
+BOBJECTS = $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+# -I $(top_builddir)/lib/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+	-package str,unix \
+	-I $(top_builddir)/common/utils/.libs \
+	-I $(top_builddir)/lib/.libs \
+	-I $(top_builddir)/gnulib/lib/.libs \
+	-I $(builddir)
+
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+else
+OBJECTS = $(XOBJECTS)
+endif
+
+libmlxml_a_DEPENDENCIES = $(OBJECTS)
+
+$(MLXML_CMA): $(OBJECTS) libmlxml.a
+	$(OCAMLFIND) mklib $(OCAMLPACKAGES) \
+	    $(OBJECTS) $(libmlxml_a_OBJECTS) \
+	    -cclib '$(LIBXML2_LIBS)' \
+	    -o mlxml
+
+# Dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+	rm -f $@ $@-t
+	$(OCAMLFIND) ocamldep -I $(abs_srcdir) $^ | \
+	  $(SED) 's/ *$$//' | \
+	  $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+	  $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+	  sort > $@-t
+	mv $@-t $@
+
+-include .depend
+
+endif
+
+.PHONY: depend docs
diff --git a/mllib/xml-c.c b/common/mlxml/xml-c.c
similarity index 95%
rename from mllib/xml-c.c
rename to common/mlxml/xml-c.c
index d3e893076..92388d940 100644
--- a/mllib/xml-c.c
+++ b/common/mlxml/xml-c.c
@@ -129,6 +129,27 @@ mllib_xml_parse_memory (value xmlv)
 }

 value
+mllib_xml_parse_file (value filenamev)
+{
+  CAMLparam1 (filenamev);
+  CAMLlocal1 (docv);
+  xmlDocPtr doc;
+
+  /* For security reasons, call xmlReadFile (not xmlParseFile) and
+   * pass XML_PARSE_NONET.  See commit 845daded5fddc70f.
+   */
+  doc = xmlReadFile (String_val (filenamev), NULL, XML_PARSE_NONET);
+  if (doc == NULL)
+    caml_invalid_argument ("parse_file: unable to parse XML from
file");
+
+  docv = caml_alloc_custom (&docptr_custom_operations, sizeof (xmlDocPtr),
+                            0, 1);
+  docptr_val (docv) = doc;
+
+  CAMLreturn (docv);
+}
+
+value
 mllib_xml_copy_doc (value docv, value recursivev)
 {
   CAMLparam2 (docv, recursivev);
diff --git a/mllib/xml.ml b/common/mlxml/xml.ml
similarity index 97%
rename from mllib/xml.ml
rename to common/mlxml/xml.ml
index 78e75b8f2..5ccf42ddd 100644
--- a/mllib/xml.ml
+++ b/common/mlxml/xml.ml
@@ -67,9 +67,11 @@ let parse_memory xml    Gc.finalise free_docptr docptr;
   docptr

-let parse_file file -  let xml = Common_utils.read_whole_file file in
-  parse_memory xml
+external _parse_file : string -> docptr = "mllib_xml_parse_file"
+let parse_file filename +  let docptr = _parse_file filename in
+  Gc.finalise free_docptr docptr;
+  docptr

 external _copy_doc : docptr -> recursive:bool -> docptr =
"mllib_xml_copy_doc"
 let copy_doc docptr ~recursive diff --git a/mllib/xml.mli
b/common/mlxml/xml.mli
similarity index 100%
rename from mllib/xml.mli
rename to common/mlxml/xml.mli
diff --git a/configure.ac b/configure.ac
index 1abb72671..7d0f0a1dd 100644
--- a/configure.ac
+++ b/configure.ac
@@ -187,6 +187,7 @@ AC_CONFIG_FILES([Makefile
                  common/miniexpect/Makefile
                  common/mlprogress/Makefile
                  common/mlvisit/Makefile
+                 common/mlxml/Makefile
                  common/options/Makefile
                  common/parallel/Makefile
                  common/progress/Makefile
diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index 1e2a99e7e..f6ac73047 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -18,6 +18,7 @@ common/miniexpect/miniexpect.h
 common/mlprogress/progress-c.c
 common/mlvisit/dummy.c
 common/mlvisit/visit-c.c
+common/mlxml/xml-c.c
 common/options/config.c
 common/options/decrypt.c
 common/options/display-options.c
@@ -342,7 +343,6 @@ mllib/dummy.c
 mllib/getopt-c.c
 mllib/unix_utils-c.c
 mllib/uri-c.c
-mllib/xml-c.c
 ocaml/guestfs-c-actions.c
 ocaml/guestfs-c-errnos.c
 ocaml/guestfs-c.c
diff --git a/docs/guestfs-hacking.pod b/docs/guestfs-hacking.pod
index f9cb88f05..1ff496381 100644
--- a/docs/guestfs-hacking.pod
+++ b/docs/guestfs-hacking.pod
@@ -108,6 +108,10 @@ OCaml bindings for the progress bar functions (see
F<common/progress>).

 OCaml bindings for the visit functions (see F<common/visit>).

+=item F<common/mlxml>
+
+OCaml bindings for the libxml2 library.
+
 =item F<common/options>

 Common options parsing for guestfish, guestmount and some virt tools.
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index 42f450323..c84f5f36d 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -27,8 +27,6 @@ EXTRA_DIST = \
 	test-getopt.sh

 SOURCES_MLI = \
-	xml.mli \
-	xpath_helpers.mli \
 	checksums.mli \
 	unix_utils.mli \
 	common_utils.mli \
@@ -39,7 +37,8 @@ SOURCES_MLI = \
 	regedit.mli \
 	registry.mli \
 	stringMap.mli \
-	URI.mli
+	URI.mli \
+	xpath_helpers.mli

 SOURCES_ML = \
 	guestfs_config.ml \
@@ -57,7 +56,6 @@ SOURCES_ML = \
 	JSON.ml \
 	curl.ml \
 	checksums.ml \
-	xml.ml \
 	xpath_helpers.ml

 SOURCES_C = \
@@ -67,8 +65,7 @@ SOURCES_C = \
 	common_utils-c.c \
 	getopt-c.c \
 	unix_utils-c.c \
-	uri-c.c \
-	xml-c.c
+	uri-c.c

 if HAVE_OCAML

@@ -95,7 +92,8 @@ libmllib_a_CPPFLAGS = \
 	-I$(shell $(OCAMLC) -where) \
 	-I$(top_srcdir)/common/utils \
 	-I$(top_srcdir)/lib \
-	-I$(top_srcdir)/common/options
+	-I$(top_srcdir)/common/options \
+	-I$(top_srcdir)/common/mlxml
 libmllib_a_CFLAGS = \
 	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
 	$(LIBVIRT_CFLAGS) $(LIBXML2_CFLAGS) \
@@ -113,6 +111,7 @@ OCAMLPACKAGES = \
 	-I $(top_builddir)/lib/.libs \
 	-I $(top_builddir)/gnulib/lib/.libs \
 	-I $(top_builddir)/ocaml \
+	-I $(top_builddir)/common/mlxml \
 	-I $(builddir)
 OCAMLPACKAGES_TESTS = $(MLLIB_CMA)
 if HAVE_OCAML_PKG_GETTEXT
diff --git a/v2v/Makefile.am b/v2v/Makefile.am
index 5b6618adf..2de99ceb9 100644
--- a/v2v/Makefile.am
+++ b/v2v/Makefile.am
@@ -146,6 +146,7 @@ OCAMLPACKAGES = \
 	-I $(top_builddir)/lib/.libs \
 	-I $(top_builddir)/gnulib/lib/.libs \
 	-I $(top_builddir)/ocaml \
+	-I $(top_builddir)/common/mlxml \
 	-I $(top_builddir)/mllib \
 	-I $(top_builddir)/customize
 if HAVE_OCAML_PKG_GETTEXT
@@ -168,7 +169,11 @@ else
 OBJECTS = $(XOBJECTS)
 endif

-OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) mllib.$(MLARCHIVE)
$(LINK_CUSTOM_OCAMLC_ONLY)
+OCAMLLINKFLAGS = \
+	mlguestfs.$(MLARCHIVE) \
+	mlxml.$(MLARCHIVE) \
+	mllib.$(MLARCHIVE) \
+	$(LINK_CUSTOM_OCAMLC_ONLY)

 virt_v2v_DEPENDENCIES = $(OBJECTS) $(top_srcdir)/ocaml-link.sh
 virt_v2v_LINK = \
@@ -205,6 +210,7 @@ endif

 virt_v2v_copy_to_local_DEPENDENCIES = \
 	$(COPY_TO_LOCAL_OBJECTS) \
+	../common/mlxml/mlxml.$(MLARCHIVE) \
 	../mllib/mllib.$(MLARCHIVE) \
 	$(top_srcdir)/ocaml-link.sh
 virt_v2v_copy_to_local_LINK = \
@@ -489,6 +495,7 @@ endif

 v2v_unit_tests_DEPENDENCIES = \
 	$(v2v_unit_tests_THEOBJECTS) \
+	../common/mlxml/mlxml.$(MLARCHIVE) \
 	../mllib/mllib.$(MLARCHIVE) \
 	$(top_srcdir)/ocaml-link.sh
 v2v_unit_tests_LINK = \
@@ -503,7 +510,7 @@ depend: .depend

 .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
 	rm -f $@ $@-t
-	$(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I
$(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \
+	$(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I
$(abs_top_builddir)/common/mlxml -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' | \
diff --git a/v2v/test-harness/Makefile.am b/v2v/test-harness/Makefile.am
index 8ce441222..9a548022a 100644
--- a/v2v/test-harness/Makefile.am
+++ b/v2v/test-harness/Makefile.am
@@ -42,6 +42,7 @@ OCAMLPACKAGES = \
 	-I $(top_builddir)/lib/.libs \
 	-I $(top_builddir)/gnulib/lib/.libs \
 	-I $(top_builddir)/ocaml \
+	-I $(top_builddir)/common/mlxml \
 	-I $(top_builddir)/mllib \
 	-I $(top_builddir)/v2v

@@ -128,7 +129,7 @@ depend: .depend

 .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
 	rm -f $@ $@-t
-	$(OCAMLFIND) ocamldep -I ../../ocaml -I $(abs_srcdir) -I
$(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize -I
$(abs_top_builddir)/v2v $^ | \
+	$(OCAMLFIND) ocamldep -I ../../ocaml -I $(abs_srcdir) -I
$(abs_top_builddir)/common/mlxml -I $(abs_top_builddir)/mllib -I
$(abs_top_builddir)/customize -I $(abs_top_builddir)/v2v $^ | \
 	  $(SED) 's/ *$$//' | \
 	  $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
 	  $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
--
2.13.0