Libguestfs - Aug 2011 - [Hivex] [PATCH] Correct 32-bit to 64-bit call

---
 generator/generator.ml |    2 +-
 1 files changed, 1 insertions(+), 1 deletions(-)

diff --git a/generator/generator.ml b/generator/generator.ml
index 31478cd..de911f1 100755
--- a/generator/generator.ml
+++ b/generator/generator.ml
@@ -1771,7 +1771,7 @@ static void raise_closed (const char *) Noreturn;
            pr "  rv = copy_type_value (r, len, t);\n";
            pr "  free (r);\n"
        | RInt32 -> pr "  rv = caml_copy_int32 (r);\n"
-       | RInt64 -> pr "  rv = caml_copy_int32 (r);\n"
+       | RInt64 -> pr "  rv = caml_copy_int64 (r);\n"
       );
 
       pr "  CAMLreturn (rv);\n";
-- 
1.7.3.1

Hello all,

I found the below call while looking for the distinction between the OCaml-bound
return types for int64_t and uint64_t.  I noticed that uint64_t is not among the
return types in generator.ml, and some of the error tests appear to rely on the
value being signed.  How would you recommend getting around the signed
requirement in order to add an unsigned return type?  Some of the time functions
I'd like to use (which seems to entail exposing a public API) call for an
unsigned return type.

--Alex


---
 generator/generator.ml |   46 +++++++++++++++++++++++++++++++++++-----------
 1 files changed, 35 insertions(+), 11 deletions(-)

diff --git a/generator/generator.ml b/generator/generator.ml
index c142a85..a6cc582 100755
--- a/generator/generator.ml
+++ b/generator/generator.ml
@@ -56,6 +56,7 @@ and ret    | RLenTypeVal                         (* See
hivex_value_value. *)
   | RInt32                              (* Returns int32. *)
   | RInt64                              (* Returns int64. *)
+  | RUInt64                             (* Returns uint64. *)
 
 and args = argt list                    (* List of parameters. *)
 
@@ -170,11 +171,6 @@ only know the \"real\" name of the root node by
knowing which registry
 file this hive originally comes from, which is knowledge that is
 outside the scope of this library.";
 
-  "node_mtime", (RString, [AHive; ANode "node"]),
-    "return the last-modified time of the node",
-    "\
-Return the last-modified time of the node.  Output is in ISO 8601
format.";
-
   "node_children", (RNodeList, [AHive; ANode "node"]),
     "return children of node",
     "\
@@ -777,7 +773,6 @@ struct hivex_visitor {
   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);
   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);
   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);
-  int (*node_mtime) (hive_h *h, void *writer_v, hive_node_h node, const char
*last_modified);
 };
 
 #define HIVEX_VISIT_SKIP_BAD 1
@@ -813,6 +808,7 @@ and generate_c_prototype ?(extern = false) name style     |
RLenTypeVal -> pr "char *"
    | RInt32 -> pr "int32_t "
    | RInt64 -> pr "int64_t "
+   | RUInt64 -> pr "uint64_t "
   );
   pr "%s (" name;
   let comma = ref false in
@@ -1033,7 +1029,7 @@ On error this returns -1 and sets errno.\n\n"
 The value is returned as an array of bytes (of length C<len>).
 The value must be freed by the caller when it is no longer needed.
 On error this returns NULL and sets errno.\n\n"
-       | RInt32 | RInt64 -> ()
+       | RInt32 | RInt64 | RUInt64 -> ()
       );
   ) functions;
 
@@ -1140,8 +1136,6 @@ all, set the function pointer to NULL.
     */
    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);
-   int (*node_mtime) (hive_h *h, void *writer_v, hive_node_h node,
-         const char *last_modified)
  };
 
 =over 4
@@ -1543,6 +1537,7 @@ and generate_ocaml_prototype ?(is_external = false) name
style     | RLenTypeVal -> pr "hive_type * string"
    | RInt32 -> pr "int32"
    | RInt64 -> pr "int64"
+   | RUInt64 -> pr "uint64"
   );
   if is_external then
     pr " = \"ocaml_hivex_%s\"" name;
@@ -1708,6 +1703,10 @@ static void raise_closed (const char *) Noreturn;
         | RInt64 ->
             pr "  errno = 0;\n";
             pr "  int64_t r;\n";
+            "-1 && errno != 0"
+        | RUInt64 ->
+            pr "  errno = 0;\n";
+            pr "  uint64_t r;\n";
             "-1 && errno != 0" in
 
       (* The libguestfs OCaml bindings call enter_blocking_section
@@ -1779,7 +1778,8 @@ static void raise_closed (const char *) Noreturn;
            pr "  rv = copy_type_value (r, len, t);\n";
            pr "  free (r);\n"
        | RInt32 -> pr "  rv = caml_copy_int32 (r);\n"
-       | RInt64 -> pr "  rv = caml_copy_int32 (r);\n"
+       | RInt64 -> pr "  rv = caml_copy_int64 (r);\n"
+       | RUInt64 -> pr "  rv = caml_copy_int64 (r);\n"
       );
 
       pr "  CAMLreturn (rv);\n";
