generator: Add OCaml bindings.

Also we tighten up the definition of hivex_close (it disposes of handles)
and hivex_node_get_child (unusual "not found" non-error condition).

This also adds tests of the OCaml bindings.

7 files changed, 328 insertions, 1 deletions

diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am
index f7d26ce..b3f5e14 100644
--- a/ocaml/Makefile.am
+++ b/ocaml/Makefile.am
@@ -49,13 +49,44 @@ TESTS_ENVIRONMENT = \
 	LD_LIBRARY_PATH=$(top_builddir)/lib/.libs \
 	$(VG)
 
-TESTS = t/hivex_005_load
+TESTS = \
+	t/hivex_005_load \
+	t/hivex_010_open \
+	t/hivex_020_root \
+	t/hivex_100_errors \
+	t/hivex_110_gc_handle \
+	t/hivex_200_write \
+	t/hivex_300_fold
 noinst_DATA += $(TESTS)
 
 t/hivex_005_load: t/hivex_005_load.cmx mlhivex.cmxa
 	mkdir -p t
 	$(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/lib/.libs -I . -package unix -linkpkg mlhivex.cmxa $< -o $@
 
+t/hivex_010_open: t/hivex_010_open.cmx mlhivex.cmxa
+	mkdir -p t
+	$(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/lib/.libs -I . -package unix -linkpkg mlhivex.cmxa $< -o $@
+
+t/hivex_020_root: t/hivex_020_root.cmx mlhivex.cmxa
+	mkdir -p t
+	$(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/lib/.libs -I . -package unix -linkpkg mlhivex.cmxa $< -o $@
+
+t/hivex_100_errors: t/hivex_100_errors.cmx mlhivex.cmxa
+	mkdir -p t
+	$(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/lib/.libs -I . -package unix -linkpkg mlhivex.cmxa $< -o $@
+
+t/hivex_110_gc_handle: t/hivex_110_gc_handle.cmx mlhivex.cmxa
+	mkdir -p t
+	$(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/lib/.libs -I . -package unix -linkpkg mlhivex.cmxa $< -o $@
+
+t/hivex_200_write: t/hivex_200_write.cmx mlhivex.cmxa
+	mkdir -p t
+	$(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/lib/.libs -I . -package unix -linkpkg mlhivex.cmxa $< -o $@
+
+t/hivex_300_fold: t/hivex_300_fold.cmx mlhivex.cmxa
+	mkdir -p t
+	$(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/lib/.libs -I . -package unix -linkpkg mlhivex.cmxa $< -o $@
+
 # Need to rebuild the tests from source if the main library has
 # changed at all, otherwise we get inconsistent assumptions.
 t/%.cmx: t/%.ml mlhivex.cmxa
diff --git a/ocaml/t/hivex_010_open.ml b/ocaml/t/hivex_010_open.ml
new file mode 100644
index 0000000..5a74a7b
--- /dev/null
+++ b/ocaml/t/hivex_010_open.ml
@@ -0,0 +1,33 @@
+(* hivex OCaml bindings
+ * Copyright (C) 2009-2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+(* Test that we can open, read in and close a hive file. *)
+
+open Unix
+open Printf
+let (//) = Filename.concat
+let srcdir = try Sys.getenv "srcdir" with Not_found -> "."
+
+let () =
+  let h = Hivex.open_file (srcdir // "../images/minimal") [] in
+  Hivex.close h;
+
+  (* Gc.compact is a good way to ensure we don't have
+   * heap corruption or double-freeing.
+   *)
+  Gc.compact ()
diff --git a/ocaml/t/hivex_020_root.ml b/ocaml/t/hivex_020_root.ml
new file mode 100644
index 0000000..d11c991
--- /dev/null
+++ b/ocaml/t/hivex_020_root.ml
@@ -0,0 +1,34 @@
+(* hivex OCaml bindings
+ * Copyright (C) 2009-2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+(* Test that the root of the minimal hive exists. *)
+
+open Unix
+open Printf
+let (//) = Filename.concat
+let srcdir = try Sys.getenv "srcdir" with Not_found -> "."
+
+let () =
+  let h = Hivex.open_file (srcdir // "../images/minimal") [] in
+  ignore (Hivex.root h);
+  Hivex.close h;
+
+  (* Gc.compact is a good way to ensure we don't have
+   * heap corruption or double-freeing.
+   *)
+  Gc.compact ()
diff --git a/ocaml/t/hivex_100_errors.ml b/ocaml/t/hivex_100_errors.ml
new file mode 100644
index 0000000..0577632
--- /dev/null
+++ b/ocaml/t/hivex_100_errors.ml
@@ -0,0 +1,69 @@
+(* hivex OCaml bindings
+ * Copyright (C) 2009-2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+(* Test different types of error handling used by the API. *)
+
+open Unix
+open Printf
+let (//) = Filename.concat
+let srcdir = try Sys.getenv "srcdir" with Not_found -> "."
+
+let () =
+  printf "01 non-existent file\n%!";
+  (try
+     ignore (Hivex.open_file "no_such_file" []);
+     failwith "no exception thrown when opening a non-existent file"
+   with
+   | Hivex.Error ("open", ENOENT, _) -> () (* ok *)
+   (* let any other exception escape and stop the test *)
+  );
+
+  printf "02 closed handle\n%!";
+  let h = Hivex.open_file (srcdir // "../images/minimal") [] in
+  Hivex.close h;
+  (try
+     ignore (Hivex.root h)
+   with
+   | Hivex.Handle_closed "root" -> () (* ok *)
+   (* let any other exception escape and stop the test *)
+  );
+
+  printf "03 write to read-only file\n%!";
+  let h = Hivex.open_file (srcdir // "../images/minimal") [] in
+  (try
+     ignore (Hivex.node_add_child h (Hivex.root h) "Foo")
+   with
+   | Hivex.Error ("node_add_child", EROFS, _) -> () (* ok *)
+   (* let any other exception escape and stop the test *)
+  );
+  Hivex.close h;
+
+  printf "04 node_get_child node not found\n%!";
+  let h = Hivex.open_file (srcdir // "../images/minimal") [] in
+  (try
+     ignore (Hivex.node_get_child h (Hivex.root h) "NoSuchNode")
+   with
+   | Not_found -> () (* ok *)
+   (* let any other exception escape and stop the test *)
+  );
+  Hivex.close h;
+
+  (* Gc.compact is a good way to ensure we don't have
+   * heap corruption or double-freeing.
+   *)
+  Gc.compact ()
diff --git a/ocaml/t/hivex_110_gc_handle.ml b/ocaml/t/hivex_110_gc_handle.ml
new file mode 100644
index 0000000..0820a89
--- /dev/null
+++ b/ocaml/t/hivex_110_gc_handle.ml
@@ -0,0 +1,32 @@
+(* hivex OCaml bindings
+ * Copyright (C) 2009-2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+(* Test that the handle is GC'd (closed) when unreachable.
+ *
+ * XXX Actually we cannot really test that, but at least make
+ * sure there is no error.
+ *)
+
+open Unix
+open Printf
+let (//) = Filename.concat
+let srcdir = try Sys.getenv "srcdir" with Not_found -> "."
+
+let () =
+  ignore (Hivex.open_file (srcdir // "../images/minimal") []);
+  Gc.compact ()
diff --git a/ocaml/t/hivex_200_write.ml b/ocaml/t/hivex_200_write.ml
new file mode 100644
index 0000000..f70deee
--- /dev/null
+++ b/ocaml/t/hivex_200_write.ml
@@ -0,0 +1,75 @@
+(* hivex OCaml bindings
+ * Copyright (C) 2009-2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+(* Test some significant write operations.  Take the minimal hive
+ * and algorithmically construct a large, deep hive.
+ *)
+
+open Unix
+open Printf
+let (//) = Filename.concat
+let srcdir = try Sys.getenv "srcdir" with Not_found -> "."
+
+let () =
+  let h = Hivex.open_file (srcdir // "../images/minimal") [Hivex.OPEN_WRITE] in
+
+  let degrees = [| 3; 1; 4; 1; 5; 9; 2 |] (* ~1000 nodes *) in
+  let numbers = [| "Zero"; "One"; "Two"; "Three"; "Four";
+                   "Five"; "Six"; "Seven"; "Eight"; "Nine" |] in
+  let animals = [| "Horse"; "Ant"; "Mouse"; "Rabbit"; "Cat";
+                   "Giraffe"; "Kangaroo"; "Tiger"; "Zebra"; "Elephant" |] in
+
+  let rec iter depth posn parent =
+    if depth < Array.length degrees then (
+      let degree = degrees.(depth) in
+      for i = 0 to degree-1 do
+        let node_name = numbers.(depth) ^ " " ^ animals.(i) in
+        let node = Hivex.node_add_child h parent node_name in
+        iter (depth+1) i node
+      done;
+      let values = Array.init (10-posn) (
+        fun i ->
+          { Hivex.key = animals.(i);
+            t = Hivex.REG_SZ;
+            value = utf16le_of_ascii numbers.(i) }
+      ) in
+      Hivex.node_set_values h parent values
+    )
+
+  (* Make a nul-terminated UTF16-LE string from an ASCII string. *)
+  and utf16le_of_ascii str =
+    let len = String.length str in
+    let len' = len * 2 + 2 in
+    let str' = String.create len' in
+    for i = 0 to len-1 do
+      str'.[i*2] <- str.[i];
+      str'.[i*2+1] <- '\000'
+    done;
+    str'.[len'-2] <- '\000';
+    str'.[len'-1] <- '\000';
+    str'
+  in
+  iter 0 0 (Hivex.root h);
+
+  (* Discard the changes. *)
+  Hivex.close h;
+
+  (* Gc.compact is a good way to ensure we don't have
+   * heap corruption or double-freeing.
+   *)
+  Gc.compact ()
diff --git a/ocaml/t/hivex_300_fold.ml b/ocaml/t/hivex_300_fold.ml
new file mode 100644
index 0000000..0c7bc4f
--- /dev/null
+++ b/ocaml/t/hivex_300_fold.ml
@@ -0,0 +1,53 @@
+(* hivex OCaml bindings
+ * Copyright (C) 2009-2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+(* Fold over the large hive. *)
+
+open Unix
+open Printf
+let (//) = Filename.concat
+let srcdir = try Sys.getenv "srcdir" with Not_found -> "."
+
+(* This is a generic function to fold over hives.
+ *   fn : 'a -> node -> 'a is called for each node
+ *   fv : 'a -> node -> value array -> 'a is called for the values at each node
+ *)
+let hive_fold h fn fv a root =
+  let rec fold a node =
+    let a = fn a node in
+    let a = fv a node (Hivex.node_values h node) in
+    Array.fold_left fold a (Hivex.node_children h node)
+  in
+  fold a root
+
+let () =
+  let h = Hivex.open_file (srcdir // "../images/large") [] in
+
+  (* Count the number of nodes and values in the hive. *)
+  let count_node (nodes, values) _ = (nodes+1, values) in
+  let count_values (nodes, values) _ vs = (nodes, values + Array.length vs) in
+  let root = Hivex.root h in
+  let (nodes, values) = hive_fold h count_node count_values (0, 0) root in
+  printf "large test hive contains %d nodes and %d values\n%!" nodes values;
+
+  Hivex.close h;
+
+  (* Gc.compact is a good way to ensure we don't have
+   * heap corruption or double-freeing.
+   *)
+  Gc.compact ()