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 | RString (* Returns char* or NULL. *)
55 | RStringList (* Returns char** or NULL. *)
56 | RLenType (* See hivex_value_type. *)
57 | RLenTypeVal (* See hivex_value_value. *)
58 | RInt32 (* Returns int32. *)
59 | RInt64 (* Returns int64. *)
61 and args = argt list (* List of parameters. *)
63 and argt = (* Note, cannot be NULL/0 unless it
64 says so explicitly below. *)
66 | ANode of string (* hive_node_h *)
67 | AValue of string (* hive_value_h *)
68 | AString of string (* char* *)
69 | AStringNullable of string (* char* (can be NULL) *)
70 | AOpenFlags (* HIVEX_OPEN_* flags list. *)
71 | AUnusedFlags (* Flags arg that is always 0 *)
72 | ASetValues (* See hivex_node_set_values. *)
73 | ASetValue (* See hivex_node_set_value. *)
76 * https://secure.wikimedia.org/wikipedia/en/wiki/Windows_Registry#Keys_and_values
78 * It's unfortunate that in our original C binding we strayed away from
79 * the names that Windows uses (eg. REG_SZ for strings). We include
80 * both our names and the Windows names.
84 "Just a key without a value";
86 "A Windows string (encoding is unknown, but often UTF16-LE)";
87 2, "expand_string", "EXPAND_SZ",
88 "A Windows string that contains %env% (environment variable expansion)";
89 3, "binary", "BINARY",
92 "DWORD (32 bit integer), little endian";
93 5, "dword_be", "DWORD_BIG_ENDIAN",
94 "DWORD (32 bit integer), big endian";
96 "Symbolic link to another part of the registry tree";
97 7, "multiple_strings", "MULTI_SZ",
98 "Multiple Windows strings. See http://blogs.msdn.com/oldnewthing/archive/2009/10/08/9904646.aspx";
99 8, "resource_list", "RESOURCE_LIST",
101 9, "full_resource_description", "FULL_RESOURCE_DESCRIPTOR",
102 "Resource descriptor";
103 10, "resource_requirements_list", "RESOURCE_REQUIREMENTS_LIST",
104 "Resouce requirements list";
105 11, "qword", "QWORD",
106 "QWORD (64 bit integer), unspecified endianness but usually little endian"
108 let max_hive_type = 11
110 (* Open flags (bitmask passed to AOpenFlags) *)
112 1, "VERBOSE", "Verbose messages";
113 2, "DEBUG", "Debug messages";
114 4, "WRITE", "Enable writes to the hive";
119 "open", (RHive, [AString "filename"; AOpenFlags]),
122 Opens the hive named C<filename> for reading.
124 Flags is an ORed list of the open flags (or C<0> if you don't
125 want to pass any flags). These flags are defined:
129 =item HIVEX_OPEN_VERBOSE
133 =item HIVEX_OPEN_DEBUG
135 Very verbose messages, suitable for debugging problems in the library
138 This is also selected if the C<HIVEX_DEBUG> environment variable
141 =item HIVEX_OPEN_WRITE
143 Open the hive for writing. If omitted, the hive is read-only.
145 See L<hivex(3)/WRITING TO HIVE FILES>.
149 "close", (RErrDispose, [AHive]),
150 "close a hive handle",
152 Close a hive handle and free all associated resources.
154 Note that any uncommitted writes are I<not> committed by this call,
155 but instead are lost. See L<hivex(3)/WRITING TO HIVE FILES>.";
157 "root", (RNode, [AHive]),
158 "return the root node of the hive",
160 Return root node of the hive. All valid hives must contain a root node.";
162 "last_modified", (RInt64, [AHive]),
163 "return the modification time from the header of the hive",
165 Return the modification time from the header of the hive.
167 The returned value is a Windows filetime.
168 To convert this to a Unix C<time_t> see:
169 L<http://stackoverflow.com/questions/6161776/convert-windows-filetime-to-second-in-unix-linux/6161842#6161842>";
171 "node_name", (RString, [AHive; ANode "node"]),
172 "return the name of the node",
174 Return the name of the node.
176 Note that the name of the root node is a dummy, such as
177 C<$$$PROTO.HIV> (other names are possible: it seems to depend on the
178 tool or program that created the hive in the first place). You can
179 only know the \"real\" name of the root node by knowing which registry
180 file this hive originally comes from, which is knowledge that is
181 outside the scope of this library.";
183 "node_timestamp", (RInt64, [AHive; ANode "node"]),
184 "return the modification time of the node",
186 Return the modification time of the node.
188 The returned value is a Windows filetime.
189 To convert this to a Unix C<time_t> see:
190 L<http://stackoverflow.com/questions/6161776/convert-windows-filetime-to-second-in-unix-linux/6161842#6161842>";
192 "node_children", (RNodeList, [AHive; ANode "node"]),
193 "return children of node",
195 Return an array of nodes which are the subkeys
196 (children) of C<node>.";
198 "node_get_child", (RNodeNotFound, [AHive; ANode "node"; AString "name"]),
199 "return named child of node",
201 Return the child of node with the name C<name>, if it exists.
203 The name is matched case insensitively.";
205 "node_parent", (RNode, [AHive; ANode "node"]),
206 "return the parent of node",
208 Return the parent of C<node>.
210 The parent pointer of the root node in registry files that we
211 have examined seems to be invalid, and so this function will
212 return an error if called on the root node.";
214 "node_values", (RValueList, [AHive; ANode "node"]),
215 "return (key, value) pairs attached to a node",
217 Return the array of (key, value) pairs attached to this node.";
219 "node_get_value", (RValue, [AHive; ANode "node"; AString "key"]),
220 "return named key at node",
222 Return the value attached to this node which has the name C<key>,
225 The key name is matched case insensitively.
227 Note that to get the default key, you should pass the empty
228 string C<\"\"> here. The default key is often written C<\"@\">, but
229 inside hives that has no meaning and won't give you the
232 "value_key", (RString, [AHive; AValue "val"]),
233 "return the key of a (key, value) pair",
235 Return the key (name) of a (key, value) pair. The name
236 is reencoded as UTF-8 and returned as a string.
238 The string should be freed by the caller when it is no longer needed.
240 Note that this function can return a zero-length string. In the
241 context of Windows Registries, this means that this value is the
242 default key for this node in the tree. This is usually written
245 "value_type", (RLenType, [AHive; AValue "val"]),
246 "return data length and data type of a value",
248 Return the data length and data type of the value in this (key, value)
249 pair. See also C<hivex_value_value> which returns all this
250 information, and the value itself. Also, C<hivex_value_*> functions
251 below which can be used to return the value in a more useful form when
252 you know the type in advance.";
254 "value_value", (RLenTypeVal, [AHive; AValue "val"]),
255 "return data length, data type and data of a value",
257 Return the value of this (key, value) pair. The value should
258 be interpreted according to its type (see C<hive_type>).";
260 "value_string", (RString, [AHive; AValue "val"]),
261 "return value as a string",
263 If this value is a string, return the string reencoded as UTF-8
264 (as a C string). This only works for values which have type
265 C<hive_t_string>, C<hive_t_expand_string> or C<hive_t_link>.";
267 "value_multiple_strings", (RStringList, [AHive; AValue "val"]),
268 "return value as multiple strings",
270 If this value is a multiple-string, return the strings reencoded
271 as UTF-8 (in C, as a NULL-terminated array of C strings, in other
272 language bindings, as a list of strings). This only
273 works for values which have type C<hive_t_multiple_strings>.";
275 "value_dword", (RInt32, [AHive; AValue "val"]),
276 "return value as a DWORD",
278 If this value is a DWORD (Windows int32), return it. This only works
279 for values which have type C<hive_t_dword> or C<hive_t_dword_be>.";
281 "value_qword", (RInt64, [AHive; AValue "val"]),
282 "return value as a QWORD",
284 If this value is a QWORD (Windows int64), return it. This only
285 works for values which have type C<hive_t_qword>.";
287 "commit", (RErr, [AHive; AStringNullable "filename"; AUnusedFlags]),
288 "commit (write) changes to file",
290 Commit (write) any changes which have been made.
292 C<filename> is the new file to write. If C<filename> is null/undefined
293 then we overwrite the original file (ie. the file name that was passed to
296 Note this does not close the hive handle. You can perform further
297 operations on the hive after committing, including making more
298 modifications. If you no longer wish to use the hive, then you
299 should close the handle after committing.";
301 "node_add_child", (RNode, [AHive; ANode "parent"; AString "name"]),
304 Add a new child node named C<name> to the existing node C<parent>.
305 The new child initially has no subnodes and contains no keys or
306 values. The sk-record (security descriptor) is inherited from
309 The parent must not have an existing child called C<name>, so if you
310 want to overwrite an existing child, call C<hivex_node_delete_child>
313 "node_delete_child", (RErr, [AHive; ANode "node"]),
316 Delete the node C<node>. All values at the node and all subnodes are
317 deleted (recursively). The C<node> handle and the handles of all
318 subnodes become invalid. You cannot delete the root node.";
320 "node_set_values", (RErr, [AHive; ANode "node"; ASetValues; AUnusedFlags]),
321 "set (key, value) pairs at a node",
323 This call can be used to set all the (key, value) pairs
326 C<node> is the node to modify.";
328 "node_set_value", (RErr, [AHive; ANode "node"; ASetValue; AUnusedFlags]),
329 "set a single (key, value) pair at a given node",
331 This call can be used to replace a single C<(key, value)> pair
332 stored in C<node>. If the key does not already exist, then a
333 new key is added. Key matching is case insensitive.
335 C<node> is the node to modify.";
339 * Note we don't want to use any external OCaml libraries which
340 * makes this a bit harder than it should be.
342 module StringMap = Map.Make (String)
344 let failwithf fs = ksprintf failwith fs
346 let unique = let i = ref 0 in fun () -> incr i; !i
348 let replace_char s c1 c2 =
349 let s2 = String.copy s in
351 for i = 0 to String.length s2 - 1 do
352 if String.unsafe_get s2 i = c1 then (
353 String.unsafe_set s2 i c2;
357 if not !r then s else s2
361 (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
363 let triml ?(test = isspace) str =
365 let n = ref (String.length str) in
366 while !n > 0 && test str.[!i]; do
371 else String.sub str !i !n
373 let trimr ?(test = isspace) str =
374 let n = ref (String.length str) in
375 while !n > 0 && test str.[!n-1]; do
378 if !n = String.length str then str
379 else String.sub str 0 !n
381 let trim ?(test = isspace) str =
382 trimr ~test (triml ~test str)
384 (* Used to memoize the result of pod2text. *)
385 let pod2text_memo_filename = "generator/.pod2text.data.version.2"
386 let pod2text_memo : ((int option * bool * bool * string * string), string list) Hashtbl.t =
388 let chan = open_in pod2text_memo_filename in
389 let v = input_value chan in
393 _ -> Hashtbl.create 13
394 let pod2text_memo_updated () =
395 let chan = open_out pod2text_memo_filename in
396 output_value chan pod2text_memo;
399 (* Useful if you need the longdesc POD text as plain text. Returns a
402 * Because this is very slow (the slowest part of autogeneration),
403 * we memoize the results.
405 let pod2text ?width ?(trim = true) ?(discard = true) name longdesc =
406 let key = width, trim, discard, name, longdesc in
407 try Hashtbl.find pod2text_memo key
409 let filename, chan = Filename.open_temp_file "gen" ".tmp" in
410 fprintf chan "=head1 %s\n\n%s\n" name longdesc;
415 sprintf "pod2text -w %d %s" width (Filename.quote filename)
417 sprintf "pod2text %s" (Filename.quote filename) in
418 let chan = open_process_in cmd in
419 let lines = ref [] in
421 let line = input_line chan in
422 if i = 1 && discard then (* discard the first line of output *)
425 let line = if trim then triml line else line in
426 lines := line :: !lines;
429 let lines = try loop 1 with End_of_file -> List.rev !lines in
431 (match close_process_in chan with
434 failwithf "pod2text: process exited with non-zero status (%d)" i
435 | WSIGNALED i | WSTOPPED i ->
436 failwithf "pod2text: process signalled or stopped by signal %d" i
438 Hashtbl.add pod2text_memo key lines;
439 pod2text_memo_updated ();
443 let len = String.length s in
444 let sublen = String.length sub in
446 if i <= len-sublen then (
449 if s.[i+j] = sub.[j] then loop2 (j+1)
455 if r = -1 then loop (i+1) else r
461 let rec replace_str s s1 s2 =
462 let len = String.length s in
463 let sublen = String.length s1 in
467 let s' = String.sub s 0 i in
468 let s'' = String.sub s (i+sublen) (len-i-sublen) in
469 s' ^ s2 ^ replace_str s'' s1 s2
472 let rec string_split sep str =
473 let len = String.length str in
474 let seplen = String.length sep in
475 let i = find str sep in
478 let s' = String.sub str 0 i in
479 let s'' = String.sub str (i+seplen) (len-i-seplen) in
480 s' :: string_split sep s''
483 let files_equal n1 n2 =
484 let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
485 match Sys.command cmd with
488 | i -> failwithf "%s: failed with error code %d" cmd i
490 let rec filter_map f = function
494 | Some y -> y :: filter_map f xs
495 | None -> filter_map f xs
497 let rec find_map f = function
498 | [] -> raise Not_found
502 | None -> find_map f xs
505 let rec loop i = function
507 | x :: xs -> f i x; loop (i+1) xs
512 let rec loop i = function
514 | x :: xs -> let r = f i x in r :: loop (i+1) xs
518 let count_chars c str =
520 for i = 0 to String.length str - 1 do
521 if c = String.unsafe_get str i then incr count
525 let name_of_argt = function
527 | ANode n | AValue n | AString n | AStringNullable n -> n
528 | AOpenFlags | AUnusedFlags -> "flags"
529 | ASetValues -> "values"
532 (* Check function names etc. for consistency. *)
533 let check_functions () =
534 let contains_uppercase str =
535 let len = String.length str in
537 if i >= len then false
540 if c >= 'A' && c <= 'Z' then true
547 (* Check function names. *)
549 fun (name, _, _, _) ->
550 if String.length name >= 7 && String.sub name 0 7 = "hivex" then
551 failwithf "function name %s does not need 'hivex' prefix" name;
553 failwithf "function name is empty";
554 if name.[0] < 'a' || name.[0] > 'z' then
555 failwithf "function name %s must start with lowercase a-z" name;
556 if String.contains name '-' then
557 failwithf "function name %s should not contain '-', use '_' instead."
561 (* Check function parameter/return names. *)
563 fun (name, style, _, _) ->
564 let check_arg_ret_name n =
565 if contains_uppercase n then
566 failwithf "%s param/ret %s should not contain uppercase chars"
568 if String.contains n '-' || String.contains n '_' then
569 failwithf "%s param/ret %s should not contain '-' or '_'"
572 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;
573 if n = "int" || n = "char" || n = "short" || n = "long" then
574 failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
575 if n = "i" || n = "n" then
576 failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
577 if n = "argv" || n = "args" then
578 failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
580 (* List Haskell, OCaml and C keywords here.
581 * http://www.haskell.org/haskellwiki/Keywords
582 * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
583 * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
584 * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
585 * |perl -pe 's/(.+)/"$1";/'|fmt -70
586 * Omitting _-containing words, since they're handled above.
587 * Omitting the OCaml reserved word, "val", is ok,
588 * and saves us from renaming several parameters.
591 "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
592 "char"; "class"; "const"; "constraint"; "continue"; "data";
593 "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
594 "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
595 "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
596 "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
597 "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
599 "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
600 "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
601 "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
602 "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
603 "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
604 "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
605 "volatile"; "when"; "where"; "while";
607 if List.mem n reserved then
608 failwithf "%s has param/ret using reserved word %s" name n;
611 List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
614 (* Check short descriptions. *)
616 fun (name, _, shortdesc, _) ->
617 if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
618 failwithf "short description of %s should begin with lowercase." name;
619 let c = shortdesc.[String.length shortdesc-1] in
620 if c = '\n' || c = '.' then
621 failwithf "short description of %s should not end with . or \\n." name
624 (* Check long dscriptions. *)
626 fun (name, _, _, longdesc) ->
627 if longdesc.[String.length longdesc-1] = '\n' then
628 failwithf "long description of %s should not end with \\n." name
631 (* 'pr' prints to the current output file. *)
632 let chan = ref Pervasives.stdout
637 let i = count_chars '\n' str in
639 output_string !chan str
642 let copyright_years =
643 let this_year = 1900 + (localtime (time ())).tm_year in
644 if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
646 (* Generate a header block in a number of standard styles. *)
648 | CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
650 type license = GPLv2plus | LGPLv2plus | GPLv2 | LGPLv2
652 let generate_header ?(extra_inputs = []) comment license =
653 let inputs = "generator/generator.ml" :: extra_inputs in
654 let c = match comment with
655 | CStyle -> pr "/* "; " *"
656 | CPlusPlusStyle -> pr "// "; "//"
657 | HashStyle -> pr "# "; "#"
658 | OCamlStyle -> pr "(* "; " *"
659 | HaskellStyle -> pr "{- "; " "
660 | PODCommentStyle -> pr "=begin comment\n\n "; "" in
661 pr "hivex generated file\n";
662 pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
663 List.iter (pr "%s %s\n" c) inputs;
664 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
666 pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
667 pr "%s Derived from code by Petter Nordahl-Hagen under a compatible license:\n" c;
668 pr "%s Copyright (c) 1997-2007 Petter Nordahl-Hagen.\n" c;
669 pr "%s Derived from code by Markus Stephany under a compatible license:\n" c;
670 pr "%s Copyright (c)2000-2004, Markus Stephany.\n" c;
674 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
675 pr "%s it under the terms of the GNU General Public License as published by\n" c;
676 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
677 pr "%s (at your option) any later version.\n" c;
679 pr "%s This program is distributed in the hope that it will be useful,\n" c;
680 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
681 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
682 pr "%s GNU General Public License for more details.\n" c;
684 pr "%s You should have received a copy of the GNU General Public License along\n" c;
685 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
686 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
689 pr "%s This library is free software; you can redistribute it and/or\n" c;
690 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
691 pr "%s License as published by the Free Software Foundation; either\n" c;
692 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
694 pr "%s This library is distributed in the hope that it will be useful,\n" c;
695 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
696 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
697 pr "%s Lesser General Public License for more details.\n" c;
699 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
700 pr "%s License along with this library; if not, write to the Free Software\n" c;
701 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
704 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
705 pr "%s it under the terms of the GNU General Public License as published by\n" c;
706 pr "%s the Free Software Foundation; version 2 of the License only.\n" c;
708 pr "%s This program is distributed in the hope that it will be useful,\n" c;
709 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
710 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
711 pr "%s GNU General Public License for more details.\n" c;
713 pr "%s You should have received a copy of the GNU General Public License along\n" c;
714 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
715 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
718 pr "%s This library is free software; you can redistribute it and/or\n" c;
719 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
720 pr "%s License as published by the Free Software Foundation;\n" c;
721 pr "%s version 2.1 of the License only.\n" c;
723 pr "%s This library is distributed in the hope that it will be useful,\n" c;
724 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
725 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
726 pr "%s Lesser General Public License for more details.\n" c;
728 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
729 pr "%s License along with this library; if not, write to the Free Software\n" c;
730 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
733 | CStyle -> pr " */\n"
736 | OCamlStyle -> pr " *)\n"
737 | HaskellStyle -> pr "-}\n"
738 | PODCommentStyle -> pr "\n=end comment\n"
742 (* Start of main code generation functions below this line. *)
744 let rec generate_c_header () =
745 generate_header CStyle LGPLv2;
758 /* NOTE: This API is documented in the man page hivex(3). */
761 typedef struct hive_h hive_h;
763 /* Nodes and values. */
764 typedef size_t hive_node_h;
765 typedef size_t hive_value_h;
769 # define HIVEX_NO_KEY ENOKEY
771 # define HIVEX_NO_KEY ENOENT
774 /* Pre-defined types. */
778 fun (t, old_style, new_style, description) ->
779 pr " /* %s */\n" description;
780 pr " hive_t_REG_%s,\n" new_style;
781 pr "#define hive_t_%s hive_t_REG_%s\n" old_style new_style;
787 typedef enum hive_type hive_type;
789 /* Bitmask of flags passed to hivex_open. */
792 fun (v, flag, description) ->
793 pr " /* %s */\n" description;
794 pr "#define HIVEX_OPEN_%-10s %d\n" flag v;
799 /* Array of (key, value) pairs passed to hivex_node_set_values. */
800 struct hive_set_value {
806 typedef struct hive_set_value hive_set_value;
810 pr "/* Functions. */\n";
812 (* Function declarations. *)
814 fun (shortname, style, _, _) ->
815 let name = "hivex_" ^ shortname in
816 generate_c_prototype ~extern:true name style
819 (* The visitor pattern. *)
821 /* Visit all nodes. This is specific to the C API and is not made
822 * available to other languages. This is because of the complexity
823 * of binding callbacks in other languages, but also because other
824 * languages make it much simpler to iterate over a tree.
826 struct hivex_visitor {
827 int (*node_start) (hive_h *, void *opaque, hive_node_h, const char *name);
828 int (*node_end) (hive_h *, void *opaque, hive_node_h, const char *name);
829 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);
830 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);
831 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);
832 int (*value_dword) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, int32_t);
833 int (*value_qword) (hive_h *, void *opaque, hive_node_h, hive_value_h, hive_type t, size_t len, const char *key, int64_t);
834 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);
835 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);
836 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);
837 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);
840 #define HIVEX_VISIT_SKIP_BAD 1
842 extern int hivex_visit (hive_h *h, const struct hivex_visitor *visitor, size_t len, void *opaque, int flags);
843 extern int hivex_visit_node (hive_h *h, hive_node_h node, const struct hivex_visitor *visitor, size_t len, void *opaque, int flags);
847 (* Finish the header file. *)
853 #endif /* HIVEX_H_ */
856 and generate_c_prototype ?(extern = false) name style =
857 if extern then pr "extern ";
858 (match fst style with
860 | RErrDispose -> pr "int "
861 | RHive -> pr "hive_h *"
862 | RSize -> pr "size_t "
863 | RNode -> pr "hive_node_h "
864 | RNodeNotFound -> pr "hive_node_h "
865 | RNodeList -> pr "hive_node_h *"
866 | RValue -> pr "hive_value_h "
867 | RValueList -> pr "hive_value_h *"
868 | RString -> pr "char *"
869 | RStringList -> pr "char **"
870 | RLenType -> pr "int "
871 | RLenTypeVal -> pr "char *"
872 | RInt32 -> pr "int32_t "
873 | RInt64 -> pr "int64_t "
876 let comma = ref false in
879 if !comma then pr ", "; comma := true;
881 | AHive -> pr "hive_h *h"
882 | ANode n -> pr "hive_node_h %s" n
883 | AValue n -> pr "hive_value_h %s" n
884 | AString n | AStringNullable n -> pr "const char *%s" n
885 | AOpenFlags | AUnusedFlags -> pr "int flags"
886 | ASetValues -> pr "size_t nr_values, const hive_set_value *values"
887 | ASetValue -> pr "const hive_set_value *val"
889 (match fst style with
890 | RLenType | RLenTypeVal -> pr ", hive_type *t, size_t *len"
895 and generate_c_pod () =
896 generate_header PODCommentStyle GPLv2;
903 hivex - Windows Registry \"hive\" extraction library
911 fun (shortname, style, _, _) ->
912 let name = "hivex_" ^ shortname in
914 generate_c_prototype ~extern:false name style;
919 Link with I<-lhivex>.
923 Hivex is a library for extracting the contents of Windows Registry
924 \"hive\" files. It is designed to be secure against buggy or malicious
927 Unlike other tools in this area, it doesn't use the textual .REG
928 format, because parsing that is as much trouble as parsing the
929 original binary format. Instead it makes the file available
930 through a C API, and then wraps this API in higher level scripting
933 There is a separate program to export the hive as XML
934 (see L<hivexml(1)>), or to navigate the file (see L<hivexsh(1)>).
935 There is also a Perl script to export and merge the
936 file as a textual .REG (regedit) file, see L<hivexregedit(1)>.
938 If you just want to export or modify the Registry of a Windows
939 virtual machine, you should look at L<virt-win-reg(1)>.
941 Hivex is also comes with language bindings for
942 OCaml, Perl, Python and Ruby.
948 This handle describes an open hive file.
950 =head2 C<hive_node_h>
952 This is a node handle, an integer but opaque outside the library.
953 Valid node handles cannot be 0. The library returns 0 in some
954 situations to indicate an error.
958 The enum below describes the possible types for the value(s)
959 stored at each node. Note that you should not trust the
960 type field in a Windows Registry, as it very often has no
961 relationship to reality. Some applications use their own
962 types. The encoding of strings is not specified. Some
963 programs store everything (including strings) in binary blobs.
968 fun (t, _, new_style, description) ->
969 pr " /* %s */\n" description;
970 pr " hive_t_REG_%s = %d,\n" new_style t
975 =head2 C<hive_value_h>
977 This is a value handle, an integer but opaque outside the library.
978 Valid value handles cannot be 0. The library returns 0 in some
979 situations to indicate an error.
981 =head2 C<hive_set_value>
983 The typedef C<hive_set_value> is used in conjunction with the
984 C<hivex_node_set_values> call described below.
986 struct hive_set_value {
987 char *key; /* key - a UTF-8 encoded ASCIIZ string */
988 hive_type t; /* type of value field */
989 size_t len; /* length of value field in bytes */
990 char *value; /* value field */
992 typedef struct hive_set_value hive_set_value;
994 To set the default value for a node, you have to pass C<key = \"\">.
996 Note that the C<value> field is just treated as a list of bytes, and
997 is stored directly in the hive. The caller has to ensure correct
998 encoding and endianness, for example converting dwords to little
1001 The correct type and encoding for values depends on the node and key
1002 in the registry, the version of Windows, and sometimes even changes
1003 between versions of Windows for the same key. We don't document it
1004 here. Often it's not documented at all.
1010 fun (shortname, style, _, longdesc) ->
1011 let name = "hivex_" ^ shortname in
1012 pr "=head2 %s\n" name;
1014 generate_c_prototype ~extern:false name style;
1019 if List.mem AUnusedFlags (snd style) then
1020 pr "The flags parameter is unused. Always pass 0.\n\n";
1022 if List.mem ASetValues (snd style) then
1023 pr "C<values> is an array of (key, value) pairs. There
1024 should be C<nr_values> elements in this array.
1026 Any existing values stored at the node are discarded, and their
1027 C<hive_value_h> handles become invalid. Thus you can remove all
1028 values stored at C<node> by passing C<nr_values = 0>.\n\n";
1030 if List.mem ASetValue (snd style) then
1031 pr "C<value> is a single (key, value) pair.
1033 Existing C<hive_value_h> handles become invalid.\n\n";
1035 (match fst style with
1038 Returns 0 on success.
1039 On error this returns -1 and sets errno.\n\n"
1042 Returns 0 on success.
1043 On error this returns -1 and sets errno.
1045 This function frees the hive handle (even if it returns an error).
1046 The hive handle must not be used again after calling this function.\n\n"
1049 Returns a new hive handle.
1050 On error this returns NULL and sets errno.\n\n"
1054 On error this returns 0 and sets errno.\n\n"
1057 Returns a node handle.
1058 On error this returns 0 and sets errno.\n\n"
1061 Returns a node handle.
1062 If the node was not found, this returns 0 without setting errno.
1063 On error this returns 0 and sets errno.\n\n"
1066 Returns a 0-terminated array of nodes.
1067 The array must be freed by the caller when it is no longer needed.
1068 On error this returns NULL and sets errno.\n\n"
1071 Returns a value handle.
1072 On error this returns 0 and sets errno.\n\n"
1075 Returns a 0-terminated array of values.
1076 The array must be freed by the caller when it is no longer needed.
1077 On error this returns NULL and sets errno.\n\n"
1081 The string must be freed by the caller when it is no longer needed.
1082 On error this returns NULL and sets errno.\n\n"
1085 Returns a NULL-terminated array of C strings.
1086 The strings and the array must all be freed by the caller when
1087 they are no longer needed.
1088 On error this returns NULL and sets errno.\n\n"
1091 Returns 0 on success.
1092 On error this returns -1 and sets errno.\n\n"
1095 The value is returned as an array of bytes (of length C<len>).
1096 The value must be freed by the caller when it is no longer needed.
1097 On error this returns NULL and sets errno.\n\n"
1098 | RInt32 | RInt64 -> ()
1103 =head1 WRITING TO HIVE FILES
1105 The hivex library supports making limited modifications to hive files.
1106 We have tried to implement this very conservatively in order to reduce
1107 the chance of corrupting your registry. However you should be careful
1108 and take back-ups, since Microsoft has never documented the hive
1109 format, and so it is possible there are nuances in the
1110 reverse-engineered format that we do not understand.
1112 To be able to modify a hive, you must pass the C<HIVEX_OPEN_WRITE>
1113 flag to C<hivex_open>, otherwise any write operation will return with
1116 The write operations shown below do not modify the on-disk file
1117 immediately. You must call C<hivex_commit> in order to write the
1118 changes to disk. If you call C<hivex_close> without committing then
1119 any writes are discarded.
1121 Hive files internally consist of a \"memory dump\" of binary blocks
1122 (like the C heap), and some of these blocks can be unused. The hivex
1123 library never reuses these unused blocks. Instead, to ensure
1124 robustness in the face of the partially understood on-disk format,
1125 hivex only allocates new blocks after the end of the file, and makes
1126 minimal modifications to existing structures in the file to point to
1127 these new blocks. This makes hivex slightly less disk-efficient than
1128 it could be, but disk is cheap, and registry modifications tend to be
1131 When deleting nodes, it is possible that this library may leave
1132 unreachable live blocks in the hive. This is because certain parts of
1133 the hive disk format such as security (sk) records and big data (db)
1134 records and classname fields are not well understood (and not
1135 documented at all) and we play it safe by not attempting to modify
1136 them. Apart from wasting a little bit of disk space, it is not
1137 thought that unreachable blocks are a problem.
1139 =head2 WRITE OPERATIONS WHICH ARE NOT SUPPORTED
1145 Changing the root node.
1149 Creating a new hive file from scratch. This is impossible at present
1150 because not all fields in the header are understood. In the hivex
1151 source tree is a file called C<images/minimal> which could be used as
1152 the basis for a new hive (but I<caveat emptor>).
1156 Modifying or deleting single values at a node.
1160 Modifying security key (sk) records or classnames.
1161 Previously we did not understand these records. However now they
1162 are well-understood and we could add support if it was required
1163 (but nothing much really uses them).
1167 =head1 VISITING ALL NODES
1169 The visitor pattern is useful if you want to visit all nodes
1170 in the tree or all nodes below a certain point in the tree.
1172 First you set up your own C<struct hivex_visitor> with your
1175 Each of these callback functions should return 0 on success or -1
1176 on error. If any callback returns -1, then the entire visit
1177 terminates immediately. If you don't need a callback function at
1178 all, set the function pointer to NULL.
1180 struct hivex_visitor {
1181 int (*node_start) (hive_h *, void *opaque, hive_node_h, const char *name);
1182 int (*node_end) (hive_h *, void *opaque, hive_node_h, const char *name);
1183 int (*value_string) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1184 hive_type t, size_t len, const char *key, const char *str);
1185 int (*value_multiple_strings) (hive_h *, void *opaque, hive_node_h,
1186 hive_value_h, hive_type t, size_t len, const char *key, char **argv);
1187 int (*value_string_invalid_utf16) (hive_h *, void *opaque, hive_node_h,
1188 hive_value_h, hive_type t, size_t len, const char *key,
1190 int (*value_dword) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1191 hive_type t, size_t len, const char *key, int32_t);
1192 int (*value_qword) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1193 hive_type t, size_t len, const char *key, int64_t);
1194 int (*value_binary) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1195 hive_type t, size_t len, const char *key, const char *value);
1196 int (*value_none) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1197 hive_type t, size_t len, const char *key, const char *value);
1198 int (*value_other) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1199 hive_type t, size_t len, const char *key, const char *value);
1200 /* If value_any callback is not NULL, then the other value_*
1201 * callbacks are not used, and value_any is called on all values.
1203 int (*value_any) (hive_h *, void *opaque, hive_node_h, hive_value_h,
1204 hive_type t, size_t len, const char *key, const char *value);
1211 int hivex_visit (hive_h *h, const struct hivex_visitor *visitor, size_t len, void *opaque, int flags);
1213 Visit all the nodes recursively in the hive C<h>.
1215 C<visitor> should be a C<hivex_visitor> structure with callback
1216 fields filled in as required (unwanted callbacks can be set to
1217 NULL). C<len> must be the length of the 'visitor' struct (you
1218 should pass C<sizeof (struct hivex_visitor)> for this).
1220 This returns 0 if the whole recursive visit was completed
1221 successfully. On error this returns -1. If one of the callback
1222 functions returned an error than we don't touch errno. If the
1223 error was generated internally then we set errno.
1225 You can skip bad registry entries by setting C<flag> to
1226 C<HIVEX_VISIT_SKIP_BAD>. If this flag is not set, then a bad registry
1227 causes the function to return an error immediately.
1229 This function is robust if the registry contains cycles or
1230 pointers which are invalid or outside the registry. It detects
1231 these cases and returns an error.
1233 =item hivex_visit_node
1235 int hivex_visit_node (hive_h *h, hive_node_h node, const struct hivex_visitor *visitor, size_t len, void *opaque);
1237 Same as C<hivex_visit> but instead of starting out at the root, this
1242 =head1 THE STRUCTURE OF THE WINDOWS REGISTRY
1244 Note: To understand the relationship between hives and the common
1245 Windows Registry keys (like C<HKEY_LOCAL_MACHINE>) please see the
1246 Wikipedia page on the Windows Registry.
1248 The Windows Registry is split across various binary files, each
1249 file being known as a \"hive\". This library only handles a single
1250 hive file at a time.
1252 Hives are n-ary trees with a single root. Each node in the tree
1255 Each node in the tree (including non-leaf nodes) may have an
1256 arbitrary list of (key, value) pairs attached to it. It may
1257 be the case that one of these pairs has an empty key. This
1258 is referred to as the default key for the node.
1260 The (key, value) pairs are the place where the useful data is
1261 stored in the registry. The key is always a string (possibly the
1262 empty string for the default key). The value is a typed object
1263 (eg. string, int32, binary, etc.).
1265 =head2 RELATIONSHIP TO .REG FILES
1267 The hivex C library does not care about or deal with Windows .REG
1268 files. Instead we push this complexity up to the Perl
1269 L<Win::Hivex(3)> library and the Perl programs
1270 L<hivexregedit(1)> and L<virt-win-reg(1)>.
1271 Nevertheless it is useful to look at the relationship between the
1272 Registry and .REG files because they are so common.
1274 A .REG file is a textual representation of the registry, or part of the
1275 registry. The actual registry hives that Windows uses are binary
1276 files. There are a number of Windows and Linux tools that let you
1277 generate .REG files, or merge .REG files back into the registry hives.
1278 Notable amongst them is Microsoft's REGEDIT program (formerly known as
1281 A typical .REG file will contain many sections looking like this:
1283 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Classes\\Stack]
1284 \"@\"=\"Generic Stack\"
1285 \"TileInfo\"=\"prop:System.FileCount\"
1286 \"TilePath\"=str(2):\"%%systemroot%%\\\\system32\"
1287 \"ThumbnailCutoff\"=dword:00000000
1288 \"FriendlyTypeName\"=hex(2):40,00,25,00,53,00,79,00,73,00,74,00,65,00,6d,00,52,00,6f,00,\\
1289 6f,00,74,00,25,00,5c,00,53,00,79,00,73,00,74,00,65,00,6d,00,\\
1290 33,00,32,00,5c,00,73,00,65,00,61,00,72,00,63,00,68,00,66,00,\\
1291 6f,00,6c,00,64,00,65,00,72,00,2e,00,64,00,6c,00,6c,00,2c,00,\\
1292 2d,00,39,00,30,00,32,00,38,00,00,00,d8
1294 Taking this one piece at a time:
1296 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Classes\\Stack]
1298 This is the path to this node in the registry tree. The first part,
1299 C<HKEY_LOCAL_MACHINE\\SOFTWARE> means that this comes from a hive
1300 file called C<C:\\WINDOWS\\SYSTEM32\\CONFIG\\SOFTWARE>.
1301 C<\\Classes\\Stack> is the real path part,
1302 starting at the root node of the C<SOFTWARE> hive.
1304 Below the node name is a list of zero or more key-value pairs. Any
1305 interior or leaf node in the registry may have key-value pairs
1308 \"@\"=\"Generic Stack\"
1310 This is the \"default key\". In reality (ie. inside the binary hive)
1311 the key string is the empty string. In .REG files this is written as
1312 C<@> but this has no meaning either in the hives themselves or in this
1313 library. The value is a string (type 1 - see C<enum hive_type>
1316 \"TileInfo\"=\"prop:System.FileCount\"
1318 This is a regular (key, value) pair, with the value being a type 1
1319 string. Note that inside the binary file the string is likely to be
1320 UTF-16LE encoded. This library converts to and from UTF-8 strings
1321 transparently in some cases.
1323 \"TilePath\"=str(2):\"%%systemroot%%\\\\system32\"
1325 The value in this case has type 2 (expanded string) meaning that some
1326 %%...%% variables get expanded by Windows. (This library doesn't know
1327 or care about variable expansion).
1329 \"ThumbnailCutoff\"=dword:00000000
1331 The value in this case is a dword (type 4).
1333 \"FriendlyTypeName\"=hex(2):40,00,....
1335 This value is an expanded string (type 2) represented in the .REG file
1336 as a series of hex bytes. In this case the string appears to be a
1339 =head1 NOTE ON THE USE OF ERRNO
1341 Many functions in this library set errno to indicate errors. These
1342 are the values of errno you may encounter (this list is not
1349 Corrupt or unsupported Registry file format.
1357 Passed an invalid argument to the function.
1361 Followed a Registry pointer which goes outside
1362 the registry or outside a registry block.
1366 Registry contains cycles.
1370 Field in the registry out of range.
1374 Registry key already exists.
1378 Tried to write to a registry which is not opened for writing.
1382 =head1 ENVIRONMENT VARIABLES
1388 Setting HIVEX_DEBUG=1 will enable very verbose messages. This is
1389 useful for debugging problems with the library itself.
1402 L<http://libguestfs.org/>,
1405 L<http://en.wikipedia.org/wiki/Windows_Registry>.
1409 Richard W.M. Jones (C<rjones at redhat dot com>)
1413 Copyright (C) 2009-2010 Red Hat Inc.
1415 Derived from code by Petter Nordahl-Hagen under a compatible license:
1416 Copyright (C) 1997-2007 Petter Nordahl-Hagen.
1418 Derived from code by Markus Stephany under a compatible license:
1419 Copyright (C) 2000-2004 Markus Stephany.
1421 This library is free software; you can redistribute it and/or
1422 modify it under the terms of the GNU Lesser General Public
1423 License as published by the Free Software Foundation;
1424 version 2.1 of the License only.
1426 This library is distributed in the hope that it will be useful,
1427 but WITHOUT ANY WARRANTY; without even the implied warranty of
1428 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1429 Lesser General Public License for more details.
1432 (* Generate the linker script which controls the visibility of
1433 * symbols in the public ABI and ensures no other symbols get
1434 * exported accidentally.
1436 and generate_linker_script () =
1437 generate_header HashStyle GPLv2plus;
1445 List.map (fun (name, _, _, _) -> "hivex_" ^ name)
1447 let globals = List.sort compare (globals @ functions) in
1451 List.iter (pr " %s;\n") globals;
1458 and generate_ocaml_interface () =
1459 generate_header OCamlStyle LGPLv2plus;
1463 (** A [hive_h] hive file handle. *)
1467 (** Nodes and values. *)
1469 exception Error of string * Unix.error * string
1470 (** Error raised by a function.
1472 The first parameter is the name of the function which raised the error.
1473 The second parameter is the errno (see the [Unix] module). The third
1474 parameter is a human-readable string corresponding to the errno.
1476 See hivex(3) for a partial list of interesting errno values that
1477 can be generated by the library. *)
1478 exception Handle_closed of string
1479 (** This exception is raised if you call a function on a closed handle. *)
1485 fun (t, _, new_style, description) ->
1487 pr " | REG_%s (** %s *)\n" new_style description
1491 | REG_UNKNOWN of int32 (** unknown type *)
1492 (** Hive type field. *)
1498 fun (v, flag, description) ->
1499 assert (1 lsl i = v);
1500 pr " | OPEN_%s (** %s *)\n" flag description
1504 (** Open flags for {!open_file} call. *)
1511 (** (key, value) pair passed (as an array) to {!node_set_values}. *)
1515 fun (name, style, shortdesc, _) ->
1517 generate_ocaml_prototype name style;
1518 pr "(** %s *)\n" shortdesc
1521 and generate_ocaml_implementation () =
1522 generate_header OCamlStyle LGPLv2plus;
1529 exception Error of string * Unix.error * string
1530 exception Handle_closed of string
1532 (* Give the exceptions names, so they can be raised from the C code. *)
1534 Callback.register_exception \"ocaml_hivex_error\"
1535 (Error (\"\", Unix.EUNKNOWNERR 0, \"\"));
1536 Callback.register_exception \"ocaml_hivex_closed\" (Handle_closed \"\")
1542 fun (t, _, new_style, _) ->
1544 pr " | REG_%s\n" new_style
1548 | REG_UNKNOWN of int32
1554 fun (v, flag, description) ->
1555 assert (1 lsl i = v);
1556 pr " | OPEN_%s (** %s *)\n" flag description
1570 fun (name, style, _, _) ->
1571 generate_ocaml_prototype ~is_external:true name style
1574 and generate_ocaml_prototype ?(is_external = false) name style =
1575 let ocaml_name = if name = "open" then "open_file" else name in
1577 if is_external then pr "external " else pr "val ";
1578 pr "%s : " ocaml_name;
1581 | AHive -> pr "t -> "
1582 | ANode _ -> pr "node -> "
1583 | AValue _ -> pr "value -> "
1584 | AString _ -> pr "string -> "
1585 | AStringNullable _ -> pr "string option -> "
1586 | AOpenFlags -> pr "open_flag list -> "
1587 | AUnusedFlags -> ()
1588 | ASetValues -> pr "set_value array -> "
1589 | ASetValue -> pr "set_value -> "
1591 (match fst style with
1592 | RErr -> pr "unit" (* all errors are turned into exceptions *)
1593 | RErrDispose -> pr "unit"
1595 | RSize -> pr "int64"
1596 | RNode -> pr "node"
1597 | RNodeNotFound -> pr "node"
1598 | RNodeList -> pr "node array"
1599 | RValue -> pr "value"
1600 | RValueList -> pr "value array"
1601 | RString -> pr "string"
1602 | RStringList -> pr "string array"
1603 | RLenType -> pr "hive_type * int"
1604 | RLenTypeVal -> pr "hive_type * string"
1605 | RInt32 -> pr "int32"
1606 | RInt64 -> pr "int64"
1609 pr " = \"ocaml_hivex_%s\"" name;
1612 and generate_ocaml_c () =
1613 generate_header CStyle LGPLv2plus;
1624 #include <caml/config.h>
1625 #include <caml/alloc.h>
1626 #include <caml/callback.h>
1627 #include <caml/custom.h>
1628 #include <caml/fail.h>
1629 #include <caml/memory.h>
1630 #include <caml/mlvalues.h>
1631 #include <caml/signals.h>
1633 #ifdef HAVE_CAML_UNIXSUPPORT_H
1634 #include <caml/unixsupport.h>
1636 extern value unix_error_of_code (int errcode);
1639 #ifndef HAVE_CAML_RAISE_WITH_ARGS
1641 caml_raise_with_args (value tag, int nargs, value args[])
1644 CAMLxparamN (args, nargs);
1648 bucket = caml_alloc_small (1 + nargs, 0);
1649 Field(bucket, 0) = tag;
1650 for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
1658 #define Hiveh_val(v) (*((hive_h **)Data_custom_val(v)))
1659 static value Val_hiveh (hive_h *);
1660 static int HiveOpenFlags_val (value);
1661 static hive_set_value *HiveSetValue_val (value);
1662 static hive_set_value *HiveSetValues_val (value);
1663 static hive_type HiveType_val (value);
1664 static value Val_hive_type (hive_type);
1665 static value copy_int_array (size_t *);
1666 static value copy_type_len (size_t, hive_type);
1667 static value copy_type_value (const char *, size_t, hive_type);
1668 static void raise_error (const char *) Noreturn;
1669 static void raise_closed (const char *) Noreturn;
1675 fun (name, style, _, _) ->
1676 pr "/* Automatically generated wrapper for function\n";
1677 pr " * "; generate_ocaml_prototype name style;
1683 | ASetValues -> ["nrvalues"; "values"]
1684 | AUnusedFlags -> ["0"]
1685 | arg -> [name_of_argt arg]) (snd style) in
1687 match fst style with
1688 | RLenType | RLenTypeVal -> c_params @ [["&t"; "&len"]]
1690 let c_params = List.concat c_params in
1693 filter_map (function
1694 | AUnusedFlags -> None
1695 | arg -> Some (name_of_argt arg ^ "v")) (snd style) in
1697 pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
1698 pr "CAMLprim value ocaml_hivex_%s (value %s" name (List.hd params);
1699 List.iter (pr ", value %s") (List.tl params); pr ");\n";
1702 pr "CAMLprim value\n";
1703 pr "ocaml_hivex_%s (value %s" name (List.hd params);
1704 List.iter (pr ", value %s") (List.tl params);
1708 pr " CAMLparam%d (%s);\n"
1709 (List.length params) (String.concat ", " params);
1710 pr " CAMLlocal1 (rv);\n";
1716 pr " hive_h *h = Hiveh_val (hv);\n";
1717 pr " if (h == NULL)\n";
1718 pr " raise_closed (\"%s\");\n" name
1720 pr " hive_node_h %s = Int_val (%sv);\n" n n
1722 pr " hive_value_h %s = Int_val (%sv);\n" n n
1724 pr " const char *%s = String_val (%sv);\n" n n
1725 | AStringNullable n ->
1726 pr " const char *%s =\n" n;
1727 pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
1730 pr " int flags = HiveOpenFlags_val (flagsv);\n"
1731 | AUnusedFlags -> ()
1733 pr " int nrvalues = Wosize_val (valuesv);\n";
1734 pr " hive_set_value *values = HiveSetValues_val (valuesv);\n"
1736 pr " hive_set_value *val = HiveSetValue_val (valv);\n"
1741 match fst style with
1742 | RErr -> pr " int r;\n"; "-1"
1743 | RErrDispose -> pr " int r;\n"; "-1"
1744 | RHive -> pr " hive_h *r;\n"; "NULL"
1745 | RSize -> pr " size_t r;\n"; "0"
1746 | RNode -> pr " hive_node_h r;\n"; "0"
1749 pr " hive_node_h r;\n";
1751 | RNodeList -> pr " hive_node_h *r;\n"; "NULL"
1752 | RValue -> pr " hive_value_h r;\n"; "0"
1753 | RValueList -> pr " hive_value_h *r;\n"; "NULL"
1754 | RString -> pr " char *r;\n"; "NULL"
1755 | RStringList -> pr " char **r;\n"; "NULL"
1758 pr " size_t len;\n";
1759 pr " hive_type t;\n";
1763 pr " size_t len;\n";
1764 pr " hive_type t;\n";
1773 "-1 && errno != 0" in
1775 (* The libguestfs OCaml bindings call enter_blocking_section
1776 * here. However I don't think that is safe, because we are
1777 * holding pointers to caml strings during the call, and these
1778 * could be moved or freed by other threads. In any case, there
1779 * is very little reason to enter_blocking_section for any hivex
1780 * call, so don't do it. XXX
1782 (*pr " caml_enter_blocking_section ();\n";*)
1783 pr " r = hivex_%s (%s" name (List.hd c_params);
1784 List.iter (pr ", %s") (List.tl c_params);
1786 (*pr " caml_leave_blocking_section ();\n";*)
1789 (* Dispose of the hive handle (even if hivex_close returns error). *)
1790 (match fst style with
1792 pr " /* So we don't double-free in the finalizer. */\n";
1793 pr " Hiveh_val (hv) = NULL;\n";
1800 | AHive | ANode _ | AValue _ | AString _ | AStringNullable _
1801 | AOpenFlags | AUnusedFlags -> ()
1803 pr " free (values);\n";
1806 pr " free (val);\n";
1810 (* Check for errors. *)
1811 pr " if (r == %s)\n" error_code;
1812 pr " raise_error (\"%s\");\n" name;
1815 (match fst style with
1816 | RErr -> pr " rv = Val_unit;\n"
1817 | RErrDispose -> pr " rv = Val_unit;\n"
1818 | RHive -> pr " rv = Val_hiveh (r);\n"
1819 | RSize -> pr " rv = caml_copy_int64 (r);\n"
1820 | RNode -> pr " rv = Val_int (r);\n"
1822 pr " if (r == 0)\n";
1823 pr " caml_raise_not_found ();\n";
1825 pr " rv = Val_int (r);\n"
1827 pr " rv = copy_int_array (r);\n";
1829 | RValue -> pr " rv = Val_int (r);\n"
1831 pr " rv = copy_int_array (r);\n";
1834 pr " rv = caml_copy_string (r);\n";
1837 pr " rv = caml_copy_string_array ((const char **) r);\n";
1838 pr " for (int i = 0; r[i] != NULL; ++i) free (r[i]);\n";
1840 | RLenType -> pr " rv = copy_type_len (len, t);\n"
1842 pr " rv = copy_type_value (r, len, t);\n";
1844 | RInt32 -> pr " rv = caml_copy_int32 (r);\n"
1845 | RInt64 -> pr " rv = caml_copy_int64 (r);\n"
1848 pr " CAMLreturn (rv);\n";
1856 HiveOpenFlags_val (value v)
1861 while (v != Val_int (0)) {
1863 flags |= 1 << Int_val (v2);
1870 static hive_set_value *
1871 HiveSetValue_val (value v)
1873 hive_set_value *val = malloc (sizeof (hive_set_value));
1875 val->key = String_val (Field (v, 0));
1876 val->t = HiveType_val (Field (v, 1));
1877 val->len = caml_string_length (Field (v, 2));
1878 val->value = String_val (Field (v, 2));
1883 static hive_set_value *
1884 HiveSetValues_val (value v)
1886 size_t nr_values = Wosize_val (v);
1887 hive_set_value *values = malloc (nr_values * sizeof (hive_set_value));
1891 for (i = 0; i < nr_values; ++i) {
1893 values[i].key = String_val (Field (v2, 0));
1894 values[i].t = HiveType_val (Field (v2, 1));
1895 values[i].len = caml_string_length (Field (v2, 2));
1896 values[i].value = String_val (Field (v2, 2));
1903 HiveType_val (value v)
1906 return Int_val (v); /* REG_NONE etc. */
1908 return Int32_val (Field (v, 0)); /* REG_UNKNOWN of int32 */
1912 Val_hive_type (hive_type t)
1918 CAMLreturn (Val_int (t));
1920 rv = caml_alloc (1, 0); /* REG_UNKNOWN of int32 */
1921 v = caml_copy_int32 (t);
1922 caml_modify (&Field (rv, 0), v);
1928 copy_int_array (size_t *xs)
1934 for (nr = 0; xs[nr] != 0; ++nr)
1937 CAMLreturn (Atom (0));
1939 rv = caml_alloc (nr, 0);
1940 for (i = 0; i < nr; ++i) {
1941 v = Val_int (xs[i]);
1942 Store_field (rv, i, v); /* Safe because v is not a block. */
1949 copy_type_len (size_t len, hive_type t)
1954 rv = caml_alloc (2, 0);
1955 v = Val_hive_type (t);
1956 Store_field (rv, 0, v);
1958 Store_field (rv, 1, v);
1963 copy_type_value (const char *r, size_t len, hive_type t)
1968 rv = caml_alloc (2, 0);
1969 v = Val_hive_type (t);
1970 Store_field (rv, 0, v);
1971 v = caml_alloc_string (len);
1972 memcpy (String_val (v), r, len);
1973 caml_modify (&Field (rv, 1), v);
1977 /* Raise exceptions. */
1979 raise_error (const char *function)
1981 /* Save errno early in case it gets trashed. */
1985 CAMLlocal3 (v1, v2, v3);
1987 v1 = caml_copy_string (function);
1988 v2 = unix_error_of_code (err);
1989 v3 = caml_copy_string (strerror (err));
1990 value vvv[] = { v1, v2, v3 };
1991 caml_raise_with_args (*caml_named_value (\"ocaml_hivex_error\"), 3, vvv);
1997 raise_closed (const char *function)
2002 v = caml_copy_string (function);
2003 caml_raise_with_arg (*caml_named_value (\"ocaml_hivex_closed\"), v);
2008 /* Allocate handles and deal with finalization. */
2010 hivex_finalize (value hv)
2012 hive_h *h = Hiveh_val (hv);
2013 if (h) hivex_close (h);
2016 static struct custom_operations hivex_custom_operations = {
2017 (char *) \"hivex_custom_operations\",
2019 custom_compare_default,
2020 custom_hash_default,
2021 custom_serialize_default,
2022 custom_deserialize_default
2026 Val_hiveh (hive_h *h)
2031 rv = caml_alloc_custom (&hivex_custom_operations,
2032 sizeof (hive_h *), 0, 1);
2039 and generate_perl_pm () =
2040 generate_header HashStyle LGPLv2plus;
2047 Win::Hivex - Perl bindings for reading and writing Windows Registry hive files
2053 $h = Win::Hivex->open ('SOFTWARE');
2054 $root_node = $h->root ();
2055 print $h->node_name ($root_node);
2059 The C<Win::Hivex> module provides a Perl XS binding to the
2060 L<hivex(3)> API for reading and writing Windows Registry binary
2065 All errors turn into calls to C<croak> (see L<Carp(3)>).
2079 XSLoader::load ('Win::Hivex');
2083 $h = Win::Hivex->open ($filename,";
2087 pr "\n [%s => 1,]" (String.lowercase flag)
2092 Open a Windows Registry binary hive file.
2094 The C<verbose> and C<debug> flags enable different levels of
2097 The C<write> flag is required if you will be modifying the
2098 hive file (see L<hivex(3)/WRITING TO HIVE FILES>).
2100 This function returns a hive handle. The hive handle is
2101 closed automatically when its reference count drops to 0.
2107 my $class = ref ($proto) || $proto;
2108 my $filename = shift;
2115 fun (n, flag, description) ->
2116 pr " # %s\n" description;
2117 pr " $flags += %d if $flags{%s};\n" n (String.lowercase flag)
2122 my $self = Win::Hivex::_open ($filename, $flags);
2123 bless $self, $class;
2130 fun (name, style, _, longdesc) ->
2131 (* The close call isn't explicit in Perl: handles are closed
2132 * when their reference count drops to 0.
2134 * The open call is coded specially in Perl.
2136 * Therefore we don't generate prototypes for these two calls:
2138 if fst style <> RErrDispose && List.hd (snd style) = AHive then (
2139 let longdesc = replace_str longdesc "C<hivex_" "C<" in
2140 pr "=item %s\n\n " name;
2141 generate_perl_prototype name style;
2143 pr "%s\n\n" longdesc;
2145 (match fst style with
2157 This returns a size.\n\n"
2160 This returns a node handle.\n\n"
2163 This returns a node handle, or C<undef> if the node was not found.\n\n"
2166 This returns a list of node handles.\n\n"
2169 This returns a value handle.\n\n"
2172 This returns a list of value handles.\n\n"
2175 if List.mem ASetValues (snd style) then
2176 pr "C<@values> is an array of (keys, value) pairs.
2177 Each element should be a hashref containing C<key>, C<t> (type)
2180 Any existing values stored at the node are discarded, and their
2181 C<value> handles become invalid. Thus you can remove all
2182 values stored at C<node> by passing C<@values = []>.\n\n"
2195 Copyright (C) %s Red Hat Inc.
2199 Please see the file COPYING.LIB for the full license.
2205 L<http://libguestfs.org>,
2211 and generate_perl_prototype name style =
2213 (match fst style with
2216 | RHive -> pr "$h = "
2217 | RSize -> pr "$size = "
2219 | RNodeNotFound -> pr "$node = "
2220 | RNodeList -> pr "@nodes = "
2221 | RValue -> pr "$value = "
2222 | RValueList -> pr "@values = "
2223 | RString -> pr "$string = "
2224 | RStringList -> pr "@strings = "
2225 | RLenType -> pr "($type, $len) = "
2226 | RLenTypeVal -> pr "($type, $data) = "
2227 | RInt32 -> pr "$int32 = "
2228 | RInt64 -> pr "$int64 = "
2231 let args = List.tl (snd style) in
2233 (* AUnusedFlags is dropped in the bindings. *)
2234 let args = List.filter ((<>) AUnusedFlags) args in
2238 let comma = ref false in
2241 if !comma then pr ", "; comma := true;
2246 | AString n -> pr "$%s" n
2247 | AStringNullable n -> pr "[$%s|undef]" n
2248 | AOpenFlags -> pr "[flags]"
2249 | AUnusedFlags -> assert false
2250 | ASetValues -> pr "\\@values"
2251 | ASetValue -> pr "$val"
2256 and generate_perl_xs () =
2257 generate_header CStyle LGPLv2plus;
2260 #include \"EXTERN.h\"
2266 #include <inttypes.h>
2269 my_newSVll(long long val) {
2270 #ifdef USE_64_BIT_ALL
2271 return newSViv(val);
2275 len = snprintf(buf, 100, \"%%\" PRId64, val);
2276 return newSVpv(buf, len);
2282 my_newSVull(unsigned long long val) {
2283 #ifdef USE_64_BIT_ALL
2284 return newSVuv(val);
2288 len = snprintf(buf, 100, \"%%\" PRIu64, val);
2289 return newSVpv(buf, len);
2295 /* http://www.perlmonks.org/?node_id=680842 */
2297 XS_unpack_charPtrPtr (SV *arg) {
2302 if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
2303 croak (\"array reference expected\");
2305 av = (AV *)SvRV (arg);
2306 ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
2308 croak (\"malloc failed\");
2310 for (i = 0; i <= av_len (av); i++) {
2311 SV **elem = av_fetch (av, i, 0);
2313 if (!elem || !*elem)
2314 croak (\"missing element in list\");
2316 ret[i] = SvPV_nolen (*elem);
2325 /* Handle set_values parameter. */
2326 typedef struct pl_set_values {
2328 hive_set_value *values;
2331 static pl_set_values
2332 unpack_pl_set_values (SV *sv)
2338 if (!sv || !SvOK (sv) || !SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
2339 croak (\"array reference expected\");
2341 av = (AV *)SvRV(sv);
2342 ret.nr_values = av_len (av) + 1;
2343 ret.values = malloc (ret.nr_values * sizeof (hive_set_value));
2345 croak (\"malloc failed\");
2347 for (i = 0; i <= av_len (av); i++) {
2348 SV **hvp = av_fetch (av, i, 0);
2350 if (!hvp || !*hvp || !SvROK (*hvp) || SvTYPE (SvRV (*hvp)) != SVt_PVHV)
2351 croak (\"missing element in list or not a hash ref\");
2353 HV *hv = (HV *)SvRV(*hvp);
2356 svp = hv_fetch (hv, \"key\", 3, 0);
2358 croak (\"missing 'key' in hash\");
2359 ret.values[i].key = SvPV_nolen (*svp);
2361 svp = hv_fetch (hv, \"t\", 1, 0);
2363 croak (\"missing 't' in hash\");
2364 ret.values[i].t = SvIV (*svp);
2366 svp = hv_fetch (hv, \"value\", 5, 0);
2368 croak (\"missing 'value' in hash\");
2369 ret.values[i].value = SvPV (*svp, ret.values[i].len);
2375 static hive_set_value *
2376 unpack_set_value (SV *sv)
2378 hive_set_value *ret;
2380 if (!sv || !SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVHV)
2381 croak (\"not a hash ref\");
2383 ret = malloc (sizeof (hive_set_value));
2385 croak (\"malloc failed\");
2387 HV *hv = (HV *)SvRV(sv);
2390 svp = hv_fetch (hv, \"key\", 3, 0);
2392 croak (\"missing 'key' in hash\");
2393 ret->key = SvPV_nolen (*svp);
2395 svp = hv_fetch (hv, \"t\", 1, 0);
2397 croak (\"missing 't' in hash\");
2398 ret->t = SvIV (*svp);
2400 svp = hv_fetch (hv, \"value\", 5, 0);
2402 croak (\"missing 'value' in hash\");
2403 ret->value = SvPV (*svp, ret->len);
2408 MODULE = Win::Hivex PACKAGE = Win::Hivex
2413 _open (filename, flags)
2417 RETVAL = hivex_open (filename, flags);
2419 croak (\"hivex_open: %%s: %%s\", filename, strerror (errno));
2427 if (hivex_close (h) == -1)
2428 croak (\"hivex_close: %%s\", strerror (errno));
2433 fun (name, style, _, longdesc) ->
2434 (* The close and open calls are handled specially above. *)
2435 if fst style <> RErrDispose && List.hd (snd style) = AHive then (
2436 (match fst style with
2437 | RErr -> pr "void\n"
2438 | RErrDispose -> failwith "perl bindings cannot handle a call which disposes of the handle"
2439 | RHive -> failwith "perl bindings cannot handle a call which returns a handle"
2444 | RString -> pr "SV *\n"
2449 | RLenTypeVal -> pr "void\n"
2450 | RInt32 -> pr "SV *\n"
2451 | RInt64 -> pr "SV *\n"
2454 (* Call and arguments. *)
2456 filter_map (function
2457 | AUnusedFlags -> None
2458 | arg -> Some (name_of_argt arg)) (snd style) in
2462 | AUnusedFlags -> "0"
2463 | ASetValues -> "values.nr_values, values.values"
2464 | arg -> name_of_argt arg) (snd style) in
2466 pr "%s (%s)\n" name (String.concat ", " perl_params);
2477 | AStringNullable n ->
2478 (* http://www.perlmonks.org/?node_id=554277 *)
2479 pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n i i
2482 | AUnusedFlags -> ()
2484 pr " pl_set_values values = unpack_pl_set_values (ST(%d));\n" i
2486 pr " hive_set_value *val = unpack_set_value (ST(%d));\n" i
2493 pr " free (values.values);\n"
2496 | AHive | ANode _ | AValue _ | AString _ | AStringNullable _
2497 | AOpenFlags | AUnusedFlags -> ()
2502 (match fst style with
2507 pr " r = hivex_%s (%s);\n"
2508 name (String.concat ", " c_params);
2510 pr " if (r == -1)\n";
2511 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2514 | RErrDispose -> assert false
2515 | RHive -> assert false
2521 pr " /* hive_node_h = hive_value_h = size_t so we cheat\n";
2522 pr " here to simplify the generator */\n";
2525 pr " r = hivex_%s (%s);\n"
2526 name (String.concat ", " c_params);
2528 pr " if (r == 0)\n";
2529 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2531 pr " RETVAL = newSViv (r);\n";
2537 pr " hive_node_h r;\n";
2540 pr " r = hivex_%s (%s);\n"
2541 name (String.concat ", " c_params);
2543 pr " if (r == 0 && errno != 0)\n";
2544 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2546 pr " if (r == 0)\n";
2547 pr " RETVAL = &PL_sv_undef;\n";
2549 pr " RETVAL = newSViv (r);\n";
2557 pr " r = hivex_%s (%s);\n"
2558 name (String.concat ", " c_params);
2560 pr " if (r == NULL)\n";
2561 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2563 pr " RETVAL = newSVpv (r, 0);\n";
2574 pr " r = hivex_%s (%s);\n"
2575 name (String.concat ", " c_params);
2577 pr " if (r == NULL)\n";
2578 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2580 pr " for (n = 0; r[n] != 0; ++n) /**/;\n";
2581 pr " EXTEND (SP, n);\n";
2582 pr " for (i = 0; i < n; ++i)\n";
2583 pr " PUSHs (sv_2mortal (newSViv (r[i])));\n";
2591 pr " r = hivex_%s (%s);\n"
2592 name (String.concat ", " c_params);
2594 pr " if (r == NULL)\n";
2595 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2597 pr " for (n = 0; r[n] != NULL; ++n) /**/;\n";
2598 pr " EXTEND (SP, n);\n";
2599 pr " for (i = 0; i < n; ++i) {\n";
2600 pr " PUSHs (sv_2mortal (newSVpv (r[i], 0)));\n";
2601 pr " free (r[i]);\n";
2608 pr " size_t len;\n";
2609 pr " hive_type type;\n";
2611 pr " r = hivex_%s (%s, &type, &len);\n"
2612 name (String.concat ", " c_params);
2614 pr " if (r == -1)\n";
2615 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2617 pr " EXTEND (SP, 2);\n";
2618 pr " PUSHs (sv_2mortal (newSViv (type)));\n";
2619 pr " PUSHs (sv_2mortal (newSViv (len)));\n";
2624 pr " size_t len;\n";
2625 pr " hive_type type;\n";
2627 pr " r = hivex_%s (%s, &type, &len);\n"
2628 name (String.concat ", " c_params);
2630 pr " if (r == NULL)\n";
2631 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2633 pr " EXTEND (SP, 2);\n";
2634 pr " PUSHs (sv_2mortal (newSViv (type)));\n";
2635 pr " PUSHs (sv_2mortal (newSVpvn (r, len)));\n";
2643 pr " r = hivex_%s (%s);\n"
2644 name (String.concat ", " c_params);
2646 pr " if (r == -1 && errno != 0)\n";
2647 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2649 pr " RETVAL = newSViv (r);\n";
2658 pr " r = hivex_%s (%s);\n"
2659 name (String.concat ", " c_params);
2661 pr " if (r == -1 && errno != 0)\n";
2662 pr " croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
2664 pr " RETVAL = my_newSVll (r);\n";
2672 and generate_python_c () =
2673 generate_header CStyle LGPLv2plus;
2676 #define PY_SSIZE_T_CLEAN 1
2679 #if PY_VERSION_HEX < 0x02050000
2680 typedef int Py_ssize_t;
2681 #define PY_SSIZE_T_MAX INT_MAX
2682 #define PY_SSIZE_T_MIN INT_MIN
2689 #include \"hivex.h\"
2691 #ifndef HAVE_PYCAPSULE_NEW
2699 get_handle (PyObject *obj)
2702 assert (obj != Py_None);
2703 #ifndef HAVE_PYCAPSULE_NEW
2704 return ((Pyhivex_Object *) obj)->h;
2706 return (hive_h *) PyCapsule_GetPointer(obj, \"hive_h\");
2711 put_handle (hive_h *h)
2714 #ifndef HAVE_PYCAPSULE_NEW
2716 PyCObject_FromVoidPtrAndDesc ((void *) h, (char *) \"hive_h\", NULL);
2718 return PyCapsule_New ((void *) h, \"hive_h\", NULL);
2722 /* This returns pointers into the Python objects, which should
2726 get_value (PyObject *v, hive_set_value *ret)
2730 obj = PyDict_GetItemString (v, \"key\");
2732 PyErr_SetString (PyExc_RuntimeError, \"no 'key' element in dictionary\");
2735 if (!PyString_Check (obj)) {
2736 PyErr_SetString (PyExc_RuntimeError, \"'key' element is not a string\");
2739 ret->key = PyString_AsString (obj);
2741 obj = PyDict_GetItemString (v, \"t\");
2743 PyErr_SetString (PyExc_RuntimeError, \"no 't' element in dictionary\");
2746 if (!PyInt_Check (obj)) {
2747 PyErr_SetString (PyExc_RuntimeError, \"'t' element is not an integer\");
2750 ret->t = PyInt_AsLong (obj);
2752 obj = PyDict_GetItemString (v, \"value\");
2754 PyErr_SetString (PyExc_RuntimeError, \"no 'value' element in dictionary\");
2757 if (!PyString_Check (obj)) {
2758 PyErr_SetString (PyExc_RuntimeError, \"'value' element is not a string\");
2761 ret->value = PyString_AsString (obj);
2762 ret->len = PyString_Size (obj);
2767 typedef struct py_set_values {
2769 hive_set_value *values;
2773 get_values (PyObject *v, py_set_values *ret)
2778 if (!PyList_Check (v)) {
2779 PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
2783 slen = PyList_Size (v);
2785 PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
2788 len = (size_t) slen;
2789 ret->nr_values = len;
2790 ret->values = malloc (len * sizeof (hive_set_value));
2792 PyErr_SetString (PyExc_RuntimeError, strerror (errno));
2796 for (i = 0; i < len; ++i) {
2797 if (get_value (PyList_GetItem (v, i), &(ret->values[i])) == -1) {
2807 put_string_list (char * const * const argv)
2812 for (argc = 0; argv[argc] != NULL; ++argc)
2815 list = PyList_New (argc);
2816 for (i = 0; i < argc; ++i)
2817 PyList_SetItem (list, i, PyString_FromString (argv[i]));
2823 free_strings (char **argv)
2827 for (argc = 0; argv[argc] != NULL; ++argc)
2832 /* Since hive_node_t is the same as hive_value_t this also works for values. */
2834 put_node_list (hive_node_h *nodes)
2839 for (argc = 0; nodes[argc] != 0; ++argc)
2842 list = PyList_New (argc);
2843 for (i = 0; i < argc; ++i)
2844 PyList_SetItem (list, i, PyLong_FromLongLong ((long) nodes[i]));
2850 put_len_type (size_t len, hive_type t)
2852 PyObject *r = PyTuple_New (2);
2853 PyTuple_SetItem (r, 0, PyInt_FromLong ((long) t));
2854 PyTuple_SetItem (r, 1, PyLong_FromLongLong ((long) len));
2859 put_val_type (char *val, size_t len, hive_type t)
2861 PyObject *r = PyTuple_New (2);
2862 PyTuple_SetItem (r, 0, PyInt_FromLong ((long) t));
2863 PyTuple_SetItem (r, 1, PyString_FromStringAndSize (val, len));
2869 (* Generate functions. *)
2871 fun (name, style, _, longdesc) ->
2872 pr "static PyObject *\n";
2873 pr "py_hivex_%s (PyObject *self, PyObject *args)\n" name;
2875 pr " PyObject *py_r;\n";
2878 match fst style with
2879 | RErr -> pr " int r;\n"; "-1"
2880 | RErrDispose -> pr " int r;\n"; "-1"
2881 | RHive -> pr " hive_h *r;\n"; "NULL"
2882 | RSize -> pr " size_t r;\n"; "0"
2883 | RNode -> pr " hive_node_h r;\n"; "0"
2886 pr " hive_node_h r;\n";
2888 | RNodeList -> pr " hive_node_h *r;\n"; "NULL"
2889 | RValue -> pr " hive_value_h r;\n"; "0"
2890 | RValueList -> pr " hive_value_h *r;\n"; "NULL"
2891 | RString -> pr " char *r;\n"; "NULL"
2892 | RStringList -> pr " char **r;\n"; "NULL"
2895 pr " size_t len;\n";
2896 pr " hive_type t;\n";
2900 pr " size_t len;\n";
2901 pr " hive_type t;\n";
2910 "-1 && errno != 0" in
2912 (* Call and arguments. *)
2915 | AUnusedFlags -> "0"
2916 | ASetValues -> "values.nr_values, values.values"
2917 | ASetValue -> "&val"
2918 | arg -> name_of_argt arg) (snd style) in
2920 match fst style with
2921 | RLenType | RLenTypeVal -> c_params @ ["&t"; "&len"]
2928 pr " PyObject *py_h;\n"
2933 | AStringNullable n ->
2937 | AUnusedFlags -> ()
2939 pr " py_set_values values;\n";
2940 pr " PyObject *py_values;\n"
2942 pr " hive_set_value val;\n";
2943 pr " PyObject *py_val;\n"
2948 (* Convert the required parameters. *)
2949 pr " if (!PyArg_ParseTuple (args, (char *) \"";
2959 | AStringNullable n ->
2963 | AUnusedFlags -> ()
2969 pr ":hivex_%s\"" name;
2979 | AStringNullable n ->
2983 | AUnusedFlags -> ()
2991 pr " return NULL;\n";
2993 (* Convert some Python argument types to C. *)
2997 pr " h = get_handle (py_h);\n"
3003 | AUnusedFlags -> ()
3005 pr " if (get_values (py_values, &values) == -1)\n";
3006 pr " return NULL;\n"
3008 pr " if (get_value (py_val, &val) == -1)\n";
3009 pr " return NULL;\n"
3012 (* Call the C function. *)
3013 pr " r = hivex_%s (%s);\n" name (String.concat ", " c_params);
3015 (* Free up arguments. *)
3018 | AHive | ANode _ | AValue _
3019 | AString _ | AStringNullable _
3020 | AOpenFlags | AUnusedFlags -> ()
3022 pr " free (values.values);\n"
3026 (* Check for errors from C library. *)
3027 pr " if (r == %s) {\n" error_code;
3028 pr " PyErr_SetString (PyExc_RuntimeError,\n";
3029 pr " strerror (errno));\n";
3030 pr " return NULL;\n";
3034 (* Convert return value to Python. *)
3035 (match fst style with
3038 pr " Py_INCREF (Py_None);\n";
3039 pr " py_r = Py_None;\n"
3041 pr " py_r = put_handle (r);\n"
3044 pr " py_r = PyLong_FromLongLong (r);\n"
3047 pr " py_r = PyLong_FromLongLong (r);\n";
3049 pr " Py_INCREF (Py_None);\n";
3050 pr " py_r = Py_None;\n";
3054 pr " py_r = put_node_list (r);\n";
3057 pr " py_r = PyLong_FromLongLong (r);\n"
3059 pr " py_r = PyString_FromString (r);\n";
3062 pr " py_r = put_string_list (r);\n";
3063 pr " free_strings (r);\n"
3065 pr " py_r = put_len_type (len, t);\n"
3067 pr " py_r = put_val_type (r, len, t);\n";
3070 pr " py_r = PyInt_FromLong ((long) r);\n"
3072 pr " py_r = PyLong_FromLongLong (r);\n"
3074 pr " return py_r;\n";
3079 (* Table of functions. *)
3080 pr "static PyMethodDef methods[] = {\n";
3082 fun (name, _, _, _) ->
3083 pr " { (char *) \"%s\", py_hivex_%s, METH_VARARGS, NULL },\n"
3086 pr " { NULL, NULL, 0, NULL }\n";
3090 (* Init function. *)
3093 initlibhivexmod (void)
3095 static int initialized = 0;
3097 if (initialized) return;
3098 Py_InitModule ((char *) \"libhivexmod\", methods);
3103 and generate_python_py () =
3104 generate_header HashStyle LGPLv2plus;
3107 u\"\"\"Python bindings for hivex
3110 h = hivex.Hivex (filename)
3112 The hivex module provides Python bindings to the hivex API for
3113 examining and modifying Windows Registry 'hive' files.
3115 Read the hivex(3) man page to find out how to use the API.
3121 \"\"\"Instances of this class are hivex API handles.\"\"\"
3123 def __init__ (self, filename";
3126 fun (_, flag, _) -> pr ", %s = False" (String.lowercase flag)
3130 \"\"\"Create a new hivex handle.\"\"\"
3135 fun (n, flag, description) ->
3136 pr " # %s\n" description;
3137 pr " if %s: flags += %d\n" (String.lowercase flag) n
3140 pr " self._o = libhivexmod.open (filename, flags)
3143 libhivexmod.close (self._o)
3148 fun (name, style, shortdesc, _) ->
3149 (* The close and open calls are handled specially above. *)
3150 if fst style <> RErrDispose && List.hd (snd style) = AHive then (
3151 let args = List.tl (snd style) in
3152 let args = List.filter (
3153 function AOpenFlags | AUnusedFlags -> false
3157 pr " def %s (self" name;
3158 List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
3160 pr " u\"\"\"%s\"\"\"\n" shortdesc;
3161 pr " return libhivexmod.%s (self._o" name;
3166 | AHive -> assert false
3167 | ANode n | AValue n
3168 | AString n | AStringNullable n -> pr "%s" n
3170 | AUnusedFlags -> assert false
3171 | ASetValues -> pr "values"
3172 | ASetValue -> pr "val"
3179 and generate_ruby_c () =
3180 generate_header CStyle LGPLv2plus;
3189 #include \"hivex.h\"
3191 #include \"extconf.h\"
3193 /* For Ruby < 1.9 */
3195 #define RARRAY_LEN(r) (RARRAY((r))->len)
3198 static VALUE m_hivex; /* hivex module */
3199 static VALUE c_hivex; /* hive_h handle */
3200 static VALUE e_Error; /* used for all errors */
3203 ruby_hivex_free (void *hvp)
3212 get_value (VALUE valv, hive_set_value *val)
3214 VALUE key = rb_hash_lookup (valv, ID2SYM (rb_intern (\"key\")));
3215 VALUE type = rb_hash_lookup (valv, ID2SYM (rb_intern (\"type\")));
3216 VALUE value = rb_hash_lookup (valv, ID2SYM (rb_intern (\"value\")));
3218 val->key = StringValueCStr (key);
3219 val->t = NUM2ULL (type);
3220 val->len = RSTRING (value)->len;
3221 val->value = RSTRING (value)->ptr;
3224 static hive_set_value *
3225 get_values (VALUE valuesv, size_t *nr_values)
3228 hive_set_value *ret;
3230 *nr_values = RARRAY_LEN (valuesv);
3231 ret = malloc (sizeof (*ret) * *nr_values);
3235 for (i = 0; i < *nr_values; ++i) {
3236 VALUE v = rb_ary_entry (valuesv, i);
3237 get_value (v, &ret[i]);
3246 fun (name, (ret, args), shortdesc, longdesc) ->
3248 (* Generate rdoc. *)
3249 let doc = replace_str longdesc "C<hivex_" "C<h." in
3250 let doc = pod2text ~width:60 name doc in
3251 let doc = String.concat "\n * " doc in
3252 let doc = trim doc in
3256 | AHive :: args -> "h." ^ name, args
3257 | args -> "Hivex::" ^ name, args in
3258 let args = filter_map (
3260 | AUnusedFlags -> None
3261 | args -> Some (name_of_argt args)
3263 let args = String.concat ", " args in
3267 | RErr | RErrDispose -> "nil"
3268 | RHive -> "Hivex::Hivex"
3269 | RSize | RNode | RNodeNotFound -> "integer"
3270 | RNodeList -> "list"
3271 | RValue -> "integer"
3272 | RValueList -> "list"
3273 | RString -> "string"
3274 | RStringList -> "list"
3275 | RLenType -> "hash"
3276 | RLenTypeVal -> "hash"
3277 | RInt32 -> "integer"
3278 | RInt64 -> "integer" in
3289 * (For the C API documentation for this function, see
3290 * +hivex_%s+[http://libguestfs.org/hivex.3.html#hivex_%s]).
3292 " call args ret shortdesc doc name name in
3294 (* Generate the function. *)
3295 pr "static VALUE\n";
3296 pr "ruby_hivex_%s (" name;
3299 (* If the first argument is not AHive, then this is a module-level
3300 * function, and Ruby passes an implicit module argument which we
3301 * must ignore. Otherwise the first argument is the hive handle.
3305 | AHive :: args -> pr "VALUE hv"; args
3306 | args -> pr "VALUE modulev"; args in
3309 | AUnusedFlags -> ()
3311 pr ", VALUE %sv" (name_of_argt arg)
3321 pr " Data_Get_Struct (hv, hive_h, h);\n";
3323 pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\",\n";
3324 pr " \"%s\");\n" name;
3326 pr " hive_node_h %s = NUM2ULL (%sv);\n" n n
3328 pr " hive_value_h %s = NUM2ULL (%sv);\n" n n
3330 pr " const char *%s = StringValueCStr (%sv);\n" n n;
3331 | AStringNullable n ->
3332 pr " const char *%s =\n" n;
3333 pr " !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n
3335 pr " int flags = 0;\n";
3338 pr " if (RTEST (rb_hash_lookup (flagsv, ID2SYM (rb_intern (\"%s\")))))\n"
3339 (String.lowercase flag);
3340 pr " flags += %d;\n" n
3342 | AUnusedFlags -> ()
3344 pr " size_t nr_values;\n";
3345 pr " hive_set_value *values;\n";
3346 pr " values = get_values (valuesv, &nr_values);\n"
3348 pr " hive_set_value val;\n";
3349 pr " get_value (valv, &val);\n"
3355 | RErr -> pr " int r;\n"; "-1"
3356 | RErrDispose -> pr " int r;\n"; "-1"
3357 | RHive -> pr " hive_h *r;\n"; "NULL"
3358 | RSize -> pr " size_t r;\n"; "0"
3359 | RNode -> pr " hive_node_h r;\n"; "0"
3362 pr " hive_node_h r;\n";
3364 | RNodeList -> pr " hive_node_h *r;\n"; "NULL"
3365 | RValue -> pr " hive_value_h r;\n"; "0"
3366 | RValueList -> pr " hive_value_h *r;\n"; "NULL"
3367 | RString -> pr " char *r;\n"; "NULL"
3368 | RStringList -> pr " char **r;\n"; "NULL"
3371 pr " size_t len;\n";
3372 pr " hive_type t;\n";
3376 pr " size_t len;\n";
3377 pr " hive_type t;\n";
3386 "-1 && errno != 0" in
3391 | ASetValues -> ["nr_values"; "values"]
3392 | ASetValue -> ["&val"]
3393 | AUnusedFlags -> ["0"]
3394 | arg -> [name_of_argt arg]) args in
3397 | RLenType | RLenTypeVal -> c_params @ [["&t"; "&len"]]
3399 let c_params = List.concat c_params in
3401 pr " r = hivex_%s (%s" name (List.hd c_params);
3402 List.iter (pr ", %s") (List.tl c_params);
3406 (* Dispose of the hive handle (even if hivex_close returns error). *)
3409 pr " /* So we don't double-free in the finalizer. */\n";
3410 pr " DATA_PTR (hv) = NULL;\n";
3423 | AUnusedFlags -> ()
3425 pr " free (values);\n"
3429 (* Check for errors from C library. *)
3430 pr " if (r == %s)\n" error_code;
3431 pr " rb_raise (e_Error, \"%%s\", strerror (errno));\n";
3435 | RErr | RErrDispose ->
3436 pr " return Qnil;\n"
3438 pr " return Data_Wrap_Struct (c_hivex, NULL, ruby_hivex_free, r);\n"
3443 pr " return ULL2NUM (r);\n"
3445 pr " return INT2NUM (r);\n"
3448 pr " return ULL2NUM (r);\n";
3450 pr " return Qnil;\n"
3453 pr " size_t i, len = 0;\n";
3454 pr " for (i = 0; r[i] != 0; ++i) len++;\n";
3455 pr " VALUE rv = rb_ary_new2 (len);\n";
3456 pr " for (i = 0; r[i] != 0; ++i)\n";
3457 pr " rb_ary_push (rv, ULL2NUM (r[i]));\n";
3461 pr " VALUE rv = rb_str_new2 (r);\n";
3465 pr " size_t i, len = 0;\n";
3466 pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
3467 pr " VALUE rv = rb_ary_new2 (len);\n";
3468 pr " for (i = 0; r[i] != NULL; ++i) {\n";
3469 pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
3470 pr " free (r[i]);\n";
3475 pr " VALUE rv = rb_hash_new ();\n";
3476 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
3477 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"type\")), INT2NUM (t));\n";
3480 pr " VALUE rv = rb_hash_new ();\n";
3481 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"len\")), INT2NUM (len));\n";
3482 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"type\")), INT2NUM (t));\n";
3483 pr " rb_hash_aset (rv, ID2SYM (rb_intern (\"value\")), rb_str_new (r, len));\n";
3493 /* Initialize the module. */
3496 m_hivex = rb_define_module (\"Hivex\");
3497 c_hivex = rb_define_class_under (m_hivex, \"Hivex\", rb_cObject);
3498 e_Error = rb_define_class_under (m_hivex, \"Error\", rb_eStandardError);
3500 /* XXX How to pass arguments? */
3502 #ifdef HAVE_RB_DEFINE_ALLOC_FUNC
3503 rb_define_alloc_func (c_hivex, ruby_hivex_open);
3511 fun (name, (_, args), _, _) ->
3512 let args = List.filter (
3514 | AUnusedFlags -> false
3517 let nr_args = List.length args in
3520 pr " rb_define_method (c_hivex, \"%s\",\n" name;
3521 pr " ruby_hivex_%s, %d);\n" name (nr_args-1)
3522 | args -> (* class function *)
3523 pr " rb_define_module_function (m_hivex, \"%s\",\n" name;
3524 pr " ruby_hivex_%s, %d);\n" name nr_args
3529 let output_to filename k =
3530 let filename_new = filename ^ ".new" in
3531 chan := open_out filename_new;
3534 chan := Pervasives.stdout;
3536 (* Is the new file different from the current file? *)
3537 if Sys.file_exists filename && files_equal filename filename_new then
3538 unlink filename_new (* same, so skip it *)
3540 (* different, overwrite old one *)
3541 (try chmod filename 0o644 with Unix_error _ -> ());
3542 rename filename_new filename;
3543 chmod filename 0o444;
3544 printf "written %s\n%!" filename;
3547 let perror msg = function
3548 | Unix_error (err, _, _) ->
3549 eprintf "%s: %s\n" msg (error_message err)
3551 eprintf "%s: %s\n" msg (Printexc.to_string exn)
3556 try openfile "configure.ac" [O_RDWR] 0
3558 | Unix_error (ENOENT, _, _) ->
3560 You are probably running this from the wrong directory.
3561 Run it from the top source directory using the command
3562 generator/generator.ml
3566 perror "open: configure.ac" exn;
3569 (* Acquire a lock so parallel builds won't try to run the generator
3570 * twice at the same time. Subsequent builds will wait for the first
3571 * one to finish. Note the lock is released implicitly when the
3574 (try lockf lock_fd F_LOCK 1
3576 perror "lock: configure.ac" exn;
3581 output_to "lib/hivex.h" generate_c_header;
3582 output_to "lib/hivex.pod" generate_c_pod;
3584 output_to "lib/hivex.syms" generate_linker_script;
3586 output_to "ocaml/hivex.mli" generate_ocaml_interface;
3587 output_to "ocaml/hivex.ml" generate_ocaml_implementation;
3588 output_to "ocaml/hivex_c.c" generate_ocaml_c;
3590 output_to "perl/lib/Win/Hivex.pm" generate_perl_pm;
3591 output_to "perl/Hivex.xs" generate_perl_xs;
3593 output_to "python/hivex.py" generate_python_py;
3594 output_to "python/hivex-py.c" generate_python_c;
3596 output_to "ruby/ext/hivex/_hivex.c" generate_ruby_c;
3598 (* Always generate this file last, and unconditionally. It's used
3599 * by the Makefile to know when we must re-run the generator.
3601 let chan = open_out "generator/stamp-generator" in
3605 printf "generated %d lines of code\n" !lines