generator: Perl bindings.
authorRichard W.M. Jones <rjones@redhat.com>
Fri, 26 Feb 2010 11:29:09 +0000 (11:29 +0000)
committerRichard W.M. Jones <rjones@redhat.com>
Fri, 26 Feb 2010 21:51:27 +0000 (21:51 +0000)
This also adds a small test suite for the Perl bindings.

generator/generator.ml
perl/t/005-pod.t [new file with mode: 0644]
perl/t/006-pod-coverage.t [new file with mode: 0644]
perl/t/010-load.t [new file with mode: 0644]
perl/t/020-open.t [new file with mode: 0644]
perl/t/021-close.t [new file with mode: 0644]
perl/t/200-write.t [new file with mode: 0644]
perl/typemap

index 8696dec..830597b 100755 (executable)
@@ -251,7 +251,8 @@ C<hive_t_string>, C<hive_t_expand_string> or C<hive_t_link>.";
     "return value as multiple strings",
     "\
 If this value is a multiple-string, return the strings reencoded
-as UTF-8 (as a NULL-terminated array of C strings).  This only
+as UTF-8 (in C, as a NULL-terminated array of C strings, in other
+language bindings, as a list of strings).  This only
 works for values which have type C<hive_t_multiple_strings>.";
 
   "value_dword", (RInt32, [AHive; AValue "val"]),
@@ -271,14 +272,14 @@ works for values which have type C<hive_t_qword>.";
     "\
 Commit (write) any changes which have been made.
 
-C<filename> is the new file to write.  If C<filename> is NULL then we
-overwrite the original file (ie. the file name that was passed to
-C<hivex_open>).  C<flags> is not used, always pass 0.
+C<filename> is the new file to write.  If C<filename> is null/undefined
+then we overwrite the original file (ie. the file name that was passed to
+C<hivex_open>).
 
 Note this does not close the hive handle.  You can perform further
 operations on the hive after committing, including making more
-modifications.  If you no longer wish to use the hive, call
-C<hivex_close> after this.";
+modifications.  If you no longer wish to use the hive, then you
+should close the handle after committing.";
 
   "node_add_child", (RNode, [AHive; ANode "parent"; AString "name"]),
     "add child node",
@@ -302,18 +303,11 @@ subnodes become invalid.  You cannot delete the root node.";
   "node_set_values", (RErr, [AHive; ANode "node"; ASetValues; AUnusedFlags]),
     "set (key, value) pairs at a node",
     "\
-This call can be used to set all the (key, value) pairs stored in C<node>.
+This call can be used to set all the (key, value) pairs
+stored in C<node>.  Note that this library does not offer
+a way to modify just a single key at a node.
 
-C<node> is the node to modify.  C<values> is an array of (key, value)
-pairs.  There should be C<nr_values> elements in this array.  C<flags>
-is not used, always pass 0.
-
-Any existing values stored at the node are discarded, and their
-C<hive_value_h> handles become invalid.  Thus you can remove all
-values stored at C<node> by passing C<nr_values = 0>.
-
-Note that this library does not offer a way to modify just a single
-key at a node.  We don't implement a way to do this efficiently.";
+C<node> is the node to modify.";
 ]
 
 (* Used to memoize the result of pod2text. *)
@@ -931,6 +925,18 @@ here.  Often it's not documented at all.
       pr "\n";
       pr "%s\n" longdesc;
       pr "\n";
