From: Richard Jones Date: Tue, 23 Feb 2010 12:27:19 +0000 (+0000) Subject: generator: Add OCaml bindings. X-Git-Tag: 1.2.0~10 X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=095c395082d1aad1e8558aa25514ad911e6d193c;p=hivex.git 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. --- diff --git a/.gitignore b/.gitignore index 5ecefaa..997bbcf 100644 --- a/.gitignore +++ b/.gitignore @@ -60,6 +60,12 @@ ocaml/hivex_c.c ocaml/META ocaml/*.so ocaml/t/hivex_005_load +ocaml/t/hivex_010_open +ocaml/t/hivex_020_root +ocaml/t/hivex_100_errors +ocaml/t/hivex_110_gc_handle +ocaml/t/hivex_200_write +ocaml/t/hivex_300_fold perl/blib perl/Hivex.bs perl/Hivex.c diff --git a/generator/generator.ml b/generator/generator.ml index 87afde3..71c3b4f 100755 --- a/generator/generator.ml +++ b/generator/generator.ml @@ -45,8 +45,10 @@ open Printf type style = ret * args and ret = | RErr (* 0 = ok, -1 = error *) + | RErrDispose (* Disposes handle, see hivex_close. *) | RHive (* Returns a hive_h or NULL. *) | RNode (* Returns hive_node_h or 0. *) + | RNodeNotFound (* See hivex_node_get_child. *) | RNodeList (* Returns hive_node_h* or NULL. *) | RValue (* Returns hive_value_h or 0. *) | RValueList (* Returns hive_value_h* or NULL. *) @@ -103,6 +105,7 @@ let hive_types = [ 11, "qword", "QWORD", "QWORD (64 bit integer), unspecified endianness but usually little endian" ] +let max_hive_type = 11 (* Open flags (bitmask passed to AOpenFlags) *) let open_flags = [ @@ -143,7 +146,7 @@ See L. =back"; - "close", (RErr, [AHive]), + "close", (RErrDispose, [AHive]), "close a hive handle", "\ Close a hive handle and free all associated resources. @@ -175,15 +178,12 @@ outside the scope of this library."; Return an array of nodes which are the subkeys (children) of C."; - "node_get_child", (RNode, [AHive; ANode "node"; AString "name"]), + "node_get_child", (RNodeNotFound, [AHive; ANode "node"; AString "name"]), "return named child of node", "\ Return the child of node with the name C, if it exists. -The name is matched case insensitively. - -If the child node does not exist, this returns 0 without -setting errno."; +The name is matched case insensitively."; "node_parent", (RNode, [AHive; ANode "node"]), "return the parent of node", @@ -786,8 +786,10 @@ and generate_c_prototype ?(extern = false) name style = if extern then pr "extern "; (match fst style with | RErr -> pr "int " + | RErrDispose -> pr "int " | RHive -> pr "hive_h *" | RNode -> pr "hive_node_h " + | RNodeNotFound -> pr "hive_node_h " | RNodeList -> pr "hive_node_h *" | RValue -> pr "hive_value_h " | RValueList -> pr "hive_value_h *" @@ -934,6 +936,13 @@ here. Often it's not documented at all. pr "\ Returns 0 on success. On error this returns -1 and sets errno.\n\n" + | RErrDispose -> + pr "\ +Returns 0 on success. +On error this returns -1 and sets errno. + +This function frees the hive handle (even if it returns an error). +The hive handle must not be used again after calling this function.\n\n" | RHive -> pr "\ Returns a new hive handle. @@ -942,6 +951,11 @@ On error this returns NULL and sets errno.\n\n" pr "\ Returns a node handle. On error this returns 0 and sets errno.\n\n" + | RNodeNotFound -> + pr "\ +Returns a node handle. +If the node was not found, this returns 0 without setting errno. +On error this returns 0 and sets errno.\n\n" | RNodeList -> pr "\ Returns a 0-terminated array of nodes. @@ -1303,14 +1317,539 @@ Lesser General Public License for more details. and generate_ocaml_interface () = generate_header OCamlStyle LGPLv2plus; - pr "val open_file : unit\n" + + pr "\ +type t +(** A [hive_h] hive file handle. *) + +type node +type value +(** Nodes and values. *) + +exception Error of string * Unix.error * string +(** Error raised by a function. + + The first parameter is the name of the function which raised the error. + The second parameter is the errno (see the [Unix] module). The third + parameter is a human-readable string corresponding to the errno. + + See hivex(3) for a partial list of interesting errno values that + can be generated by the library. *) +exception Handle_closed of string +(** This exception is raised if you call a function on a closed handle. *) + +type hive_type = +"; + iteri ( + fun i -> + fun (t, _, new_style, description) -> + assert (i = t); + pr " | REG_%s (** %s *)\n" new_style description + ) hive_types; + + pr "\ + | REG_UNKNOWN of int32 (** unknown type *) +(** Hive type field. *) + +type open_flag = +"; + iteri ( + fun i -> + fun (v, flag, description) -> + assert (1 lsl i = v); + pr " | OPEN_%s (** %s *)\n" flag description + ) open_flags; + + pr "\ +(** Open flags for {!open_file} call. *) + +type set_value = { + key : string; + t : hive_type; + value : string; +} +(** (key, value) pair passed (as an array) to {!node_set_values}. *) +"; + + List.iter ( + fun (name, style, shortdesc, _) -> + pr "\n"; + generate_ocaml_prototype name style; + pr "(** %s *)\n" shortdesc + ) functions and generate_ocaml_implementation () = generate_header OCamlStyle LGPLv2plus; - pr "let open_file = ()\n" + + pr "\ +type t +type node = int +type value = int + +exception Error of string * Unix.error * string +exception Handle_closed of string + +(* Give the exceptions names, so they can be raised from the C code. *) +let () = + Callback.register_exception \"ocaml_hivex_error\" + (Error (\"\", Unix.EUNKNOWNERR 0, \"\")); + Callback.register_exception \"ocaml_hivex_closed\" (Handle_closed \"\") + +type hive_type = +"; + iteri ( + fun i -> + fun (t, _, new_style, _) -> + assert (i = t); + pr " | REG_%s\n" new_style + ) hive_types; + + pr "\ + | REG_UNKNOWN of int32 + +type open_flag = +"; + iteri ( + fun i -> + fun (v, flag, description) -> + assert (1 lsl i = v); + pr " | OPEN_%s (** %s *)\n" flag description + ) open_flags; + + pr "\ + +type set_value = { + key : string; + t : hive_type; + value : string; +} + +"; + + List.iter ( + fun (name, style, _, _) -> + generate_ocaml_prototype ~is_external:true name style + ) functions + +and generate_ocaml_prototype ?(is_external = false) name style = + let ocaml_name = if name = "open" then "open_file" else name in + + if is_external then pr "external " else pr "val "; + pr "%s : " ocaml_name; + List.iter ( + function + | AHive -> pr "t -> " + | ANode _ -> pr "node -> " + | AValue _ -> pr "value -> " + | AString _ -> pr "string -> " + | AStringNullable _ -> pr "string option -> " + | AOpenFlags -> pr "open_flag list -> " + | AUnusedFlags -> () + | ASetValues -> pr "set_value array -> " + ) (snd style); + (match fst style with + | RErr -> pr "unit" (* all errors are turned into exceptions *) + | RErrDispose -> pr "unit" + | RHive -> pr "t" + | RNode -> pr "node" + | RNodeNotFound -> pr "node" + | RNodeList -> pr "node array" + | RValue -> pr "value" + | RValueList -> pr "value array" + | RString -> pr "string" + | RStringList -> pr "string array" + | RLenType -> pr "hive_type * int" + | RLenTypeVal -> pr "hive_type * string" + | RInt32 -> pr "int32" + | RInt64 -> pr "int64" + ); + if is_external then + pr " = \"ocaml_hivex_%s\"" name; + pr "\n" and generate_ocaml_c () = - generate_header CStyle LGPLv2plus + generate_header CStyle LGPLv2plus; + + pr "\ +#include + +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include + +#define Hiveh_val(v) (*((hive_h **)Data_custom_val(v))) +static value Val_hiveh (hive_h *); +static int HiveOpenFlags_val (value); +static hive_set_value *HiveSetValues_val (value); +static hive_type HiveType_val (value); +static value Val_hive_type (hive_type); +static value copy_int_array (size_t *); +static value copy_type_len (size_t, hive_type); +static value copy_type_value (const char *, size_t, hive_type); +static void raise_error (const char *) Noreturn; +static void raise_closed (const char *) Noreturn; + +"; + + (* The wrappers. *) + List.iter ( + fun (name, style, _, _) -> + pr "/* Automatically generated wrapper for function\n"; + pr " * "; generate_ocaml_prototype name style; + pr " */\n"; + pr "\n"; + + let c_params = + List.map (function + | ASetValues -> ["nrvalues"; "values"] + | AUnusedFlags -> ["0"] + | arg -> [name_of_argt arg]) (snd style) in + let c_params = + match fst style with + | RLenType | RLenTypeVal -> c_params @ [["&t"; "&len"]] + | _ -> c_params in + let c_params = List.concat c_params in + + let params = + filter_map (function + | AUnusedFlags -> None + | arg -> Some (name_of_argt arg ^ "v")) (snd style) in + + pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n"; + pr "CAMLprim value ocaml_hivex_%s (value %s" name (List.hd params); + List.iter (pr ", value %s") (List.tl params); pr ");\n"; + pr "\n"; + + pr "CAMLprim value\n"; + pr "ocaml_hivex_%s (value %s" name (List.hd params); + List.iter (pr ", value %s") (List.tl params); + pr ")\n"; + pr "{\n"; + + pr " CAMLparam%d (%s);\n" + (List.length params) (String.concat ", " params); + pr " CAMLlocal1 (rv);\n"; + pr "\n"; + + List.iter ( + function + | AHive -> + pr " hive_h *h = Hiveh_val (hv);\n"; + pr " if (h == NULL)\n"; + pr " raise_closed (\"%s\");\n" name + | ANode n -> + pr " hive_node_h %s = Int_val (%sv);\n" n n + | AValue n -> + pr " hive_value_h %s = Int_val (%sv);\n" n n + | AString n -> + pr " const char *%s = String_val (%sv);\n" n n + | AStringNullable n -> + pr " const char *%s =\n" n; + pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n" + n n + | AOpenFlags -> + pr " int flags = HiveOpenFlags_val (flagsv);\n" + | AUnusedFlags -> () + | ASetValues -> + pr " int nrvalues = Wosize_val (valuesv);\n"; + pr " hive_set_value *values = HiveSetValues_val (valuesv);\n" + ) (snd style); + pr "\n"; + + let error_code = + match fst style with + | RErr -> pr " int r;\n"; "-1" + | RErrDispose -> pr " int r;\n"; "-1" + | RHive -> pr " hive_h *r;\n"; "NULL" + | RNode -> pr " hive_node_h r;\n"; "0" + | RNodeNotFound -> + pr " errno = 0;\n"; + pr " hive_node_h r;\n"; + "0 && errno != 0" + | RNodeList -> pr " hive_node_h *r;\n"; "NULL" + | RValue -> pr " hive_value_h r;\n"; "0" + | RValueList -> pr " hive_value_h *r;\n"; "NULL" + | RString -> pr " char *r;\n"; "NULL" + | RStringList -> pr " char **r;\n"; "NULL" + | RLenType -> + pr " int r;\n"; + pr " size_t len;\n"; + pr " hive_type t;\n"; + "-1" + | RLenTypeVal -> + pr " char *r;\n"; + pr " size_t len;\n"; + pr " hive_type t;\n"; + "NULL" + | RInt32 -> + pr " errno = 0;\n"; + pr " int32_t r;\n"; + "-1 && errno != 0" + | RInt64 -> + pr " errno = 0;\n"; + pr " int64_t r;\n"; + "-1 && errno != 0" in + + (* The libguestfs OCaml bindings call enter_blocking_section + * here. However I don't think that is safe, because we are + * holding pointers to caml strings during the call, and these + * could be moved or freed by other threads. In any case, there + * is very little reason to enter_blocking_section for any hivex + * call, so don't do it. XXX + *) + (*pr " caml_enter_blocking_section ();\n";*) + pr " r = hivex_%s (%s" name (List.hd c_params); + List.iter (pr ", %s") (List.tl c_params); + pr ");\n"; + (*pr " caml_leave_blocking_section ();\n";*) + pr "\n"; + + (* Dispose of the hive handle (even if hivex_close returns error). *) + (match fst style with + | RErrDispose -> + pr " /* So we don't double-free in the finalizer. */\n"; + pr " Hiveh_val (hv) = NULL;\n"; + pr "\n"; + | _ -> () + ); + + List.iter ( + function + | AHive | ANode _ | AValue _ | AString _ | AStringNullable _ + | AOpenFlags | AUnusedFlags -> () + | ASetValues -> + pr " free (values);\n"; + pr "\n"; + ) (snd style); + + (* Check for errors. *) + pr " if (r == %s)\n" error_code; + pr " raise_error (\"%s\");\n" name; + pr "\n"; + + (match fst style with + | RErr -> pr " rv = Val_unit;\n" + | RErrDispose -> pr " rv = Val_unit;\n" + | RHive -> pr " rv = Val_hiveh (r);\n" + | RNode -> pr " rv = Val_int (r);\n" + | RNodeNotFound -> + pr " if (r == 0)\n"; + pr " caml_raise_not_found ();\n"; + pr "\n"; + pr " rv = Val_int (r);\n" + | RNodeList -> + pr " rv = copy_int_array (r);\n"; + pr " free (r);\n" + | RValue -> pr " rv = Val_int (r);\n" + | RValueList -> + pr " rv = copy_int_array (r);\n"; + pr " free (r);\n" + | RString -> + pr " rv = caml_copy_string (r);\n"; + pr " free (r);\n" + | RStringList -> + pr " rv = caml_copy_string_array ((const char **) r);\n"; + pr " for (int i = 0; r[i] != NULL; ++i) free (r[i]);\n"; + pr " free (r);\n" + | RLenType -> pr " rv = copy_type_len (len, t);\n" + | RLenTypeVal -> + pr " rv = copy_type_value (r, len, t);\n"; + pr " free (r);\n" + | RInt32 -> pr " rv = caml_copy_int32 (r);\n" + | RInt64 -> pr " rv = caml_copy_int32 (r);\n" + ); + + pr " CAMLreturn (rv);\n"; + pr "}\n"; + pr "\n"; + + ) functions; + + pr "\ +static int +HiveOpenFlags_val (value v) +{ + int flags = 0; + value v2; + + while (v != Val_int (0)) { + v2 = Field (v, 0); + flags |= 1 << Int_val (v2); + v = Field (v, 1); + } + + return flags; +} + +static hive_set_value * +HiveSetValues_val (value v) +{ + size_t nr_values = Wosize_val (v); + hive_set_value *values = malloc (nr_values * sizeof (hive_set_value)); + size_t i; + value v2; + + for (i = 0; i < nr_values; ++i) { + v2 = Field (v, i); + values[i].key = String_val (Field (v2, 0)); + values[i].t = HiveType_val (Field (v2, 1)); + values[i].len = caml_string_length (Field (v2, 2)); + values[i].value = String_val (Field (v2, 2)); + } + + return values; +} + +static hive_type +HiveType_val (value v) +{ + if (Is_long (v)) + return Int_val (v); /* REG_NONE etc. */ + else + return Int32_val (Field (v, 0)); /* REG_UNKNOWN of int32 */ +} + +static value +Val_hive_type (hive_type t) +{ + CAMLparam0 (); + CAMLlocal2 (rv, v); + + if (t <= %d) + CAMLreturn (Val_int (t)); + else { + rv = caml_alloc (1, 0); /* REG_UNKNOWN of int32 */ + v = caml_copy_int32 (t); + caml_modify (&Field (rv, 0), v); + CAMLreturn (rv); + } +} + +static value +copy_int_array (size_t *xs) +{ + CAMLparam0 (); + CAMLlocal2 (v, rv); + size_t nr, i; + + for (nr = 0; xs[nr] != 0; ++nr) + ; + if (nr == 0) + CAMLreturn (Atom (0)); + else { + rv = caml_alloc (nr, 0); + for (i = 0; i < nr; ++i) { + v = Val_int (xs[i]); + Store_field (rv, i, v); /* Safe because v is not a block. */ + } + CAMLreturn (rv); + } +} + +static value +copy_type_len (size_t len, hive_type t) +{ + CAMLparam0 (); + CAMLlocal2 (v, rv); + + rv = caml_alloc (2, 0); + v = Val_hive_type (t); + Store_field (rv, 0, v); + v = Val_int (len); + Store_field (rv, 1, len); + CAMLreturn (rv); +} + +static value +copy_type_value (const char *r, size_t len, hive_type t) +{ + CAMLparam0 (); + CAMLlocal2 (v, rv); + + rv = caml_alloc (2, 0); + v = Val_hive_type (t); + Store_field (rv, 0, v); + v = caml_alloc_string (len); + memcpy (String_val (v), r, len); + caml_modify (&Field (rv, 1), len); + CAMLreturn (rv); +} + +/* Raise exceptions. */ +static void +raise_error (const char *function) +{ + /* Save errno early in case it gets trashed. */ + int err = errno; + + CAMLparam0 (); + CAMLlocal3 (v1, v2, v3); + + v1 = caml_copy_string (function); + v2 = unix_error_of_code (err); + v3 = caml_copy_string (strerror (err)); + value vvv[] = { v1, v2, v3 }; + caml_raise_with_args (*caml_named_value (\"ocaml_hivex_error\"), 3, vvv); + + CAMLnoreturn; +} + +static void +raise_closed (const char *function) +{ + CAMLparam0 (); + CAMLlocal1 (v); + + v = caml_copy_string (function); + caml_raise_with_arg (*caml_named_value (\"ocaml_hivex_closed\"), v); + + CAMLnoreturn; +} + +/* Allocate handles and deal with finalization. */ +static void +hivex_finalize (value hv) +{ + hive_h *h = Hiveh_val (hv); + if (h) hivex_close (h); +} + +static struct custom_operations hivex_custom_operations = { + (char *) \"hivex_custom_operations\", + hivex_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +static value +Val_hiveh (hive_h *h) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + + rv = caml_alloc_custom (&hivex_custom_operations, + sizeof (hive_h *), 0, 1); + Hiveh_val (rv) = h; + + CAMLreturn (rv); +} +" max_hive_type and generate_perl_pm () = generate_header HashStyle LGPLv2plus 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 ()