#!/usr/bin/env ocaml
(* hivex
- * Copyright (C) 2009-2010 Red Hat Inc.
+ * Copyright (C) 2009-2011 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
(* This script generates language bindings and some documentation for
* hivex.
- *
+ *
* After editing this file, run it (./generator/generator.ml) to
* regenerate all the output files. 'make' will rerun this
* automatically when necessary. Note that if you are using a separate
* build directory you must run generator.ml from the _source_
* directory.
- *
+ *
* IMPORTANT: This script should NOT print any warnings. If it prints
* warnings, you should treat them as errors.
- *
+ *
* OCaml tips: (1) In emacs, install tuareg-mode to display and format
* OCaml code correctly. 'vim' comes with a good OCaml editing mode by
* default. (2) Read the resources at http://ocaml-tutorial.org/
#load "unix.cma";;
#load "str.cma";;
-#directory "+xml-light";;
-#load "xml-light.cma";;
open Unix
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. *)
+ | RSize (* Returns size_t or 0. *)
| 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. *)
+ | RLenValue (* Returns offset and length of value. *)
| RString (* Returns char* or NULL. *)
| RStringList (* Returns char** or NULL. *)
| RLenType (* See hivex_value_type. *)
| AOpenFlags (* HIVEX_OPEN_* flags list. *)
| AUnusedFlags (* Flags arg that is always 0 *)
| ASetValues (* See hivex_node_set_values. *)
+ | ASetValue (* See hivex_node_set_value. *)
(* Hive types, from:
* https://secure.wikimedia.org/wikipedia/en/wiki/Windows_Registry#Keys_and_values
- *
+ *
* It's unfortunate that in our original C binding we strayed away from
* the names that Windows uses (eg. REG_SZ for strings). We include
* both our names and the Windows names.
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.
"root", (RNode, [AHive]),
"return the root node of the hive",
"\
-Return root node of the hive. All valid registries must contain
-a root node.";
+Return root node of the hive. All valid hives must contain a root node.";
+
+ "last_modified", (RInt64, [AHive]),
+ "return the modification time from the header of the hive",
+ "\
+Return the modification time from the header of the hive.
+
+The returned value is a Windows filetime.
+To convert this to a Unix C<time_t> see:
+L<http://stackoverflow.com/questions/6161776/convert-windows-filetime-to-second-in-unix-linux/6161842#6161842>";
"node_name", (RString, [AHive; ANode "node"]),
"return the name of the node",
file this hive originally comes from, which is knowledge that is
outside the scope of this library.";
+ "node_timestamp", (RInt64, [AHive; ANode "node"]),
+ "return the modification time of the node",
+ "\
+Return the modification time of the node.
+
+The returned value is a Windows filetime.
+To convert this to a Unix C<time_t> see:
+L<http://stackoverflow.com/questions/6161776/convert-windows-filetime-to-second-in-unix-linux/6161842#6161842>";
+
"node_children", (RNodeList, [AHive; ANode "node"]),
"return children of node",
"\
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",
inside hives that has no meaning and won't give you the
default key.";
+ "value_key_len", (RSize, [AHive; AValue "val"]),
+ "return the length of a value's key",
+ "\
+Return the length of the key (name) of a (key, value) pair. The
+length can legitimately be 0, so errno is the necesary mechanism
+to check for errors.
+
+In the context of Windows Registries, a zero-length name means
+that this value is the default key for this node in the tree.
+This is usually written as C<\"@\">.";
+
"value_key", (RString, [AHive; AValue "val"]),
"return the key of a (key, value) pair",
"\
below which can be used to return the value in a more useful form when
you know the type in advance.";
+ "node_struct_length", (RSize, [AHive; ANode "node"]),
+ "return the length of a node",
+ "\
+Return the length of the node data structure.";
+
+ "value_struct_length", (RSize, [AHive; AValue "val"]),
+ "return the length of a value data structure",
+ "\
+Return the length of the value data structure.";
+
+ "value_data_cell_offset", (RLenValue, [AHive; AValue "val"]),
+ "return the offset and length of a value data cell",
+ "\
+Return the offset and length of the value's data cell.
+
+The data cell is a registry structure that contains the length
+(a 4 byte, little endian integer) followed by the data.
+
+If the length of the value is less than or equal to 4 bytes
+then the offset and length returned by this function is zero
+as the data is inlined in the value.
+
+Returns 0 and sets errno on error.";
+
"value_value", (RLenTypeVal, [AHive; AValue "val"]),
"return data length, data type and data of a value",
"\
"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>.
+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.
+C<node> is the node to modify.";
-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>.
+ "node_set_value", (RErr, [AHive; ANode "node"; ASetValue; AUnusedFlags]),
+ "set a single (key, value) pair at a given node",
+ "\
+This call can be used to replace a single C<(key, value)> pair
+stored in C<node>. If the key does not already exist, then a
+new key is added. Key matching is case insensitive.
-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. *)
-let pod2text_memo_filename = "generator/.pod2text.data"
-let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
- try
- let chan = open_in pod2text_memo_filename in
- let v = input_value chan in
- close_in chan;
- v
- with
- _ -> Hashtbl.create 13
-let pod2text_memo_updated () =
- let chan = open_out pod2text_memo_filename in
- output_value chan pod2text_memo;
- close_out chan
-
(* Useful functions.
* Note we don't want to use any external OCaml libraries which
* makes this a bit harder than it should be.
let trim ?(test = isspace) str =
trimr ~test (triml ~test str)
+(* Used to memoize the result of pod2text. *)
+let pod2text_memo_filename = "generator/.pod2text.data.version.2"
+let pod2text_memo : ((int option * bool * bool * string * string), string list) Hashtbl.t =
+ try
+ let chan = open_in pod2text_memo_filename in
+ let v = input_value chan in
+ close_in chan;
+ v
+ with
+ _ -> Hashtbl.create 13
+let pod2text_memo_updated () =
+ let chan = open_out pod2text_memo_filename in
+ output_value chan pod2text_memo;
+ close_out chan
+
+(* Useful if you need the longdesc POD text as plain text. Returns a
+ * list of lines.
+ *
+ * Because this is very slow (the slowest part of autogeneration),
+ * we memoize the results.
+ *)
+let pod2text ?width ?(trim = true) ?(discard = true) name longdesc =
+ let key = width, trim, discard, name, longdesc in
+ try Hashtbl.find pod2text_memo key
+ with Not_found ->
+ let filename, chan = Filename.open_temp_file "gen" ".tmp" in
+ fprintf chan "=head1 %s\n\n%s\n" name longdesc;
+ close_out chan;
+ let cmd =
+ match width with
+ | Some width ->
+ sprintf "pod2text -w %d %s" width (Filename.quote filename)
+ | None ->
+ sprintf "pod2text %s" (Filename.quote filename) in
+ let chan = open_process_in cmd in
+ let lines = ref [] in
+ let rec loop i =
+ let line = input_line chan in
+ if i = 1 && discard then (* discard the first line of output *)
+ loop (i+1)
+ else (
+ let line = if trim then triml line else line in
+ lines := line :: !lines;
+ loop (i+1)
+ ) in
+ let lines = try loop 1 with End_of_file -> List.rev !lines in
+ unlink filename;
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED i ->
+ failwithf "pod2text: process exited with non-zero status (%d)" i
+ | WSIGNALED i | WSTOPPED i ->
+ failwithf "pod2text: process signalled or stopped by signal %d" i
+ );
+ Hashtbl.add pod2text_memo key lines;
+ pod2text_memo_updated ();
+ lines
+
let rec find s sub =
let len = String.length s in
let sublen = String.length sub in
| ANode n | AValue n | AString n | AStringNullable n -> n
| AOpenFlags | AUnusedFlags -> "flags"
| ASetValues -> "values"
+ | ASetValue -> "val"
(* Check function names etc. for consistency. *)
let check_functions () =
| 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;
#ifndef HIVEX_H_
#define HIVEX_H_
+#include <stdlib.h>
#include <stdint.h>
#ifdef __cplusplus
typedef size_t hive_node_h;
typedef size_t hive_value_h;
+#include <errno.h>
+#ifdef ENOKEY
+# define HIVEX_NO_KEY ENOKEY
+#else
+# define HIVEX_NO_KEY ENOENT
+#endif
+
/* Pre-defined types. */
enum hive_type {
";
if extern then pr "extern ";
(match fst style with
| RErr -> pr "int "
+ | RErrDispose -> pr "int "
| RHive -> pr "hive_h *"
+ | RSize -> pr "size_t "
| 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 *"
| RString -> pr "char *"
| RStringList -> pr "char **"
+ | RLenValue -> pr "hive_value_h "
| RLenType -> pr "int "
| RLenTypeVal -> pr "char *"
| RInt32 -> pr "int32_t "
| AString n | AStringNullable n -> pr "const char *%s" n
| AOpenFlags | AUnusedFlags -> pr "int flags"
| ASetValues -> pr "size_t nr_values, const hive_set_value *values"
+ | ASetValue -> pr "const hive_set_value *val"
) (snd style);
(match fst style with
| RLenType | RLenTypeVal -> pr ", hive_type *t, size_t *len"
+ | RLenValue -> pr ", size_t *len"
| _ -> ()
);
pr ");\n"
=head1 SYNOPSIS
#include <hivex.h>
-
+
";
List.iter (
fun (shortname, style, _, _) ->
=head1 DESCRIPTION
-libhivex is a library for extracting the contents of Windows Registry
+Hivex is a library for extracting the contents of Windows Registry
\"hive\" files. It is designed to be secure against buggy or malicious
registry files.
-Unlike many other tools in this area, it doesn't use the textual .REG
-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 navigate the file (see L<hivexsh(1)>).
+Unlike other tools in this area, it doesn't use the textual .REG
+format, because parsing that is as much trouble as parsing the
+original binary format. Instead it makes the file available
+through a C API, and then wraps this API in higher level scripting
+and GUI tools.
+
+There is a separate program to export the hive as XML
+(see L<hivexml(1)>), or to navigate the file (see L<hivexsh(1)>).
+There is also a Perl script to export and merge the
+file as a textual .REG (regedit) file, see L<hivexregedit(1)>.
+
+If you just want to export or modify the Registry of a Windows
+virtual machine, you should look at L<virt-win-reg(1)>.
+
+Hivex is also comes with language bindings for
+OCaml, Perl, Python and Ruby.
=head1 TYPES
-=head2 hive_h *
+=head2 C<hive_h *>
This handle describes an open hive file.
-=head2 hive_node_h
+=head2 C<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.
-=head2 hive_type
+=head2 C<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 "\
};
-=head2 hive_value_h
+=head2 C<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.
-=head2 hive_set_value
+=head2 C<hive_set_value>
The typedef C<hive_set_value> is used in conjunction with the
C<hivex_node_set_values> call described below.
fun (shortname, style, _, longdesc) ->
let name = "hivex_" ^ shortname in
pr "=head2 %s\n" name;
- pr "\n";
+ 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";
+
+ if List.mem ASetValue (snd style) then
+ pr "C<value> is a single (key, value) pair.
+
+Existing C<hive_value_h> handles become invalid.\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.
On error this returns NULL and sets errno.\n\n"
+ | RSize ->
+ pr "\
+Returns a size.
+On error this returns 0 and sets errno.\n\n"
| RNode ->
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.
| RLenType ->
pr "\
Returns 0 on success.
-On error this returns NULL and sets errno.\n\n"
+On error this returns -1 and sets errno.\n\n"
+ | RLenValue ->
+ pr "\
+Returns a value handle.
+On error this returns 0 and sets errno.\n\n"
| RLenTypeVal ->
pr "\
The value is returned as an array of bytes (of length C<len>).
=item *
Creating a new hive file from scratch. This is impossible at present
-because not all fields in the header are understood.
+because not all fields in the header are understood. In the hivex
+source tree is a file called C<images/minimal> which could be used as
+the basis for a new hive (but I<caveat emptor>).
=item *
=head2 RELATIONSHIP TO .REG FILES
-Although this library does not care about or deal with Windows reg
-files, it's useful to look at the relationship between the registry
-itself and reg files because they are so common.
+The hivex C library does not care about or deal with Windows .REG
+files. Instead we push this complexity up to the Perl
+L<Win::Hivex(3)> library and the Perl programs
+L<hivexregedit(1)> and L<virt-win-reg(1)>.
+Nevertheless it is useful to look at the relationship between the
+Registry and .REG files because they are so common.
-A reg file is a text representation of the registry, or part of the
+A .REG file is a textual representation of the registry, or part of the
registry. The actual registry hives that Windows uses are binary
files. There are a number of Windows and Linux tools that let you
-generate reg files, or merge reg files back into the registry hives.
+generate .REG files, or merge .REG files back into the registry hives.
Notable amongst them is Microsoft's REGEDIT program (formerly known as
REGEDT32).
-A typical reg file will contain many sections looking like this:
+A typical .REG file will contain many sections looking like this:
[HKEY_LOCAL_MACHINE\\SOFTWARE\\Classes\\Stack]
\"@\"=\"Generic Stack\"
This is the path to this node in the registry tree. The first part,
C<HKEY_LOCAL_MACHINE\\SOFTWARE> means that this comes from a hive
-(file) called C<SOFTWARE>. C<\\Classes\\Stack> is the real path part,
+file called C<C:\\WINDOWS\\SYSTEM32\\CONFIG\\SOFTWARE>.
+C<\\Classes\\Stack> is the real path part,
starting at the root node of the C<SOFTWARE> hive.
Below the node name is a list of zero or more key-value pairs. Any
\"@\"=\"Generic Stack\"
This is the \"default key\". In reality (ie. inside the binary hive)
-the key string is the empty string. In reg files this is written as
+the key string is the empty string. In .REG files this is written as
C<@> but this has no meaning either in the hives themselves or in this
library. The value is a string (type 1 - see C<enum hive_type>
above).
This is a regular (key, value) pair, with the value being a type 1
string. Note that inside the binary file the string is likely to be
-UTF-16 encoded. This library converts to and from UTF-8 strings
-transparently.
+UTF-16LE encoded. This library converts to and from UTF-8 strings
+transparently in some cases.
\"TilePath\"=str(2):\"%%systemroot%%\\\\system32\"
\"FriendlyTypeName\"=hex(2):40,00,....
-This value is an expanded string (type 2) represented in the reg file
+This value is an expanded string (type 2) represented in the .REG file
as a series of hex bytes. In this case the string appears to be a
-UTF-16 string.
+UTF-16LE string.
=head1 NOTE ON THE USE OF ERRNO
Corrupt or unsupported Registry file format.
-=item ENOKEY
+=item HIVEX_NO_KEY
Missing root key.
=head1 SEE ALSO
+L<hivexget(1)>,
L<hivexml(1)>,
L<hivexsh(1)>,
+L<hivexregedit(1)>,
L<virt-win-reg(1)>,
+L<Win::Hivex(3)>,
L<guestfs(3)>,
L<http://libguestfs.org/>,
L<virt-cat(1)>,
Lesser General Public License for more details.
"
-let output_to filename k =
- let filename_new = filename ^ ".new" in
- chan := open_out filename_new;
- k ();
- close_out !chan;
- chan := Pervasives.stdout;
+(* Generate the linker script which controls the visibility of
+ * symbols in the public ABI and ensures no other symbols get
+ * exported accidentally.
+ *)
+and generate_linker_script () =
+ generate_header HashStyle GPLv2plus;
+
+ let globals = [
+ "hivex_visit";
+ "hivex_visit_node"
+ ] in
+
+ let functions =
+ List.map (fun (name, _, _, _) -> "hivex_" ^ name)
+ functions in
+ let globals = List.sort compare (globals @ functions) in
+
+ pr "{\n";
+ pr " global:\n";
+ List.iter (pr " %s;\n") globals;
+ pr "\n";
- (* Is the new file different from the current file? *)
- if Sys.file_exists filename && files_equal filename filename_new then
- unlink filename_new (* same, so skip it *)
- else (
- (* different, overwrite old one *)
- (try chmod filename 0o644 with Unix_error _ -> ());
- rename filename_new filename;
- chmod filename 0o444;
- printf "written %s\n%!" filename;
- )
+ pr " local:\n";
+ pr " *;\n";
+ pr "};\n"
-let perror msg = function
- | Unix_error (err, _, _) ->
- eprintf "%s: %s\n" msg (error_message err)
- | exn ->
- eprintf "%s: %s\n" msg (Printexc.to_string exn)
+and generate_ocaml_interface () =
+ generate_header OCamlStyle LGPLv2plus;
-(* Main program. *)
+ 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 () =
- let lock_fd =
- try openfile "configure.ac" [O_RDWR] 0
- with
- | Unix_error (ENOENT, _, _) ->
- eprintf "\
-You are probably running this from the wrong directory.
-Run it from the top source directory using the command
- generator/generator.ml
+ Callback.register_exception \"ocaml_hivex_error\"
+ (Error (\"\", Unix.EUNKNOWNERR 0, \"\"));
+ Callback.register_exception \"ocaml_hivex_closed\" (Handle_closed \"\")
+
+type hive_type =
";
- exit 1
- | exn ->
- perror "open: configure.ac" exn;
- exit 1 in
+ iteri (
+ fun i ->
+ fun (t, _, new_style, _) ->
+ assert (i = t);
+ pr " | REG_%s\n" new_style
+ ) hive_types;
- (* Acquire a lock so parallel builds won't try to run the generator
- * twice at the same time. Subsequent builds will wait for the first
- * one to finish. Note the lock is released implicitly when the
- * program exits.
- *)
- (try lockf lock_fd F_LOCK 1
- with exn ->
- perror "lock: configure.ac" exn;
- exit 1);
+ pr "\
+ | REG_UNKNOWN of int32
- check_functions ();
+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 -> "
+ | ASetValue -> pr "set_value -> "
+ ) (snd style);
+ (match fst style with
+ | RErr -> pr "unit" (* all errors are turned into exceptions *)
+ | RErrDispose -> pr "unit"
+ | RHive -> pr "t"
+ | RSize -> pr "int64"
+ | 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"
+ | RLenValue -> pr "int * value"
+ | 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 *HiveSetValue_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_len_value (size_t, hive_value_h);
+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"]]
+ | RLenValue -> c_params @ [["&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"
+ | ASetValue ->
+ pr " hive_set_value *val = HiveSetValue_val (valv);\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"
+ | RSize -> pr " size_t r;\n"; "0"
+ | 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"
+ | RLenValue ->
+ pr " errno = 0;";
+ pr " hive_value_h r;\n";
+ pr " size_t len;\n";
+ "0 && errno != 0"
+ | 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";
+ | ASetValue ->
+ pr " free (val);\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"
+ | RSize -> pr " rv = caml_copy_int64 (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"
+ | RLenValue -> pr " rv = copy_len_value (len, r);\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_int64 (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 *
+HiveSetValue_val (value v)
+{
+ hive_set_value *val = malloc (sizeof (hive_set_value));
+
+ val->key = String_val (Field (v, 0));
+ val->t = HiveType_val (Field (v, 1));
+ val->len = caml_string_length (Field (v, 2));
+ val->value = String_val (Field (v, 2));
+
+ return val;
+}
+
+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, v);
+ CAMLreturn (rv);
+}
+
+static value
+copy_len_value (size_t len, hive_value_h r)
+{
+ CAMLparam0 ();
+ CAMLlocal2 (v, rv);
+
+ rv = caml_alloc (2, 0);
+ v = Val_int (len);
+ Store_field (rv, 0, v);
+ v = Val_int (r);
+ Store_field (rv, 1, v);
+ 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), v);
+ 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
+ | RLenValue
+ | RLenTypeVal
+ | RInt32
+ | RInt64 -> ()
+ | RSize ->
+ pr "\
+This returns a size.\n\n"
+ | 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 = "
+ | RSize -> pr "$size = "
+ | RNode
+ | RNodeNotFound -> pr "$node = "
+ | RNodeList -> pr "@nodes = "
+ | RValue -> pr "$value = "
+ | RValueList -> pr "@values = "
+ | RString -> pr "$string = "
+ | RStringList -> pr "@strings = "
+ | RLenType -> pr "($type, $len) = "
+ | RLenValue -> pr "($len, $value) = "
+ | 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"
+ | ASetValue -> pr "$val"
+ ) 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>
+#include <inttypes.h>
+
+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
+}
+
+#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;
+}
+
+static hive_set_value *
+unpack_set_value (SV *sv)
+{
+ hive_set_value *ret;
+
+ if (!sv || !SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVHV)
+ croak (\"not a hash ref\");
+
+ ret = malloc (sizeof (hive_set_value));
+ if (ret == NULL)
+ croak (\"malloc failed\");
+
+ HV *hv = (HV *)SvRV(sv);
+
+ SV **svp;
+ svp = hv_fetch (hv, \"key\", 3, 0);
+ if (!svp || !*svp)
+ croak (\"missing 'key' in hash\");
+ ret->key = SvPV_nolen (*svp);
+
+ svp = hv_fetch (hv, \"t\", 1, 0);
+ if (!svp || !*svp)
+ croak (\"missing 't' in hash\");
+ ret->t = SvIV (*svp);
+
+ svp = hv_fetch (hv, \"value\", 5, 0);
+ if (!svp || !*svp)
+ croak (\"missing 'value' in hash\");
+ ret->value = SvPV (*svp, ret->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"
+ | RSize
+ | RNode
+ | RNodeNotFound
+ | RValue
+ | RString -> pr "SV *\n"
+ | RNodeList
+ | RValueList
+ | RStringList
+ | RLenType
+ | RLenValue
+ | 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
+ | ASetValue ->
+ pr " hive_set_value *val = unpack_set_value (ST(%d));\n" i
+ ) (snd style);
+
+ let free_args () =
+ List.iter (
+ function
+ | ASetValues ->
+ pr " free (values.values);\n"
+ | ASetValue ->
+ pr " free (val);\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
+
+ | RSize
+ | 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, &type, &len);\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";
+
+ | RLenValue ->
+ pr "PREINIT:\n";
+ pr " hive_value_h r;\n";
+ pr " size_t len;\n";
+ pr " PPCODE:\n";
+ pr " errno = 0;\n";
+ pr " r = hivex_%s (%s, &len);\n"
+ name (String.concat ", " c_params);
+ free_args ();
+ pr " if (r == 0 && errno)\n";
+ pr " croak (\"%%s: \", \"%s\", strerror (errno));\n"
+ name;
+ pr " EXTEND (SP, 2);\n";
+ pr " PUSHs (sv_2mortal (newSViv (len)));\n";
+ pr " PUSHs (sv_2mortal (newSViv (r)));\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, &type, &len);\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 (newSVpvn (r, len)));\n";
+ pr " free (r);\n";
+
+ | RInt32 ->
+ pr "PREINIT:\n";
+ pr " int32_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 = newSViv (r);\n";
+ pr " OUTPUT:\n";
+ pr " RETVAL\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_c () =
+ generate_header CStyle LGPLv2plus;
+
+ pr "\
+#include <config.h>
+
+#define PY_SSIZE_T_CLEAN 1
+#include <Python.h>
+
+#if PY_VERSION_HEX < 0x02050000
+typedef int Py_ssize_t;
+#define PY_SSIZE_T_MAX INT_MAX
+#define PY_SSIZE_T_MIN INT_MIN
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#include \"hivex.h\"
+
+#ifndef HAVE_PYCAPSULE_NEW
+typedef struct {
+ PyObject_HEAD
+ hive_h *h;
+} Pyhivex_Object;
+#endif
+
+static hive_h *
+get_handle (PyObject *obj)
+{
+ assert (obj);
+ assert (obj != Py_None);
+#ifndef HAVE_PYCAPSULE_NEW
+ return ((Pyhivex_Object *) obj)->h;
+#else
+ return (hive_h *) PyCapsule_GetPointer(obj, \"hive_h\");
+#endif
+}
+
+static PyObject *
+put_handle (hive_h *h)
+{
+ assert (h);
+#ifndef HAVE_PYCAPSULE_NEW
+ return
+ PyCObject_FromVoidPtrAndDesc ((void *) h, (char *) \"hive_h\", NULL);
+#else
+ return PyCapsule_New ((void *) h, \"hive_h\", NULL);
+#endif
+}
+
+/* This returns pointers into the Python objects, which should
+ * not be freed.
+ */
+static int
+get_value (PyObject *v, hive_set_value *ret)
+{
+ PyObject *obj;
+#ifndef HAVE_PYSTRING_ASSTRING
+ PyObject *bytes;
+#endif
+
+ obj = PyDict_GetItemString (v, \"key\");
+ if (!obj) {
+ PyErr_SetString (PyExc_RuntimeError, \"no 'key' element in dictionary\");
+ return -1;
+ }
+#ifdef HAVE_PYSTRING_ASSTRING
+ ret->key = PyString_AsString (obj);
+#else
+ bytes = PyUnicode_AsUTF8String (obj);
+ ret->key = PyBytes_AS_STRING (bytes);
+#endif
+
+ obj = PyDict_GetItemString (v, \"t\");
+ if (!obj) {
+ PyErr_SetString (PyExc_RuntimeError, \"no 't' element in dictionary\");
+ return -1;
+ }
+ ret->t = PyLong_AsLong (obj);
+
+ obj = PyDict_GetItemString (v, \"value\");
+ if (!obj) {
+ PyErr_SetString (PyExc_RuntimeError, \"no 'value' element in dictionary\");
+ return -1;
+ }
+#ifdef HAVE_PYSTRING_ASSTRING
+ ret->value = PyString_AsString (obj);
+ ret->len = PyString_Size (obj);
+#else
+ bytes = PyUnicode_AsUTF8String (obj);
+ ret->value = PyBytes_AS_STRING (bytes);
+ ret->len = PyBytes_GET_SIZE (bytes);
+#endif
+
+ return 0;
+}
+
+typedef struct py_set_values {
+ size_t nr_values;
+ hive_set_value *values;
+} py_set_values;
+
+static int
+get_values (PyObject *v, py_set_values *ret)
+{
+ Py_ssize_t slen;
+ size_t len, i;
+
+ if (!PyList_Check (v)) {
+ PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
+ return -1;
+ }
+
+ slen = PyList_Size (v);
+ if (slen < 0) {
+ PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
+ return -1;
+ }
+ len = (size_t) slen;
+ ret->nr_values = len;
+ ret->values = malloc (len * sizeof (hive_set_value));
+ if (!ret->values) {
+ PyErr_SetString (PyExc_RuntimeError, strerror (errno));
+ return -1;
+ }
+
+ for (i = 0; i < len; ++i) {
+ if (get_value (PyList_GetItem (v, i), &(ret->values[i])) == -1) {
+ free (ret->values);
+ return -1;
+ }
+ }
+
+ return 0;
+}
+
+static PyObject *
+put_string_list (char * const * const argv)
+{
+ PyObject *list;
+ size_t argc, i;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ ;
+
+ list = PyList_New (argc);
+ for (i = 0; i < argc; ++i) {
+#ifdef HAVE_PYSTRING_ASSTRING
+ PyList_SetItem (list, i, PyString_FromString (argv[i]));
+#else
+ PyList_SetItem (list, i, PyUnicode_FromString (argv[i]));
+#endif
+ }
+
+ return list;
+}
+
+static void
+free_strings (char **argv)
+{
+ size_t argc;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ free (argv[argc]);
+ free (argv);
+}
+
+/* Since hive_node_t is the same as hive_value_t this also works for values. */
+static PyObject *
+put_node_list (hive_node_h *nodes)
+{
+ PyObject *list;
+ size_t argc, i;
+
+ for (argc = 0; nodes[argc] != 0; ++argc)
+ ;
+
+ list = PyList_New (argc);
+ for (i = 0; i < argc; ++i)
+ PyList_SetItem (list, i, PyLong_FromLongLong ((long) nodes[i]));
+
+ return list;
+}
+
+static PyObject *
+put_len_type (size_t len, hive_type t)
+{
+ PyObject *r = PyTuple_New (2);
+ PyTuple_SetItem (r, 0, PyLong_FromLong ((long) t));
+ PyTuple_SetItem (r, 1, PyLong_FromLongLong ((long) len));
+ return r;
+}
+
+static PyObject *
+put_len_val (size_t len, hive_value_h value)
+{
+ PyObject *r = PyTuple_New (2);
+ PyTuple_SetItem (r, 0, PyLong_FromLongLong ((long) len));
+ PyTuple_SetItem (r, 1, PyLong_FromLongLong ((long) value));
+ return r;
+}
+
+static PyObject *
+put_val_type (char *val, size_t len, hive_type t)
+{
+ PyObject *r = PyTuple_New (2);
+ PyTuple_SetItem (r, 0, PyLong_FromLong ((long) t));
+#ifdef HAVE_PYSTRING_ASSTRING
+ PyTuple_SetItem (r, 1, PyString_FromStringAndSize (val, len));
+#else
+ PyTuple_SetItem (r, 1, PyBytes_FromStringAndSize (val, len));
+#endif
+ return r;
+}
+
+";
+
+ (* Generate functions. *)
+ List.iter (
+ fun (name, style, _, longdesc) ->
+ pr "static PyObject *\n";
+ pr "py_hivex_%s (PyObject *self, PyObject *args)\n" name;
+ pr "{\n";
+ pr " PyObject *py_r;\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"
+ | RSize -> pr " size_t r;\n"; "0"
+ | 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"
+ | RLenValue ->
+ pr " errno = 0;\n";
+ pr " int r;\n";
+ pr " size_t len;\n";
+ "0 && errno != 0"
+ | 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
+
+ (* Call and arguments. *)
+ let c_params =
+ List.map (function
+ | AUnusedFlags -> "0"
+ | ASetValues -> "values.nr_values, values.values"
+ | ASetValue -> "&val"
+ | arg -> name_of_argt arg) (snd style) in
+ let c_params =
+ match fst style with
+ | RLenType | RLenTypeVal -> c_params @ ["&t"; "&len"]
+ | RLenValue -> c_params @ ["&len"]
+ | _ -> c_params in
+
+ List.iter (
+ function
+ | AHive ->
+ pr " hive_h *h;\n";
+ pr " PyObject *py_h;\n"
+ | ANode n
+ | AValue n ->
+ pr " long %s;\n" n
+ | AString n
+ | AStringNullable n ->
+ pr " char *%s;\n" n
+ | AOpenFlags ->
+ pr " int flags;\n"
+ | AUnusedFlags -> ()
+ | ASetValues ->
+ pr " py_set_values values;\n";
+ pr " PyObject *py_values;\n"
+ | ASetValue ->
+ pr " hive_set_value val;\n";
+ pr " PyObject *py_val;\n"
+ ) (snd style);
+
+ pr "\n";
+
+ (* Convert the required parameters. *)
+ pr " if (!PyArg_ParseTuple (args, (char *) \"";
+ List.iter (
+ function
+ | AHive ->
+ pr "O"
+ | ANode n
+ | AValue n ->
+ pr "l"
+ | AString n ->
+ pr "s"
+ | AStringNullable n ->
+ pr "z"
+ | AOpenFlags ->
+ pr "i"
+ | AUnusedFlags -> ()
+ | ASetValues
+ | ASetValue ->
+ pr "O"
+ ) (snd style);
+
+ pr ":hivex_%s\"" name;
+
+ List.iter (
+ function
+ | AHive ->
+ pr ", &py_h"
+ | ANode n
+ | AValue n ->
+ pr ", &%s" n
+ | AString n
+ | AStringNullable n ->
+ pr ", &%s" n
+ | AOpenFlags ->
+ pr ", &flags"
+ | AUnusedFlags -> ()
+ | ASetValues ->
+ pr ", &py_values"
+ | ASetValue ->
+ pr ", &py_val"
+ ) (snd style);
+
+ pr "))\n";
+ pr " return NULL;\n";
+
+ (* Convert some Python argument types to C. *)
+ List.iter (
+ function
+ | AHive ->
+ pr " h = get_handle (py_h);\n"
+ | ANode _
+ | AValue _
+ | AString _
+ | AStringNullable _
+ | AOpenFlags
+ | AUnusedFlags -> ()
+ | ASetValues ->
+ pr " if (get_values (py_values, &values) == -1)\n";
+ pr " return NULL;\n"
+ | ASetValue ->
+ pr " if (get_value (py_val, &val) == -1)\n";
+ pr " return NULL;\n"
+ ) (snd style);
+
+ (* Call the C function. *)
+ pr " r = hivex_%s (%s);\n" name (String.concat ", " c_params);
+
+ (* Free up arguments. *)
+ List.iter (
+ function
+ | AHive | ANode _ | AValue _
+ | AString _ | AStringNullable _
+ | AOpenFlags | AUnusedFlags -> ()
+ | ASetValues ->
+ pr " free (values.values);\n"
+ | ASetValue -> ()
+ ) (snd style);
+
+ (* Check for errors from C library. *)
+ pr " if (r == %s) {\n" error_code;
+ pr " PyErr_SetString (PyExc_RuntimeError,\n";
+ pr " strerror (errno));\n";
+ pr " return NULL;\n";
+ pr " }\n";
+ pr "\n";
+
+ (* Convert return value to Python. *)
+ (match fst style with
+ | RErr
+ | RErrDispose ->
+ pr " Py_INCREF (Py_None);\n";
+ pr " py_r = Py_None;\n"
+ | RHive ->
+ pr " py_r = put_handle (r);\n"
+ | RSize
+ | RNode ->
+ pr " py_r = PyLong_FromLongLong (r);\n"
+ | RNodeNotFound ->
+ pr " if (r)\n";
+ pr " py_r = PyLong_FromLongLong (r);\n";
+ pr " else {\n";
+ pr " Py_INCREF (Py_None);\n";
+ pr " py_r = Py_None;\n";
+ pr " }\n";
+ | RNodeList
+ | RValueList ->
+ pr " py_r = put_node_list (r);\n";
+ pr " free (r);\n"
+ | RValue ->
+ pr " py_r = PyLong_FromLongLong (r);\n"
+ | RString ->
+ pr "#ifdef HAVE_PYSTRING_ASSTRING\n";
+ pr " py_r = PyString_FromString (r);\n";
+ pr "#else\n";
+ pr " py_r = PyUnicode_FromString (r);\n";
+ pr "#endif\n";
+ pr " free (r);"
+ | RStringList ->
+ pr " py_r = put_string_list (r);\n";
+ pr " free_strings (r);\n"
+ | RLenType ->
+ pr " py_r = put_len_type (len, t);\n"
+ | RLenValue ->
+ pr " py_r = put_len_val (len, r);\n"
+ | RLenTypeVal ->
+ pr " py_r = put_val_type (r, len, t);\n";
+ pr " free (r);\n"
+ | RInt32 ->
+ pr " py_r = PyLong_FromLong ((long) r);\n"
+ | RInt64 ->
+ pr " py_r = PyLong_FromLongLong (r);\n"
+ );
+ pr " return py_r;\n";
+ pr "}\n";
+ pr "\n"
+ ) functions;
+
+ (* Table of functions. *)
+ pr "static PyMethodDef methods[] = {\n";
+ List.iter (
+ fun (name, _, _, _) ->
+ pr " { (char *) \"%s\", py_hivex_%s, METH_VARARGS, NULL },\n"
+ name name
+ ) functions;
+ pr " { NULL, NULL, 0, NULL }\n";
+ pr "};\n";
+ pr "\n";
+
+ (* Init function. *)
+ pr "\
+#if PY_MAJOR_VERSION >= 3
+static struct PyModuleDef moduledef = {
+ PyModuleDef_HEAD_INIT,
+ \"libhivexmod\", /* m_name */
+ \"hivex module\", /* m_doc */
+ -1, /* m_size */
+ methods, /* m_methods */
+ NULL, /* m_reload */
+ NULL, /* m_traverse */
+ NULL, /* m_clear */
+ NULL, /* m_free */
+};
+#endif
+
+static PyObject *
+moduleinit (void)
+{
+ PyObject *m;
+
+#if PY_MAJOR_VERSION >= 3
+ m = PyModule_Create (&moduledef);
+#else
+ m = Py_InitModule ((char *) \"libhivexmod\", methods);
+#endif
+
+ return m; /* m might be NULL if module init failed */
+}
+
+#if PY_MAJOR_VERSION >= 3
+PyMODINIT_FUNC
+PyInit_libhivexmod (void)
+{
+ return moduleinit ();
+}
+#else
+void
+initlibhivexmod (void)
+{
+ (void) moduleinit ();
+}
+#endif
+"
+
+and generate_python_py () =
+ generate_header HashStyle LGPLv2plus;
+
+ pr "\
+\"\"\"Python bindings for hivex
+
+import hivex
+h = hivex.Hivex (filename)
+
+The hivex module provides Python bindings to the hivex API for
+examining and modifying Windows Registry 'hive' files.
+
+Read the hivex(3) man page to find out how to use the API.
+\"\"\"
+
+import libhivexmod
+
+class Hivex:
+ \"\"\"Instances of this class are hivex API handles.\"\"\"
+
+ def __init__ (self, filename";
+
+ List.iter (
+ fun (_, flag, _) -> pr ", %s = False" (String.lowercase flag)
+ ) open_flags;
+
+ pr "):
+ \"\"\"Create a new hivex handle.\"\"\"
+ flags = 0
+";
+
+ List.iter (
+ fun (n, flag, description) ->
+ pr " # %s\n" description;
+ pr " if %s: flags += %d\n" (String.lowercase flag) n
+ ) open_flags;
+
+ pr " self._o = libhivexmod.open (filename, flags)
+
+ def __del__ (self):
+ libhivexmod.close (self._o)
+
+";
+
+ List.iter (
+ fun (name, style, shortdesc, _) ->
+ (* The close and open calls are handled specially above. *)
+ if fst style <> RErrDispose && List.hd (snd style) = AHive then (
+ let args = List.tl (snd style) in
+ let args = List.filter (
+ function AOpenFlags | AUnusedFlags -> false
+ | _ -> true
+ ) args in
+
+ pr " def %s (self" name;
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
+ pr "):\n";
+ pr " \"\"\"%s\"\"\"\n" shortdesc;
+ pr " return libhivexmod.%s (self._o" name;
+ List.iter (
+ fun arg ->
+ pr ", ";
+ match arg with
+ | AHive -> assert false
+ | ANode n | AValue n
+ | AString n | AStringNullable n -> pr "%s" n
+ | AOpenFlags
+ | AUnusedFlags -> assert false
+ | ASetValues -> pr "values"
+ | ASetValue -> pr "val"
+ ) args;
+ pr ")\n";
+ pr "\n"
+ )
+ ) functions
+
+and generate_ruby_c () =
+ generate_header CStyle LGPLv2plus;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+
+#include <ruby.h>
+
+#include \"hivex.h\"
+
+#include \"extconf.h\"
+
+/* For Ruby < 1.9 */
+#ifndef RARRAY_LEN
+#define RARRAY_LEN(r) (RARRAY((r))->len)
+#endif
+
+#ifndef RSTRING_LEN
+#define RSTRING_LEN(r) (RSTRING((r))->len)
+#endif
+
+#ifndef RSTRING_PTR
+#define RSTRING_PTR(r) (RSTRING((r))->ptr)
+#endif
+
+static VALUE m_hivex; /* hivex module */
+static VALUE c_hivex; /* hive_h handle */
+static VALUE e_Error; /* used for all errors */
+
+static void
+ruby_hivex_free (void *hvp)
+{
+ hive_h *h = hvp;
+
+ if (h)
+ hivex_close (h);
+}
+
+static void
+get_value (VALUE valv, hive_set_value *val)
+{
+ VALUE key = rb_hash_lookup (valv, ID2SYM (rb_intern (\"key\")));
+ VALUE type = rb_hash_lookup (valv, ID2SYM (rb_intern (\"type\")));
+ VALUE value = rb_hash_lookup (valv, ID2SYM (rb_intern (\"value\")));
+
+ val->key = StringValueCStr (key);
+ val->t = NUM2ULL (type);
+ val->len = RSTRING_LEN (value);
+ val->value = RSTRING_PTR (value);
+}
+
+static hive_set_value *
+get_values (VALUE valuesv, size_t *nr_values)
+{
+ size_t i;
+ hive_set_value *ret;
+
+ *nr_values = RARRAY_LEN (valuesv);
+ ret = malloc (sizeof (*ret) * *nr_values);
+ if (ret == NULL)
+ abort ();
+
+ for (i = 0; i < *nr_values; ++i) {
+ VALUE v = rb_ary_entry (valuesv, i);
+ get_value (v, &ret[i]);
+ }
+
+ return ret;
+}
+
+";
+
+ List.iter (
+ fun (name, (ret, args), shortdesc, longdesc) ->
+ let () =
+ (* Generate rdoc. *)
+ let doc = replace_str longdesc "C<hivex_" "C<h." in
+ let doc = pod2text ~width:60 name doc in
+ let doc = String.concat "\n * " doc in
+ let doc = trim doc in
+
+ let call, args =
+ match args with
+ | AHive :: args -> "h." ^ name, args
+ | args -> "Hivex::" ^ name, args in
+ let args = filter_map (
+ function
+ | AUnusedFlags -> None
+ | args -> Some (name_of_argt args)
+ ) args in
+ let args = String.concat ", " args in
+
+ let ret =
+ match ret with
+ | RErr | RErrDispose -> "nil"
+ | RHive -> "Hivex::Hivex"
+ | RSize | RNode | RNodeNotFound -> "integer"
+ | RNodeList -> "list"
+ | RValue -> "integer"
+ | RValueList -> "list"
+ | RString -> "string"
+ | RStringList -> "list"
+ | RLenType -> "hash"
+ | RLenValue -> "integer"
+ | RLenTypeVal -> "hash"
+ | RInt32 -> "integer"
+ | RInt64 -> "integer" in
+
+ pr "\
+/*
+ * call-seq:
+ * %s(%s) -> %s
+ *
+ * %s
+ *
+ * %s
+ *
+ * (For the C API documentation for this function, see
+ * +hivex_%s+[http://libguestfs.org/hivex.3.html#hivex_%s]).
+ */
+" call args ret shortdesc doc name name in
+
+ (* Generate the function. *)
+ pr "static VALUE\n";
+ pr "ruby_hivex_%s (" name;
+
+ let () =
+ (* If the first argument is not AHive, then this is a module-level
+ * function, and Ruby passes an implicit module argument which we
+ * must ignore. Otherwise the first argument is the hive handle.
+ *)
+ let args =
+ match args with
+ | AHive :: args -> pr "VALUE hv"; args
+ | args -> pr "VALUE modulev"; args in
+ List.iter (
+ function
+ | AUnusedFlags -> ()
+ | arg ->
+ pr ", VALUE %sv" (name_of_argt arg)
+ ) args;
+ pr ")\n" in
+
+ pr "{\n";
+
+ List.iter (
+ function
+ | AHive ->
+ pr " hive_h *h;\n";
+ pr " Data_Get_Struct (hv, hive_h, h);\n";
+ pr " if (!h)\n";
+ pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\",\n";
+ pr " \"%s\");\n" name;
+ | ANode n ->
+ pr " hive_node_h %s = NUM2ULL (%sv);\n" n n
+ | AValue n ->
+ pr " hive_value_h %s = NUM2ULL (%sv);\n" n n
+ | AString n ->
+ pr " const char *%s = StringValueCStr (%sv);\n" n n;
+ | AStringNullable n ->
+ pr " const char *%s =\n" n;
+ pr " !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n
+ | AOpenFlags ->
+ pr " int flags = 0;\n";
+ List.iter (
+ fun (n, flag, _) ->
+ pr " if (RTEST (rb_hash_lookup (flagsv, ID2SYM (rb_intern (\"%s\")))))\n"
+ (String.lowercase flag);
+ pr " flags += %d;\n" n
+ ) open_flags
+ | AUnusedFlags -> ()
+ | ASetValues ->
+ pr " size_t nr_values;\n";
+ pr " hive_set_value *values;\n";
+ pr " values = get_values (valuesv, &nr_values);\n"
+ | ASetValue ->
+ pr " hive_set_value val;\n";
+ pr " get_value (valv, &val);\n"
+ ) args;
+ pr "\n";
+
+ let error_code =
+ match ret with
+ | RErr -> pr " int r;\n"; "-1"
+ | RErrDispose -> pr " int r;\n"; "-1"
+ | RHive -> pr " hive_h *r;\n"; "NULL"
+ | RSize -> pr " size_t r;\n"; "0"
+ | 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"
+ | RLenValue ->
+ pr " errno = 0;\n";
+ pr " hive_value_h r;\n";
+ pr " size_t len;\n";
+ "0 && errno != 0"
+ | 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
+ pr "\n";
+
+ let c_params =
+ List.map (function
+ | ASetValues -> ["nr_values"; "values"]
+ | ASetValue -> ["&val"]
+ | AUnusedFlags -> ["0"]
+ | arg -> [name_of_argt arg]) args in
+ let c_params =
+ match ret with
+ | RLenType | RLenTypeVal -> c_params @ [["&t"; "&len"]]
+ | RLenValue -> c_params @ [["&len"]]
+ | _ -> c_params in
+ let c_params = List.concat c_params in
+
+ pr " r = hivex_%s (%s" name (List.hd c_params);
+ List.iter (pr ", %s") (List.tl c_params);
+ pr ");\n";
+ pr "\n";
+
+ (* Dispose of the hive handle (even if hivex_close returns error). *)
+ (match ret with
+ | RErrDispose ->
+ pr " /* So we don't double-free in the finalizer. */\n";
+ pr " DATA_PTR (hv) = NULL;\n";
+ pr "\n";
+ | _ -> ()
+ );
+
+ List.iter (
+ function
+ | AHive
+ | ANode _
+ | AValue _
+ | AString _
+ | AStringNullable _
+ | AOpenFlags
+ | AUnusedFlags -> ()
+ | ASetValues ->
+ pr " free (values);\n"
+ | ASetValue -> ()
+ ) args;
+
+ (* Check for errors from C library. *)
+ pr " if (r == %s)\n" error_code;
+ pr " rb_raise (e_Error, \"%%s\", strerror (errno));\n";
+ pr "\n";
+
+ (match ret with
+ | RErr | RErrDispose ->
+ pr " return Qnil;\n"
+ | RHive ->
+ pr " return Data_Wrap_Struct (c_hivex, NULL, ruby_hivex_free, r);\n"
+ | RSize
+ | RNode
+ | RValue
+ | RInt64 ->
+ pr " return ULL2NUM (r);\n"
+ | RInt32 ->
+ pr " return INT2NUM (r);\n"
+ | RNodeNotFound ->
+ pr " if (r)\n";
+ pr " return ULL2NUM (r);\n";
+ pr " else\n";
+ pr " return Qnil;\n"
+ | RNodeList
+ | RValueList ->
+ pr " size_t i, len = 0;\n";
+ pr " for (i = 0; r[i] != 0; ++i) len++;\n";
+ pr " VALUE rv = rb_ary_new2 (len);\n";
+ pr " for (i = 0; r[i] != 0; ++i)\n";
+ pr " rb_ary_push (rv, ULL2NUM (r[i]));\n";
+ pr " free (r);\n";
+ pr " return rv;\n"
+ | RString ->
+ pr " VALUE rv = rb_str_new2 (r);\n";
+ pr " free (r);\n";
+ pr " return rv;\n"
+ | RStringList ->
+ pr " size_t i, len = 0;\n";
+ pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
+ pr " VALUE rv = rb_ary_new2 (len);\n";
+ pr " for (i = 0; r[i] != NULL; ++i) {\n";
+ pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
+ pr " free (r[i]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ pr " return rv;\n"
+ | RLenType ->
+ pr " VALUE rv = rb_hash_new ();\n";
+ pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
+ pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"type\")), INT2NUM (t));\n";
+ pr " return rv;\n"
+ | RLenValue ->
+ pr " VALUE rv = rb_hash_new ();\n";
+ pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
+ pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"off\")), ULL2NUM (r));\n";
+ pr " return rv;\n"
+ | RLenTypeVal ->
+ pr " VALUE rv = rb_hash_new ();\n";
+ pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
+ pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"type\")), INT2NUM (t));\n";
+ pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"value\")), rb_str_new (r, len));\n";
+ pr " free (r);\n";
+ pr " return rv;\n"
+ );
+
+ pr "}\n";
+ pr "\n"
+ ) functions;
+
+ pr "\
+/* Initialize the module. */
+void Init__hivex ()
+{
+ m_hivex = rb_define_module (\"Hivex\");
+ c_hivex = rb_define_class_under (m_hivex, \"Hivex\", rb_cObject);
+ e_Error = rb_define_class_under (m_hivex, \"Error\", rb_eStandardError);
+
+ /* XXX How to pass arguments? */
+#if 0
+#ifdef HAVE_RB_DEFINE_ALLOC_FUNC
+ rb_define_alloc_func (c_hivex, ruby_hivex_open);
+#endif
+#endif
+
+";
+
+ (* Methods. *)
+ List.iter (
+ fun (name, (_, args), _, _) ->
+ let args = List.filter (
+ function
+ | AUnusedFlags -> false
+ | _ -> true
+ ) args in
+ let nr_args = List.length args in
+ match args with
+ | AHive :: _ ->
+ pr " rb_define_method (c_hivex, \"%s\",\n" name;
+ pr " ruby_hivex_%s, %d);\n" name (nr_args-1)
+ | args -> (* class function *)
+ pr " rb_define_module_function (m_hivex, \"%s\",\n" name;
+ pr " ruby_hivex_%s, %d);\n" name nr_args
+ ) functions;
+
+ pr "}\n"
+
+let output_to filename k =
+ let filename_new = filename ^ ".new" in
+ chan := open_out filename_new;
+ k ();
+ close_out !chan;
+ chan := Pervasives.stdout;
+
+ (* Is the new file different from the current file? *)
+ if Sys.file_exists filename && files_equal filename filename_new then
+ unlink filename_new (* same, so skip it *)
+ else (
+ (* different, overwrite old one *)
+ (try chmod filename 0o644 with Unix_error _ -> ());
+ rename filename_new filename;
+ chmod filename 0o444;
+ printf "written %s\n%!" filename;
+ )
+
+let perror msg = function
+ | Unix_error (err, _, _) ->
+ eprintf "%s: %s\n" msg (error_message err)
+ | exn ->
+ eprintf "%s: %s\n" msg (Printexc.to_string exn)
+
+(* Main program. *)
+let () =
+ let lock_fd =
+ try openfile "configure.ac" [O_RDWR] 0
+ with
+ | Unix_error (ENOENT, _, _) ->
+ eprintf "\
+You are probably running this from the wrong directory.
+Run it from the top source directory using the command
+ generator/generator.ml
+";
+ exit 1
+ | exn ->
+ perror "open: configure.ac" exn;
+ exit 1 in
+
+ (* Acquire a lock so parallel builds won't try to run the generator
+ * twice at the same time. Subsequent builds will wait for the first
+ * one to finish. Note the lock is released implicitly when the
+ * program exits.
+ *)
+ (try lockf lock_fd F_LOCK 1
+ with exn ->
+ perror "lock: configure.ac" exn;
+ exit 1);
+
+ check_functions ();
+
+ output_to "lib/hivex.h" generate_c_header;
+ output_to "lib/hivex.pod" generate_c_pod;
+
+ output_to "lib/hivex.syms" generate_linker_script;
+
+ 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;
+
+ output_to "python/hivex.py" generate_python_py;
+ output_to "python/hivex-py.c" generate_python_c;
- output_to "hivex/hivex.h" generate_c_header;
- output_to "hivex/hivex.pod" generate_c_pod;
+ output_to "ruby/ext/hivex/_hivex.c" generate_ruby_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