+
+      if List.mem AUnusedFlags (snd style) then
+       pr "The flags parameter is unused.  Always pass 0.\n\n";
+
+      if List.mem ASetValues (snd style) then
+       pr "C<values> is an array of (key, value) pairs.  There
+should be C<nr_values> elements in this array.
+
+Any existing values stored at the node are discarded, and their
+C<hive_value_h> handles become invalid.  Thus you can remove all
+values stored at C<node> by passing C<nr_values = 0>.\n\n";
+
       (match fst style with
        | RErr ->
            pr "\
@@ -1852,10 +1858,586 @@ Val_hiveh (hive_h *h)
 " max_hive_type
 
 and generate_perl_pm () =
-  generate_header HashStyle LGPLv2plus
+  generate_header HashStyle LGPLv2plus;
+
+  pr "\
+=pod
+
+=head1 NAME
+
+Win::Hivex - Perl bindings for reading and writing Windows Registry hive files
+
+=head1 SYNOPSIS
+
+ use Win::Hivex;
+
+ $h = Win::Hivex->open ('SOFTWARE');
+ $root_node = $h->root ();
+ print $h->node_name ($root_node);
+
+=head1 DESCRIPTION
+
+The C<Win::Hivex> module provides a Perl XS binding to the
+L<hivex(3)> API for reading and writing Windows Registry binary
+hive files.
+
+=head1 ERRORS
+
+All errors turn into calls to C<croak> (see L<Carp(3)>).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Win::Hivex;
+
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load ('Win::Hivex');
+
+=item open
+
+ $h = Win::Hivex::open ($filename,";
+
+  List.iter (
+    fun (_, flag, _) ->
+      pr "\n                        [%s => 1,]" (String.lowercase flag)
+  ) open_flags;
+
+  pr ")
+
+Open a Windows Registry binary hive file.
+
+The C<verbose> and C<debug> flags enable different levels of
+debugging messages.
+
+The C<write> flag is required if you will be modifying the
+hive file (see L<hivex(3)/WRITING TO HIVE FILES>).
+
+This function returns a hive handle.  The hive handle is
+closed automatically when its reference count drops to 0.
+
+=cut
+
+sub open {
+  my $proto = shift;
+  my $class = ref ($proto) || $proto;
+  my $filename = shift;
+  my %%flags = @_;
+  my $flags = 0;
+
+";
+
+  List.iter (
+    fun (n, flag, description) ->
+      pr "  # %s\n" description;
+      pr "  $flags += %d if $flags{%s};\n" n (String.lowercase flag)
+  ) open_flags;
+
+  pr "\
+
+  my $self = Win::Hivex::_open ($filename, $flags);
+  bless $self, $class;
+  return $self;
+}
+
+";
+
+  List.iter (
+    fun (name, style, _, longdesc) ->
+      (* The close call isn't explicit in Perl: handles are closed
+       * when their reference count drops to 0.
+       *
+       * The open call is coded specially in Perl.
+       *
+       * Therefore we don't generate prototypes for these two calls:
+       *)
+      if fst style <> RErrDispose && List.hd (snd style) = AHive then (
+       let longdesc = replace_str longdesc "C<hivex_" "C<" in
+       pr "=item %s\n\n " name;
+       generate_perl_prototype name style;
+       pr "\n\n";
+       pr "%s\n\n" longdesc;
+
+       (match fst style with
+        | RErr
+        | RErrDispose
+        | RHive
+        | RString
+        | RStringList
+        | RLenType
+        | RLenTypeVal
+        | RInt32
+        | RInt64 -> ()
+        | RNode ->
+            pr "\
+This returns a node handle.\n\n"
+        | RNodeNotFound ->
+            pr "\
+This returns a node handle, or C<undef> if the node was not found.\n\n"
+        | RNodeList ->
+            pr "\
+This returns a list of node handles.\n\n"
+        | RValue ->
+            pr "\
+This returns a value handle.\n\n"
+        | RValueList ->
+            pr "\
+This returns a list of value handles.\n\n"
+       );
+
+       if List.mem ASetValues (snd style) then
+         pr "C<@values> is an array of (keys, value) pairs.
+Each element should be a hashref containing C<key>, C<t> (type)
+and C<data>.
+
+Any existing values stored at the node are discarded, and their
+C<value> handles become invalid.  Thus you can remove all
+values stored at C<node> by passing C<@values = []>.\n\n"
+      )
+  ) functions;
+
+  pr "\
+=cut
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) %s Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<hivex(3)>,
+L<hivexsh(1)>,
+L<http://libguestfs.org>,
+L<Sys::Guestfs(3)>.
+
+=cut
+" copyright_years
+
+and generate_perl_prototype name style =
+  (* Return type. *)
+  (match fst style with
+   | RErr
+   | RErrDispose -> ()
+   | RHive -> pr "$h = "
+   | RNode
+   | RNodeNotFound -> pr "$node = "
+   | RNodeList -> pr "@nodes = "
+   | RValue -> pr "$value = "
+   | RValueList -> pr "@values = "
+   | RString -> pr "$string = "
+   | RStringList -> pr "@strings = "
+   | RLenType -> pr "($type, $len) = "
+   | RLenTypeVal -> pr "($type, $data) = "
+   | RInt32 -> pr "$int32 = "
+   | RInt64 -> pr "$int64 = "
+  );
+
+  let args = List.tl (snd style) in
+
+  (* AUnusedFlags is dropped in the bindings. *)
+  let args = List.filter ((<>) AUnusedFlags) args in
+
+  pr "$h->%s (" name;
+
+  let comma = ref false in
+  List.iter (
+    fun arg ->
+      if !comma then pr ", "; comma := true;
+      match arg with
+      | AHive -> pr "$h"
+      | ANode n
+      | AValue n
+      | AString n -> pr "$%s" n
+      | AStringNullable n -> pr "[$%s|undef]" n
+      | AOpenFlags -> pr "[flags]"
+      | AUnusedFlags -> assert false
+      | ASetValues -> pr "\\@values"
+  ) args;
+
+  pr ")"
 
 and generate_perl_xs () =
-  generate_header CStyle LGPLv2plus
+  generate_header CStyle LGPLv2plus;
+
+  pr "\
+#include \"EXTERN.h\"
+#include \"perl.h\"
+#include \"XSUB.h\"
+
+#include <string.h>
+#include <hivex.h>
+
+#ifndef PRId64
+#define PRId64 \"lld\"
+#endif
+
+static SV *
+my_newSVll(long long val) {
+#ifdef USE_64_BIT_ALL
+  return newSViv(val);
+#else
+  char buf[100];
+  int len;
+  len = snprintf(buf, 100, \"%%\" PRId64, val);
+  return newSVpv(buf, len);
+#endif
+}
+
+#ifndef PRIu64
+#define PRIu64 \"llu\"
+#endif
+
+#if 0
+static SV *
+my_newSVull(unsigned long long val) {
+#ifdef USE_64_BIT_ALL
+  return newSVuv(val);
+#else
+  char buf[100];
+  int len;
+  len = snprintf(buf, 100, \"%%\" PRIu64, val);
+  return newSVpv(buf, len);
+#endif
+}
+#endif
+
+#if 0
+/* http://www.perlmonks.org/?node_id=680842 */
+static char **
+XS_unpack_charPtrPtr (SV *arg) {
+  char **ret;
+  AV *av;
+  I32 i;
+
+  if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
+    croak (\"array reference expected\");
+
+  av = (AV *)SvRV (arg);
+  ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
+  if (!ret)
+    croak (\"malloc failed\");
+
+  for (i = 0; i <= av_len (av); i++) {
+    SV **elem = av_fetch (av, i, 0);
+
+    if (!elem || !*elem)
+      croak (\"missing element in list\");
+
+    ret[i] = SvPV_nolen (*elem);
+  }
+
+  ret[i] = NULL;
+
+  return ret;
+}
+#endif
+
+/* Handle set_values parameter. */
+typedef struct pl_set_values {
+  size_t nr_values;
+  hive_set_value *values;
+} pl_set_values;
+
+static pl_set_values
+unpack_pl_set_values (SV *sv)
+{
+  pl_set_values ret;
+  AV *av;
+  I32 i;
+
+  if (!sv || !SvOK (sv) || !SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
+    croak (\"array reference expected\");
+
+  av = (AV *)SvRV(sv);
+  ret.nr_values = av_len (av) + 1;
+  ret.values = malloc (ret.nr_values * sizeof (hive_set_value));
+  if (!ret.values)
+    croak (\"malloc failed\");
+
+  for (i = 0; i <= av_len (av); i++) {
+    SV **hvp = av_fetch (av, i, 0);
+
+    if (!hvp || !*hvp || !SvROK (*hvp) || SvTYPE (SvRV (*hvp)) != SVt_PVHV)
+      croak (\"missing element in list or not a hash ref\");
+
+    HV *hv = (HV *)SvRV(*hvp);
+
+    SV **svp;
+    svp = hv_fetch (hv, \"key\", 3, 0);
+    if (!svp || !*svp)
+      croak (\"missing 'key' in hash\");
+    ret.values[i].key = SvPV_nolen (*svp);
+
+    svp = hv_fetch (hv, \"t\", 1, 0);
+    if (!svp || !*svp)
+      croak (\"missing 't' in hash\");
+    ret.values[i].t = SvIV (*svp);
+
+    svp = hv_fetch (hv, \"value\", 5, 0);
+    if (!svp || !*svp)
+      croak (\"missing 'value' in hash\");
+    ret.values[i].value = SvPV (*svp, ret.values[i].len);
+  }
+
+  return ret;
+}
+
+MODULE = Win::Hivex  PACKAGE = Win::Hivex
+
+PROTOTYPES: ENABLE
+
+hive_h *
+_open (filename, flags)
+      char *filename;
+      int flags;
+   CODE:
+      RETVAL = hivex_open (filename, flags);
+      if (!RETVAL)
+        croak (\"hivex_open: %%s: %%s\", filename, strerror (errno));
+ OUTPUT:
+      RETVAL
+
+void
+DESTROY (h)
+      hive_h *h;
+ PPCODE:
+      if (hivex_close (h) == -1)
+        croak (\"hivex_close: %%s\", strerror (errno));
+
+";
+
+  List.iter (
+    fun (name, style, _, longdesc) ->
+      (* The close and open calls are handled specially above. *)
+      if fst style <> RErrDispose && List.hd (snd style) = AHive then (
+       (match fst style with
+        | RErr -> pr "void\n"
+        | RErrDispose -> failwith "perl bindings cannot handle a call which disposes of the handle"
+        | RHive -> failwith "perl bindings cannot handle a call which returns a handle"
+        | RNode
+        | RNodeNotFound
+        | RValue
+        | RString -> pr "SV *\n"
+        | RNodeList
+        | RValueList
+        | RStringList
+        | RLenType
+        | RLenTypeVal -> pr "void\n"
+        | RInt32 -> pr "SV *\n"
+        | RInt64 -> pr "SV *\n"
+       );
+
+       (* Call and arguments. *)
+       let perl_params =
+         filter_map (function
+                     | AUnusedFlags -> None
+                     | arg -> Some (name_of_argt arg)) (snd style) in
+
+       let c_params =
+         List.map (function
+                   | AUnusedFlags -> "0"
+                   | ASetValues -> "values.nr_values, values.values"
+                   | arg -> name_of_argt arg) (snd style) in
+
+       pr "%s (%s)\n" name (String.concat ", " perl_params);
+       iteri (
+          fun i ->
+            function
+            | AHive ->
+               pr "      hive_h *h;\n"
+           | ANode n
+           | AValue n ->
+               pr "      int %s;\n" n
+           | AString n ->
+               pr "      char *%s;\n" n
+            | AStringNullable n ->
+               (* http://www.perlmonks.org/?node_id=554277 *)
+               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n i i
+           | AOpenFlags ->
+               pr "      int flags;\n"
+           | AUnusedFlags -> ()
+           | ASetValues ->
+               pr "      pl_set_values values = unpack_pl_set_values (ST(%d));\n" i
+       ) (snd style);
+
+       let free_args () =
+         List.iter (
+           function
+           | ASetValues ->
+               pr "      free (values.values);\n"
+           | AHive | ANode _ | AValue _ | AString _ | AStringNullable _
+           | AOpenFlags | AUnusedFlags -> ()
+         ) (snd style)
+       in
+
+       (* Code. *)
+       (match fst style with
+        | RErr ->
+             pr "PREINIT:\n";
+             pr "      int r;\n";
+             pr " PPCODE:\n";
+             pr "      r = hivex_%s (%s);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == -1)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+
+        | RErrDispose -> assert false
+        | RHive -> assert false
+
+        | RInt32
+        | RNode
+        | RValue ->
+             pr "PREINIT:\n";
+            pr "      /* hive_node_h = hive_value_h = size_t so we cheat\n";
+            pr "         here to simplify the generator */\n";
+             pr "      size_t r;\n";
+             pr "   CODE:\n";
+             pr "      r = hivex_%s (%s);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == 0)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+             pr "      RETVAL = newSViv (r);\n";
+             pr " OUTPUT:\n";
+             pr "      RETVAL\n"
+
+        | RNodeNotFound ->
+             pr "PREINIT:\n";
+             pr "      hive_node_h r;\n";
+             pr "   CODE:\n";
+            pr "      errno = 0;\n";
+             pr "      r = hivex_%s (%s);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == 0 && errno != 0)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+            pr "      if (r == 0)\n";
+             pr "        RETVAL = &PL_sv_undef;\n";
+            pr "      else\n";
+             pr "        RETVAL = newSViv (r);\n";
+             pr " OUTPUT:\n";
+             pr "      RETVAL\n"
+
+        | RString ->
+             pr "PREINIT:\n";
+             pr "      char *r;\n";
+             pr "   CODE:\n";
+             pr "      r = hivex_%s (%s);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == NULL)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+             pr "      RETVAL = newSVpv (r, 0);\n";
+            pr "      free (r);\n";
+             pr " OUTPUT:\n";
+             pr "      RETVAL\n"
+
+        | RNodeList
+        | RValueList ->
+             pr "PREINIT:\n";
+             pr "      size_t *r;\n";
+             pr "      int i, n;\n";
+             pr " PPCODE:\n";
+             pr "      r = hivex_%s (%s);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == NULL)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+             pr "      for (n = 0; r[n] != 0; ++n) /**/;\n";
+             pr "      EXTEND (SP, n);\n";
+             pr "      for (i = 0; i < n; ++i)\n";
+             pr "        PUSHs (sv_2mortal (newSViv (r[i])));\n";
+             pr "      free (r);\n";
+
+        | RStringList ->
+             pr "PREINIT:\n";
+             pr "      char **r;\n";
+             pr "      int i, n;\n";
+             pr " PPCODE:\n";
+             pr "      r = hivex_%s (%s);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == NULL)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+             pr "      for (n = 0; r[n] != NULL; ++n) /**/;\n";
+             pr "      EXTEND (SP, n);\n";
+             pr "      for (i = 0; i < n; ++i) {\n";
+             pr "        PUSHs (sv_2mortal (newSVpv (r[i], 0)));\n";
+             pr "        free (r[i]);\n";
+             pr "      }\n";
+             pr "      free (r);\n";
+
+        | RLenType ->
+            pr "PREINIT:\n";
+            pr "      int r;\n";
+            pr "      size_t len;\n";
+            pr "      hive_type type;\n";
+            pr " PPCODE:\n";
+             pr "      r = hivex_%s (%s, &len, &type);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == -1)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+            pr "      EXTEND (SP, 2);\n";
+            pr "      PUSHs (sv_2mortal (newSViv (type)));\n";
+            pr "      PUSHs (sv_2mortal (newSViv (len)));\n";
+
+        | RLenTypeVal ->
+            pr "PREINIT:\n";
+            pr "      char *r;\n";
+            pr "      size_t len;\n";
+            pr "      hive_type type;\n";
+            pr " PPCODE:\n";
+             pr "      r = hivex_%s (%s, &len, &type);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == NULL)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+            pr "      EXTEND (SP, 2);\n";
+            pr "      PUSHs (sv_2mortal (newSViv (type)));\n";
+            pr "      PUSHs (sv_2mortal (newSVpv (r, len)));\n";
+            pr "      free (r);\n";
+
+        | RInt64 ->
+             pr "PREINIT:\n";
+             pr "      int64_t r;\n";
+             pr "   CODE:\n";
+            pr "      errno = 0;\n";
+             pr "      r = hivex_%s (%s);\n"
+              name (String.concat ", " c_params);
+            free_args ();
+             pr "      if (r == -1 && errno != 0)\n";
+             pr "        croak (\"%%s: %%s\", \"%s\", strerror (errno));\n"
+              name;
+             pr "      RETVAL = my_newSVll (r);\n";
+             pr " OUTPUT:\n";
+             pr "      RETVAL\n"
+       );
+       pr "\n"
+      )
+  ) functions
 
 and generate_python_py () =
   generate_header HashStyle LGPLv2plus
diff --git a/perl/t/005-pod.t b/perl/t/005-pod.t
new file mode 100644 (file)
index 0000000..8fef583
--- /dev/null
@@ -0,0 +1,24 @@
+# hivex Perl bindings -*- perl -*-
+# Copyright (C) 2010 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use Test::More;
+use strict;
+use warnings;
+
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok ();
diff --git a/perl/t/006-pod-coverage.t b/perl/t/006-pod-coverage.t
new file mode 100644 (file)
index 0000000..00c13c6
--- /dev/null
@@ -0,0 +1,24 @@
+# hivex Perl bindings -*- perl -*-
+# Copyright (C) 2009 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use Test::More;
+use strict;
+use warnings;
+
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD" if $@;
+all_pod_coverage_ok ({also_private => [ qr/^test0.*/ ]});
diff --git a/perl/t/010-load.t b/perl/t/010-load.t
new file mode 100644 (file)
index 0000000..9abcdc8
--- /dev/null
@@ -0,0 +1,24 @@
+# hivex Perl bindings -*- perl -*-
+# Copyright (C) 2010 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+BEGIN {
+    use_ok ("Win::Hivex");
+}
diff --git a/perl/t/020-open.t b/perl/t/020-open.t
new file mode 100644 (file)
index 0000000..b3c58f0
--- /dev/null
@@ -0,0 +1,27 @@
+# hivex Perl bindings -*- perl -*-
+# Copyright (C) 2010 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use Win::Hivex;
+
+my $srcdir = $ENV{srcdir} || ".";
+
+my $h = Win::Hivex->open ("$srcdir/../images/minimal");
+ok ($h);
diff --git a/perl/t/021-close.t b/perl/t/021-close.t
new file mode 100644 (file)
index 0000000..f6388fc
--- /dev/null
@@ -0,0 +1,31 @@
+# hivex Perl bindings -*- perl -*-
+# Copyright (C) 2010 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+use Win::Hivex;
+
+my $srcdir = $ENV{srcdir} || ".";
+
+# Put it in a block so the handle gets destroyed as well.
+{
+    my $h = Win::Hivex->open ("$srcdir/../images/minimal");
+    ok ($h);
+}
+ok (1);
diff --git a/perl/t/200-write.t b/perl/t/200-write.t
new file mode 100644 (file)
index 0000000..e7fd570
--- /dev/null
@@ -0,0 +1,49 @@
+# hivex Perl bindings -*- perl -*-
+# Copyright (C) 2010 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+use Win::Hivex;
+
+my $srcdir = $ENV{srcdir} || ".";
+
+my $h = Win::Hivex->open ("$srcdir/../images/minimal", write => 1);
+ok ($h);
+
+my $root = $h->root ();
+ok ($root);
+
+$h->node_add_child ($root, "A");
+ok (1);
+
+$h->node_add_child ($root, "B");
+ok (1);
+
+my $b = $h->node_get_child ($root, "B");
+ok ($b);
+
+my $values = [
+    { key => "Key1", t => 3, value => "ABC" },
+    { key => "Key2", t => 3, value => "DEF" }
+    ];
+$h->node_set_values ($b, $values);
+ok (1);
+
+# don't commit because that would overwrite the original file
+# $h->commit ();
index 752ca0d..2cc5e0c 100644 (file)
@@ -1,11 +1,11 @@
 TYPEMAP
 char *         T_PV
 const char *   T_PV
-guestfs_h *    O_OBJECT_guestfs_h
+hive_h *       O_OBJECT_hive_h
 int64_t                T_IV
 
 INPUT
-O_OBJECT_guestfs_h
+O_OBJECT_hive_h
     if (sv_isobject ($arg) && SvTYPE (SvRV ($arg)) == SVt_PVMG)
         $var = ($type) SvIV ((SV *) SvRV ($arg));
     else {
@@ -14,5 +14,5 @@ O_OBJECT_guestfs_h
     }
 
 OUTPUT
-O_OBJECT_guestfs_h
-    sv_setref_pv ($arg, "Sys::Guestfs", (void *) $var);
+O_OBJECT_hive_h
+    sv_setref_pv ($arg, "Win::Hivex", (void *) $var);