Add Ruby bindings.
[hivex.git] / generator / generator.ml
index 71c3b4f..de103ed 100755 (executable)
@@ -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
 
 (* 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
@@ -71,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.
@@ -157,8 +156,16 @@ but instead are lost.  See L<hivex(3)/WRITING TO HIVE FILES>.";
   "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",
@@ -172,6 +179,15 @@ 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<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",
     "\
@@ -251,7 +267,8 @@ C<hive_t_string>, C<hive_t_expand_string> or C<hive_t_link>.";
     "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"]),
@@ -271,14 +288,14 @@ works for values which have type C<hive_t_qword>.";
     "\
 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",
@@ -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<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.
@@ -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 <stdlib.h>
 #include <stdint.h>
 
 #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 <errno.h>
+#ifdef ENOKEY
+# define HIVEX_NO_KEY ENOKEY
+#else
+# define HIVEX_NO_KEY ENOENT
+#endif
+
 /* Pre-defined types. */
 enum hive_type {
 ";
@@ -812,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"
@@ -832,7 +903,7 @@ hivex - Windows Registry \"hive\" extraction library
 =head1 SYNOPSIS
 
  #include <hivex.h>
+
 ";
   List.iter (
     fun (shortname, style, _, _) ->
@@ -847,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<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
@@ -888,13 +970,13 @@ programs store everything (including strings) in binary blobs.
   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.
@@ -926,11 +1008,28 @@ 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<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 "\
@@ -984,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<len>).
@@ -1042,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<images/minimal> which could be used as
+the basis for a new hive (but I<caveat emptor>).
 
 =item *
 
@@ -1157,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<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\"
@@ -1187,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<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
@@ -1197,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<enum hive_type>
 above).
@@ -1206,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\"
 
@@ -1221,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
 
@@ -1237,7 +1342,7 @@ exhaustive):
 
 Corrupt or unsupported Registry file format.
 
-=item ENOKEY
+=item HIVEX_NO_KEY
 
 Missing root key.
 
@@ -1281,9 +1386,12 @@ useful for debugging problems with the library itself.
 
 =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)>,
@@ -1315,6 +1423,32 @@ 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;
 
@@ -1446,6 +1580,7 @@ and generate_ocaml_prototype ?(is_external = false) name style =
     | 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 *)
@@ -1487,13 +1622,36 @@ and generate_ocaml_c () =
 #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);
@@ -1567,6 +1725,8 @@ static void raise_closed (const char *) Noreturn;
         | 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";
 
@@ -1634,6 +1794,9 @@ static void raise_closed (const char *) Noreturn;
         | ASetValues ->
             pr "  free (values);\n";
             pr "\n";
+       | ASetValue ->
+           pr "  free (val);\n";
+           pr "\n";
       ) (snd style);
 
       (* Check for errors. *)
@@ -1670,7 +1833,7 @@ static void raise_closed (const char *) Noreturn;
            pr "  rv = copy_type_value (r, len, t);\n";
            pr "  free (r);\n"
        | RInt32 -> pr "  rv = caml_copy_int32 (r);\n"
-       | RInt64 -> pr "  rv = caml_copy_int32 (r);\n"
+       | RInt64 -> pr "  rv = caml_copy_int64 (r);\n"
       );
 
       pr "  CAMLreturn (rv);\n";
@@ -1696,6 +1859,19 @@ HiveOpenFlags_val (value v)
 }
 
 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);
@@ -1785,7 +1961,7 @@ copy_type_value (const char *r, size_t len, hive_type t)
   Store_field (rv, 0, v);
   v = caml_alloc_string (len);
   memcpy (String_val (v), r, len);
-  caml_modify (&Field (rv, 1), len);
+  caml_modify (&Field (rv, 1), v);
   CAMLreturn (rv);
 }
 
@@ -1852,81 +2028,1553 @@ Val_hiveh (hive_h *h)
 " max_hive_type
 
 and generate_perl_pm () =
-  generate_header HashStyle LGPLv2plus
+  generate_header HashStyle LGPLv2plus;
 
-and generate_perl_xs () =
-  generate_header CStyle LGPLv2plus
+  pr "\
+=pod
 
-and generate_python_py () =
-  generate_header HashStyle LGPLv2plus
+=head1 NAME
 
-and generate_python_c () =
-  generate_header CStyle LGPLv2plus
+Win::Hivex - Perl bindings for reading and writing Windows Registry hive files
 
