3 * Copyright (C) 2009-2011 Red Hat Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (* This script generates language bindings and some documentation for
23 * After editing this file, run it (./generator/generator.ml) to
24 * regenerate all the output files. 'make' will rerun this
25 * automatically when necessary. Note that if you are using a separate
26 * build directory you must run generator.ml from the _source_
29 * IMPORTANT: This script should NOT print any warnings. If it prints
30 * warnings, you should treat them as errors.
32 * OCaml tips: (1) In emacs, install tuareg-mode to display and format
33 * OCaml code correctly. 'vim' comes with a good OCaml editing mode by
34 * default. (2) Read the resources at http://ocaml-tutorial.org/
43 type style = ret * args
45 | RErr (* 0 = ok, -1 = error *)
46 | RErrDispose (* Disposes handle, see hivex_close. *)
47 | RHive (* Returns a hive_h or NULL. *)
48 | RSize (* Returns size_t or 0. *)
49 | RNode (* Returns hive_node_h or 0. *)
50 | RNodeNotFound (* See hivex_node_get_child. *)
51 | RNodeList (* Returns hive_node_h* or NULL. *)
52 | RValue (* Returns hive_value_h or 0. *)
53 | RValueList (* Returns hive_value_h* or NULL. *)
54 | RLenValue (* Returns offset and length of value. *)
55 | RString (* Returns char* or NULL. *)
56 | RStringList (* Returns char** or NULL. *)
57 | RLenType (* See hivex_value_type. *)
58 | RLenTypeVal (* See hivex_value_value. *)
59 | RInt32 (* Returns int32. *)
60 | RInt64 (* Returns int64. *)
62 and args = argt list (* List of parameters. *)
64 and argt = (* Note, cannot be NULL/0 unless it
65 says so explicitly below. *)
67 | ANode of string (* hive_node_h *)
68 | AValue of string (* hive_value_h *)
69 | AString of string (* char* *)
70 | AStringNullable of string (* char* (can be NULL) *)
71 | AOpenFlags (* HIVEX_OPEN_* flags list. *)
72 | AUnusedFlags (* Flags arg that is always 0 *)
73 | ASetValues (* See hivex_node_set_values. *)
74 | ASetValue (* See hivex_node_set_value. *)
77 * https://secure.wikimedia.org/wikipedia/en/wiki/Windows_Registry#Keys_and_values
79 * It's unfortunate that in our original C binding we strayed away from
80 * the names that Windows uses (eg. REG_SZ for strings). We include
81 * both our names and the Windows names.
85 "Just a key without a value";
87 "A Windows string (encoding is unknown, but often UTF16-LE)";
88 2, "expand_string", "EXPAND_SZ",
89 "A Windows string that contains %env% (environment variable expansion)";
90 3, "binary", "BINARY",
93 "DWORD (32 bit integer), little endian";
94 5, "dword_be", "DWORD_BIG_ENDIAN",
95 "DWORD (32 bit integer), big endian";
97 "Symbolic link to another part of the registry tree";
98 7, "multiple_strings", "MULTI_SZ",
99 "Multiple Windows strings. See http://blogs.msdn.com/oldnewthing/archive/2009/10/08/9904646.aspx";
100 8, "resource_list", "RESOURCE_LIST",
102 9, "full_resource_description", "FULL_RESOURCE_DESCRIPTOR",
103 "Resource descriptor";
104 10, "resource_requirements_list", "RESOURCE_REQUIREMENTS_LIST",
105 "Resouce requirements list";
106 11, "qword", "QWORD",
107 "QWORD (64 bit integer), unspecified endianness but usually little endian"
109 let max_hive_type = 11
111 (* Open flags (bitmask passed to AOpenFlags) *)
113 1, "VERBOSE", "Verbose messages";
114 2, "DEBUG", "Debug messages";
115 4, "WRITE", "Enable writes to the hive";
120 "open", (RHive, [AString "filename"; AOpenFlags]),
123 Opens the hive named C<filename> for reading.
125 Flags is an ORed list of the open flags (or C<0> if you don't
126 want to pass any flags). These flags are defined:
130 =item HIVEX_OPEN_VERBOSE
134 =item HIVEX_OPEN_DEBUG
136 Very verbose messages, suitable for debugging problems in the library
139 This is also selected if the C<HIVEX_DEBUG> environment variable
142 =item HIVEX_OPEN_WRITE
144 Open the hive for writing. If omitted, the hive is read-only.
146 See L<hivex(3)/WRITING TO HIVE FILES>.
150 "close", (RErrDispose, [AHive]),
151 "close a hive handle",
153 Close a hive handle and free all associated resources.
155 Note that any uncommitted writes are I<not> committed by this call,
156 but instead are lost. See L<hivex(3)/WRITING TO HIVE FILES>.";
158 "root", (RNode, [AHive]),
159 "return the root node of the hive",
161 Return root node of the hive. All valid hives must contain a root node.";
163 "last_modified", (RInt64, [AHive]),
164 "return the modification time from the header of the hive",
166 Return the modification time from the header of the hive.
168 The returned value is a Windows filetime.
169 To convert this to a Unix C<time_t> see:
170 L<http://stackoverflow.com/questions/6161776/convert-windows-filetime-to-second-in-unix-linux/6161842#6161842>";
172 "node_name", (RString, [AHive; ANode "node"]),
173 "return the name of the node",
175 Return the name of the node.
177 Note that the name of the root node is a dummy, such as
178 C<$$$PROTO.HIV> (other names are possible: it seems to depend on the
179 tool or program that created the hive in the first place). You can
180 only know the \"real\" name of the root node by knowing which registry
181 file this hive originally comes from, which is knowledge that is
182 outside the scope of this library.";
184 "node_timestamp", (RInt64, [AHive; ANode "node"]),
185 "return the modification time of the node",
187 Return the modification time of the node.
189 The returned value is a Windows filetime.
190 To convert this to a Unix C<time_t> see:
191 L<http://stackoverflow.com/questions/6161776/convert-windows-filetime-to-second-in-unix-linux/6161842#6161842>";
193 "node_children", (RNodeList, [AHive; ANode "node"]),
194 "return children of node",
196 Return an array of nodes which are the subkeys
197 (children) of C<node>.";
199 "node_get_child", (RNodeNotFound, [AHive; ANode "node"; AString "name"]),
200 "return named child of node",
202 Return the child of node with the name C<name>, if it exists.
204 The name is matched case insensitively.";
206 "node_parent", (RNode, [AHive; ANode "node"]),
207 "return the parent of node",
209 Return the parent of C<node>.
211 The parent pointer of the root node in registry files that we
212 have examined seems to be invalid, and so this function will
213 return an error if called on the root node.";
215 "node_values", (RValueList, [AHive; ANode "node"]),
216 "return (key, value) pairs attached to a node",
218 Return the array of (key, value) pairs attached to this node.";
220 "node_get_value", (RValue, [AHive; ANode "node"; AString "key"]),
221 "return named key at node",
223 Return the value attached to this node which has the name C<key>,
226 The key name is matched case insensitively.
228 Note that to get the default key, you should pass the empty
229 string C<\"\"> here. The default key is often written C<\"@\">, but
230 inside hives that has no meaning and won't give you the
233 "value_key_len", (RSize, [AHive; AValue "val"]),
234 "return the length of a value's key",
236 Return the length of the key (name) of a (key, value) pair. The
237 length can legitimately be 0, so errno is the necesary mechanism
240 In the context of Windows Registries, a zero-length name means
241 that this value is the default key for this node in the tree.
242 This is usually written as C<\"@\">.";
244 "value_key", (RString, [AHive; AValue "val"]),
245 "return the key of a (key, value) pair",
247 Return the key (name) of a (key, value) pair. The name
248 is reencoded as UTF-8 and returned as a string.
250 The string should be freed by the caller when it is no longer needed.
252 Note that this function can return a zero-length string. In the
253 context of Windows Registries, this means that this value is the
254 default key for this node in the tree. This is usually written
257 "value_type", (RLenType, [AHive; AValue "val"]),
258 "return data length and data type of a value",
260 Return the data length and data type of the value in this (key, value)
261 pair. See also C<hivex_value_value> which returns all this
262 information, and the value itself. Also, C<hivex_value_*> functions
263 below which can be used to return the value in a more useful form when
264 you know the type in advance.";
266 "node_struct_length", (RSize, [AHive; ANode "node"]),
267 "return the length of a node",
269 Return the length of the node data structure.";
271 "value_struct_length", (RSize, [AHive; AValue "val"]),
272 "return the length of a value data structure",
274 Return the length of the value data structure.";
276 "value_value", (RLenTypeVal, [AHive; AValue "val"]),
277 "return data length, data type and data of a value",
279 Return the value of this (key, value) pair. The value should
280 be interpreted according to its type (see C<hive_type>).";
282 "value_string", (RString, [AHive; AValue "val"]),
283 "return value as a string",
285 If this value is a string, return the string reencoded as UTF-8
286 (as a C string). This only works for values which have type
287 C<hive_t_string>, C<hive_t_expand_string> or C<hive_t_link>.";
289 "value_multiple_strings", (RStringList, [AHive; AValue "val"]),
290 "return value as multiple strings",
292 If this value is a multiple-string, return the strings reencoded
293 as UTF-8 (in C, as a NULL-terminated array of C strings, in other
294 language bindings, as a list of strings). This only
295 works for values which have type C<hive_t_multiple_strings>.";
297 "value_dword", (RInt32, [AHive; AValue "val"]),
298 "return value as a DWORD",
300 If this value is a DWORD (Windows int32), return it. This only works
301 for values which have type C<hive_t_dword> or C<hive_t_dword_be>.";
303 "value_qword", (RInt64, [AHive; AValue "val"]),
304 "return value as a QWORD",
306 If this value is a QWORD (Windows int64), return it. This only
307 works for values which have type C<hive_t_qword>.";
309 "commit", (RErr, [AHive; AStringNullable "filename"; AUnusedFlags]),
310 "commit (write) changes to file",
312 Commit (write) any changes which have been made.
314 C<filename> is the new file to write. If C<filename> is null/undefined
315 then we overwrite the original file (ie. the file name that was passed to
318 Note this does not close the hive handle. You can perform further
319 operations on the hive after committing, including making more
320 modifications. If you no longer wish to use the hive, then you
321 should close the handle after committing.";
323 "node_add_child", (RNode, [AHive; ANode "parent"; AString "name"]),
326 Add a new child node named C<name> to the existing node C<parent>.
327 The new child initially has no subnodes and contains no keys or
328 values. The sk-record (security descriptor) is inherited from
331 The parent must not have an existing child called C<name>, so if you
332 want to overwrite an existing child, call C<hivex_node_delete_child>
335 "node_delete_child", (RErr, [AHive; ANode "node"]),
338 Delete the node C<node>. All values at the node and all subnodes are
339 deleted (recursively). The C<node> handle and the handles of all
340 subnodes become invalid. You cannot delete the root node.";
342 "node_set_values", (RErr, [AHive; ANode "node"; ASetValues; AUnusedFlags]),
343 "set (key, value) pairs at a node",
345 This call can be used to set all the (key, value) pairs
348 C<node> is the node to modify.";
350 "node_set_value", (RErr, [AHive; ANode "node"; ASetValue; AUnusedFlags]),
351 "set a single (key, value) pair at a given node",
353 This call can be used to replace a single C<(key, value)> pair
354 stored in C<node>. If the key does not already exist, then a
355 new key is added. Key matching is case insensitive.
357 C<node> is the node to modify.";
361 * Note we don't want to use any external OCaml libraries which
362 * makes this a bit harder than it should be.
364 module StringMap = Map.Make (String)
366 let failwithf fs = ksprintf failwith fs
368 let unique = let i = ref 0 in fun () -> incr i; !i
370 let replace_char s c1 c2 =
371 let s2 = String.copy s in
373 for i = 0 to String.length s2 - 1 do
374 if String.unsafe_get s2 i = c1 then (
375 String.unsafe_set s2 i c2;
379 if not !r then s else s2
383 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
385 let triml ?(test = isspace) str =
387 let n = ref (String.length str) in
388 while !n > 0 && test str.[!i]; do
393 else String.sub str !i !n
395 let trimr ?(test = isspace) str =
396 let n = ref (String.length str) in
397 while !n > 0 && test str.[!n-1]; do
400 if !n = String.length str then str
401 else String.sub str 0 !n
403 let trim ?(test = isspace) str =
404 trimr ~test (triml ~test str)
406 (* Used to memoize the result of pod2text. *)
407 let pod2text_memo_filename = "generator/.pod2text.data.version.2"
408 let pod2text_memo : ((int option * bool * bool * string * string), string list) Hashtbl.t =
410 let chan = open_in pod2text_memo_filename in
411 let v = input_value chan in
415 _ -> Hashtbl.create 13
416 let pod2text_memo_updated () =
417 let chan = open_out pod2text_memo_filename in
418 output_value chan pod2text_memo;
421 (* Useful if you need the longdesc POD text as plain text. Returns a
424 * Because this is very slow (the slowest part of autogeneration),
425 * we memoize the results.
427 let pod2text ?width ?(trim = true) ?(discard = true) name longdesc =
428 let key = width, trim, discard, name, longdesc in
429 try Hashtbl.find pod2text_memo key
431 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
432 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
437 sprintf "pod2text -w %d %s" width (Filename.quote filename)
439 sprintf "pod2text %s" (Filename.quote filename) in
440 let chan = open_process_in cmd in
441 let lines = ref [] in
443 let line = input_line chan in
444 if i = 1 && discard then (* discard the first line of output *)
447 let line = if trim then triml line else line in
448 lines := line :: !lines;
451 let lines = try loop 1 with End_of_file -> List.rev !lines in
453 (match close_process_in chan with
456 failwithf "pod2text: process exited with non-zero status (%d)" i
457 | WSIGNALED i | WSTOPPED i ->
458 failwithf "pod2text: process signalled or stopped by signal %d" i
460 Hashtbl.add pod2text_memo key lines;
461 pod2text_memo_updated ();
465 let len = String.length s in
466 let sublen = String.length sub in
468 if i <= len-sublen then (
471 if s.[i+j] = sub.[j] then loop2 (j+1)
477 if r = -1 then loop (i+1) else r
483 let rec replace_str s s1 s2 =
484 let len = String.length s in
485 let sublen = String.length s1 in
489 let s' = String.sub s 0 i in
490 let s'' = String.sub s (i+sublen) (len-i-sublen) in
491 s' ^ s2 ^ replace_str s'' s1 s2
494 let rec string_split sep str =
495 let len = String.length str in
496 let seplen = String.length sep in
497 let i = find str sep in
500 let s' = String.sub str 0 i in
501 let s'' = String.sub str (i+seplen) (len-i-seplen) in
502 s' :: string_split sep s''
505 let files_equal n1 n2 =
506 let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
507 match Sys.command cmd with
510 | i -> failwithf "%s: failed with error code %d" cmd i
512 let rec filter_map f = function
516 | Some y -> y :: filter_map f xs
517 | None -> filter_map f xs
519 let rec find_map f = function
520 | [] -> raise Not_found
524 | None -> find_map f xs
527 let rec loop i = function
529 | x :: xs -> f i x; loop (i+1) xs
534 let rec loop i = function
536 | x :: xs -> let r = f i x in r :: loop (i+1) xs
540 let count_chars c str =
542 for i = 0 to String.length str - 1 do
543 if c = String.unsafe_get str i then incr count
547 let name_of_argt = function
549 | ANode n | AValue n | AString n | AStringNullable n -> n
550 | AOpenFlags | AUnusedFlags -> "flags"
551 | ASetValues -> "values"
554 (* Check function names etc. for consistency. *)
555 let check_functions () =
556 let contains_uppercase str =
557 let len = String.length str in
559 if i >= len then false
562 if c >= 'A' && c <= 'Z' then true
569 (* Check function names. *)
571 fun (name, _, _, _) ->
572 if String.length name >= 7 && String.sub name 0 7 = "hivex" then
573 failwithf "function name %s does not need 'hivex' prefix" name;
575 failwithf "function name is empty";
576 if name.[0] < 'a' || name.[0] > 'z' then
577 failwithf "function name %s must start with lowercase a-z" name;
578 if String.contains name '-' then
579 failwithf "function name %s should not contain '-', use '_' instead."
583 (* Check function parameter/return names. *)
585 fun (name, style, _, _) ->
586 let check_arg_ret_name n =
587 if contains_uppercase n then
588 failwithf "%s param/ret %s should not contain uppercase chars"
590 if String.contains n '-' || String.contains n '_' then
591 failwithf "%s param/ret %s should not contain '-' or '_'"
594 failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
595 if n = "int" || n = "char" || n = "short" || n = "long" then
596 failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
597 if n = "i" || n = "n" then
598 failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
599 if n = "argv" || n = "args" then
600 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
602 (* List Haskell, OCaml and C keywords here.
603 * http://www.haskell.org/haskellwiki/Keywords
604 * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
605 * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
606 * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
607 * |perl -pe 's/(.+)/"$1";/'|fmt -70
608 * Omitting _-containing words, since they're handled above.
609 * Omitting the OCaml reserved word, "val", is ok,
610 * and saves us from renaming several parameters.
613 "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
614 "char"; "class"; "const"; "constraint"; "continue"; "data";
615 "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
616 "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
617 "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
618 "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
619 "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
621 "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
622 "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
623 "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
624 "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
625 "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
626 "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
627 "volatile"; "when"; "where"; "while";
629 if List.mem n reserved then
630 failwithf "%s has param/ret using reserved word %s" name n;
633 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
636 (* Check short descriptions. *)
638 fun (name, _, shortdesc, _) ->
639 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
640 failwithf "short description of %s should begin with lowercase." name;
641 let c = shortdesc.[String.length shortdesc-1] in
642 if c = '\n' || c = '.' then
643 failwithf "short description of %s should not end with . or \\n." name
646 (* Check long dscriptions. *)
648 fun (name, _, _, longdesc) ->
649 if longdesc.[String.length longdesc-1] = '\n' then
650 failwithf "long description of %s should not end with \\n." name
653 (* 'pr' prints to the current output file. *)
654 let chan = ref Pervasives.stdout
659 let i = count_chars '\n' str in
661 output_string !chan str
664 let copyright_years =
665 let this_year = 1900 + (localtime (time ())).tm_year in
666 if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
668 (* Generate a header block in a number of standard styles. *)
670 | CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
672 type license = GPLv2plus | LGPLv2plus | GPLv2 | LGPLv2
674 let generate_header ?(extra_inputs = []) comment license =
675 let inputs = "generator/generator.ml" :: extra_inputs in
676 let c = match comment with
677 | CStyle -> pr "/* "; " *"
678 | CPlusPlusStyle -> pr "// "; "//"
679 | HashStyle -> pr "# "; "#"
680 | OCamlStyle -> pr "(* "; " *"
681 | HaskellStyle -> pr "{- "; " "
682 | PODCommentStyle -> pr "=begin comment\n\n "; "" in
683 pr "hivex generated file\n";
684 pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
685 List.iter (pr "%s %s\n" c) inputs;
686 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
688 pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
689 pr "%s Derived from code by Petter Nordahl-Hagen under a compatible license:\n" c;
690 pr "%s Copyright (c) 1997-2007 Petter Nordahl-Hagen.\n" c;
691 pr "%s Derived from code by Markus Stephany under a compatible license:\n" c;
692 pr "%s Copyright (c)2000-2004, Markus Stephany.\n" c;
696 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
697 pr "%s it under the terms of the GNU General Public License as published by\n" c;
698 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
699 pr "%s (at your option) any later version.\n" c;
701 pr "%s This program is distributed in the hope that it will be useful,\n" c;
702 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
703 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
704 pr "%s GNU General Public License for more details.\n" c;
706 pr "%s You should have received a copy of the GNU General Public License along\n" c;
707 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
708 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
711 pr "%s This library is free software; you can redistribute it and/or\n" c;
712 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
713 pr "%s License as published by the Free Software Foundation; either\n" c;
714 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
716 pr "%s This library is distributed in the hope that it will be useful,\n" c;
717 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
718 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
719 pr "%s Lesser General Public License for more details.\n" c;
721 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
722 pr "%s License along with this library; if not, write to the Free Software\n" c;
723 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
726 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
727 pr "%s it under the terms of the GNU General Public License as published by\n" c;
728 pr "%s the Free Software Foundation; version 2 of the License only.\n" c;
730 pr "%s This program is distributed in the hope that it will be useful,\n" c;
731 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
732 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
733 pr "%s GNU General Public License for more details.\n" c;
735 pr "%s You should have received a copy of the GNU General Public License along\n" c;
736 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
737 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
740 pr "%s This library is free software; you can redistribute it and/or\n" c;
741 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
742 pr "%s License as published by the Free Software Foundation;\n" c;
743 pr "%s version 2.1 of the License only.\n" c;
745 pr "%s This library is distributed in the hope that it will be useful,\n" c;
746 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
747 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
748 pr "%s Lesser General Public License for more details.\n" c;
750 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
751 pr "%s License along with this library; if not, write to the Free Software\n" c;
752 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
755 | CStyle -> pr " */\n"
758 | OCamlStyle -> pr " *)\n"
759 | HaskellStyle -> pr "-}\n"
760 | PODCommentStyle -> pr "\n=end comment\n"
764 (* Start of main code generation functions below this line. *)
766 let rec generate_c_header () =
767 generate_header CStyle LGPLv2;
780 /* NOTE: This API is documented in the man page hivex(3). */
783 typedef struct hive_h hive_h;
785 /* Nodes and values. */
786 typedef size_t hive_node_h;
787 typedef size_t hive_value_h;
791 # define HIVEX_NO_KEY ENOKEY
793 # define HIVEX_NO_KEY ENOENT
796 /* Pre-defined types. */
800 fun (t, old_style, new_style, description) ->
801 pr " /* %s */\n" description;
802 pr " hive_t_REG_%s,\n" new_style;
803 pr "#define hive_t_%s hive_t_REG_%s\n" old_style new_style;
809 typedef enum hive_type hive_type;
811 /* Bitmask of flags passed to hivex_open. */
814 fun (v, flag, description) ->
815 pr " /* %s */\n" description;
816 pr "#define HIVEX_OPEN_%-10s %d\n" flag v;
821 /* Array of (key, value) pairs passed to hivex_node_set_values. */
822 struct hive_set_value {
828 typedef struct hive_set_value hive_set_value;
832 pr "/* Functions. */\n";
834 (* Function declarations. *)
836 fun (shortname, style, _, _) ->
837 let name = "hivex_" ^ shortname in
838 generate_c_prototype ~extern:true name style
841 (* The visitor pattern. *)
843 /* Visit all nodes. This is specific to the C API and is not made
844 * available to other languages. This is because of the complexity
845 * of binding callbacks in other languages, but also because other
846 * languages make it much simpler to iterate over a tree.
848 struct hivex_visitor {
849 int (*node_start) (hive_h *, void *opaque, hive_node_h, const char *name);
850 int (*node_end) (hive_h *, void *opaque, hive_node_h, const char *name);
851 int (*value_string) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, const char *str);
852 int (*value_multiple_strings) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, char **argv);
853 int (*value_string_invalid_utf16) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, const char *str);
854 int (*value_dword) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, int32_t);
855 int (*value_qword) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, int64_t);
856 int (*value_binary) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, const char *value);
857 int (*value_none) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, const char *value);
858 int (*value_other) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, const char *value);
859 int (*value_any) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, const char *value);
862 #define HIVEX_VISIT_SKIP_BAD 1
864 extern int hivex_visit (hive_h *h, const struct hivex_visitor *visitor, size_t len, void *opaque, int flags);
865 extern int hivex_visit_node (hive_h *h, hive_node_h node, const struct hivex_visitor *visitor, size_t len, void *opaque, int flags);
869 (* Finish the header file. *)
875 #endif /* HIVEX_H_ */
878 and generate_c_prototype ?(extern = false) name style =
879 if extern then pr "extern ";
880 (match fst style with
882 | RErrDispose -> pr "int "
883 | RHive -> pr "hive_h *"
884 | RSize -> pr "size_t "
885 | RNode -> pr "hive_node_h "
886 | RNodeNotFound -> pr "hive_node_h "
887 | RNodeList -> pr "hive_node_h *"
888 | RValue -> pr "hive_value_h "
889 | RValueList -> pr "hive_value_h *"
890 | RString -> pr "char *"
891 | RStringList -> pr "char **"
892 | RLenValue -> pr "hive_value_h "
893 | RLenType -> pr "int "
894 | RLenTypeVal -> pr "char *"
895 | RInt32 -> pr "int32_t "
896 | RInt64 -> pr "int64_t "
899 let comma = ref false in
902 if !comma then pr ", "; comma := true;
904 | AHive -> pr "hive_h *h"
905 | ANode n -> pr "hive_node_h %s" n
906 | AValue n -> pr "hive_value_h %s" n
907 | AString n | AStringNullable n -> pr "const char *%s" n
908 | AOpenFlags | AUnusedFlags -> pr "int flags"
909 | ASetValues -> pr "size_t nr_values, const hive_set_value *values"
910 | ASetValue -> pr "const hive_set_value *val"
912 (match fst style with
913 | RLenType | RLenTypeVal -> pr ", hive_type *t, size_t *len"
914 | RLenValue -> pr ", size_t *len"
919 and generate_c_pod () =
920 generate_header PODCommentStyle GPLv2;
927 hivex - Windows Registry \"hive\" extraction library
935 fun (shortname, style, _, _) ->
936 let name = "hivex_" ^ shortname in
938 generate_c_prototype ~extern:false name style;
943 Link with I<-lhivex>.
947 Hivex is a library for extracting the contents of Windows Registry
948 \"hive\" files. It is designed to be secure against buggy or malicious
951 Unlike other tools in this area, it doesn't use the textual .REG
952 format, because parsing that is as much trouble as parsing the
953 original binary format. Instead it makes the file available
954 through a C API, and then wraps this API in higher level scripting
957 There is a separate program to export the hive as XML
958 (see L<hivexml(1)>), or to navigate the file (see L<hivexsh(1)>).
959 There is also a Perl script to export and merge the
960 file as a textual .REG (regedit) file, see L<hivexregedit(1)>.
962 If you just want to export or modify the Registry of a Windows
963 virtual machine, you should look at L<virt-win-reg(1)>.
965 Hivex is also comes with language bindings for
966 OCaml, Perl, Python and Ruby.
972 This handle describes an open hive file.
974 =head2 C<hive_node_h>
976 This is a node handle, an integer but opaque outside the library.
977 Valid node handles cannot be 0. The library returns 0 in some
978 situations to indicate an error.
982 The enum below describes the possible types for the value(s)
983 stored at each node. Note that you should not trust the
984 type field in a Windows Registry, as it very often has no
985 relationship to reality. Some applications use their own
986 types. The encoding of strings is not specified. Some
987 programs store everything (including strings) in binary blobs.
992 fun (t, _, new_style, description) ->
993 pr " /* %s */\n" description;
994 pr " hive_t_REG_%s = %d,\n" new_style t
999 =head2 C<hive_value_h>
1001 This is a value handle, an integer but opaque outside the library.
1002 Valid value handles cannot be 0. The library returns 0 in some
1003 situations to indicate an error.
1005 =head2 C<hive_set_value>
1007 The typedef C<hive_set_value> is used in conjunction with the
1008 C<hivex_node_set_values> call described below.
1010 struct hive_set_value {
1011 char *key; /* key - a UTF-8 encoded ASCIIZ string */
1012 hive_type t; /* type of value field */
1013 size_t len; /* length of value field in bytes */
1014 char *value; /* value field */
1016 typedef struct hive_set_value hive_set_value;
1018 To set the default value for a node, you have to pass C<key = \"\">.
1020 Note that the C<value> field is just treated as a list of bytes, and
1021 is stored directly in the hive. The caller has to ensure correct
1022 encoding and endianness, for example converting dwords to little
1025 The correct type and encoding for values depends on the node and key
1026 in the registry, the version of Windows, and sometimes even changes
1027 between versions of Windows for the same key. We don't document it
1028 here. Often it's not documented at all.
1034 fun (shortname, style, _, longdesc) ->
1035 let name = "hivex_" ^ shortname in
1036 pr "=head2 %s\n" name;
1038 generate_c_prototype ~extern:false name style;
1043 if List.mem AUnusedFlags (snd style) then
1044 pr "The flags parameter is unused. Always pass 0.\n\n";
1046 if List.mem ASetValues (snd style) then
1047 pr "C<values> is an array of (key, value) pairs. There
1048 should be C<nr_values> elements in this array.
1050 Any existing values stored at the node are discarded, and their
1051 C<hive_value_h> handles become invalid. Thus you can remove all
1052 values stored at C<node> by passing C<nr_values = 0>.\n\n";
1054 if List.mem ASetValue (snd style) then
1055 pr "C<value> is a single (key, value) pair.
1057 Existing C<hive_value_h> handles become invalid.\n\n";
1059 (match fst style with
1062 Returns 0 on success.
1063 On error this returns -1 and sets errno.\n\n"
1066 Returns 0 on success.
1067 On error this returns -1 and sets errno.
1069 This function frees the hive handle (even if it returns an error).
1070 The hive handle must not be used again after calling this function.\n\n"
1073 Returns a new hive handle.
1074 On error this returns NULL and sets errno.\n\n"
1078 On error this returns 0 and sets errno.\n\n"
1081 Returns a node handle.
1082 On error this returns 0 and sets errno.\n\n"
1085 Returns a node handle.
1086 If the node was not found, this returns 0 without setting errno.
1087 On error this returns 0 and sets errno.\n\n"
1090 Returns a 0-terminated array of nodes.
1091 The array must be freed by the caller when it is no longer needed.
1092 On error this returns NULL and sets errno.\n\n"
1095 Returns a value handle.
1096 On error this returns 0 and sets errno.\n\n"
1099 Returns a 0-terminated array of values.
1100 The array must be freed by the caller when it is no longer needed.
1101 On error this returns NULL and sets errno.\n\n"
1105 The string must be freed by the caller when it is no longer needed.
1106 On error this returns NULL and sets errno.\n\n"
1109 Returns a NULL-terminated array of C strings.
1110 The strings and the array must all be freed by the caller when
1111 they are no longer needed.
1112 On error this returns NULL and sets errno.\n\n"
1115 Returns 0 on success.
1116 On error this returns -1 and sets errno.\n\n"
1119 Returns a value handle.
1120 On error this returns 0 and sets errno.\n\n"
1123 The value is returned as an array of bytes (of length C<len>).
1124 The value must be freed by the caller when it is no longer needed.
1125 On error this returns NULL and sets errno.\n\n"
1126 | RInt32 | RInt64 -> ()
1131 =head1 WRITING TO HIVE FILES
1133 The hivex library supports making limited modifications to hive files.
1134 We have tried to implement this very conservatively in order to reduce
1135 the chance of corrupting your registry. However you should be careful
1136 and take back-ups, since Microsoft has never documented the hive
1137 format, and so it is possible there are nuances in the
1138 reverse-engineered format that we do not understand.
1140 To be able to modify a hive, you must pass the C<HIVEX_OPEN_WRITE>
1141 flag to C<hivex_open>, otherwise any write operation will return with
1144 The write operations shown below do not modify the on-disk file
1145 immediately. You must call C<hivex_commit> in order to write the
1146 changes to disk. If you call C<hivex_close> without committing then
1147 any writes are discarded.
1149 Hive files internally consist of a \"memory dump\" of binary blocks
1150 (like the C heap), and some of these blocks can be unused. The hivex
1151 library never reuses these unused blocks. Instead, to ensure
1152 robustness in the face of the partially understood on-disk format,
1153 hivex only allocates new blocks after the end of the file, and makes
1154 minimal modifications to existing structures in the file to point to
1155 these new blocks. This makes hivex slightly less disk-efficient than
1156 it could be, but disk is cheap, and registry modifications tend to be
1159 When deleting nodes, it is possible that this library may leave
1160 unreachable live blocks in the hive. This is because certain parts of
1161 the hive disk format such as security (sk) records and big data (db)
1162 records and classname fields are not well understood (and not
1163 documented at all) and we play it safe by not attempting to modify
1164 them. Apart from wasting a little bit of disk space, it is not
1165 thought that unreachable blocks are a problem.
1167 =head2 WRITE OPERATIONS WHICH ARE NOT SUPPORTED
1173 Changing the root node.
1177 Creating a new hive file from scratch. This is impossible at present
1178 because not all fields in the header are understood. In the hivex
1179 source tree is a file called C<images/minimal> which could be used as
1180 the basis for a new hive (but I<caveat emptor>).
1184 Modifying or deleting single values at a node.
1188 Modifying security key (sk) records or classnames.
1189 Previously we did not understand these records. However now they
1190 are well-understood and we could add support if it was required
1191 (but nothing much really uses them).
1195 =head1 VISITING ALL NODES
1197 The visitor pattern is useful if you want to visit all nodes
1198 in the tree or all nodes below a certain point in the tree.
1200 First you set up your own C<struct hivex_visitor> with your
1203 Each of these callback functions should return 0 on success or -1
1204 on error. If any callback returns -1, then the entire visit
1205 terminates immediately. If you don't need a callback function at
1206 all, set the function pointer to NULL.
1208 struct hivex_visitor {
1209 int (*node_start) (hive_h *, void *opaque, hive_node_h, const char *name);
1210 int (*node_end) (hive_h *, void *opaque, hive_node_h, const char *name);
1211 int (*value_string) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1212 hive_type t, size_t len, const char *key, const char *str);
1213 int (*value_multiple_strings) (hive_h *, void *opaque, hive_node_h,
1214 hive_value_h, hive_type t, size_t len, const char *key, char **argv);
1215 int (*value_string_invalid_utf16) (hive_h *, void *opaque, hive_node_h,
1216 hive_value_h, hive_type t, size_t len, const char *key,
1218 int (*value_dword) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1219 hive_type t, size_t len, const char *key, int32_t);
1220 int (*value_qword) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1221 hive_type t, size_t len, const char *key, int64_t);
1222 int (*value_binary) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1223 hive_type t, size_t len, const char *key, const char *value);
1224 int (*value_none) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1225 hive_type t, size_t len, const char *key, const char *value);
1226 int (*value_other) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1227 hive_type t, size_t len, const char *key, const char *value);
1228 /* If value_any callback is not NULL, then the other value_*
1229 * callbacks are not used, and value_any is called on all values.
1231 int (*value_any) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1232 hive_type t, size_t len, const char *key, const char *value);
1239 int hivex_visit (hive_h *h, const struct hivex_visitor *visitor, size_t len, void *opaque, int flags);
1241 Visit all the nodes recursively in the hive C<h>.
1243 C<visitor> should be a C<hivex_visitor> structure with callback
1244 fields filled in as required (unwanted callbacks can be set to
1245 NULL). C<len> must be the length of the 'visitor' struct (you
1246 should pass C<sizeof (struct hivex_visitor)> for this).
1248 This returns 0 if the whole recursive visit was completed
1249 successfully. On error this returns -1. If one of the callback
1250 functions returned an error than we don't touch errno. If the
1251 error was generated internally then we set errno.
1253 You can skip bad registry entries by setting C<flag> to
1254 C<HIVEX_VISIT_SKIP_BAD>. If this flag is not set, then a bad registry
1255 causes the function to return an error immediately.
1257 This function is robust if the registry contains cycles or
1258 pointers which are invalid or outside the registry. It detects
1259 these cases and returns an error.
1261 =item hivex_visit_node
1263 int hivex_visit_node (hive_h *h, hive_node_h node, const struct hivex_visitor *visitor, size_t len, void *opaque);
1265 Same as C<hivex_visit> but instead of starting out at the root, this
1270 =head1 THE STRUCTURE OF THE WINDOWS REGISTRY
1272 Note: To understand the relationship between hives and the common
1273 Windows Registry keys (like C<HKEY_LOCAL_MACHINE>) please see the
1274 Wikipedia page on the Windows Registry.
1276 The Windows Registry is split across various binary files, each
1277 file being known as a \"hive\". This library only handles a single
1278 hive file at a time.
1280 Hives are n-ary trees with a single root. Each node in the tree
1283 Each node in the tree (including non-leaf nodes) may have an
1284 arbitrary list of (key, value) pairs attached to it. It may
1285 be the case that one of these pairs has an empty key. This
1286 is referred to as the default key for the node.
1288 The (key, value) pairs are the place where the useful data is
1289 stored in the registry. The key is always a string (possibly the
1290 empty string for the default key). The value is a typed object
1291 (eg. string, int32, binary, etc.).
1293 =head2 RELATIONSHIP TO .REG FILES
1295 The hivex C library does not care about or deal with Windows .REG
1296 files. Instead we push this complexity up to the Perl
1297 L<Win::Hivex(3)> library and the Perl programs
1298 L<hivexregedit(1)> and L<virt-win-reg(1)>.
1299 Nevertheless it is useful to look at the relationship between the
1300 Registry and .REG files because they are so common.
1302 A .REG file is a textual representation of the registry, or part of the
1303 registry. The actual registry hives that Windows uses are binary
1304 files. There are a number of Windows and Linux tools that let you
1305 generate .REG files, or merge .REG files back into the registry hives.
1306 Notable amongst them is Microsoft's REGEDIT program (formerly known as
1309 A typical .REG file will contain many sections looking like this:
1311 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Classes\\Stack]
1312 \"@\"=\"Generic Stack\"
1313 \"TileInfo\"=\"prop:System.FileCount\"
1314 \"TilePath\"=str(2):\"%%systemroot%%\\\\system32\"
1315 \"ThumbnailCutoff\"=dword:00000000
1316 \"FriendlyTypeName\"=hex(2):40,00,25,00,53,00,79,00,73,00,74,00,65,00,6d,00,52,00,6f,00,\\
1317 6f,00,74,00,25,00,5c,00,53,00,79,00,73,00,74,00,65,00,6d,00,\\
1318 33,00,32,00,5c,00,73,00,65,00,61,00,72,00,63,00,68,00,66,00,\\
1319 6f,00,6c,00,64,00,65,00,72,00,2e,00,64,00,6c,00,6c,00,2c,00,\\
1320 2d,00,39,00,30,00,32,00,38,00,00,00,d8
1322 Taking this one piece at a time:
1324 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Classes\\Stack]
1326 This is the path to this node in the registry tree. The first part,
1327 C<HKEY_LOCAL_MACHINE\\SOFTWARE> means that this comes from a hive
1328 file called C<C:\\WINDOWS\\SYSTEM32\\CONFIG\\SOFTWARE>.
1329 C<\\Classes\\Stack> is the real path part,
1330 starting at the root node of the C<SOFTWARE> hive.
1332 Below the node name is a list of zero or more key-value pairs. Any
1333 interior or leaf node in the registry may have key-value pairs
1336 \"@\"=\"Generic Stack\"
1338 This is the \"default key\". In reality (ie. inside the binary hive)
1339 the key string is the empty string. In .REG files this is written as
1340 C<@> but this has no meaning either in the hives themselves or in this
1341 library. The value is a string (type 1 - see C<enum hive_type>
1344 \"TileInfo\"=\"prop:System.FileCount\"
1346 This is a regular (key, value) pair, with the value being a type 1
1347 string. Note that inside the binary file the string is likely to be
1348 UTF-16LE encoded. This library converts to and from UTF-8 strings
1349 transparently in some cases.
1351 \"TilePath\"=str(2):\"%%systemroot%%\\\\system32\"
1353 The value in this case has type 2 (expanded string) meaning that some
1354 %%...%% variables get expanded by Windows. (This library doesn't know
1355 or care about variable expansion).
1357 \"ThumbnailCutoff\"=dword:00000000
1359 The value in this case is a dword (type 4).
1361 \"FriendlyTypeName\"=hex(2):40,00,....
1363 This value is an expanded string (type 2) represented in the .REG file
1364 as a series of hex bytes. In this case the string appears to be a
1367 =head1 NOTE ON THE USE OF ERRNO
1369 Many functions in this library set errno to indicate errors. These
1370 are the values of errno you may encounter (this list is not
1377 Corrupt or unsupported Registry file format.
1385 Passed an invalid argument to the function.
1389 Followed a Registry pointer which goes outside
1390 the registry or outside a registry block.
1394 Registry contains cycles.
1398 Field in the registry out of range.
1402 Registry key already exists.
1406 Tried to write to a registry which is not opened for writing.
1410 =head1 ENVIRONMENT VARIABLES
1416 Setting HIVEX_DEBUG=1 will enable very verbose messages. This is
1417 useful for debugging problems with the library itself.
1430 L<http://libguestfs.org/>,
1433 L<http://en.wikipedia.org/wiki/Windows_Registry>.
1437 Richard W.M. Jones (C<rjones at redhat dot com>)
1441 Copyright (C) 2009-2010 Red Hat Inc.
1443 Derived from code by Petter Nordahl-Hagen under a compatible license:
1444 Copyright (C) 1997-2007 Petter Nordahl-Hagen.
1446 Derived from code by Markus Stephany under a compatible license:
1447 Copyright (C) 2000-2004 Markus Stephany.
1449 This library is free software; you can redistribute it and/or
1450 modify it under the terms of the GNU Lesser General Public
1451 License as published by the Free Software Foundation;
1452 version 2.1 of the License only.
1454 This library is distributed in the hope that it will be useful,
1455 but WITHOUT ANY WARRANTY; without even the implied warranty of
1456 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1457 Lesser General Public License for more details.
1460 (* Generate the linker script which controls the visibility of
1461 * symbols in the public ABI and ensures no other symbols get
1462 * exported accidentally.
1464 and generate_linker_script () =
1465 generate_header HashStyle GPLv2plus;
1473 List.map (fun (name, _, _, _) -> "hivex_" ^ name)
1475 let globals = List.sort compare (globals @ functions) in
1479 List.iter (pr " %s;\n") globals;
1486 and generate_ocaml_interface () =
1487 generate_header OCamlStyle LGPLv2plus;
1491 (** A [hive_h] hive file handle. *)
1495 (** Nodes and values. *)
1497 exception Error of string * Unix.error * string
1498 (** Error raised by a function.
1500 The first parameter is the name of the function which raised the error.
1501 The second parameter is the errno (see the [Unix] module). The third
1502 parameter is a human-readable string corresponding to the errno.
1504 See hivex(3) for a partial list of interesting errno values that
1505 can be generated by the library. *)
1506 exception Handle_closed of string
1507 (** This exception is raised if you call a function on a closed handle. *)
1513 fun (t, _, new_style, description) ->
1515 pr " | REG_%s (** %s *)\n" new_style description
1519 | REG_UNKNOWN of int32 (** unknown type *)
1520 (** Hive type field. *)
1526 fun (v, flag, description) ->
1527 assert (1 lsl i = v);
1528 pr " | OPEN_%s (** %s *)\n" flag description
1532 (** Open flags for {!open_file} call. *)
1539 (** (key, value) pair passed (as an array) to {!node_set_values}. *)
1543 fun (name, style, shortdesc, _) ->
1545 generate_ocaml_prototype name style;
1546 pr "(** %s *)\n" shortdesc
1549 and generate_ocaml_implementation () =
1550 generate_header OCamlStyle LGPLv2plus;
1557 exception Error of string * Unix.error * string
1558 exception Handle_closed of string
1560 (* Give the exceptions names, so they can be raised from the C code. *)
1562 Callback.register_exception \"ocaml_hivex_error\"
1563 (Error (\"\", Unix.EUNKNOWNERR 0, \"\"));
1564 Callback.register_exception \"ocaml_hivex_closed\" (Handle_closed \"\")
1570 fun (t, _, new_style, _) ->
1572 pr " | REG_%s\n" new_style
1576 | REG_UNKNOWN of int32
1582 fun (v, flag, description) ->
1583 assert (1 lsl i = v);
1584 pr " | OPEN_%s (** %s *)\n" flag description
1598 fun (name, style, _, _) ->
1599 generate_ocaml_prototype ~is_external:true name style
1602 and generate_ocaml_prototype ?(is_external = false) name style =
1603 let ocaml_name = if name = "open" then "open_file" else name in
1605 if is_external then pr "external " else pr "val ";
1606 pr "%s : " ocaml_name;
1609 | AHive -> pr "t -> "
1610 | ANode _ -> pr "node -> "
1611 | AValue _ -> pr "value -> "
1612 | AString _ -> pr "string -> "
1613 | AStringNullable _ -> pr "string option -> "
1614 | AOpenFlags -> pr "open_flag list -> "
1615 | AUnusedFlags -> ()
1616 | ASetValues -> pr "set_value array -> "
1617 | ASetValue -> pr "set_value -> "
1619 (match fst style with
1620 | RErr -> pr "unit" (* all errors are turned into exceptions *)
1621 | RErrDispose -> pr "unit"
1623 | RSize -> pr "int64"
1624 | RNode -> pr "node"
1625 | RNodeNotFound -> pr "node"
1626 | RNodeList -> pr "node array"
1627 | RValue -> pr "value"
1628 | RValueList -> pr "value array"
1629 | RString -> pr "string"
1630 | RStringList -> pr "string array"
1631 | RLenType -> pr "hive_type * int"
1632 | RLenValue -> pr "int * value"
1633 | RLenTypeVal -> pr "hive_type * string"
1634 | RInt32 -> pr "int32"
1635 | RInt64 -> pr "int64"
1638 pr " = \"ocaml_hivex_%s\"" name;
1641 and generate_ocaml_c () =
1642 generate_header CStyle LGPLv2plus;
1653 #include <caml/config.h>
1654 #include <caml/alloc.h>
1655 #include <caml/callback.h>
1656 #include <caml/custom.h>
1657 #include <caml/fail.h>
1658 #include <caml/memory.h>
1659 #include <caml/mlvalues.h>
1660 #include <caml/signals.h>
1662 #ifdef HAVE_CAML_UNIXSUPPORT_H
1663 #include <caml/unixsupport.h>
1665 extern value unix_error_of_code (int errcode);
1668 #ifndef HAVE_CAML_RAISE_WITH_ARGS
1670 caml_raise_with_args (value tag, int nargs, value args[])
1673 CAMLxparamN (args, nargs);
1677 bucket = caml_alloc_small (1 + nargs, 0);
1678 Field(bucket, 0) = tag;
1679 for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
1687 #define Hiveh_val(v) (*((hive_h **)Data_custom_val(v)))
1688 static value Val_hiveh (hive_h *);
1689 static int HiveOpenFlags_val (value);
1690 static hive_set_value *HiveSetValue_val (value);
1691 static hive_set_value *HiveSetValues_val (value);
1692 static hive_type HiveType_val (value);
1693 static value Val_hive_type (hive_type);
1694 static value copy_int_array (size_t *);
1695 static value copy_type_len (size_t, hive_type);
1696 static value copy_len_value (size_t, hive_value_h);
1697 static value copy_type_value (const char *, size_t, hive_type);
1698 static void raise_error (const char *) Noreturn;
1699 static void raise_closed (const char *) Noreturn;
1705 fun (name, style, _, _) ->
1706 pr "/* Automatically generated wrapper for function\n";
1707 pr " * "; generate_ocaml_prototype name style;
1713 | ASetValues -> ["nrvalues"; "values"]
1714 | AUnusedFlags -> ["0"]
1715 | arg -> [name_of_argt arg]) (snd style) in
1717 match fst style with
1718 | RLenType | RLenTypeVal -> c_params @ [["&t"; "&len"]]
1719 | RLenValue -> c_params @ [["&len"]]
1721 let c_params = List.concat c_params in
1724 filter_map (function
1725 | AUnusedFlags -> None
1726 | arg -> Some (name_of_argt arg ^ "v")) (snd style) in
1728 pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
1729 pr "CAMLprim value ocaml_hivex_%s (value %s" name (List.hd params);
1730 List.iter (pr ", value %s") (List.tl params); pr ");\n";
1733 pr "CAMLprim value\n";
1734 pr "ocaml_hivex_%s (value %s" name (List.hd params);
1735 List.iter (pr ", value %s") (List.tl params);
1739 pr " CAMLparam%d (%s);\n"
1740 (List.length params) (String.concat ", " params);
1741 pr " CAMLlocal1 (rv);\n";
1747 pr " hive_h *h = Hiveh_val (hv);\n";
1748 pr " if (h == NULL)\n";
1749 pr " raise_closed (\"%s\");\n" name
1751 pr " hive_node_h %s = Int_val (%sv);\n" n n
1753 pr " hive_value_h %s = Int_val (%sv);\n" n n
1755 pr " const char *%s = String_val (%sv);\n" n n
1756 | AStringNullable n ->
1757 pr " const char *%s =\n" n;
1758 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
1761 pr " int flags = HiveOpenFlags_val (flagsv);\n"
1762 | AUnusedFlags -> ()
1764 pr " int nrvalues = Wosize_val (valuesv);\n";
1765 pr " hive_set_value *values = HiveSetValues_val (valuesv);\n"
1767 pr " hive_set_value *val = HiveSetValue_val (valv);\n"
1772 match fst style with
1773 | RErr -> pr " int r;\n"; "-1"
1774 | RErrDispose -> pr " int r;\n"; "-1"
1775 | RHive -> pr " hive_h *r;\n"; "NULL"
1776 | RSize -> pr " size_t r;\n"; "0"
1777 | RNode -> pr " hive_node_h r;\n"; "0"
1780 pr " hive_node_h r;\n";
1782 | RNodeList -> pr " hive_node_h *r;\n"; "NULL"
1783 | RValue -> pr " hive_value_h r;\n"; "0"
1784 | RValueList -> pr " hive_value_h *r;\n"; "NULL"
1785 | RString -> pr " char *r;\n"; "NULL"
1786 | RStringList -> pr " char **r;\n"; "NULL"
1789 pr " size_t len;\n";
1790 pr " hive_type t;\n";
1794 pr " hive_value_h r;\n";
1795 pr " size_t len;\n";
1799 pr " size_t len;\n";
1800 pr " hive_type t;\n";
1809 "-1 && errno != 0" in
1811 (* The libguestfs OCaml bindings call enter_blocking_section
1812 * here. However I don't think that is safe, because we are
1813 * holding pointers to caml strings during the call, and these
1814 * could be moved or freed by other threads. In any case, there
1815 * is very little reason to enter_blocking_section for any hivex
1816 * call, so don't do it. XXX
1818 (*pr " caml_enter_blocking_section ();\n";*)
1819 pr " r = hivex_%s (%s" name (List.hd c_params);
1820 List.iter (pr ", %s") (List.tl c_params);
1822 (*pr " caml_leave_blocking_section ();\n";*)
1825 (* Dispose of the hive handle (even if hivex_close returns error). *)
1826 (match fst style with
1828 pr " /* So we don't double-free in the finalizer. */\n";
1829 pr " Hiveh_val (hv) = NULL;\n";
1836 | AHive | ANode _ | AValue _ | AString _ | AStringNullable _
1837 | AOpenFlags | AUnusedFlags -> ()
1839 pr " free (values);\n";
1842 pr " free (val);\n";
1846 (* Check for errors. *)
1847 pr " if (r == %s)\n" error_code;
1848 pr " raise_error (\"%s\");\n" name;
1851 (match fst style with
1852 | RErr -> pr " rv = Val_unit;\n"
1853 | RErrDispose -> pr " rv = Val_unit;\n"
1854 | RHive -> pr " rv = Val_hiveh (r);\n"
1855 | RSize -> pr " rv = caml_copy_int64 (r);\n"
1856 | RNode -> pr " rv = Val_int (r);\n"
1858 pr " if (r == 0)\n";
1859 pr " caml_raise_not_found ();\n";
1861 pr " rv = Val_int (r);\n"
1863 pr " rv = copy_int_array (r);\n";
1865 | RValue -> pr " rv = Val_int (r);\n"
1867 pr " rv = copy_int_array (r);\n";
1870 pr " rv = caml_copy_string (r);\n";
1873 pr " rv = caml_copy_string_array ((const char **) r);\n";
1874 pr " for (int i = 0; r[i] != NULL; ++i) free (r[i]);\n";
1876 | RLenType -> pr " rv = copy_type_len (len, t);\n"
1877 | RLenValue -> pr " rv = copy_len_value (len, r);\n"
1879 pr " rv = copy_type_value (r, len, t);\n";
1881 | RInt32 -> pr " rv = caml_copy_int32 (r);\n"
1882 | RInt64 -> pr " rv = caml_copy_int64 (r);\n"
1885 pr " CAMLreturn (rv);\n";
1893 HiveOpenFlags_val (value v)
1898 while (v != Val_int (0)) {
1900 flags |= 1 << Int_val (v2);
1907 static hive_set_value *
1908 HiveSetValue_val (value v)
1910 hive_set_value *val = malloc (sizeof (hive_set_value));
1912 val->key = String_val (Field (v, 0));
1913 val->t = HiveType_val (Field (v, 1));
1914 val->len = caml_string_length (Field (v, 2));
1915 val->value = String_val (Field (v, 2));
1920 static hive_set_value *
1921 HiveSetValues_val (value v)
1923 size_t nr_values = Wosize_val (v);
1924 hive_set_value *values = malloc (nr_values * sizeof (hive_set_value));
1928 for (i = 0; i < nr_values; ++i) {
1930 values[i].key = String_val (Field (v2, 0));
1931 values[i].t = HiveType_val (Field (v2, 1));
1932 values[i].len = caml_string_length (Field (v2, 2));
1933 values[i].value = String_val (Field (v2, 2));
1940 HiveType_val (value v)
1943 return Int_val (v); /* REG_NONE etc. */
1945 return Int32_val (Field (v, 0)); /* REG_UNKNOWN of int32 */
1949 Val_hive_type (hive_type t)
1955 CAMLreturn (Val_int (t));
1957 rv = caml_alloc (1, 0); /* REG_UNKNOWN of int32 */
1958 v = caml_copy_int32 (t);
1959 caml_modify (&Field (rv, 0), v);
1965 copy_int_array (size_t *xs)
1971 for (nr = 0; xs[nr] != 0; ++nr)
1974 CAMLreturn (Atom (0));
1976 rv = caml_alloc (nr, 0);
1977 for (i = 0; i < nr; ++i) {
1978 v = Val_int (xs[i]);
1979 Store_field (rv, i, v); /* Safe because v is not a block. */
1986 copy_type_len (size_t len, hive_type t)
1991 rv = caml_alloc (2, 0);
1992 v = Val_hive_type (t);
1993 Store_field (rv, 0, v);
1995 Store_field (rv, 1, v);
2000 copy_len_value (size_t len, hive_value_h r)
2005 rv = caml_alloc (2, 0);
2007 Store_field (rv, 0, v);
2009 Store_field (rv, 1, v);
2014 copy_type_value (const char *r, size_t len, hive_type t)
2019 rv = caml_alloc (2, 0);
2020 v = Val_hive_type (t);
2021 Store_field (rv, 0, v);
2022 v = caml_alloc_string (len);
2023 memcpy (String_val (v), r, len);
2024 caml_modify (&Field (rv, 1), v);
2028 /* Raise exceptions. */
2030 raise_error (const char *function)
2032 /* Save errno early in case it gets trashed. */
2036 CAMLlocal3 (v1, v2, v3);
2038 v1 = caml_copy_string (function);
2039 v2 = unix_error_of_code (err);
2040 v3 = caml_copy_string (strerror (err));
2041 value vvv[] = { v1, v2, v3 };
2042 caml_raise_with_args (*caml_named_value (\"ocaml_hivex_error\"), 3, vvv);
2048 raise_closed (const char *function)
2053 v = caml_copy_string (function);
2054 caml_raise_with_arg (*caml_named_value (\"ocaml_hivex_closed\"), v);
2059 /* Allocate handles and deal with finalization. */
2061 hivex_finalize (value hv)
2063 hive_h *h = Hiveh_val (hv);
2064 if (h) hivex_close (h);
2067 static struct custom_operations hivex_custom_operations = {
2068 (char *) \"hivex_custom_operations\",
2070 custom_compare_default,
2071 custom_hash_default,
2072 custom_serialize_default,
2073 custom_deserialize_default
2077 Val_hiveh (hive_h *h)
2082 rv = caml_alloc_custom (&hivex_custom_operations,
2083 sizeof (hive_h *), 0, 1);
2090 and generate_perl_pm () =
2091 generate_header HashStyle LGPLv2plus;
2098 Win::Hivex - Perl bindings for reading and writing Windows Registry hive files
2104 $h = Win::Hivex->open ('SOFTWARE');
2105 $root_node = $h->root ();
2106 print $h->node_name ($root_node);
2110 The C<Win::Hivex> module provides a Perl XS binding to the
2111 L<hivex(3)> API for reading and writing Windows Registry binary
2116 All errors turn into calls to C<croak> (see L<Carp(3)>).
2130 XSLoader::load ('Win::Hivex');
2134 $h = Win::Hivex->open ($filename,";
2138 pr "\n [%s => 1,]" (String.lowercase flag)
2143 Open a Windows Registry binary hive file.
2145 The C<verbose> and C<debug> flags enable different levels of
2148 The C<write> flag is required if you will be modifying the
2149 hive file (see L<hivex(3)/WRITING TO HIVE FILES>).
2151 This function returns a hive handle. The hive handle is
2152 closed automatically when its reference count drops to 0.
2158 my $class = ref ($proto) || $proto;
2159 my $filename = shift;
2166 fun (n, flag, description) ->
2167 pr " # %s\n" description;
2168 pr " $flags += %d if $flags{%s};\n" n (String.lowercase flag)
2173 my $self = Win::Hivex::_open ($filename, $flags);
2174 bless $self, $class;
2181 fun (name, style, _, longdesc) ->
2182 (* The close call isn't explicit in Perl: handles are closed
2183 * when their reference count drops to 0.
2185 * The open call is coded specially in Perl.
2187 * Therefore we don't generate prototypes for these two calls:
2189 if fst style <> RErrDispose && List.hd (snd style) = AHive then (
2190 let longdesc = replace_str longdesc "C<hivex_" "C<" in
2191 pr "=item %s\n\n " name;
2192 generate_perl_prototype name style;
2194 pr "%s\n\n" longdesc;
2196 (match fst style with
2209 This returns a size.\n\n"
2212 This returns a node handle.\n\n"
2215 This returns a node handle, or C<undef> if the node was not found.\n\n"
2218 This returns a list of node handles.\n\n"
2221 This returns a value handle.\n\n"
2224 This returns a list of value handles.\n\n"
2227 if List.mem ASetValues (snd style) then
2228 pr "C<@values> is an array of (keys, value) pairs.
2229 Each element should be a hashref containing C<key>, C<t> (type)
2232 Any existing values stored at the node are discarded, and their
2233 C<value> handles become invalid. Thus you can remove all
2234 values stored at C<node> by passing C<@values = []>.\n\n"
2247 Copyright (C) %s Red Hat Inc.
2251 Please see the file COPYING.LIB for the full license.
2257 L<http://libguestfs.org>,
2263 and generate_perl_prototype name style =
2265 (match fst style with
2268 | RHive -> pr "$h = "
2269 | RSize -> pr "$size = "
2271 | RNodeNotFound -> pr "$node = "
2272 | RNodeList -> pr "@nodes = "
2273 | RValue -> pr "$value = "
2274 | RValueList -> pr "@values = "
2275 | RString -> pr "$string = "
2276 | RStringList -> pr "@strings = "
2277 | RLenType -> pr "($type, $len) = "
2278 | RLenValue -> pr "($len, $value) = "
2279 | RLenTypeVal -> pr "($type, $data) = "
2280 | RInt32 -> pr "$int32 = "
2281 | RInt64 -> pr "$int64 = "
2284 let args = List.tl (snd style) in
2286 (* AUnusedFlags is dropped in the bindings. *)
2287 let args = List.filter ((<>) AUnusedFlags) args in
2291 let comma = ref false in
2294 if !comma then pr ", "; comma := true;
2299 | AString n -> pr "$%s" n
2300 | AStringNullable n -> pr "[$%s|undef]" n
2301 | AOpenFlags -> pr "[flags]"
2302 | AUnusedFlags -> assert false
2303 | ASetValues -> pr "\\@values"
2304 | ASetValue -> pr "$val"
2309 and generate_perl_xs () =
2310 generate_header CStyle LGPLv2plus;
2313 #include \"EXTERN.h\"
2319 #include <inttypes.h>
2322 my_newSVll(long long val) {
2323 #ifdef USE_64_BIT_ALL
2324 return newSViv(val);
2328 len = snprintf(buf, 100, \"%%\" PRId64, val);
2329 return newSVpv(buf, len);
2335 my_newSVull(unsigned long long val) {
2336 #ifdef USE_64_BIT_ALL
2337 return newSVuv(val);
2341 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2342 return newSVpv(buf, len);
2348 /* http://www.perlmonks.org/?node_id=680842 */
2350 XS_unpack_charPtrPtr (SV *arg) {
2355 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
2356 croak (\"array reference expected\");
2358 av = (AV *)SvRV (arg);
2359 ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
2361 croak (\"malloc failed\");
2363 for (i = 0; i <= av_len (av); i++) {
2364 SV **elem = av_fetch (av, i, 0);
2366 if (!elem || !*elem)
2367 croak (\"missing element in list\");
2369 ret[i] = SvPV_nolen (*elem);
2378 /* Handle set_values parameter. */
2379 typedef struct pl_set_values {
2381 hive_set_value *values;
2384 static pl_set_values
2385 unpack_pl_set_values (SV *sv)
2391 if (!sv || !SvOK (sv) || !SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
2392 croak (\"array reference expected\");
2394 av = (AV *)SvRV(sv);
2395 ret.nr_values = av_len (av) + 1;
2396 ret.values = malloc (ret.nr_values * sizeof (hive_set_value));
2398 croak (\"malloc failed\");
2400 for (i = 0; i <= av_len (av); i++) {
2401 SV **hvp = av_fetch (av, i, 0);
2403 if (!hvp || !*hvp || !SvROK (*hvp) || SvTYPE (SvRV (*hvp)) != SVt_PVHV)
2404 croak (\"missing element in list or not a hash ref\");
2406 HV *hv = (HV *)SvRV(*hvp);
2409 svp = hv_fetch (hv, \"key\", 3, 0);
2411 croak (\"missing 'key' in hash\");
2412 ret.values[i].key = SvPV_nolen (*svp);
2414 svp = hv_fetch (hv, \"t\", 1, 0);
2416 croak (\"missing 't' in hash\");
2417 ret.values[i].t = SvIV (*svp);
2419 svp = hv_fetch (hv, \"value\", 5, 0);
2421 croak (\"missing 'value' in hash\");
2422 ret.values[i].value = SvPV (*svp, ret.values[i].len);
2428 static hive_set_value *
2429 unpack_set_value (SV *sv)
2431 hive_set_value *ret;
2433 if (!sv || !SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVHV)
2434 croak (\"not a hash ref\");
2436 ret = malloc (sizeof (hive_set_value));
2438 croak (\"malloc failed\");
2440 HV *hv = (HV *)SvRV(sv);
2443 svp = hv_fetch (hv, \"key\", 3, 0);
2445 croak (\"missing 'key' in hash\");
2446 ret->key = SvPV_nolen (*svp);
2448 svp = hv_fetch (hv, \"t\", 1, 0);
2450 croak (\"missing 't' in hash\");
2451 ret->t = SvIV (*svp);
2453 svp = hv_fetch (hv, \"value\", 5, 0);
2455 croak (\"missing 'value' in hash\");
2456 ret->value = SvPV (*svp, ret->len);
2461 MODULE = Win::Hivex PACKAGE = Win::Hivex
2466 _open (filename, flags)
2470 RETVAL = hivex_open (filename, flags);
2472 croak (\"hivex_open: %%s: %%s\", filename, strerror (errno));
2480 if (hivex_close (h) == -1)
2481 croak (\"hivex_close: %%s\", strerror (errno));
2486 fun (name, style, _, longdesc) ->
2487 (* The close and open calls are handled specially above. *)
2488 if fst style <> RErrDispose && List.hd (snd style) = AHive then (
2489 (match fst style with
2490 | RErr -> pr "void\n"
2491 | RErrDispose -> failwith "perl bindings cannot handle a call which disposes of the handle"
2492 | RHive -> failwith "perl bindings cannot handle a call which returns a handle"
2497 | RString -> pr "SV *\n"
2503 | RLenTypeVal -> pr "void\n"
2504 | RInt32 -> pr "SV *\n"
2505 | RInt64 -> pr "SV *\n"
2508 (* Call and arguments. *)
2510 filter_map (function
2511 | AUnusedFlags -> None
2512 | arg -> Some (name_of_argt arg)) (snd style) in
2516 | AUnusedFlags -> "0"
2517 | ASetValues -> "values.nr_values, values.values"
2518 | arg -> name_of_argt arg) (snd style) in
2520 pr "%s (%s)\n" name (String.concat ", " perl_params);
2531 | AStringNullable n ->
2532 (* http://www.perlmonks.org/?node_id=554277 *)
2533 pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n i i
2536 | AUnusedFlags -> ()
2538 pr " pl_set_values values = unpack_pl_set_values (ST(%d));\n" i
2540 pr " hive_set_value *val = unpack_set_value (ST(%d));\n" i
2547 pr " free (values.values);\n"
2550 | AHive | ANode _ | AValue _ | AString _ | AStringNullable _
2551 | AOpenFlags | AUnusedFlags -> ()
2556 (match fst style with
2561 pr " r = hivex_%s (%s);\n"
2562 name (String.concat ", " c_params);
2564 pr " if (r == -1)\n";
2565 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2568 | RErrDispose -> assert false
2569 | RHive -> assert false
2575 pr " /* hive_node_h = hive_value_h = size_t so we cheat\n";
2576 pr " here to simplify the generator */\n";
2579 pr " r = hivex_%s (%s);\n"
2580 name (String.concat ", " c_params);
2582 pr " if (r == 0)\n";
2583 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2585 pr " RETVAL = newSViv (r);\n";
2591 pr " hive_node_h r;\n";
2594 pr " r = hivex_%s (%s);\n"
2595 name (String.concat ", " c_params);
2597 pr " if (r == 0 && errno != 0)\n";
2598 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2600 pr " if (r == 0)\n";
2601 pr " RETVAL = &PL_sv_undef;\n";
2603 pr " RETVAL = newSViv (r);\n";
2611 pr " r = hivex_%s (%s);\n"
2612 name (String.concat ", " c_params);
2614 pr " if (r == NULL)\n";
2615 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2617 pr " RETVAL = newSVpv (r, 0);\n";
2628 pr " r = hivex_%s (%s);\n"
2629 name (String.concat ", " c_params);
2631 pr " if (r == NULL)\n";
2632 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2634 pr " for (n = 0; r[n] != 0; ++n) /**/;\n";
2635 pr " EXTEND (SP, n);\n";
2636 pr " for (i = 0; i < n; ++i)\n";
2637 pr " PUSHs (sv_2mortal (newSViv (r[i])));\n";
2645 pr " r = hivex_%s (%s);\n"
2646 name (String.concat ", " c_params);
2648 pr " if (r == NULL)\n";
2649 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2651 pr " for (n = 0; r[n] != NULL; ++n) /**/;\n";
2652 pr " EXTEND (SP, n);\n";
2653 pr " for (i = 0; i < n; ++i) {\n";
2654 pr " PUSHs (sv_2mortal (newSVpv (r[i], 0)));\n";
2655 pr " free (r[i]);\n";
2662 pr " size_t len;\n";
2663 pr " hive_type type;\n";
2665 pr " r = hivex_%s (%s, &type, &len);\n"
2666 name (String.concat ", " c_params);
2668 pr " if (r == -1)\n";
2669 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2671 pr " EXTEND (SP, 2);\n";
2672 pr " PUSHs (sv_2mortal (newSViv (type)));\n";
2673 pr " PUSHs (sv_2mortal (newSViv (len)));\n";
2677 pr " hive_value_h r;\n";
2678 pr " size_t len;\n";
2681 pr " r = hivex_%s (%s, &len);\n"
2682 name (String.concat ", " c_params);
2684 pr " if (r == 0 && errno)\n";
2685 pr " croak (\"%%s: \", \"%s\", strerror (errno));\n"
2687 pr " EXTEND (SP, 2);\n";
2688 pr " PUSHs (sv_2mortal (newSViv (len)));\n";
2689 pr " PUSHs (sv_2mortal (newSViv (r)));\n";
2694 pr " size_t len;\n";
2695 pr " hive_type type;\n";
2697 pr " r = hivex_%s (%s, &type, &len);\n"
2698 name (String.concat ", " c_params);
2700 pr " if (r == NULL)\n";
2701 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2703 pr " EXTEND (SP, 2);\n";
2704 pr " PUSHs (sv_2mortal (newSViv (type)));\n";
2705 pr " PUSHs (sv_2mortal (newSVpvn (r, len)));\n";
2713 pr " r = hivex_%s (%s);\n"
2714 name (String.concat ", " c_params);
2716 pr " if (r == -1 && errno != 0)\n";
2717 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2719 pr " RETVAL = newSViv (r);\n";
2728 pr " r = hivex_%s (%s);\n"
2729 name (String.concat ", " c_params);
2731 pr " if (r == -1 && errno != 0)\n";
2732 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2734 pr " RETVAL = my_newSVll (r);\n";
2742 and generate_python_c () =
2743 generate_header CStyle LGPLv2plus;
2748 #define PY_SSIZE_T_CLEAN 1
2751 #if PY_VERSION_HEX < 0x02050000
2752 typedef int Py_ssize_t;
2753 #define PY_SSIZE_T_MAX INT_MAX
2754 #define PY_SSIZE_T_MIN INT_MIN
2761 #include \"hivex.h\"
2763 #ifndef HAVE_PYCAPSULE_NEW
2771 get_handle (PyObject *obj)
2774 assert (obj != Py_None);
2775 #ifndef HAVE_PYCAPSULE_NEW
2776 return ((Pyhivex_Object *) obj)->h;
2778 return (hive_h *) PyCapsule_GetPointer(obj, \"hive_h\");
2783 put_handle (hive_h *h)
2786 #ifndef HAVE_PYCAPSULE_NEW
2788 PyCObject_FromVoidPtrAndDesc ((void *) h, (char *) \"hive_h\", NULL);
2790 return PyCapsule_New ((void *) h, \"hive_h\", NULL);
2794 /* This returns pointers into the Python objects, which should
2798 get_value (PyObject *v, hive_set_value *ret)
2801 #ifndef HAVE_PYSTRING_ASSTRING
2805 obj = PyDict_GetItemString (v, \"key\");
2807 PyErr_SetString (PyExc_RuntimeError, \"no 'key' element in dictionary\");
2810 #ifdef HAVE_PYSTRING_ASSTRING
2811 ret->key = PyString_AsString (obj);
2813 bytes = PyUnicode_AsUTF8String (obj);
2814 ret->key = PyBytes_AS_STRING (bytes);
2817 obj = PyDict_GetItemString (v, \"t\");
2819 PyErr_SetString (PyExc_RuntimeError, \"no 't' element in dictionary\");
2822 ret->t = PyLong_AsLong (obj);
2824 obj = PyDict_GetItemString (v, \"value\");
2826 PyErr_SetString (PyExc_RuntimeError, \"no 'value' element in dictionary\");
2829 #ifdef HAVE_PYSTRING_ASSTRING
2830 ret->value = PyString_AsString (obj);
2831 ret->len = PyString_Size (obj);
2833 bytes = PyUnicode_AsUTF8String (obj);
2834 ret->value = PyBytes_AS_STRING (bytes);
2835 ret->len = PyBytes_GET_SIZE (bytes);
2841 typedef struct py_set_values {
2843 hive_set_value *values;
2847 get_values (PyObject *v, py_set_values *ret)
2852 if (!PyList_Check (v)) {
2853 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
2857 slen = PyList_Size (v);
2859 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
2862 len = (size_t) slen;
2863 ret->nr_values = len;
2864 ret->values = malloc (len * sizeof (hive_set_value));
2866 PyErr_SetString (PyExc_RuntimeError, strerror (errno));
2870 for (i = 0; i < len; ++i) {
2871 if (get_value (PyList_GetItem (v, i), &(ret->values[i])) == -1) {
2881 put_string_list (char * const * const argv)
2886 for (argc = 0; argv[argc] != NULL; ++argc)
2889 list = PyList_New (argc);
2890 for (i = 0; i < argc; ++i) {
2891 #ifdef HAVE_PYSTRING_ASSTRING
2892 PyList_SetItem (list, i, PyString_FromString (argv[i]));
2894 PyList_SetItem (list, i, PyUnicode_FromString (argv[i]));
2902 free_strings (char **argv)
2906 for (argc = 0; argv[argc] != NULL; ++argc)
2911 /* Since hive_node_t is the same as hive_value_t this also works for values. */
2913 put_node_list (hive_node_h *nodes)
2918 for (argc = 0; nodes[argc] != 0; ++argc)
2921 list = PyList_New (argc);
2922 for (i = 0; i < argc; ++i)
2923 PyList_SetItem (list, i, PyLong_FromLongLong ((long) nodes[i]));
2929 put_len_type (size_t len, hive_type t)
2931 PyObject *r = PyTuple_New (2);
2932 PyTuple_SetItem (r, 0, PyLong_FromLong ((long) t));
2933 PyTuple_SetItem (r, 1, PyLong_FromLongLong ((long) len));
2938 put_len_val (size_t len, hive_value_h value)
2940 PyObject *r = PyTuple_New (2);
2941 PyTuple_SetItem (r, 0, PyLong_FromLongLong ((long) len));
2942 PyTuple_SetItem (r, 1, PyLong_FromLongLong ((long) value));
2947 put_val_type (char *val, size_t len, hive_type t)
2949 PyObject *r = PyTuple_New (2);
2950 PyTuple_SetItem (r, 0, PyLong_FromLong ((long) t));
2951 #ifdef HAVE_PYSTRING_ASSTRING
2952 PyTuple_SetItem (r, 1, PyString_FromStringAndSize (val, len));
2954 PyTuple_SetItem (r, 1, PyBytes_FromStringAndSize (val, len));
2961 (* Generate functions. *)
2963 fun (name, style, _, longdesc) ->
2964 pr "static PyObject *\n";
2965 pr "py_hivex_%s (PyObject *self, PyObject *args)\n" name;
2967 pr " PyObject *py_r;\n";
2970 match fst style with
2971 | RErr -> pr " int r;\n"; "-1"
2972 | RErrDispose -> pr " int r;\n"; "-1"
2973 | RHive -> pr " hive_h *r;\n"; "NULL"
2974 | RSize -> pr " size_t r;\n"; "0"
2975 | RNode -> pr " hive_node_h r;\n"; "0"
2978 pr " hive_node_h r;\n";
2980 | RNodeList -> pr " hive_node_h *r;\n"; "NULL"
2981 | RValue -> pr " hive_value_h r;\n"; "0"
2982 | RValueList -> pr " hive_value_h *r;\n"; "NULL"
2983 | RString -> pr " char *r;\n"; "NULL"
2984 | RStringList -> pr " char **r;\n"; "NULL"
2987 pr " size_t len;\n";
2988 pr " hive_type t;\n";
2993 pr " size_t len;\n";
2997 pr " size_t len;\n";
2998 pr " hive_type t;\n";
3007 "-1 && errno != 0" in
3009 (* Call and arguments. *)
3012 | AUnusedFlags -> "0"
3013 | ASetValues -> "values.nr_values, values.values"
3014 | ASetValue -> "&val"
3015 | arg -> name_of_argt arg) (snd style) in
3017 match fst style with
3018 | RLenType | RLenTypeVal -> c_params @ ["&t"; "&len"]
3019 | RLenValue -> c_params @ ["&len"]
3026 pr " PyObject *py_h;\n"
3031 | AStringNullable n ->
3035 | AUnusedFlags -> ()
3037 pr " py_set_values values;\n";
3038 pr " PyObject *py_values;\n"
3040 pr " hive_set_value val;\n";
3041 pr " PyObject *py_val;\n"
3046 (* Convert the required parameters. *)
3047 pr " if (!PyArg_ParseTuple (args, (char *) \"";
3057 | AStringNullable n ->
3061 | AUnusedFlags -> ()
3067 pr ":hivex_%s\"" name;
3077 | AStringNullable n ->
3081 | AUnusedFlags -> ()
3089 pr " return NULL;\n";
3091 (* Convert some Python argument types to C. *)
3095 pr " h = get_handle (py_h);\n"
3101 | AUnusedFlags -> ()
3103 pr " if (get_values (py_values, &values) == -1)\n";
3104 pr " return NULL;\n"
3106 pr " if (get_value (py_val, &val) == -1)\n";
3107 pr " return NULL;\n"
3110 (* Call the C function. *)
3111 pr " r = hivex_%s (%s);\n" name (String.concat ", " c_params);
3113 (* Free up arguments. *)
3116 | AHive | ANode _ | AValue _
3117 | AString _ | AStringNullable _
3118 | AOpenFlags | AUnusedFlags -> ()
3120 pr " free (values.values);\n"
3124 (* Check for errors from C library. *)
3125 pr " if (r == %s) {\n" error_code;
3126 pr " PyErr_SetString (PyExc_RuntimeError,\n";
3127 pr " strerror (errno));\n";
3128 pr " return NULL;\n";
3132 (* Convert return value to Python. *)
3133 (match fst style with
3136 pr " Py_INCREF (Py_None);\n";
3137 pr " py_r = Py_None;\n"
3139 pr " py_r = put_handle (r);\n"
3142 pr " py_r = PyLong_FromLongLong (r);\n"
3145 pr " py_r = PyLong_FromLongLong (r);\n";
3147 pr " Py_INCREF (Py_None);\n";
3148 pr " py_r = Py_None;\n";
3152 pr " py_r = put_node_list (r);\n";
3155 pr " py_r = PyLong_FromLongLong (r);\n"
3157 pr "#ifdef HAVE_PYSTRING_ASSTRING\n";
3158 pr " py_r = PyString_FromString (r);\n";
3160 pr " py_r = PyUnicode_FromString (r);\n";
3164 pr " py_r = put_string_list (r);\n";
3165 pr " free_strings (r);\n"
3167 pr " py_r = put_len_type (len, t);\n"
3169 pr " py_r = put_len_val (len, r);\n"
3171 pr " py_r = put_val_type (r, len, t);\n";
3174 pr " py_r = PyLong_FromLong ((long) r);\n"
3176 pr " py_r = PyLong_FromLongLong (r);\n"
3178 pr " return py_r;\n";
3183 (* Table of functions. *)
3184 pr "static PyMethodDef methods[] = {\n";
3186 fun (name, _, _, _) ->
3187 pr " { (char *) \"%s\", py_hivex_%s, METH_VARARGS, NULL },\n"
3190 pr " { NULL, NULL, 0, NULL }\n";
3194 (* Init function. *)
3196 #if PY_MAJOR_VERSION >= 3
3197 static struct PyModuleDef moduledef = {
3198 PyModuleDef_HEAD_INIT,
3199 \"libhivexmod\", /* m_name */
3200 \"hivex module\", /* m_doc */
3202 methods, /* m_methods */
3203 NULL, /* m_reload */
3204 NULL, /* m_traverse */
3215 #if PY_MAJOR_VERSION >= 3
3216 m = PyModule_Create (&moduledef);
3218 m = Py_InitModule ((char *) \"libhivexmod\", methods);
3221 return m; /* m might be NULL if module init failed */
3224 #if PY_MAJOR_VERSION >= 3
3226 PyInit_libhivexmod (void)
3228 return moduleinit ();
3232 initlibhivexmod (void)
3234 (void) moduleinit ();
3239 and generate_python_py () =
3240 generate_header HashStyle LGPLv2plus;
3243 \"\"\"Python bindings for hivex
3246 h = hivex.Hivex (filename)
3248 The hivex module provides Python bindings to the hivex API for
3249 examining and modifying Windows Registry 'hive' files.
3251 Read the hivex(3) man page to find out how to use the API.
3257 \"\"\"Instances of this class are hivex API handles.\"\"\"
3259 def __init__ (self, filename";
3262 fun (_, flag, _) -> pr ", %s = False" (String.lowercase flag)
3266 \"\"\"Create a new hivex handle.\"\"\"
3271 fun (n, flag, description) ->
3272 pr " # %s\n" description;
3273 pr " if %s: flags += %d\n" (String.lowercase flag) n
3276 pr " self._o = libhivexmod.open (filename, flags)
3279 libhivexmod.close (self._o)
3284 fun (name, style, shortdesc, _) ->
3285 (* The close and open calls are handled specially above. *)
3286 if fst style <> RErrDispose && List.hd (snd style) = AHive then (
3287 let args = List.tl (snd style) in
3288 let args = List.filter (
3289 function AOpenFlags | AUnusedFlags -> false
3293 pr " def %s (self" name;
3294 List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
3296 pr " \"\"\"%s\"\"\"\n" shortdesc;
3297 pr " return libhivexmod.%s (self._o" name;
3302 | AHive -> assert false
3303 | ANode n | AValue n
3304 | AString n | AStringNullable n -> pr "%s" n
3306 | AUnusedFlags -> assert false
3307 | ASetValues -> pr "values"
3308 | ASetValue -> pr "val"
3315 and generate_ruby_c () =
3316 generate_header CStyle LGPLv2plus;
3325 #include \"hivex.h\"
3327 #include \"extconf.h\"
3329 /* For Ruby < 1.9 */
3331 #define RARRAY_LEN(r) (RARRAY((r))->len)
3335 #define RSTRING_LEN(r) (RSTRING((r))->len)
3339 #define RSTRING_PTR(r) (RSTRING((r))->ptr)
3342 static VALUE m_hivex; /* hivex module */
3343 static VALUE c_hivex; /* hive_h handle */
3344 static VALUE e_Error; /* used for all errors */
3347 ruby_hivex_free (void *hvp)
3356 get_value (VALUE valv, hive_set_value *val)
3358 VALUE key = rb_hash_lookup (valv, ID2SYM (rb_intern (\"key\")));
3359 VALUE type = rb_hash_lookup (valv, ID2SYM (rb_intern (\"type\")));
3360 VALUE value = rb_hash_lookup (valv, ID2SYM (rb_intern (\"value\")));
3362 val->key = StringValueCStr (key);
3363 val->t = NUM2ULL (type);
3364 val->len = RSTRING_LEN (value);
3365 val->value = RSTRING_PTR (value);
3368 static hive_set_value *
3369 get_values (VALUE valuesv, size_t *nr_values)
3372 hive_set_value *ret;
3374 *nr_values = RARRAY_LEN (valuesv);
3375 ret = malloc (sizeof (*ret) * *nr_values);
3379 for (i = 0; i < *nr_values; ++i) {
3380 VALUE v = rb_ary_entry (valuesv, i);
3381 get_value (v, &ret[i]);
3390 fun (name, (ret, args), shortdesc, longdesc) ->
3392 (* Generate rdoc. *)
3393 let doc = replace_str longdesc "C<hivex_" "C<h." in
3394 let doc = pod2text ~width:60 name doc in
3395 let doc = String.concat "\n * " doc in
3396 let doc = trim doc in
3400 | AHive :: args -> "h." ^ name, args
3401 | args -> "Hivex::" ^ name, args in
3402 let args = filter_map (
3404 | AUnusedFlags -> None
3405 | args -> Some (name_of_argt args)
3407 let args = String.concat ", " args in
3411 | RErr | RErrDispose -> "nil"
3412 | RHive -> "Hivex::Hivex"
3413 | RSize | RNode | RNodeNotFound -> "integer"
3414 | RNodeList -> "list"
3415 | RValue -> "integer"
3416 | RValueList -> "list"
3417 | RString -> "string"
3418 | RStringList -> "list"
3419 | RLenType -> "hash"
3420 | RLenValue -> "integer"
3421 | RLenTypeVal -> "hash"
3422 | RInt32 -> "integer"
3423 | RInt64 -> "integer" in
3434 * (For the C API documentation for this function, see
3435 * +hivex_%s+[http://libguestfs.org/hivex.3.html#hivex_%s]).
3437 " call args ret shortdesc doc name name in
3439 (* Generate the function. *)
3440 pr "static VALUE\n";
3441 pr "ruby_hivex_%s (" name;
3444 (* If the first argument is not AHive, then this is a module-level
3445 * function, and Ruby passes an implicit module argument which we
3446 * must ignore. Otherwise the first argument is the hive handle.
3450 | AHive :: args -> pr "VALUE hv"; args
3451 | args -> pr "VALUE modulev"; args in
3454 | AUnusedFlags -> ()
3456 pr ", VALUE %sv" (name_of_argt arg)
3466 pr " Data_Get_Struct (hv, hive_h, h);\n";
3468 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\",\n";
3469 pr " \"%s\");\n" name;
3471 pr " hive_node_h %s = NUM2ULL (%sv);\n" n n
3473 pr " hive_value_h %s = NUM2ULL (%sv);\n" n n
3475 pr " const char *%s = StringValueCStr (%sv);\n" n n;
3476 | AStringNullable n ->
3477 pr " const char *%s =\n" n;
3478 pr " !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n
3480 pr " int flags = 0;\n";
3483 pr " if (RTEST (rb_hash_lookup (flagsv, ID2SYM (rb_intern (\"%s\")))))\n"
3484 (String.lowercase flag);
3485 pr " flags += %d;\n" n
3487 | AUnusedFlags -> ()
3489 pr " size_t nr_values;\n";
3490 pr " hive_set_value *values;\n";
3491 pr " values = get_values (valuesv, &nr_values);\n"
3493 pr " hive_set_value val;\n";
3494 pr " get_value (valv, &val);\n"
3500 | RErr -> pr " int r;\n"; "-1"
3501 | RErrDispose -> pr " int r;\n"; "-1"
3502 | RHive -> pr " hive_h *r;\n"; "NULL"
3503 | RSize -> pr " size_t r;\n"; "0"
3504 | RNode -> pr " hive_node_h r;\n"; "0"
3507 pr " hive_node_h r;\n";
3509 | RNodeList -> pr " hive_node_h *r;\n"; "NULL"
3510 | RValue -> pr " hive_value_h r;\n"; "0"
3511 | RValueList -> pr " hive_value_h *r;\n"; "NULL"
3512 | RString -> pr " char *r;\n"; "NULL"
3513 | RStringList -> pr " char **r;\n"; "NULL"
3516 pr " size_t len;\n";
3517 pr " hive_type t;\n";
3521 pr " hive_value_h r;\n";
3522 pr " size_t len;\n";
3526 pr " size_t len;\n";
3527 pr " hive_type t;\n";
3536 "-1 && errno != 0" in
3541 | ASetValues -> ["nr_values"; "values"]
3542 | ASetValue -> ["&val"]
3543 | AUnusedFlags -> ["0"]
3544 | arg -> [name_of_argt arg]) args in
3547 | RLenType | RLenTypeVal -> c_params @ [["&t"; "&len"]]
3548 | RLenValue -> c_params @ [["&len"]]
3550 let c_params = List.concat c_params in
3552 pr " r = hivex_%s (%s" name (List.hd c_params);
3553 List.iter (pr ", %s") (List.tl c_params);
3557 (* Dispose of the hive handle (even if hivex_close returns error). *)
3560 pr " /* So we don't double-free in the finalizer. */\n";
3561 pr " DATA_PTR (hv) = NULL;\n";
3574 | AUnusedFlags -> ()
3576 pr " free (values);\n"
3580 (* Check for errors from C library. *)
3581 pr " if (r == %s)\n" error_code;
3582 pr " rb_raise (e_Error, \"%%s\", strerror (errno));\n";
3586 | RErr | RErrDispose ->
3587 pr " return Qnil;\n"
3589 pr " return Data_Wrap_Struct (c_hivex, NULL, ruby_hivex_free, r);\n"
3594 pr " return ULL2NUM (r);\n"
3596 pr " return INT2NUM (r);\n"
3599 pr " return ULL2NUM (r);\n";
3601 pr " return Qnil;\n"
3604 pr " size_t i, len = 0;\n";
3605 pr " for (i = 0; r[i] != 0; ++i) len++;\n";
3606 pr " VALUE rv = rb_ary_new2 (len);\n";
3607 pr " for (i = 0; r[i] != 0; ++i)\n";
3608 pr " rb_ary_push (rv, ULL2NUM (r[i]));\n";
3612 pr " VALUE rv = rb_str_new2 (r);\n";
3616 pr " size_t i, len = 0;\n";
3617 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
3618 pr " VALUE rv = rb_ary_new2 (len);\n";
3619 pr " for (i = 0; r[i] != NULL; ++i) {\n";
3620 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
3621 pr " free (r[i]);\n";
3626 pr " VALUE rv = rb_hash_new ();\n";
3627 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
3628 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"type\")), INT2NUM (t));\n";
3631 pr " VALUE rv = rb_hash_new ();\n";
3632 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
3633 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"off\")), ULL2NUM (r));\n";
3636 pr " VALUE rv = rb_hash_new ();\n";
3637 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
3638 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"type\")), INT2NUM (t));\n";
3639 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"value\")), rb_str_new (r, len));\n";
3649 /* Initialize the module. */
3652 m_hivex = rb_define_module (\"Hivex\");
3653 c_hivex = rb_define_class_under (m_hivex, \"Hivex\", rb_cObject);
3654 e_Error = rb_define_class_under (m_hivex, \"Error\", rb_eStandardError);
3656 /* XXX How to pass arguments? */
3658 #ifdef HAVE_RB_DEFINE_ALLOC_FUNC
3659 rb_define_alloc_func (c_hivex, ruby_hivex_open);
3667 fun (name, (_, args), _, _) ->
3668 let args = List.filter (
3670 | AUnusedFlags -> false
3673 let nr_args = List.length args in
3676 pr " rb_define_method (c_hivex, \"%s\",\n" name;
3677 pr " ruby_hivex_%s, %d);\n" name (nr_args-1)
3678 | args -> (* class function *)
3679 pr " rb_define_module_function (m_hivex, \"%s\",\n" name;
3680 pr " ruby_hivex_%s, %d);\n" name nr_args
3685 let output_to filename k =
3686 let filename_new = filename ^ ".new" in
3687 chan := open_out filename_new;
3690 chan := Pervasives.stdout;
3692 (* Is the new file different from the current file? *)
3693 if Sys.file_exists filename && files_equal filename filename_new then
3694 unlink filename_new (* same, so skip it *)
3696 (* different, overwrite old one *)
3697 (try chmod filename 0o644 with Unix_error _ -> ());
3698 rename filename_new filename;
3699 chmod filename 0o444;
3700 printf "written %s\n%!" filename;
3703 let perror msg = function
3704 | Unix_error (err, _, _) ->
3705 eprintf "%s: %s\n" msg (error_message err)
3707 eprintf "%s: %s\n" msg (Printexc.to_string exn)
3712 try openfile "configure.ac" [O_RDWR] 0
3714 | Unix_error (ENOENT, _, _) ->
3716 You are probably running this from the wrong directory.
3717 Run it from the top source directory using the command
3718 generator/generator.ml
3722 perror "open: configure.ac" exn;
3725 (* Acquire a lock so parallel builds won't try to run the generator
3726 * twice at the same time. Subsequent builds will wait for the first
3727 * one to finish. Note the lock is released implicitly when the
3730 (try lockf lock_fd F_LOCK 1
3732 perror "lock: configure.ac" exn;
3737 output_to "lib/hivex.h" generate_c_header;
3738 output_to "lib/hivex.pod" generate_c_pod;
3740 output_to "lib/hivex.syms" generate_linker_script;
3742 output_to "ocaml/hivex.mli" generate_ocaml_interface;
3743 output_to "ocaml/hivex.ml" generate_ocaml_implementation;
3744 output_to "ocaml/hivex_c.c" generate_ocaml_c;
3746 output_to "perl/lib/Win/Hivex.pm" generate_perl_pm;
3747 output_to "perl/Hivex.xs" generate_perl_xs;
3749 output_to "python/hivex.py" generate_python_py;
3750 output_to "python/hivex-py.c" generate_python_c;
3752 output_to "ruby/ext/hivex/_hivex.c" generate_ruby_c;
3754 (* Always generate this file last, and unconditionally. It's used
3755 * by the Makefile to know when we must re-run the generator.
3757 let chan = open_out "generator/stamp-generator" in
3761 printf "generated %d lines of code\n" !lines