X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=generator%2Fgenerator.ml;h=de103ed5d24fad04b52f21ccacba151595bf55dc;hb=49b89eec45780eceea5b72ad1a466f9549e788eb;hp=7a326db54f7fd68596104f3e0e149fc0984b5812;hpb=bc1784a2103d884f85a448af856d5c6254583979;p=hivex.git diff --git a/generator/generator.ml b/generator/generator.ml index 7a326db..de103ed 100755 --- a/generator/generator.ml +++ b/generator/generator.ml @@ -1,6 +1,6 @@ #!/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 @@ -19,16 +19,16 @@ (* 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/ @@ -36,8 +36,6 @@ #load "unix.cma";; #load "str.cma";; -#directory "+xml-light";; -#load "xml-light.cma";; open Unix open Printf @@ -45,8 +43,10 @@ open Printf type style = ret * args and ret = | RErr (* 0 = ok, -1 = error *) + | RErrDispose (* Disposes handle, see hivex_close. *) | RHive (* Returns a hive_h or NULL. *) | RNode (* Returns hive_node_h or 0. *) + | RNodeNotFound (* See hivex_node_get_child. *) | RNodeList (* Returns hive_node_h* or NULL. *) | RValue (* Returns hive_value_h or 0. *) | RValueList (* Returns hive_value_h* or NULL. *) @@ -69,10 +69,11 @@ and argt = (* Note, cannot be NULL/0 unless it | 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. @@ -103,6 +104,7 @@ let hive_types = [ 11, "qword", "QWORD", "QWORD (64 bit integer), unspecified endianness but usually little endian" ] +let max_hive_type = 11 (* Open flags (bitmask passed to AOpenFlags) *) let open_flags = [ @@ -143,7 +145,7 @@ See L. =back"; - "close", (RErr, [AHive]), + "close", (RErrDispose, [AHive]), "close a hive handle", "\ Close a hive handle and free all associated resources. @@ -154,8 +156,16 @@ but instead are lost. See L."; "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 see: +L"; "node_name", (RString, [AHive; ANode "node"]), "return the name of the node", @@ -169,21 +179,27 @@ only know the \"real\" name of the root node by knowing which registry 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 see: +L"; + "node_children", (RNodeList, [AHive; ANode "node"]), "return children of node", "\ Return an array of nodes which are the subkeys (children) of C."; - "node_get_child", (RNode, [AHive; ANode "node"; AString "name"]), + "node_get_child", (RNodeNotFound, [AHive; ANode "node"; AString "name"]), "return named child of node", "\ Return the child of node with the name C, if it exists. -The name is matched case insensitively. - -If the child node does not exist, this returns 0 without -setting errno."; +The name is matched case insensitively."; "node_parent", (RNode, [AHive; ANode "node"]), "return the parent of node", @@ -251,7 +267,8 @@ C, C or C."; "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."; "value_dword", (RInt32, [AHive; AValue "val"]), @@ -271,14 +288,14 @@ works for values which have type C."; "\ Commit (write) any changes which have been made. -C is the new file to write. If C is NULL then we -overwrite the original file (ie. the file name that was passed to -C). C is not used, always pass 0. +C is the new file to write. If C is null/undefined +then we overwrite the original file (ie. the file name that was passed to +C). 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 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", @@ -302,35 +319,21 @@ subnodes become invalid. You cannot delete the root 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. +This call can be used to set all the (key, value) pairs +stored in C. -C is the node to modify. C is an array of (key, value) -pairs. There should be C elements in this array. C -is not used, always pass 0. +C is the node to modify."; -Any existing values stored at the node are discarded, and their -C handles become invalid. Thus you can remove all -values stored at C by passing C. + "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. 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 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. @@ -377,6 +380,64 @@ let trimr ?(test = isspace) str = 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 @@ -465,6 +526,7 @@ let name_of_argt = function | 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 () = @@ -654,7 +716,7 @@ let generate_header ?(extra_inputs = []) comment license = | 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; @@ -685,6 +747,7 @@ let rec generate_c_header () = #ifndef HIVEX_H_ #define HIVEX_H_ +#include #include #ifdef __cplusplus @@ -700,6 +763,13 @@ typedef struct hive_h hive_h; typedef size_t hive_node_h; typedef size_t hive_value_h; +#include +#ifdef ENOKEY +# define HIVEX_NO_KEY ENOKEY +#else +# define HIVEX_NO_KEY ENOENT +#endif + /* Pre-defined types. */ enum hive_type { "; @@ -786,8 +856,10 @@ and generate_c_prototype ?(extern = false) name style = if extern then pr "extern "; (match fst style with | RErr -> pr "int " + | RErrDispose -> pr "int " | RHive -> pr "hive_h *" | RNode -> pr "hive_node_h " + | RNodeNotFound -> pr "hive_node_h " | RNodeList -> pr "hive_node_h *" | RValue -> pr "hive_value_h " | RValueList -> pr "hive_value_h *" @@ -810,6 +882,7 @@ and generate_c_prototype ?(extern = false) name style = | 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" @@ -830,7 +903,7 @@ hivex - Windows Registry \"hive\" extraction library =head1 SYNOPSIS #include - + "; List.iter ( fun (shortname, style, _, _) -> @@ -845,29 +918,40 @@ Link with I<-lhivex>. =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), or to navigate the file (see L). +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), or to navigate the file (see L). +There is also a Perl script to export and merge the +file as a textual .REG (regedit) file, see L. + +If you just want to export or modify the Registry of a Windows +virtual machine, you should look at L. + +Hivex is also comes with language bindings for +OCaml, Perl, Python and Ruby. =head1 TYPES -=head2 hive_h * +=head2 C This handle describes an open hive file. -=head2 hive_node_h +=head2 C 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 The enum below describes the possible types for the value(s) stored at each node. Note that you should not trust the @@ -886,13 +970,13 @@ programs store everything (including strings) in binary blobs. pr "\ }; -=head2 hive_value_h +=head2 C 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 The typedef C is used in conjunction with the C call described below. @@ -924,16 +1008,40 @@ here. Often it's not documented at all. 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 is an array of (key, value) pairs. There +should be C elements in this array. + +Any existing values stored at the node are discarded, and their +C handles become invalid. Thus you can remove all +values stored at C by passing C.\n\n"; + + if List.mem ASetValue (snd style) then + pr "C is a single (key, value) pair. + +Existing C 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. @@ -942,6 +1050,11 @@ On error this returns NULL and sets errno.\n\n" pr "\ Returns a node handle. On error this returns 0 and sets errno.\n\n" + | RNodeNotFound -> + pr "\ +Returns a node handle. +If the node was not found, this returns 0 without setting errno. +On error this returns 0 and sets errno.\n\n" | RNodeList -> pr "\ Returns a 0-terminated array of nodes. @@ -970,7 +1083,7 @@ On error this returns NULL and sets errno.\n\n" | 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" | RLenTypeVal -> pr "\ The value is returned as an array of bytes (of length C). @@ -1028,7 +1141,9 @@ Changing the root node. =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 which could be used as +the basis for a new hive (but I). =item * @@ -1143,18 +1258,21 @@ empty string for the default key). The value is a typed object =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 library and the Perl programs +L and L. +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\" @@ -1173,7 +1291,8 @@ Taking this one piece at a time: This is the path to this node in the registry tree. The first part, C means that this comes from a hive -(file) called C. C<\\Classes\\Stack> is the real path part, +file called C. +C<\\Classes\\Stack> is the real path part, starting at the root node of the C hive. Below the node name is a list of zero or more key-value pairs. Any @@ -1183,7 +1302,7 @@ attached. \"@\"=\"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 above). @@ -1192,8 +1311,8 @@ 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\" @@ -1207,9 +1326,9 @@ The value in this case is a dword (type 4). \"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 @@ -1223,7 +1342,7 @@ exhaustive): Corrupt or unsupported Registry file format. -=item ENOKEY +=item HIVEX_NO_KEY Missing root key. @@ -1267,9 +1386,12 @@ useful for debugging problems with the library itself. =head1 SEE ALSO +L, L, L, +L, L, +L, L, L, L, @@ -1301,6 +1423,2090 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. " +(* 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"; + + pr " local:\n"; + pr " *;\n"; + pr "};\n" + +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 -> " + | 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" + | 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 + +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include + +#ifdef HAVE_CAML_UNIXSUPPORT_H +#include +#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 + +#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_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" + | 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" + | 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"; + | 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" + | 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_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, 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), 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 module provides a Perl XS binding to the +L API for reading and writing Windows Registry binary +hive files. + +=head1 ERRORS + +All errors turn into calls to C (see L). + +=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 and C flags enable different levels of +debugging messages. + +The C flag is required if you will be modifying the +hive file (see L). + +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 () + | RNode -> + pr "\ +This returns a node handle.\n\n" + | RNodeNotFound -> + pr "\ +This returns a node handle, or C 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, C (type) +and C. + +Any existing values stored at the node are discarded, and their +C handles become invalid. Thus you can remove all +values stored at C 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, +L, +L, +L. + +=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" + | ASetValue -> pr "$val" + ) args; + + pr ")" + +and generate_perl_xs () = + generate_header CStyle LGPLv2plus; + + pr "\ +#include \"EXTERN.h\" +#include \"perl.h\" +#include \"XSUB.h\" + +#include +#include +#include + +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" + | 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 + | 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 + + | 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"; + + | 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 "\ +#define PY_SSIZE_T_CLEAN 1 +#include + +#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 +#include +#include + +#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; + + obj = PyDict_GetItemString (v, \"key\"); + if (!obj) { + PyErr_SetString (PyExc_RuntimeError, \"no 'key' element in dictionary\"); + return -1; + } + if (!PyString_Check (obj)) { + PyErr_SetString (PyExc_RuntimeError, \"'key' element is not a string\"); + return -1; + } + ret->key = PyString_AsString (obj); + + obj = PyDict_GetItemString (v, \"t\"); + if (!obj) { + PyErr_SetString (PyExc_RuntimeError, \"no 't' element in dictionary\"); + return -1; + } + if (!PyInt_Check (obj)) { + PyErr_SetString (PyExc_RuntimeError, \"'t' element is not an integer\"); + return -1; + } + ret->t = PyInt_AsLong (obj); + + obj = PyDict_GetItemString (v, \"value\"); + if (!obj) { + PyErr_SetString (PyExc_RuntimeError, \"no 'value' element in dictionary\"); + return -1; + } + if (!PyString_Check (obj)) { + PyErr_SetString (PyExc_RuntimeError, \"'value' element is not a string\"); + return -1; + } + ret->value = PyString_AsString (obj); + ret->len = PyString_Size (obj); + + 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) + PyList_SetItem (list, i, PyString_FromString (argv[i])); + + 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, PyInt_FromLong ((long) t)); + PyTuple_SetItem (r, 1, PyLong_FromLongLong ((long) len)); + return r; +} + +static PyObject * +put_val_type (char *val, size_t len, hive_type t) +{ + PyObject *r = PyTuple_New (2); + PyTuple_SetItem (r, 0, PyInt_FromLong ((long) t)); + PyTuple_SetItem (r, 1, PyString_FromStringAndSize (val, len)); + 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" + | 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 + + (* 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"] + | _ -> 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" + | 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 " py_r = PyString_FromString (r);\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" + | RLenTypeVal -> + pr " py_r = put_val_type (r, len, t);\n"; + pr " free (r);\n" + | RInt32 -> + pr " py_r = PyInt_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 "\ +void +initlibhivexmod (void) +{ + static int initialized = 0; + + if (initialized) return; + Py_InitModule ((char *) \"libhivexmod\", methods); + initialized = 1; +} +" + +and generate_python_py () = + generate_header HashStyle LGPLv2plus; + + pr "\ +u\"\"\"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 " u\"\"\"%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 +#include +#include + +#include + +#include \"hivex.h\" + +#include \"extconf.h\" + +/* For Ruby < 1.9 */ +#ifndef RARRAY_LEN +#define RARRAY_LEN(r) (RARRAY((r))->len) +#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 (value)->len; + val->value = RSTRING (value)->ptr; +} + +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 "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" + | RNode | RNodeNotFound -> "integer" + | RNodeList -> "list" + | RValue -> "integer" + | RValueList -> "list" + | RString -> "string" + | RStringList -> "list" + | RLenType -> "hash" + | 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" + | 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 + 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"]] + | _ -> 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" + | 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" + | 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; @@ -1356,6 +3562,20 @@ Run it from the top source directory using the command 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 "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. *)