mrc0mmand / rpms / libguestfs

Forked from rpms/libguestfs 3 years ago
Clone

Blame SOURCES/0196-v2v-Free-XML-objects-in-the-correct-order.patch

ffd6ed
From cf3b6c9450c252fd16774e606b03c1730c216a18 Mon Sep 17 00:00:00 2001
ffd6ed
From: "Richard W.M. Jones" <rjones@redhat.com>
ffd6ed
Date: Thu, 25 Jun 2015 18:00:02 +0100
ffd6ed
Subject: [PATCH] v2v: Free XML objects in the correct order.
ffd6ed
ffd6ed
If you free an xmlDocPtr before any xmlXPathObjectPtrs that reference
ffd6ed
the doc, you'll get valgrind errors like this:
ffd6ed
ffd6ed
  ==7390== Invalid read of size 4
ffd6ed
  ==7390==    at 0x4EB8BC6: xmlXPathFreeNodeSet (xpath.c:4185)
ffd6ed
  ==7390==    by 0x4EB8CC5: xmlXPathFreeObject (xpath.c:5492)
ffd6ed
  ==7390==    by 0x400A56: main (in /tmp/test)
ffd6ed
  ==7390==  Address 0x60c0928 is 8 bytes inside a block of size 120 free'd
ffd6ed
  ==7390==    at 0x4C29D2A: free (in /usr/lib64/valgrind/vgpreload_memcheck-amd64-linux.so)
ffd6ed
  ==7390==    by 0x4E8784F: xmlFreeNodeList (tree.c:3683)
ffd6ed
  ==7390==    by 0x4E87605: xmlFreeDoc (tree.c:1242)
ffd6ed
  ==7390==    by 0x400A4A: main (in /tmp/test)
ffd6ed
ffd6ed
The following simple test program demonstrates the problem:
ffd6ed
ffd6ed
  #include <stdio.h>
ffd6ed
  #include <stdlib.h>
ffd6ed
  #include <assert.h>
ffd6ed
  #include <libxml/xpath.h>
ffd6ed
ffd6ed
  int
ffd6ed
  main (int argc, char *argv[])
ffd6ed
  {
ffd6ed
    xmlDocPtr doc;
ffd6ed
    xmlXPathContextPtr xpathctx;
ffd6ed
    xmlXPathObjectPtr xpathobj;
ffd6ed
ffd6ed
    doc = xmlReadMemory ("<test/>", 7, NULL, NULL, XML_PARSE_NONET);
ffd6ed
    assert (doc);
ffd6ed
    xpathctx = xmlXPathNewContext (doc);
ffd6ed
    assert (xpathctx);
ffd6ed
    xpathobj = xmlXPathEvalExpression (BAD_CAST "/test", xpathctx);
ffd6ed
    assert (xpathobj);
ffd6ed
    xmlFreeDoc (doc);
ffd6ed
    xmlXPathFreeObject (xpathobj);
ffd6ed
    xmlXPathFreeContext (xpathctx);
ffd6ed
    exit (EXIT_SUCCESS);
ffd6ed
  }
ffd6ed
ffd6ed
In virt-v2v we were not freeing up objects in the correct order,
ffd6ed
because we didn't express the dependency between objects at the C
ffd6ed
level into the OCaml, where the OCaml garbage collector could see
ffd6ed
those dependencies.  For example code like:
ffd6ed
ffd6ed
  let doc = ... in
ffd6ed
  let xpathctx = xpath_new_context doc in
ffd6ed
  let xpathobj = xpath_eval_expression xpathctx "/foo" in
ffd6ed
ffd6ed
might end up freeing the 'doc' (xmlDocPtr) if, say, there were no
ffd6ed
further references to it in the code, even though the 'xpathobj'
ffd6ed
(xmlXPathObjectPtr) remains live.
ffd6ed
ffd6ed
To avoid this, we change the OCaml-level representation of objects
ffd6ed
like xpathobj so they contain a reference back to the higher-level
ffd6ed
objects (xpathctx & doc).  Therefore holding an xpathobj means that
ffd6ed
the doc cannot be freed.
ffd6ed
ffd6ed
However that alone is not quite sufficient.  There is a further
ffd6ed
problem when the program calls Gc.full_major, Gc.compact etc., or even
ffd6ed
just when xpathctx & doc happen to be freed at the same time.  The GC
ffd6ed
won't necessarily free them in the right order as it knows both need
ffd6ed
to be freed but doesn't know that one must be freed before the other.
ffd6ed
ffd6ed
To solve this we have to move the finalisers into OCaml code, since
ffd6ed
the OCaml Gc.finalise function comes with an explicit ordering
ffd6ed
guarantee (that finalisers are always called in reverse order that
ffd6ed
they were created), which the C-level finaliser does not.
ffd6ed
ffd6ed
(cherry picked from commit 3888582da89c757d0740d11c3a62433d748c85aa)
ffd6ed
---
ffd6ed
 v2v/input_libvirtxml.ml |  18 ++++-----