@@ -2088,7 +2088,8 @@ sub open {
 	 | RLenType
 	 | RLenTypeVal
 	 | RInt32
-	 | RInt64 -> ()
+	 | RInt64
+	 | RUInt64 -> ()
 	 | RNode ->
 	     pr "\
 This returns a node handle.\n\n"
@@ -2159,6 +2160,7 @@ and generate_perl_prototype name style     | RLenTypeVal
-> pr "($type, $data) = "
    | RInt32 -> pr "$int32 = "
    | RInt64 -> pr "$int64 = "
+   | RUInt64 -> pr "$uint64 = "
   );
 
   let args = List.tl (snd style) in
@@ -2381,6 +2383,7 @@ DESTROY (h)
 	 | RLenTypeVal -> pr "void\n"
 	 | RInt32 -> pr "SV *\n"
 	 | RInt64 -> pr "SV *\n"
+	 | RUInt64 -> pr "SV *\n"
 	);
 
 	(* Call and arguments. *)
@@ -2595,6 +2598,21 @@ DESTROY (h)
              pr "      RETVAL = my_newSVll (r);\n";
              pr " OUTPUT:\n";
              pr "      RETVAL\n"
+
+	 | RUInt64 ->
+             pr "PREINIT:\n";
+             pr "      uint64_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"
       )
@@ -2837,6 +2855,10 @@ put_val_type (char *val, size_t len, hive_type t)
         | RInt64 ->
             pr "  errno = 0;\n";
             pr "  int64_t r;\n";
+            "-1 && errno != 0"
+        | RUInt64 ->
+            pr "  errno = 0;\n";
+            pr "  uint64_t r;\n";
             "-1 && errno != 0" in
 
       (* Call and arguments. *)
@@ -2999,6 +3021,8 @@ put_val_type (char *val, size_t len, hive_type t)
            pr "  py_r = PyInt_FromLong ((long) r);\n"
        | RInt64 ->
            pr "  py_r = PyLong_FromLongLong (r);\n"
+       | RUInt64 ->
+           pr "  py_r = PyLong_FromLongLong (r);\n"
       );
       pr "  return py_r;\n";
       pr "}\n";
-- 
1.7.6




On Aug 10, 2011, at 20:56 , Alex? Nelson wrote:
> ---
> generator/generator.ml |    2 +-
> 1 files changed, 1 insertions(+), 1 deletions(-)
> 
> diff --git a/generator/generator.ml b/generator/generator.ml
> index 31478cd..de911f1 100755
> --- a/generator/generator.ml
> +++ b/generator/generator.ml
> @@ -1771,7 +1771,7 @@ static void raise_closed (const char *) Noreturn;
>            pr "  rv = copy_type_value (r, len, t);\n";
>            pr "  free (r);\n"
>        | RInt32 -> pr "  rv = caml_copy_int32 (r);\n"
> -       | RInt64 -> pr "  rv = caml_copy_int32 (r);\n"
> +       | RInt64 -> pr "  rv = caml_copy_int64 (r);\n"
>       );
> 
>       pr "  CAMLreturn (rv);\n";
> -- 
> 1.7.3.1
> 
> 
> _______________________________________________
> Libguestfs mailing list
> Libguestfs at redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs

On Wed, Aug 10, 2011 at 08:56:33PM -0700, Alex? Nelson
wrote:
> ---
>  generator/generator.ml |    2 +-
>  1 files changed, 1 insertions(+), 1 deletions(-)
> 
> diff --git a/generator/generator.ml b/generator/generator.ml
> index 31478cd..de911f1 100755
> --- a/generator/generator.ml
> +++ b/generator/generator.ml
> @@ -1771,7 +1771,7 @@ static void raise_closed (const char *) Noreturn;
>             pr "  rv = copy_type_value (r, len, t);\n";
>             pr "  free (r);\n"
>         | RInt32 -> pr "  rv = caml_copy_int32 (r);\n"
> -       | RInt64 -> pr "  rv = caml_copy_int32 (r);\n"
> +       | RInt64 -> pr "  rv = caml_copy_int64 (r);\n"
>        );
>  
>        pr "  CAMLreturn (rv);\n";
> -- 
> 1.7.3.1
Yikes ...  Just as well no one really uses hivex_value_qword from
OCaml programs.

Thanks, I'll push this shortly.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into Xen guests.
http://et.redhat.com/~rjones/virt-p2v