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. *)
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 = [
=back";
- "close", (RErr, [AHive]),
+ "close", (RErrDispose, [AHive]),
"close a hive handle",
"\
Close a hive handle and free all associated resources.
Return an array of nodes which are the subkeys
(children) of C<node>.";
- "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<name>, 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",
"return value as multiple strings",
"\
If this value is a multiple-string, return the strings reencoded
-as UTF-8 (as a NULL-terminated array of C strings). This only
+as UTF-8 (in C, as a NULL-terminated array of C strings, in other
+language bindings, as a list of strings). This only
works for values which have type C<hive_t_multiple_strings>.";
"value_dword", (RInt32, [AHive; AValue "val"]),
"\
Commit (write) any changes which have been made.
-C<filename> is the new file to write. If C<filename> is NULL then we
-overwrite the original file (ie. the file name that was passed to
-C<hivex_open>). C<flags> is not used, always pass 0.
+C<filename> is the new file to write. If C<filename> is null/undefined
+then we overwrite the original file (ie. the file name that was passed to
+C<hivex_open>).
Note this does not close the hive handle. You can perform further
operations on the hive after committing, including making more
-modifications. If you no longer wish to use the hive, call
-C<hivex_close> after this.";
+modifications. If you no longer wish to use the hive, then you
+should close the handle after committing.";
"node_add_child", (RNode, [AHive; ANode "parent"; AString "name"]),
"add child node",
"node_set_values", (RErr, [AHive; ANode "node"; ASetValues; AUnusedFlags]),
"set (key, value) pairs at a node",
"\
-This call can be used to set all the (key, value) pairs stored in C<node>.
-
-C<node> is the node to modify. C<values> is an array of (key, value)
-pairs. There should be C<nr_values> elements in this array. C<flags>
-is not used, always pass 0.
-
-Any existing values stored at the node are discarded, and their
-C<hive_value_h> handles become invalid. Thus you can remove all
-values stored at C<node> by passing C<nr_values = 0>.
+This call can be used to set all the (key, value) pairs
+stored in C<node>. Note that this library does not offer
+a way to modify just a single key at a node.
-Note that this library does not offer a way to modify just a single
-key at a node. We don't implement a way to do this efficiently.";
+C<node> is the node to modify.";
]
(* Used to memoize the result of pod2text. *)
(* Generate a header block in a number of standard styles. *)
type comment_style =
- CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+ | CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+ | PODCommentStyle
type license = GPLv2plus | LGPLv2plus | GPLv2 | LGPLv2
let generate_header ?(extra_inputs = []) comment license =
| CPlusPlusStyle -> pr "// "; "//"
| HashStyle -> pr "# "; "#"
| OCamlStyle -> pr "(* "; " *"
- | HaskellStyle -> pr "{- "; " " in
+ | HaskellStyle -> pr "{- "; " "
+ | PODCommentStyle -> pr "=begin comment\n\n "; "" in
pr "hivex generated file\n";
pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
List.iter (pr "%s %s\n" c) inputs;
| LGPLv2 ->
pr "%s This library is free software; you can redistribute it and/or\n" c;
pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
- pr "%s License as published by the Free Software Foundation; either\n" c;
+ pr "%s License as published by the Free Software Foundation;\n" c;
pr "%s version 2.1 of the License only.\n" c;
pr "%s\n" c;
pr "%s This library is distributed in the hope that it will be useful,\n" c;
| HashStyle -> ()
| OCamlStyle -> pr " *)\n"
| HaskellStyle -> pr "-}\n"
+ | PODCommentStyle -> pr "\n=end comment\n"
);
pr "\n"
char *value;
};
typedef struct hive_set_value hive_set_value;
+
";
+ pr "/* Functions. */\n";
+
(* Function declarations. *)
List.iter (
fun (shortname, 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 *"
pr ");\n"
and generate_c_pod () =
+ generate_header PODCommentStyle GPLv2;
+
pr "\
=encoding utf8
=head1 SYNOPSIS
- hive_h *hivex_open (const char *filename, int flags);
- int hivex_close (hive_h *h);
+ #include <hivex.h>
+
+";
+ List.iter (
+ fun (shortname, style, _, _) ->
+ let name = "hivex_" ^ shortname in
+ pr " ";
+ generate_c_prototype ~extern:false name style;
+ ) functions;
+
+ pr "\
+
+Link with I<-lhivex>.
=head1 DESCRIPTION
format for output, because parsing that is as much trouble as parsing
the original binary format. Instead it makes the file available
through a C API, or there is a separate program to export the hive as
-XML (see L<hivexml(1)>), or to get individual keys (see
-L<hivexget(1)>).
+XML (see L<hivexml(1)>), or to navigate the file (see L<hivexsh(1)>).
-=head2 TYPES
+=head1 TYPES
-=over 4
-
-=item hive_h *
+=head2 hive_h *
This handle describes an open hive file.
-=item hive_node_h
+=head2 hive_node_h
This is a node handle, an integer but opaque outside the library.
Valid node handles cannot be 0. The library returns 0 in some
situations to indicate an error.
-=item hive_type
+=head2 hive_type
The enum below describes the possible types for the value(s)
stored at each node. Note that you should not trust the
pr "\
};
-=item hive_value_h
+=head2 hive_value_h
This is a value handle, an integer but opaque outside the library.
Valid value handles cannot be 0. The library returns 0 in some
situations to indicate an error.
-=item hive_set_value
+=head2 hive_set_value
The typedef C<hive_set_value> is used in conjunction with the
C<hivex_node_set_values> call described below.
between versions of Windows for the same key. We don't document it
here. Often it's not documented at all.
-=back
-
-=head2 FUNCTIONS
-
-=over 4
+=head1 FUNCTIONS
";
List.iter (
fun (shortname, style, _, longdesc) ->
let name = "hivex_" ^ shortname in
- pr "=item %s\n" name;
+ pr "=head2 %s\n" name;
pr "\n";
generate_c_prototype ~extern:false name style;
pr "\n";
pr "%s\n" longdesc;
pr "\n";
+
+ if List.mem AUnusedFlags (snd style) then
+ pr "The flags parameter is unused. Always pass 0.\n\n";
+
+ if List.mem ASetValues (snd style) then
+ pr "C<values> is an array of (key, value) pairs. There
+should be C<nr_values> elements in this array.
+
+Any existing values stored at the node are discarded, and their
+C<hive_value_h> handles become invalid. Thus you can remove all
+values stored at C<node> by passing C<nr_values = 0>.\n\n";
+
(match fst style with
| RErr ->
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.
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.
) functions;
pr "\
-=back
-
-=head2 WRITING TO HIVE FILES
+=head1 WRITING TO HIVE FILES
The hivex library supports making limited modifications to hive files.
We have tried to implement this very conservatively in order to reduce
them. Apart from wasting a little bit of disk space, it is not
thought that unreachable blocks are a problem.
-=head3 WRITE OPERATIONS WHICH ARE NOT SUPPORTED
+=head2 WRITE OPERATIONS WHICH ARE NOT SUPPORTED
=over 4
=back
-=head2 VISITING ALL NODES
+=head1 VISITING ALL NODES
The visitor pattern is useful if you want to visit all nodes
in the tree or all nodes below a certain point in the tree.
=head1 SEE ALSO
L<hivexml(1)>,
-L<hivexget(1)>,
+L<hivexsh(1)>,
L<virt-win-reg(1)>,
L<guestfs(3)>,
L<http://libguestfs.org/>,
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation;
-version 2.1 of the License.
+version 2.1 of the License only.
This library 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
Lesser General Public License for more details.
-
-See file LICENSE for the full license.
"
+and generate_ocaml_interface () =
+ generate_header OCamlStyle LGPLv2plus;
+
+ 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 "\
+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;
+
+ pr "\
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdint.h>
+#include <errno.h>
+
+#include <caml/config.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+
+#ifdef HAVE_CAML_UNIXSUPPORT_H
+#include <caml/unixsupport.h>
+#else
+extern value unix_error_of_code (int errcode);
+#endif
+
+#ifndef HAVE_CAML_RAISE_WITH_ARGS
+static void
+caml_raise_with_args (value tag, int nargs, value args[])
+{
+ CAMLparam1 (tag);
+ CAMLxparamN (args, nargs);
+ value bucket;
+ int i;
+
+ bucket = caml_alloc_small (1 + nargs, 0);
+ Field(bucket, 0) = tag;
+ for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
+ caml_raise(bucket);
+ CAMLnoreturn;
+}
+#endif
+
+#include <hivex.h>
+
+#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;
+
+ pr "\
+=pod
+
+=head1 NAME
+
+Win::Hivex - Perl bindings for reading and writing Windows Registry hive files
+
+=head1 SYNOPSIS
+
+ use Win::Hivex;
+
+ $h = Win::Hivex->open ('SOFTWARE');
+ $root_node = $h->root ();
+ print $h->node_name ($root_node);
+
+=head1 DESCRIPTION
+
+The C<Win::Hivex> module provides a Perl XS binding to the
+L<hivex(3)> API for reading and writing Windows Registry binary
+hive files.
+
+=head1 ERRORS
+
+All errors turn into calls to C<croak> (see L<Carp(3)>).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Win::Hivex;
+
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load ('Win::Hivex');
+
+=item open
+
+ $h = Win::Hivex->open ($filename,";
+
+ List.iter (
+ fun (_, flag, _) ->
+ pr "\n [%s => 1,]" (String.lowercase flag)
+ ) open_flags;
+
+ pr ")
+
+Open a Windows Registry binary hive file.
+
+The C<verbose> and C<debug> flags enable different levels of
+debugging messages.
+
+The C<write> flag is required if you will be modifying the
+hive file (see L<hivex(3)/WRITING TO HIVE FILES>).
+
+This function returns a hive handle. The hive handle is
+closed automatically when its reference count drops to 0.
+
+=cut
+
+sub open {
+ my $proto = shift;
+ my $class = ref ($proto) || $proto;
+ my $filename = shift;
+ my %%flags = @_;
+ my $flags = 0;
+
+";
+
+ List.iter (
+ fun (n, flag, description) ->
+ pr " # %s\n" description;
+ pr " $flags += %d if $flags{%s};\n" n (String.lowercase flag)
+ ) open_flags;
+
+ pr "\
+
+ my $self = Win::Hivex::_open ($filename, $flags);
+ bless $self, $class;
+ return $self;
+}
+
+";
+
+ List.iter (
+ fun (name, style, _, longdesc) ->
+ (* The close call isn't explicit in Perl: handles are closed
+ * when their reference count drops to 0.
+ *
+ * The open call is coded specially in Perl.
+ *
+ * Therefore we don't generate prototypes for these two calls:
+ *)
+ if fst style <> RErrDispose && List.hd (snd style) = AHive then (
+ let longdesc = replace_str longdesc "C<hivex_" "C<" in
+ pr "=item %s\n\n " name;
+ generate_perl_prototype name style;
+ pr "\n\n";
+ pr "%s\n\n" longdesc;
+
+ (match fst style with
+ | RErr
+ | RErrDispose
+ | RHive
+ | RString
+ | RStringList
+ | RLenType
+ | RLenTypeVal
+ | RInt32
+ | RInt64 -> ()
+ | RNode ->
+ pr "\
+This returns a node handle.\n\n"
+ | RNodeNotFound ->
+ pr "\
+This returns a node handle, or C<undef> if the node was not found.\n\n"
+ | RNodeList ->
+ pr "\
+This returns a list of node handles.\n\n"
+ | RValue ->
+ pr "\
+This returns a value handle.\n\n"
+ | RValueList ->
+ pr "\
+This returns a list of value handles.\n\n"
+ );
+
+ if List.mem ASetValues (snd style) then
+ pr "C<@values> is an array of (keys, value) pairs.
+Each element should be a hashref containing C<key>, C<t> (type)
+and C<data>.
+
+Any existing values stored at the node are discarded, and their
+C<value> handles become invalid. Thus you can remove all
+values stored at C<node> by passing C<@values = []>.\n\n"
+ )
+ ) functions;
+
+ pr "\
+=cut
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) %s Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<hivex(3)>,
+L<hivexsh(1)>,
+L<http://libguestfs.org>,
+L<Sys::Guestfs(3)>.
+
+=cut
+" copyright_years
+
+and generate_perl_prototype name style =
+ (* Return type. *)
+ (match fst style with
+ | RErr
+ | RErrDispose -> ()
+ | RHive -> pr "$h = "
+ | RNode
+ | RNodeNotFound -> pr "$node = "
+ | RNodeList -> pr "@nodes = "
+ | RValue -> pr "$value = "
+ | RValueList -> pr "@values = "
+ | RString -> pr "$string = "
+ | RStringList -> pr "@strings = "
+ | RLenType -> pr "($type, $len) = "
+ | RLenTypeVal -> pr "($type, $data) = "
+ | RInt32 -> pr "$int32 = "
+ | RInt64 -> pr "$int64 = "
+ );
+
+ let args = List.tl (snd style) in
+
+ (* AUnusedFlags is dropped in the bindings. *)
+ let args = List.filter ((<>) AUnusedFlags) args in
+
+ pr "$h->%s (" name;
+
+ let comma = ref false in
+ List.iter (
+ fun arg ->
+ if !comma then pr ", "; comma := true;
+ match arg with
+ | AHive -> pr "$h"
+ | ANode n
+ | AValue n
+ | AString n -> pr "$%s" n
+ | AStringNullable n -> pr "[$%s|undef]" n
+ | AOpenFlags -> pr "[flags]"
+ | AUnusedFlags -> assert false
+ | ASetValues -> pr "\\@values"
+ ) args;
+
+ pr ")"
+
+and generate_perl_xs () =
+ generate_header CStyle LGPLv2plus;
+
+ pr "\
+#include \"EXTERN.h\"
+#include \"perl.h\"
+#include \"XSUB.h\"
+
+#include <string.h>
+#include <hivex.h>
+
+#ifndef PRId64
+#define PRId64 \"lld\"
+#endif
+
+static SV *
+my_newSVll(long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSViv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, \"%%\" PRId64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+#ifndef PRIu64
+#define PRIu64 \"llu\"
+#endif
+
+#if 0
+static SV *
+my_newSVull(unsigned long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSVuv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, \"%%\" PRIu64, val);
+ return newSVpv(buf, len);
+#endif
+}
+#endif
+
+#if 0
+/* http://www.perlmonks.org/?node_id=680842 */
+static char **
+XS_unpack_charPtrPtr (SV *arg) {
+ char **ret;
+ AV *av;
+ I32 i;
+
+ if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
+ croak (\"array reference expected\");
+
+ av = (AV *)SvRV (arg);
+ ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
+ if (!ret)
+ croak (\"malloc failed\");
+
+ for (i = 0; i <= av_len (av); i++) {
+ SV **elem = av_fetch (av, i, 0);
+
+ if (!elem || !*elem)
+ croak (\"missing element in list\");
+
+ ret[i] = SvPV_nolen (*elem);
+ }
+
+ ret[i] = NULL;
+
+ return ret;
+}
+#endif
+
+/* Handle set_values parameter. */
+typedef struct pl_set_values {
+ size_t nr_values;
+ hive_set_value *values;
+} pl_set_values;
+
+static pl_set_values
+unpack_pl_set_values (SV *sv)
+{
+ pl_set_values ret;
+ AV *av;
+ I32 i;
+
+ if (!sv || !SvOK (sv) || !SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
+ croak (\"array reference expected\");
+
+ av = (AV *)SvRV(sv);
+ ret.nr_values = av_len (av) + 1;
+ ret.values = malloc (ret.nr_values * sizeof (hive_set_value));
+ if (!ret.values)
+ croak (\"malloc failed\");
+
+ for (i = 0; i <= av_len (av); i++) {
+ SV **hvp = av_fetch (av, i, 0);
+
+ if (!hvp || !*hvp || !SvROK (*hvp) || SvTYPE (SvRV (*hvp)) != SVt_PVHV)
+ croak (\"missing element in list or not a hash ref\");
+
+ HV *hv = (HV *)SvRV(*hvp);
+
+ SV **svp;
+ svp = hv_fetch (hv, \"key\", 3, 0);
+ if (!svp || !*svp)
+ croak (\"missing 'key' in hash\");
+ ret.values[i].key = SvPV_nolen (*svp);
+
+ svp = hv_fetch (hv, \"t\", 1, 0);
+ if (!svp || !*svp)
+ croak (\"missing 't' in hash\");
+ ret.values[i].t = SvIV (*svp);
+
+ svp = hv_fetch (hv, \"value\", 5, 0);
+ if (!svp || !*svp)
+ croak (\"missing 'value' in hash\");
+ ret.values[i].value = SvPV (*svp, ret.values[i].len);
+ }
+
+ return ret;
+}
+
+MODULE = Win::Hivex PACKAGE = Win::Hivex
+
+PROTOTYPES: ENABLE
+
+hive_h *
+_open (filename, flags)
+ char *filename;
+ int flags;
+ CODE:
+ RETVAL = hivex_open (filename, flags);
+ if (!RETVAL)
+ croak (\"hivex_open: %%s: %%s\", filename, strerror (errno));
+ OUTPUT:
+ RETVAL
+
+void
+DESTROY (h)
+ hive_h *h;
+ PPCODE:
+ if (hivex_close (h) == -1)
+ croak (\"hivex_close: %%s\", strerror (errno));
+
+";
+
+ List.iter (
+ fun (name, style, _, longdesc) ->
+ (* The close and open calls are handled specially above. *)
+ if fst style <> RErrDispose && List.hd (snd style) = AHive then (
+ (match fst style with
+ | RErr -> pr "void\n"
+ | RErrDispose -> failwith "perl bindings cannot handle a call which disposes of the handle"
+ | RHive -> failwith "perl bindings cannot handle a call which returns a handle"
+ | RNode
+ | RNodeNotFound
+ | RValue
+ | RString -> pr "SV *\n"
+ | RNodeList
+ | RValueList
+ | RStringList
+ | RLenType
+ | RLenTypeVal -> pr "void\n"
+ | RInt32 -> pr "SV *\n"
+ | RInt64 -> pr "SV *\n"
+ );
+
+ (* Call and arguments. *)
+ let perl_params =
+ filter_map (function
+ | AUnusedFlags -> None
+ | arg -> Some (name_of_argt arg)) (snd style) in
+
+ let c_params =
+ List.map (function
+ | AUnusedFlags -> "0"
+ | ASetValues -> "values.nr_values, values.values"
+ | arg -> name_of_argt arg) (snd style) in
+
+ pr "%s (%s)\n" name (String.concat ", " perl_params);
+ iteri (
+ fun i ->
+ function
+ | AHive ->
+ pr " hive_h *h;\n"
+ | ANode n
+ | AValue n ->
+ pr " int %s;\n" n
+ | AString n ->
+ pr " char *%s;\n" n
+ | AStringNullable n ->
+ (* http://www.perlmonks.org/?node_id=554277 *)
+ pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n i i
+ | AOpenFlags ->
+ pr " int flags;\n"
+ | AUnusedFlags -> ()
+ | ASetValues ->
+ pr " pl_set_values values = unpack_pl_set_values (ST(%d));\n" i
+ ) (snd style);
+
+ let free_args () =
+ List.iter (
+ function
+ | ASetValues ->
+ pr " free (values.values);\n"
+ | AHive | ANode _ | AValue _ | AString _ | AStringNullable _
+ | AOpenFlags | AUnusedFlags -> ()
+ ) (snd style)
+ in
+
+ (* Code. *)
+ (match fst style with
+ | RErr ->
+ pr "PREINIT:\n";
+ pr " int r;\n";
+ pr " PPCODE:\n";
+ pr " r = hivex_%s (%s);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == -1)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+
+ | RErrDispose -> assert false
+ | RHive -> assert false
+
+ | RInt32
+ | RNode
+ | RValue ->
+ pr "PREINIT:\n";
+ pr " /* hive_node_h = hive_value_h = size_t so we cheat\n";
+ pr " here to simplify the generator */\n";
+ pr " size_t r;\n";
+ pr " CODE:\n";
+ pr " r = hivex_%s (%s);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == 0)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+ pr " RETVAL = newSViv (r);\n";
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+
+ | RNodeNotFound ->
+ pr "PREINIT:\n";
+ pr " hive_node_h r;\n";
+ pr " CODE:\n";
+ pr " errno = 0;\n";
+ pr " r = hivex_%s (%s);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == 0 && errno != 0)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+ pr " if (r == 0)\n";
+ pr " RETVAL = &PL_sv_undef;\n";
+ pr " else\n";
+ pr " RETVAL = newSViv (r);\n";
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+
+ | RString ->
+ pr "PREINIT:\n";
+ pr " char *r;\n";
+ pr " CODE:\n";
+ pr " r = hivex_%s (%s);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == NULL)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+ pr " RETVAL = newSVpv (r, 0);\n";
+ pr " free (r);\n";
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+
+ | RNodeList
+ | RValueList ->
+ pr "PREINIT:\n";
+ pr " size_t *r;\n";
+ pr " int i, n;\n";
+ pr " PPCODE:\n";
+ pr " r = hivex_%s (%s);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == NULL)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+ pr " for (n = 0; r[n] != 0; ++n) /**/;\n";
+ pr " EXTEND (SP, n);\n";
+ pr " for (i = 0; i < n; ++i)\n";
+ pr " PUSHs (sv_2mortal (newSViv (r[i])));\n";
+ pr " free (r);\n";
+
+ | RStringList ->
+ pr "PREINIT:\n";
+ pr " char **r;\n";
+ pr " int i, n;\n";
+ pr " PPCODE:\n";
+ pr " r = hivex_%s (%s);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == NULL)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+ pr " for (n = 0; r[n] != NULL; ++n) /**/;\n";
+ pr " EXTEND (SP, n);\n";
+ pr " for (i = 0; i < n; ++i) {\n";
+ pr " PUSHs (sv_2mortal (newSVpv (r[i], 0)));\n";
+ pr " free (r[i]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+
+ | RLenType ->
+ pr "PREINIT:\n";
+ pr " int r;\n";
+ pr " size_t len;\n";
+ pr " hive_type type;\n";
+ pr " PPCODE:\n";
+ pr " r = hivex_%s (%s, &len, &type);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == -1)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+ pr " EXTEND (SP, 2);\n";
+ pr " PUSHs (sv_2mortal (newSViv (type)));\n";
+ pr " PUSHs (sv_2mortal (newSViv (len)));\n";
+
+ | RLenTypeVal ->
+ pr "PREINIT:\n";
+ pr " char *r;\n";
+ pr " size_t len;\n";
+ pr " hive_type type;\n";
+ pr " PPCODE:\n";
+ pr " r = hivex_%s (%s, &len, &type);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == NULL)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+ pr " EXTEND (SP, 2);\n";
+ pr " PUSHs (sv_2mortal (newSViv (type)));\n";
+ pr " PUSHs (sv_2mortal (newSVpv (r, len)));\n";
+ pr " free (r);\n";
+
+ | RInt64 ->
+ pr "PREINIT:\n";
+ pr " int64_t r;\n";
+ pr " CODE:\n";
+ pr " errno = 0;\n";
+ pr " r = hivex_%s (%s);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == -1 && errno != 0)\n";
+ pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+ name;
+ pr " RETVAL = my_newSVll (r);\n";
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+ );
+ pr "\n"
+ )
+ ) functions
+
+and generate_python_py () =
+ generate_header HashStyle LGPLv2plus
+
+and generate_python_c () =
+ generate_header CStyle LGPLv2plus
+
let output_to filename k =
let filename_new = filename ^ ".new" in
chan := open_out filename_new;
check_functions ();
- output_to "hivex/hivex.h" generate_c_header;
- output_to "hivex/hivex.pod" generate_c_pod;
+ output_to "lib/hivex.h" generate_c_header;
+ output_to "lib/hivex.pod" generate_c_pod;
+
+ output_to "ocaml/hivex.mli" generate_ocaml_interface;
+ output_to "ocaml/hivex.ml" generate_ocaml_implementation;
+ output_to "ocaml/hivex_c.c" generate_ocaml_c;
+
+ output_to "perl/lib/Win/Hivex.pm" generate_perl_pm;
+ output_to "perl/Hivex.xs" generate_perl_xs;
+
+(*
+ We ran out of time before we could write the Python bindings.
+ output_to "python/hivex.py" generate_python_py;
+ output_to "python/hivex-py.c" generate_python_c;
+*)
(* Always generate this file last, and unconditionally. It's used
* by the Makefile to know when we must re-run the generator.
git.annexia.org / hivex.git / blobdiff