ffd6ed
 v2v/input_ova.ml        |  10 ++---
ffd6ed
 v2v/output_libvirt.ml   |   6 +--
ffd6ed
 v2v/xml-c.c             | 103 +++++++++++++++++++++++++-----------------------
ffd6ed
 v2v/xml.ml              |  77 ++++++++++++++++++++++++------------
ffd6ed
 v2v/xml.mli             |   2 +-
ffd6ed
 6 files changed, 123 insertions(+), 93 deletions(-)
ffd6ed
ffd6ed
diff --git a/v2v/input_libvirtxml.ml b/v2v/input_libvirtxml.ml
ffd6ed
index 0f21bb3..16c34a6 100644
ffd6ed
--- a/v2v/input_libvirtxml.ml
ffd6ed
+++ b/v2v/input_libvirtxml.ml
ffd6ed
@@ -44,14 +44,14 @@ let parse_libvirt_xml ?conn ~verbose xml =
ffd6ed
     let obj = Xml.xpath_eval_expression xpathctx expr in
ffd6ed
     if Xml.xpathobj_nr_nodes obj < 1 then default
ffd6ed
     else (
ffd6ed
-      let node = Xml.xpathobj_node doc obj 0 in
ffd6ed
+      let node = Xml.xpathobj_node obj 0 in
ffd6ed
       Xml.node_as_string node
ffd6ed
     )
ffd6ed
   and xpath_to_int expr default =
ffd6ed
     let obj = Xml.xpath_eval_expression xpathctx expr in
ffd6ed
     if Xml.xpathobj_nr_nodes obj < 1 then default