-let output_to filename k =
-  let filename_new = filename ^ ".new" in
-  chan := open_out filename_new;
-  k ();
-  close_out !chan;
-  chan := Pervasives.stdout;
+=head1 SYNOPSIS
 
-  (* 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;
-  )
+ use Win::Hivex;
 
-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)
+ $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;
 
-(* 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);
+  List.iter (
+    fun (n, flag, description) ->
+      pr "  # %s\n" description;
+      pr "  $flags += %d if $flags{%s};\n" n (String.lowercase flag)
+  ) open_flags;
 
-  check_functions ();
+  pr "\
 
-  output_to "lib/hivex.h" generate_c_header;
-  output_to "lib/hivex.pod" generate_c_pod;
+  my $self = Win::Hivex::_open ($filename, $flags);
+  bless $self, $class;
+  return $self;
+}
 
-  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;
+  List.iter (
+    fun (name, style, _, longdesc) ->
+      (* The close call isn't explicit in Perl: handles are closed
+       * when their reference count drops to 0.
+       *
+       * The open call is coded specially in Perl.
+       *
+       * Therefore we don't generate prototypes for these two calls:
+       *)
+      if fst style <> RErrDispose && List.hd (snd style) = AHive then (
+       let longdesc = replace_str longdesc "C<hivex_" "C<" in
+       pr "=item %s\n\n " name;
+       generate_perl_prototype name style;
+       pr "\n\n";
+       pr "%s\n\n" longdesc;
+
+       (match fst style with
+        | RErr
+        | RErrDispose
+        | RHive
+        | RString
+        | RStringList
+        | RLenType
+        | RLenTypeVal
+        | RInt32
+        | RInt64 -> ()
+        | RNode ->
+            pr "\
+This returns a node handle.\n\n"
+        | RNodeNotFound ->
+            pr "\
+This returns a node handle, or C<undef> if the node was not found.\n\n"
+        | RNodeList ->
+            pr "\
+This returns a list of node handles.\n\n"
+        | RValue ->
+            pr "\
+This returns a value handle.\n\n"
+        | RValueList ->
+            pr "\
+This returns a list of value handles.\n\n"
+       );
+
+       if List.mem ASetValues (snd style) then
+         pr "C<@values> is an array of (keys, value) pairs.
+Each element should be a hashref containing C<key>, C<t> (type)
+and C<data>.
 
-  output_to "python/hivex.py" generate_python_py;
-  output_to "python/hivex-py.c" generate_python_c;
+Any existing values stored at the node are discarded, and their
+C<value> handles become invalid.  Thus you can remove all
+values stored at C<node> by passing C<@values = []>.\n\n"
+      )
+  ) functions;
+
+  pr "\
+=cut
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) %s Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<hivex(3)>,
+L<hivexsh(1)>,
+L<http://libguestfs.org>,
+L<Sys::Guestfs(3)>.
+
+=cut
+" copyright_years
+
+and generate_perl_prototype name style =
+  (* Return type. *)
+  (match fst style with
+   | RErr
+   | RErrDispose -> ()
+   | RHive -> pr "$h = "
+   | RNode
+   | RNodeNotFound -> pr "$node = "
+   | RNodeList -> pr "@nodes = "
+   | RValue -> pr "$value = "
+   | RValueList -> pr "@values = "
+   | RString -> pr "$string = "
+   | RStringList -> pr "@strings = "
+   | RLenType -> pr "($type, $len) = "
+   | RLenTypeVal -> pr "($type, $data) = "
+   | RInt32 -> pr "$int32 = "
+   | RInt64 -> pr "$int64 = "
+  );
+
+  let args = List.tl (snd style) in
+
+  (* AUnusedFlags is dropped in the bindings. *)
+  let args = List.filter ((<>) AUnusedFlags) args in
+
+  pr "$h->%s (" name;
+
+  let comma = ref false in
+  List.iter (
+    fun arg ->
+      if !comma then pr ", "; comma := true;
+      match arg with
+      | AHive -> pr "$h"
+      | ANode n
+      | AValue n
+      | AString n -> pr "$%s" n
+      | AStringNullable n -> pr "[$%s|undef]" n
+      | AOpenFlags -> pr "[flags]"
+      | AUnusedFlags -> assert false
+      | ASetValues -> pr "\\@values"
+      | 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"
+        | 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 <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;
+
+  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 <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
+
+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<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"
+          | 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;
+  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 "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.