ffd6ed
     else (
ffd6ed
-      let node = Xml.xpathobj_node doc obj 0 in
ffd6ed
+      let node = Xml.xpathobj_node obj 0 in
ffd6ed
       let str = Xml.node_as_string node in
ffd6ed
       try int_of_string str
ffd6ed
       with Failure "int_of_string" ->
ffd6ed
@@ -76,7 +76,7 @@ let parse_libvirt_xml ?conn ~verbose xml =
ffd6ed
     let obj = Xml.xpath_eval_expression xpathctx "/domain/features/*" in
ffd6ed
     let nr_nodes = Xml.xpathobj_nr_nodes obj in
ffd6ed
     for i = 0 to nr_nodes-1 do
ffd6ed
-      let node = Xml.xpathobj_node doc obj i in
ffd6ed
+      let node = Xml.xpathobj_node obj i in
ffd6ed
       features := Xml.node_name node :: !features
ffd6ed
     done;
ffd6ed
     !features in
ffd6ed
@@ -87,7 +87,7 @@ let parse_libvirt_xml ?conn ~verbose xml =
ffd6ed
     if nr_nodes < 1 then None
ffd6ed
     else (
ffd6ed
       (* Ignore everything except the first <graphics> device. *)
ffd6ed
-      let node = Xml.xpathobj_node doc obj 0 in
ffd6ed
+      let node = Xml.xpathobj_node obj 0 in
ffd6ed
       Xml.xpathctx_set_current_context xpathctx node;
ffd6ed
       let keymap =
ffd6ed
         match xpath_to_string "@keymap" "" with "" -> None | k -> Some k in
ffd6ed
@@ -148,7 +148,7 @@ let parse_libvirt_xml ?conn ~verbose xml =
ffd6ed
     if nr_nodes < 1 then None
ffd6ed
     else (
ffd6ed
       (* Ignore everything except the first <sound> device. *)
ffd6ed
-      let node = Xml.xpathobj_node doc obj 0 in
ffd6ed
+      let node = Xml.xpathobj_node obj 0 in
ffd6ed
 
ffd6ed
       Xml.xpathctx_set_current_context xpathctx node;
ffd6ed
       match xpath_to_string "@model" "" with
ffd6ed
@@ -187,7 +187,7 @@ let parse_libvirt_xml ?conn ~verbose xml =
ffd6ed
     if nr_nodes < 1 then
ffd6ed
       error (f_"this guest has no non-removable disks");
ffd6ed
     for i = 0 to nr_nodes-1 do
ffd6ed
-      let node = Xml.xpathobj_node doc obj i in
ffd6ed
+      let node = Xml.xpathobj_node obj i in
ffd6ed
       Xml.xpathctx_set_current_context xpathctx node;
ffd6ed
 
ffd6ed
       let controller =
ffd6ed
@@ -250,7 +250,7 @@ let parse_libvirt_xml ?conn ~verbose xml =
ffd6ed
             let obj = Xml.xpath_eval_expression xpathctx expr in
ffd6ed
             if Xml.xpathobj_nr_nodes obj < 1 then default
ffd6ed
             else (
ffd6ed
-              let node = Xml.xpathobj_node doc obj 0 in
ffd6ed
+              let node = Xml.xpathobj_node obj 0 in
ffd6ed
               Xml.node_as_string node
ffd6ed
             ) in
ffd6ed
 
ffd6ed
@@ -281,7 +281,7 @@ let parse_libvirt_xml ?conn ~verbose xml =
ffd6ed
     let nr_nodes = Xml.xpathobj_nr_nodes obj in
ffd6ed
     let disks = ref [] in
ffd6ed
     for i = 0 to nr_nodes-1 do
ffd6ed
-      let node = Xml.xpathobj_node doc obj i in
ffd6ed
+      let node = Xml.xpathobj_node obj i in
ffd6ed
       Xml.xpathctx_set_current_context xpathctx node;
ffd6ed
 
ffd6ed
       let controller =
ffd6ed
@@ -311,7 +311,7 @@ let parse_libvirt_xml ?conn ~verbose xml =
ffd6ed
     let nr_nodes = Xml.xpathobj_nr_nodes obj in
ffd6ed
     let nics = ref [] in
ffd6ed
     for i = 0 to nr_nodes-1 do
ffd6ed
-      let node = Xml.xpathobj_node doc obj i in
ffd6ed
+      let node = Xml.xpathobj_node obj i in
ffd6ed
       Xml.xpathctx_set_current_context xpathctx node;
ffd6ed
 
ffd6ed
       let mac = xpath_to_string "mac/@address" "" in
ffd6ed
diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml
ffd6ed
index 8deedda..ab8c27b 100644
ffd6ed
--- a/v2v/input_ova.ml
ffd6ed
+++ b/v2v/input_ova.ml
ffd6ed
@@ -184,14 +184,14 @@ object
ffd6ed
       let obj = Xml.xpath_eval_expression xpathctx expr in
ffd6ed
       if Xml.xpathobj_nr_nodes obj < 1 then default
ffd6ed
       else (
ffd6ed
-        let node = Xml.xpathobj_node doc obj 0 in
ffd6ed
+        let node = Xml.xpathobj_node obj 0 in
ffd6ed
         Xml.node_as_string node
ffd6ed
       )
ffd6ed
     and xpath_to_int expr default =
ffd6ed
       let obj = Xml.xpath_eval_expression xpathctx expr in
ffd6ed
       if Xml.xpathobj_nr_nodes obj < 1 then default
ffd6ed
       else (
ffd6ed
-        let node = Xml.xpathobj_node doc obj 0 in
ffd6ed
+        let node = Xml.xpathobj_node obj 0 in
ffd6ed
         let str = Xml.node_as_string node in
ffd6ed
         try int_of_string str
ffd6ed
         with Failure "int_of_string" ->
ffd6ed
@@ -247,7 +247,7 @@ object
ffd6ed
       let obj = Xml.xpath_eval_expression xpathctx expr in
ffd6ed
       let nr_nodes = Xml.xpathobj_nr_nodes obj in
ffd6ed
       for i = 0 to nr_nodes-1 do
ffd6ed
-        let n = Xml.xpathobj_node doc obj i in
ffd6ed
+        let n = Xml.xpathobj_node obj i in
ffd6ed
         Xml.xpathctx_set_current_context xpathctx n;
ffd6ed
 
ffd6ed
         (* XXX We assume the OVF lists these in order.
ffd6ed
@@ -316,7 +316,7 @@ object
ffd6ed
       let obj = Xml.xpath_eval_expression xpathctx expr in
ffd6ed
       let nr_nodes = Xml.xpathobj_nr_nodes obj in
ffd6ed
       for i = 0 to nr_nodes-1 do
ffd6ed
-        let n = Xml.xpathobj_node doc obj i in
ffd6ed
+        let n = Xml.xpathobj_node obj i in
ffd6ed
         Xml.xpathctx_set_current_context xpathctx n;
ffd6ed
         let id = xpath_to_int "rasd:ResourceType/text()" 0 in
ffd6ed
         assert (id = 14 || id = 15 || id = 16);
ffd6ed
@@ -350,7 +350,7 @@ object
ffd6ed
     let obj = Xml.xpath_eval_expression xpathctx "/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=10]"  in
ffd6ed
     let nr_nodes = Xml.xpathobj_nr_nodes obj in
ffd6ed
     for i = 0 to nr_nodes-1 do
ffd6ed
-      let n = Xml.xpathobj_node doc obj i in
ffd6ed
+      let n = Xml.xpathobj_node obj i in
ffd6ed
       Xml.xpathctx_set_current_context xpathctx n;
ffd6ed
       let vnet = xpath_to_string "rasd:ElementName/text()" (sprintf"eth%d" i) in
ffd6ed
       let nic = {
ffd6ed
diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml
ffd6ed
index 23e881a..6188aa6 100644
ffd6ed
--- a/v2v/output_libvirt.ml
ffd6ed
+++ b/v2v/output_libvirt.ml
ffd6ed
@@ -52,7 +52,7 @@ let target_features_of_capabilities_doc doc arch =
ffd6ed
     warning ~prog (f_"the target hypervisor does not support a %s KVM guest") arch;
ffd6ed
     []
ffd6ed
   ) else (
ffd6ed
-    let node (* first matching <guest> *) = Xml.xpathobj_node doc obj 0 in
ffd6ed
+    let node (* first matching <guest> *) = Xml.xpathobj_node obj 0 in
ffd6ed
     Xml.xpathctx_set_current_context xpathctx node;
ffd6ed
 
ffd6ed
     (* Get guest/features/* nodes. *)
ffd6ed
@@ -60,7 +60,7 @@ let target_features_of_capabilities_doc doc arch =
ffd6ed
 
ffd6ed
     let features = ref [] in
ffd6ed
     for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
ffd6ed
-      let feature_node = Xml.xpathobj_node doc obj i in
ffd6ed
+      let feature_node = Xml.xpathobj_node obj i in
ffd6ed
       let feature_name = Xml.node_name feature_node in
ffd6ed
       features := feature_name :: !features
ffd6ed
     done;
ffd6ed
@@ -355,7 +355,7 @@ class output_libvirt verbose oc output_pool = object
ffd6ed
       let obj = Xml.xpath_eval_expression xpathctx expr in
ffd6ed
       if Xml.xpathobj_nr_nodes obj < 1 then default
ffd6ed
       else (
ffd6ed
-        let node = Xml.xpathobj_node doc obj 0 in
ffd6ed
+        let node = Xml.xpathobj_node obj 0 in
ffd6ed
         Xml.node_as_string node
ffd6ed
       )
ffd6ed
     in
ffd6ed
diff --git a/v2v/xml-c.c b/v2v/xml-c.c
ffd6ed
index 0b619e5..c71ab24 100644
ffd6ed
--- a/v2v/xml-c.c
ffd6ed
+++ b/v2v/xml-c.c
ffd6ed
@@ -42,60 +42,53 @@
ffd6ed
 /* xmlDocPtr type */
ffd6ed
 #define Doc_val(v) (*((xmlDocPtr *)Data_custom_val(v)))
ffd6ed
 
ffd6ed
-static void
ffd6ed
-doc_finalize (value docv)
ffd6ed
-{
ffd6ed
-  xmlDocPtr doc = Doc_val (docv);
ffd6ed
-
ffd6ed
-  if (doc)
ffd6ed
-    xmlFreeDoc (doc);
ffd6ed
-}
ffd6ed
-
ffd6ed
 static struct custom_operations doc_custom_operations = {
ffd6ed
   (char *) "doc_custom_operations",
ffd6ed
-  doc_finalize,
ffd6ed
+  custom_finalize_default,
ffd6ed
   custom_compare_default,
ffd6ed
   custom_hash_default,
ffd6ed
   custom_serialize_default,
ffd6ed
   custom_deserialize_default
ffd6ed
 };
ffd6ed
 
ffd6ed
+value
ffd6ed
+v2v_xml_free_doc_ptr (value docv)
ffd6ed
+{
ffd6ed
+  CAMLparam1 (docv);
ffd6ed
+  xmlDocPtr doc = Doc_val (docv);
ffd6ed
+
ffd6ed
+  xmlFreeDoc (doc);
ffd6ed
+  CAMLreturn (Val_unit);
ffd6ed
+}
ffd6ed
+
ffd6ed
 /* xmlXPathContextPtr type */
ffd6ed
-#define Xpathctx_val(v) (*((xmlXPathContextPtr *)Data_custom_val(v)))
ffd6ed
+#define Xpathctx_ptr_val(v) (*((xmlXPathContextPtr *)Data_custom_val(v)))
ffd6ed
 
ffd6ed
-static void
ffd6ed
-xpathctx_finalize (value xpathctxv)
ffd6ed
-{
ffd6ed
-  xmlXPathContextPtr xpathctx = Xpathctx_val (xpathctxv);
ffd6ed
-
ffd6ed
-  if (xpathctx)
ffd6ed
-    xmlXPathFreeContext (xpathctx);
ffd6ed
-}
ffd6ed
-
ffd6ed
-static struct custom_operations xpathctx_custom_operations = {
ffd6ed
-  (char *) "xpathctx_custom_operations",
ffd6ed
-  xpathctx_finalize,
ffd6ed
+static struct custom_operations xpathctx_ptr_custom_operations = {
ffd6ed
+  (char *) "xpathctx_ptr_custom_operations",
ffd6ed
+  custom_finalize_default,
ffd6ed
   custom_compare_default,
ffd6ed
   custom_hash_default,
ffd6ed
   custom_serialize_default,
ffd6ed
   custom_deserialize_default
ffd6ed
 };
ffd6ed
 
ffd6ed
+value
ffd6ed
+v2v_xml_free_xpathctx_ptr (value xpathctxv)
ffd6ed
+{
ffd6ed
+  CAMLparam1 (xpathctxv);
ffd6ed
+  xmlXPathContextPtr xpathctx = Xpathctx_ptr_val (xpathctxv);
ffd6ed
+
ffd6ed
+  xmlXPathFreeContext (xpathctx);
ffd6ed
+  CAMLreturn (Val_unit);
ffd6ed
+}
ffd6ed
+
ffd6ed
 /* xmlXPathObjectPtr type */
ffd6ed
-#define Xpathobj_val(v) (*((xmlXPathObjectPtr *)Data_custom_val(v)))
ffd6ed
+#define Xpathobj_ptr_val(v) (*((xmlXPathObjectPtr *)Data_custom_val(v)))
ffd6ed
 
ffd6ed
-static void
ffd6ed
-xpathobj_finalize (value xpathobjv)
ffd6ed
-{
ffd6ed
-  xmlXPathObjectPtr xpathobj = Xpathobj_val (xpathobjv);
ffd6ed
-
ffd6ed
-  if (xpathobj)
ffd6ed
-    xmlXPathFreeObject (xpathobj);
ffd6ed
-}
ffd6ed
-
ffd6ed
-static struct custom_operations xpathobj_custom_operations = {
ffd6ed
-  (char *) "xpathobj_custom_operations",
ffd6ed
-  xpathobj_finalize,
ffd6ed
+static struct custom_operations xpathobj_ptr_custom_operations = {
ffd6ed
+  (char *) "xpathobj_ptr_custom_operations",
ffd6ed
+  custom_finalize_default,
ffd6ed
   custom_compare_default,
ffd6ed
   custom_hash_default,
ffd6ed
   custom_serialize_default,
ffd6ed
@@ -103,6 +96,16 @@ static struct custom_operations xpathobj_custom_operations = {
ffd6ed
 };
ffd6ed
 
ffd6ed
 value
ffd6ed
+v2v_xml_free_xpathobj_ptr (value xpathobjv)
ffd6ed
+{
ffd6ed
+  CAMLparam1 (xpathobjv);
ffd6ed
+  xmlXPathObjectPtr xpathobj = Xpathobj_ptr_val (xpathobjv);
ffd6ed
+
ffd6ed
+  xmlXPathFreeObject (xpathobj);
ffd6ed
+  CAMLreturn (Val_unit);
ffd6ed
+}
ffd6ed
+
ffd6ed
+value
ffd6ed
 v2v_xml_parse_memory (value xmlv)
ffd6ed
 {
ffd6ed
   CAMLparam1 (xmlv);
ffd6ed
@@ -124,7 +127,7 @@ v2v_xml_parse_memory (value xmlv)
ffd6ed
 }
ffd6ed
 
ffd6ed
 value
ffd6ed
-v2v_xml_xpath_new_context (value docv)
ffd6ed
+v2v_xml_xpath_new_context_ptr (value docv)
ffd6ed
 {
ffd6ed
   CAMLparam1 (docv);
ffd6ed
   CAMLlocal1 (xpathctxv);
ffd6ed
@@ -136,21 +139,21 @@ v2v_xml_xpath_new_context (value docv)
ffd6ed
   if (xpathctx == NULL)
ffd6ed
     caml_invalid_argument ("xpath_new_context: unable to create xmlXPathNewContext");
ffd6ed
 
ffd6ed
-  xpathctxv = caml_alloc_custom (&xpathctx_custom_operations,
ffd6ed
+  xpathctxv = caml_alloc_custom (&xpathctx_ptr_custom_operations,
ffd6ed
                                  sizeof (xmlXPathContextPtr), 0, 1);
ffd6ed
-  Xpathctx_val (xpathctxv) = xpathctx;
ffd6ed
+  Xpathctx_ptr_val (xpathctxv) = xpathctx;
ffd6ed
 
ffd6ed
   CAMLreturn (xpathctxv);
ffd6ed
 }
ffd6ed
 
ffd6ed
 value
ffd6ed
-v2v_xml_xpath_register_ns (value xpathctxv, value prefix, value uri)
ffd6ed
+v2v_xml_xpathctx_ptr_register_ns (value xpathctxv, value prefix, value uri)
ffd6ed
 {
ffd6ed
   CAMLparam3 (xpathctxv, prefix, uri);
ffd6ed
   xmlXPathContextPtr xpathctx;
ffd6ed
   int r;
ffd6ed
 
ffd6ed
-  xpathctx = Xpathctx_val (xpathctxv);
ffd6ed
+  xpathctx = Xpathctx_ptr_val (xpathctxv);
ffd6ed
   r = xmlXPathRegisterNs (xpathctx, BAD_CAST String_val (prefix), BAD_CAST String_val (uri));
ffd6ed
   if (r == -1)
ffd6ed
       caml_invalid_argument ("xpath_register_ns: unable to register namespace");
ffd6ed
@@ -159,30 +162,30 @@ v2v_xml_xpath_register_ns (value xpathctxv, value prefix, value uri)
ffd6ed
 }
ffd6ed
 
ffd6ed
 value
ffd6ed
-v2v_xml_xpath_eval_expression (value xpathctxv, value exprv)
ffd6ed
+v2v_xml_xpathctx_ptr_eval_expression (value xpathctxv, value exprv)
ffd6ed
 {
ffd6ed
   CAMLparam2 (xpathctxv, exprv);
ffd6ed
   CAMLlocal1 (xpathobjv);
ffd6ed
   xmlXPathContextPtr xpathctx;
ffd6ed
   xmlXPathObjectPtr xpathobj;
ffd6ed
 
ffd6ed
-  xpathctx = Xpathctx_val (xpathctxv);
ffd6ed
+  xpathctx = Xpathctx_ptr_val (xpathctxv);
ffd6ed
   xpathobj = xmlXPathEvalExpression (BAD_CAST String_val (exprv), xpathctx);
ffd6ed
   if (xpathobj == NULL)
ffd6ed
     caml_invalid_argument ("xpath_eval_expression: unable to evaluate XPath expression");
ffd6ed
 
ffd6ed
-  xpathobjv = caml_alloc_custom (&xpathobj_custom_operations,
ffd6ed
+  xpathobjv = caml_alloc_custom (&xpathobj_ptr_custom_operations,
ffd6ed
                                  sizeof (xmlXPathObjectPtr), 0, 1);
ffd6ed
-  Xpathobj_val (xpathobjv) = xpathobj;
ffd6ed
+  Xpathobj_ptr_val (xpathobjv) = xpathobj;
ffd6ed
 
ffd6ed
   CAMLreturn (xpathobjv);
ffd6ed
 }
ffd6ed
 
ffd6ed
 value
ffd6ed
-v2v_xml_xpathobj_nr_nodes (value xpathobjv)
ffd6ed
+v2v_xml_xpathobj_ptr_nr_nodes (value xpathobjv)
ffd6ed
 {
ffd6ed
   CAMLparam1 (xpathobjv);
ffd6ed
-  xmlXPathObjectPtr xpathobj = Xpathobj_val (xpathobjv);
ffd6ed
+  xmlXPathObjectPtr xpathobj = Xpathobj_ptr_val (xpathobjv);
ffd6ed
 
ffd6ed
   if (xpathobj->nodesetval == NULL)
ffd6ed
     CAMLreturn (Val_int (0));
ffd6ed
@@ -191,10 +194,10 @@ v2v_xml_xpathobj_nr_nodes (value xpathobjv)
ffd6ed
 }
ffd6ed
 
ffd6ed
 value
ffd6ed
-v2v_xml_xpathobj_get_node_ptr (value xpathobjv, value iv)
ffd6ed
+v2v_xml_xpathobj_ptr_get_node_ptr (value xpathobjv, value iv)
ffd6ed
 {
ffd6ed
   CAMLparam2 (xpathobjv, iv);
ffd6ed
-  xmlXPathObjectPtr xpathobj = Xpathobj_val (xpathobjv);
ffd6ed
+  xmlXPathObjectPtr xpathobj = Xpathobj_ptr_val (xpathobjv);
ffd6ed
   int i = Int_val (iv);
ffd6ed
 
ffd6ed
   if (i < 0 || i >= xpathobj->nodesetval->nodeNr)
ffd6ed
@@ -215,7 +218,7 @@ value
ffd6ed
 v2v_xml_xpathctx_set_node_ptr (value xpathctxv, value nodev)
ffd6ed
 {
ffd6ed
   CAMLparam2 (xpathctxv, nodev);
ffd6ed
-  xmlXPathContextPtr xpathctx = Xpathctx_val (xpathctxv);
ffd6ed
+  xmlXPathContextPtr xpathctx = Xpathctx_ptr_val (xpathctxv);
ffd6ed
   xmlNodePtr node = (xmlNodePtr) nodev;
ffd6ed
 
ffd6ed
   xpathctx->node = node;
ffd6ed
diff --git a/v2v/xml.ml b/v2v/xml.ml
ffd6ed
index fea8784..16f3f70 100644
ffd6ed
--- a/v2v/xml.ml
ffd6ed
+++ b/v2v/xml.ml
ffd6ed
@@ -18,37 +18,64 @@
ffd6ed
 
ffd6ed
 (* Mini interface to libxml2. *)
ffd6ed
 
ffd6ed
-type doc
ffd6ed
+type doc = doc_ptr
ffd6ed
+and doc_ptr
ffd6ed
 type node_ptr
ffd6ed
-type xpathctx
ffd6ed
-type xpathobj
ffd6ed
+type xpathctx_ptr
ffd6ed
+type xpathobj_ptr
ffd6ed
 
ffd6ed
-(* Since node is owned by doc, we have to make that explicit to the
ffd6ed
- * garbage collector.
ffd6ed
+(* At the C level, various objects "own" other objects.  We have to
ffd6ed
+ * make that ownership explicit to the garbage collector, else we could
ffd6ed
+ * end up freeing an object before all the C references to it are
ffd6ed
+ * freed.
ffd6ed
  *)
ffd6ed
-type node = doc * node_ptr
ffd6ed
-
ffd6ed
-external parse_memory : string -> doc = "v2v_xml_parse_memory"
ffd6ed
-external xpath_new_context : doc -> xpathctx = "v2v_xml_xpath_new_context"
ffd6ed
-external xpath_eval_expression : xpathctx -> string -> xpathobj = "v2v_xml_xpath_eval_expression"
ffd6ed
-external xpath_register_ns : xpathctx -> string -> string -> unit = "v2v_xml_xpath_register_ns"
ffd6ed
-
ffd6ed
-external xpathobj_nr_nodes : xpathobj -> int = "v2v_xml_xpathobj_nr_nodes"
ffd6ed
-external xpathobj_get_node_ptr : xpathobj -> int -> node_ptr = "v2v_xml_xpathobj_get_node_ptr"
ffd6ed
-let xpathobj_node doc xpathobj i =
ffd6ed
-  let n = xpathobj_get_node_ptr xpathobj i in
ffd6ed
-  (doc, n)
ffd6ed
-
ffd6ed
-external xpathctx_set_node_ptr : xpathctx -> node_ptr -> unit = "v2v_xml_xpathctx_set_node_ptr"
ffd6ed
-let xpathctx_set_current_context xpathctx (_, node) =
ffd6ed
-  xpathctx_set_node_ptr xpathctx node
ffd6ed
+type xpathctx = doc_ptr * xpathctx_ptr
ffd6ed
+type xpathobj = xpathctx * xpathobj_ptr
ffd6ed
+type node = doc_ptr * node_ptr
ffd6ed
+
ffd6ed
+external free_doc_ptr : doc_ptr -> unit = "v2v_xml_free_doc_ptr"
ffd6ed
+external free_xpathctx_ptr : xpathctx_ptr -> unit = "v2v_xml_free_xpathctx_ptr"
ffd6ed
+external free_xpathobj_ptr : xpathobj_ptr -> unit = "v2v_xml_free_xpathobj_ptr"
ffd6ed
+
ffd6ed
+external _parse_memory : string -> doc_ptr = "v2v_xml_parse_memory"
ffd6ed
+let parse_memory xml =
ffd6ed
+  let doc_ptr = _parse_memory xml in
ffd6ed
+  Gc.finalise free_doc_ptr doc_ptr;
ffd6ed
+  doc_ptr
ffd6ed
+
ffd6ed
+external xpath_new_context_ptr : doc_ptr -> xpathctx_ptr = "v2v_xml_xpath_new_context_ptr"
ffd6ed
+let xpath_new_context doc_ptr =
ffd6ed
+  let xpathctx_ptr = xpath_new_context_ptr doc_ptr in
ffd6ed
+  Gc.finalise free_xpathctx_ptr xpathctx_ptr;
ffd6ed
+  doc_ptr, xpathctx_ptr
ffd6ed
+
ffd6ed
+external xpathctx_ptr_register_ns : xpathctx_ptr -> string -> string -> unit = "v2v_xml_xpathctx_ptr_register_ns"
ffd6ed
+let xpath_register_ns (_, xpathctx_ptr) prefix uri =
ffd6ed
+  xpathctx_ptr_register_ns xpathctx_ptr prefix uri
ffd6ed
+
ffd6ed
+external xpathctx_ptr_eval_expression : xpathctx_ptr -> string -> xpathobj_ptr = "v2v_xml_xpathctx_ptr_eval_expression"
ffd6ed
+let xpath_eval_expression ((_, xpathctx_ptr) as xpathctx) expr =
ffd6ed
+  let xpathobj_ptr = xpathctx_ptr_eval_expression xpathctx_ptr expr in
ffd6ed
+  Gc.finalise free_xpathobj_ptr xpathobj_ptr;
ffd6ed
+  xpathctx, xpathobj_ptr
ffd6ed
+
ffd6ed
+external xpathobj_ptr_nr_nodes : xpathobj_ptr -> int = "v2v_xml_xpathobj_ptr_nr_nodes"
ffd6ed
+let xpathobj_nr_nodes (_, xpathobj_ptr) =
ffd6ed
+  xpathobj_ptr_nr_nodes xpathobj_ptr
ffd6ed
+
ffd6ed
+external xpathobj_ptr_get_node_ptr : xpathobj_ptr -> int -> node_ptr = "v2v_xml_xpathobj_ptr_get_node_ptr"
ffd6ed
+let xpathobj_node ((doc_ptr, _), xpathobj_ptr) i =
ffd6ed
+  doc_ptr, xpathobj_ptr_get_node_ptr xpathobj_ptr i
ffd6ed
+
ffd6ed
+external xpathctx_ptr_set_node_ptr : xpathctx_ptr -> node_ptr -> unit = "v2v_xml_xpathctx_set_node_ptr"
ffd6ed
+let xpathctx_set_current_context (_, xpathctx_ptr) (_, node_ptr) =
ffd6ed
+  xpathctx_ptr_set_node_ptr xpathctx_ptr node_ptr
ffd6ed
 
ffd6ed
 external node_ptr_name : node_ptr -> string = "v2v_xml_node_ptr_name"
ffd6ed
-let node_name (_, node) = node_ptr_name node
ffd6ed
+let node_name (_, node_ptr) = node_ptr_name node_ptr
ffd6ed
 
ffd6ed
-external node_ptr_as_string : doc -> node_ptr -> string = "v2v_xml_node_ptr_as_string"
ffd6ed
-let node_as_string (doc, node) =
ffd6ed
-  node_ptr_as_string doc node
ffd6ed
+external node_ptr_as_string : doc_ptr -> node_ptr -> string = "v2v_xml_node_ptr_as_string"
ffd6ed
+let node_as_string (doc_ptr, node_ptr) = node_ptr_as_string doc_ptr node_ptr
ffd6ed
 
ffd6ed
 type uri = {
ffd6ed
   uri_scheme : string option;
ffd6ed
diff --git a/v2v/xml.mli b/v2v/xml.mli
ffd6ed
index 890fa4e..46c7d3e 100644
ffd6ed
--- a/v2v/xml.mli
ffd6ed
+++ b/v2v/xml.mli
ffd6ed
@@ -34,7 +34,7 @@ val xpath_register_ns : xpathctx -> string -> string -> unit
ffd6ed
 
ffd6ed
 val xpathobj_nr_nodes : xpathobj -> int
ffd6ed
 (** Get the number of nodes in the nodeset of the xmlXPathObjectPtr. *)
ffd6ed
-val xpathobj_node : doc -> xpathobj -> int -> node
ffd6ed
+val xpathobj_node : xpathobj -> int -> node
ffd6ed
 (** Get the i'th node in the nodeset of the xmlXPathObjectPtr. *)
ffd6ed
 
ffd6ed
 val xpathctx_set_current_context : xpathctx -> node -> unit
ffd6ed
-- 
ffd6ed
1.8.3.1
ffd6ed