* daemon/<somefile>.c to write the implementation.
*
* After editing this file, run it (./src/generator.ml) to regenerate all the
- * output files. Note that if you are using a separate build directory you must
- * run generator.ml from your top level build directory. You must also have run
- * configure before generator.ml will run.
+ * output files. Note that if you are using a separate build directory you
+ * must run generator.ml from the _source_ directory.
*
* IMPORTANT: This script should NOT print any warnings. If it prints
* warnings, you should treat them as errors.
* indication, ie. 0 or -1.
*)
| RErr
+
(* "RInt" as a return value means an int which is -1 for error
* or any value >= 0 on success. Only use this for smallish
* positive ints (0 <= i < 2^30).
*)
| RInt of string
+
(* "RInt64" is the same as RInt, but is guaranteed to be able
* to return a full 64 bit value, _except_ that -1 means error
* (so -1 cannot be a valid, non-error return value).
*)
| RInt64 of string
+
(* "RBool" is a bool return value which can be true/false or
* -1 for error.
*)
| RBool of string
+
(* "RConstString" is a string that refers to a constant value.
+ * The return value must NOT be NULL (since NULL indicates
+ * an error).
+ *
* Try to avoid using this. In particular you cannot use this
* for values returned from the daemon, because there is no
* thread-safe way to return them in the C API.
*)
| RConstString of string
- (* "RString" and "RStringList" are caller-frees. *)
+
+ (* "RConstOptString" is an even more broken version of
+ * "RConstString". The returned string may be NULL and there
+ * is no way to return an error indication. Avoid using this!
+ *)
+ | RConstOptString of string
+
+ (* "RString" is a returned string. It must NOT be NULL, since
+ * a NULL return indicates an error. The caller frees this.
+ *)
| RString of string
+
+ (* "RStringList" is a list of strings. No string in the list
+ * can be NULL. The caller frees the strings and the array.
+ *)
| RStringList of string
+
(* "RStruct" is a function which returns a single named structure
* or an error indication (in C, a struct, and in other languages
* with varying representations, but usually very efficient). See
* after the function list below for the structures.
*)
| RStruct of string * string (* name of retval, name of struct *)
+
(* "RStructList" is a function which returns either a list/array
* of structures (could be zero-length), or an error indication.
*)
| RStructList of string * string (* name of retval, name of struct *)
+
(* Key-value pairs of untyped strings. Turns into a hashtable or
* dictionary in languages which support it. DON'T use this as a
* general "bucket" for results. Prefer a stronger typed return
* inefficient. Keys should be unique. NULLs are not permitted.
*)
| RHashtable of string
-(* Not implemented:
+
(* "RBufferOut" is handled almost exactly like RString, but
* it allows the string to contain arbitrary 8 bit data including
* ASCII NUL. In the C API this causes an implicit extra parameter
- * to be added of type <size_t *size_r>. Other programming languages
- * support strings with arbitrary 8 bit data. At the RPC layer
- * we have to use the opaque<> type instead of string<>.
+ * to be added of type <size_t *size_r>. The extra parameter
+ * returns the actual size of the return buffer in bytes.
+ *
+ * Other programming languages support strings with arbitrary 8 bit
+ * data.
+ *
+ * At the RPC layer we have to use the opaque<> type instead of
+ * string<>. Returned data is still limited to the max message
+ * size (ie. ~ 2 MB).
*)
| RBufferOut of string
-*)
and args = argt list (* Function parameters, guestfs handle is implicit. *)
"test0rint64", RInt64 "valout";
"test0rbool", RBool "valout";
"test0rconststring", RConstString "valout";
+ "test0rconstoptstring", RConstOptString "valout";
"test0rstring", RString "valout";
"test0rstringlist", RStringList "valout";
"test0rstruct", RStruct ("valout", "lvm_pv");
This is always non-NULL. If it wasn't set already, then this will
return the default path.");
- ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"],
+ ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
[],
"add options to kernel command line",
"\
Setting C<append> to C<NULL> means I<no> additional options
are passed (libguestfs always adds a few of its own).");
- ("get_append", (RConstString "append", []), -1, [],
+ ("get_append", (RConstOptString "append", []), -1, [],
(* This cannot be tested with the current framework. The
* function can return NULL in normal operations, which the
* test framework interprets as an error.
Note that this function cannot correctly handle binary files
(specifically, files containing C<\\0> character which is treated
-as end of string). For those you need to use the C<guestfs_download>
-function which has a more complex interface.");
+as end of string). For those you need to use the C<guestfs_read_file>
+or C<guestfs_download> functions which have a more complex interface.");
("ll", (RString "listing", [String "directory"]), 5, [],
[], (* XXX Tricky to test because it depends on the exact format
C<..>. The entries are I<not> sorted, but returned in the same
order as the underlying filesystem.
+Also this call returns basic file type information about each
+file. The C<ftyp> field will contain one of the following characters:
+
+=over 4
+
+=item 'b'
+
+Block special
+
+=item 'c'
+
+Char special
+
+=item 'd'
+
+Directory
+
+=item 'f'
+
+FIFO (named pipe)
+
+=item 'l'
+
+Symbolic link
+
+=item 'r'
+
+Regular file
+
+=item 's'
+
+Socket
+
+=item 'u'
+
+Unknown file type
+
+=item '?'
+
+The L<readdir(3)> returned a C<d_type> field with an
+unexpected value
+
+=back
+
This function is primarily intended for use by programs. To
get a simple list of names, use C<guestfs_ls>. To get a printable
directory for human consumption, use C<guestfs_ll>.");
with C<guestfs_mkmountpoint>. See C<guestfs_mkmountpoint>
for full details.");
+ ("read_file", (RBufferOut "content", [String "path"]), 150, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "new file contents"; "0"];
+ ["read_file"; "/new"]], "new file contents")],
+ "read a file",
+ "\
+This calls returns the contents of the file C<path> as a
+buffer.
+
+Unlike C<guestfs_cat>, this function can correctly
+handle files that contain embedded ASCII NUL characters.
+However unlike C<guestfs_download>, this function is limited
+in the total size of file that can be handled.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
(match fst style with
| RErr -> ()
- | RInt n | RInt64 n | RBool n | RConstString n | RString n
+ | RInt n | RInt64 n | RBool n
+ | RConstString n | RConstOptString n | RString n
| RStringList n | RStruct (n, _) | RStructList (n, _)
- | RHashtable n ->
+ | RHashtable n | RBufferOut n ->
check_arg_ret_name n
);
List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
| RConstString _ ->
pr "This function returns a string, or NULL on error.
The string is owned by the guest handle and must I<not> be freed.\n\n"
+ | RConstOptString _ ->
+ pr "This function returns a string which may be NULL.
+There is way to return an error from this function.
+The string is owned by the guest handle and must I<not> be freed.\n\n"
| RString _ ->
pr "This function returns a string, or NULL on error.
I<The caller must free the returned string after use>.\n\n"
The array of strings will always have length C<2n+1>, where
C<n> keys and values alternate, followed by the trailing NULL entry.
I<The caller must free the strings and the array after use>.\n\n"
+ | RBufferOut _ ->
+ pr "This function returns a buffer, or NULL on error.
+The size of the returned buffer is written to C<*size_r>.
+I<The caller must free the returned buffer after use>.\n\n"
);
if List.mem ProtocolLimitWarning flags then
pr "%s\n\n" protocol_limit_warning;
pr "struct %s_ret {\n" name;
pr " bool %s;\n" n;
pr "};\n\n"
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RString n ->
pr "struct %s_ret {\n" name;
pr " string %s<>;\n" n;
pr "struct %s_ret {\n" name;
pr " str %s<>;\n" n;
pr "};\n\n"
+ | RBufferOut n ->
+ pr "struct %s_ret {\n" name;
+ pr " opaque %s<>;\n" n;
+ pr "};\n\n"
);
) daemon_functions;
pr " struct guestfs_message_error err;\n";
(match fst style with
| RErr -> ()
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RInt _ | RInt64 _
| RBool _ | RString _ | RStringList _
| RStruct _ | RStructList _
- | RHashtable _ ->
+ | RHashtable _ | RBufferOut _ ->
pr " struct %s_ret ret;\n" name
);
pr "};\n";
(match fst style with
| RErr -> ()
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RInt _ | RInt64 _
| RBool _ | RString _ | RStringList _
| RStruct _ | RStructList _
- | RHashtable _ ->
+ | RHashtable _ | RBufferOut _ ->
pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
pr " return;\n";
let error_code =
match fst style with
| RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RString _ | RStringList _
| RStruct _ | RStructList _
- | RHashtable _ ->
+ | RHashtable _ | RBufferOut _ ->
"NULL" in
pr "{\n";
| RErr -> pr " return 0;\n"
| RInt n | RInt64 n | RBool n ->
pr " return ctx.ret.%s;\n" n
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RString n ->
pr " return ctx.ret.%s; /* caller will free */\n" n
| RStringList n | RHashtable n ->
| RStructList (n, _) ->
pr " /* caller will free this */\n";
pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
+ | RBufferOut n ->
+ pr " *size_r = ctx.ret.%s.%s_len;\n" n n;
+ pr " return ctx.ret.%s.%s_val; /* caller will free */\n" n n
);
pr "}\n\n"
| RErr | RInt _ -> pr " int r;\n"; "-1"
| RInt64 _ -> pr " int64_t r;\n"; "-1"
| RBool _ -> pr " int r;\n"; "-1"
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
| RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL"
- | RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL" in
+ | RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " size_t size;\n";
+ pr " char *r;\n";
+ "NULL" in
(match snd style with
| [] -> ()
(* Don't want to call the impl with any FileIn or FileOut
* parameters, since these go "outside" the RPC protocol.
*)
- let argsnofile =
+ let args' =
List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
(snd style) in
pr " r = do_%s " name;
- generate_call_args argsnofile;
+ generate_c_call_args (fst style, args');
pr ";\n";
pr " if (r == %s)\n" error_code;
pr " ret.%s = r;\n" n;
pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
name
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RString n ->
pr " struct guestfs_%s_ret ret;\n" name;
pr " ret.%s = r;\n" n;
name;
pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
name
+ | RBufferOut n ->
+ pr " struct guestfs_%s_ret ret;\n" name;
+ pr " ret.%s.%s_val = r;\n" n n;
+ pr " ret.%s.%s_len = size;\n" n n;
+ pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
+ name;
+ pr " free (r);\n"
);
(* Free the args. *)
match fst style with
| RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
| RInt64 _ -> pr " int64_t r;\n"; "-1"
- | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ ->
pr " char **r;\n";
| RStruct (_, typ) ->
pr " struct guestfs_%s *r;\n" typ; "NULL"
| RStructList (_, typ) ->
- pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
pr " r = guestfs_%s (g" name;
let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
) (List.combine (snd style) args);
+ (match fst style with
+ | RBufferOut _ -> pr ", &size"
+ | _ -> ()
+ );
+
pr ");\n";
+
if not expect_error then
pr " if (r == %s)\n" error_code
else
);
(match fst style with
- | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
- | RString _ -> pr " free (r);\n"
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstString _ | RConstOptString _ -> ()
+ | RString _ | RBufferOut _ -> pr " free (r);\n"
| RStringList _ | RHashtable _ ->
pr " for (i = 0; r[i] != NULL; ++i)\n";
pr " free (r[i]);\n";
| RInt _
| RBool _ -> pr " int r;\n"
| RInt64 _ -> pr " int64_t r;\n"
- | RConstString _ -> pr " const char *r;\n"
+ | RConstString _ | RConstOptString _ -> pr " const char *r;\n"
| RString _ -> pr " char *r;\n"
| RStringList _ | RHashtable _ -> pr " char **r;\n"
| RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ
| RStructList (_, typ) -> pr " struct guestfs_%s_list *r;\n" typ
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
);
List.iter (
function
try find_map (function FishAction n -> Some n | _ -> None) flags
with Not_found -> sprintf "guestfs_%s" name in
pr " r = %s " fn;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
(* Check return value for errors and display command results. *)
pr " if (r == NULL) return -1;\n";
pr " printf (\"%%s\\n\", r);\n";
pr " return 0;\n"
+ | RConstOptString _ ->
+ pr " printf (\"%%s\\n\", r ? : \"(null)\");\n";
+ pr " return 0;\n"
| RString _ ->
pr " if (r == NULL) return -1;\n";
pr " printf (\"%%s\\n\", r);\n";
pr " print_table (r);\n";
pr " free_strings (r);\n";
pr " return 0;\n"
+ | RBufferOut _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " fwrite (r, size, 1, stdout);\n";
+ pr " free (r);\n";
+ pr " return 0;\n"
);
pr "}\n";
pr "\n"
| RInt _ -> pr "int "
| RInt64 _ -> pr "int64_t "
| RBool _ -> pr "int "
- | RConstString _ -> pr "const char *"
- | RString _ -> pr "char *"
+ | RConstString _ | RConstOptString _ -> pr "const char *"
+ | RString _ | RBufferOut _ -> pr "char *"
| RStringList _ | RHashtable _ -> pr "char **"
| RStruct (_, typ) ->
if not in_daemon then pr "struct guestfs_%s *" typ
if not in_daemon then pr "struct guestfs_%s_list *" typ
else pr "guestfs_int_%s_list *" typ
);
+ let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
pr "%s%s (" prefix name;
- if handle = None && List.length (snd style) = 0 then
+ if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
pr "void"
else (
let comma = ref false in
| FileOut n ->
if not in_daemon then (next (); pr "const char *%s" n)
) (snd style);
+ if is_RBufferOut then (next (); pr "size_t *size_r");
);
pr ")";
if semicolon then pr ";";
if newline then pr "\n"
(* Generate C call arguments, eg "(handle, foo, bar)" *)
-and generate_call_args ?handle args =
+and generate_c_call_args ?handle ?(decl = false) style =
pr "(";
let comma = ref false in
+ let next () =
+ if !comma then pr ", ";
+ comma := true
+ in
(match handle with
| None -> ()
| Some handle -> pr "%s" handle; comma := true
);
List.iter (
fun arg ->
- if !comma then pr ", ";
- comma := true;
+ next ();
pr "%s" (name_of_argt arg)
- ) args;
+ ) (snd style);
+ (* For RBufferOut calls, add implicit &size parameter. *)
+ if not decl then (
+ match fst style with
+ | RBufferOut _ ->
+ next ();
+ pr "&size"
+ | _ -> ()
+ );
pr ")"
(* Generate the OCaml bindings interface. *)
let params =
"gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
+ let needs_extra_vs =
+ match fst style with RConstOptString _ -> true | _ -> false in
+
pr "CAMLprim value\n";
pr "ocaml_guestfs_%s (value %s" name (List.hd params);
List.iter (pr ", value %s") (List.tl params);
| ps ->
pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
);
- pr " CAMLlocal1 (rv);\n";
+ if not needs_extra_vs then
+ pr " CAMLlocal1 (rv);\n"
+ else
+ pr " CAMLlocal3 (rv, v, v2);\n";
pr "\n";
pr " guestfs_h *g = Guestfs_val (gv);\n";
| RInt _ -> pr " int r;\n"; "-1"
| RInt64 _ -> pr " int64_t r;\n"; "-1"
| RBool _ -> pr " int r;\n"; "-1"
- | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ ->
pr " int i;\n";
| RHashtable _ ->
pr " int i;\n";
pr " char **r;\n";
+ "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
"NULL" in
pr "\n";
pr " caml_enter_blocking_section ();\n";
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
pr " caml_leave_blocking_section ();\n";
| RInt64 _ ->
pr " rv = caml_copy_int64 (r);\n"
| RBool _ -> pr " rv = Val_bool (r);\n"
- | RConstString _ -> pr " rv = caml_copy_string (r);\n"
+ | RConstString _ ->
+ pr " rv = caml_copy_string (r);\n"
+ | RConstOptString _ ->
+ pr " if (r) { /* Some string */\n";
+ pr " v = caml_alloc (1, 0);\n";
+ pr " v2 = caml_copy_string (r);\n";
+ pr " Store_field (v, 0, v2);\n";
+ pr " } else /* None */\n";
+ pr " v = Val_int (0);\n";
| RString _ ->
pr " rv = caml_copy_string (r);\n";
pr " free (r);\n"
pr " rv = copy_table (r);\n";
pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
pr " free (r);\n";
+ | RBufferOut _ ->
+ pr " rv = caml_alloc_string (size);\n";
+ pr " memcpy (String_val (rv), r, size);\n";
);
pr " CAMLreturn (rv);\n";
| RInt64 _ -> pr "int64"
| RBool _ -> pr "bool"
| RConstString _ -> pr "string"
- | RString _ -> pr "string"
+ | RConstOptString _ -> pr "string option"
+ | RString _ | RBufferOut _ -> pr "string"
| RStringList _ -> pr "string array"
| RStruct (_, typ) -> pr "%s" typ
| RStructList (_, typ) -> pr "%s array" typ
| RInt64 _ -> pr "SV *\n"
| RBool _ -> pr "SV *\n"
| RConstString _ -> pr "SV *\n"
+ | RConstOptString _ -> pr "SV *\n"
| RString _ -> pr "SV *\n"
+ | RBufferOut _ -> pr "SV *\n"
| RStringList _
| RStruct _ | RStructList _
| RHashtable _ ->
);
(* Call and arguments. *)
pr "%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" ~decl:true style;
pr "\n";
pr " guestfs_h *g;\n";
iteri (
pr " int r;\n";
pr " PPCODE:\n";
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (r == -1)\n";
pr " int %s;\n" n;
pr " CODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == -1)\n" n;
pr " int64_t %s;\n" n;
pr " CODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == -1)\n" n;
pr " const char *%s;\n" n;
pr " CODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " RETVAL = newSVpv (%s, 0);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
+ | RConstOptString n ->
+ pr "PREINIT:\n";
+ pr " const char *%s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " RETVAL = &PL_sv_undef;\n";
+ pr " else\n";
+ pr " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
| RString n ->
pr "PREINIT:\n";
pr " char *%s;\n" n;
pr " CODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " int i, n;\n";
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
| RStructList (n, typ) ->
let cols = cols_of_struct typ in
generate_perl_struct_list_code typ cols name style n do_cleanups
+ | RBufferOut n ->
+ pr "PREINIT:\n";
+ pr " char *%s;\n" n;
+ pr " size_t size;\n";
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = newSVpv (%s, size);\n" n;
+ pr " free (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
);
pr "\n"
pr " HV *hv;\n";
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " struct guestfs_%s *%s;\n" typ n;
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
| RInt n
| RInt64 n
| RConstString n
- | RString n -> pr "$%s = " n
+ | RConstOptString n
+ | RString n
+ | RBufferOut n -> pr "$%s = " n
| RStruct (n,_)
| RHashtable n -> pr "%%%s = " n
| RStringList n
match fst style with
| RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
| RInt64 _ -> pr " int64_t r;\n"; "-1"
- | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
| RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
| RStructList (_, typ) ->
- pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
List.iter (
function
pr "\n";
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
List.iter (
| RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
| RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
| RConstString _ -> pr " py_r = PyString_FromString (r);\n"
+ | RConstOptString _ ->
+ pr " if (r)\n";
+ pr " py_r = PyString_FromString (r);\n";
+ pr " else {\n";
+ pr " Py_INCREF (Py_None);\n";
+ pr " py_r = Py_None;\n";
+ pr " }\n"
| RString _ ->
pr " py_r = PyString_FromString (r);\n";
pr " free (r);\n"
| RHashtable n ->
pr " py_r = put_table (r);\n";
pr " free_strings (r);\n"
+ | RBufferOut _ ->
+ pr " py_r = PyString_FromStringAndSize (r, size);\n";
+ pr " free (r);\n"
);
pr " return py_r;\n";
List.iter (
fun (name, style, _, flags, _, _, longdesc) ->
pr " def %s " name;
- generate_call_args ~handle:"self" (snd style);
+ generate_py_call_args ~handle:"self" (snd style);
pr ":\n";
if not (List.mem NotInDocs flags) then (
let doc = replace_str longdesc "C<guestfs_" "C<g." in
let doc =
match fst style with
- | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
- | RString _ -> doc
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstOptString _ | RConstString _
+ | RString _ | RBufferOut _ -> doc
| RStringList _ ->
doc ^ "\n\nThis function returns a list of strings."
| RStruct (_, typ) ->
pr " u\"\"\"%s\"\"\"\n" doc;
);
pr " return libguestfsmod.%s " name;
- generate_call_args ~handle:"self._o" (snd style);
+ generate_py_call_args ~handle:"self._o" (snd style);
pr "\n";
pr "\n";
) all_functions
+(* Generate Python call arguments, eg "(handle, foo, bar)" *)
+and generate_py_call_args ~handle args =
+ pr "(%s" handle;
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
+ pr ")"
+
(* Useful if you need the longdesc POD text as plain text. Returns a
* list of lines.
*
match fst style with
| RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
| RInt64 _ -> pr " int64_t r;\n"; "-1"
- | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
| RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
| RStructList (_, typ) ->
- pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
pr "\n";
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
List.iter (
pr " return ULL2NUM (r);\n"
| RConstString _ ->
pr " return rb_str_new2 (r);\n";
+ | RConstOptString _ ->
+ pr " if (r)\n";
+ pr " return rb_str_new2 (r);\n";
+ pr " else\n";
+ pr " return Qnil;\n";
| RString _ ->
pr " VALUE rv = rb_str_new2 (r);\n";
pr " free (r);\n";
pr " }\n";
pr " free (r);\n";
pr " return rv;\n"
+ | RBufferOut _ ->
+ pr " VALUE rv = rb_str_new (r, size);\n";
+ pr " free (r);\n";
+ pr " return rv;\n";
);
pr "}\n";
pr " ";
if fst style <> RErr then pr "return ";
pr "_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_java_call_args ~handle:"g" (snd style);
pr ";\n";
pr " }\n";
pr " ";
pr "}\n"
+(* Generate Java call arguments, eg "(handle, foo, bar)" *)
+and generate_java_call_args ~handle args =
+ pr "(%s" handle;
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
+ pr ")"
+
and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
?(semicolon=true) name style =
if privat then pr "private ";
| RInt _ -> pr "int ";
| RInt64 _ -> pr "long ";
| RBool _ -> pr "boolean ";
- | RConstString _ | RString _ -> pr "String ";
+ | RConstString _ | RConstOptString _ | RString _
+ | RBufferOut _ -> pr "String ";
| RStringList _ -> pr "String[] ";
| RStruct (_, typ) ->
let name = java_name_of_struct typ in
| RInt _ -> pr "jint ";
| RInt64 _ -> pr "jlong ";
| RBool _ -> pr "jboolean ";
- | RConstString _ | RString _ -> pr "jstring ";
+ | RConstString _ | RConstOptString _ | RString _
+ | RBufferOut _ -> pr "jstring ";
| RStruct _ | RHashtable _ ->
pr "jobject ";
| RStringList _ | RStructList _ ->
| RInt _ -> pr " int r;\n"; "-1", "0"
| RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
| RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
+ | RConstOptString _ -> pr " const char *r;\n"; "NULL", "NULL"
| RString _ ->
pr " jstring jr;\n";
pr " char *r;\n"; "NULL", "NULL"
pr " jfieldID fl;\n";
pr " jobject jfl;\n";
pr " struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
- | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in
+ | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL"
+ | RBufferOut _ ->
+ pr " jstring jr;\n";
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL", "NULL" in
List.iter (
function
| String n
(match fst style with
| RStringList _ | RStructList _ -> true
| RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
- | RString _ | RStruct _ | RHashtable _ -> false) ||
+ | RConstOptString _
+ | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
List.exists (function StringList _ -> true | _ -> false) (snd style) in
if needs_i then
pr " int i;\n";
(* Make the call. *)
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
(* Release the parameters. *)
| RBool _ -> pr " return (jboolean) r;\n"
| RInt64 _ -> pr " return (jlong) r;\n"
| RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n"
+ | RConstOptString _ ->
+ pr " return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
| RString _ ->
pr " jr = (*env)->NewStringUTF (env, r);\n";
pr " free (r);\n";
(* XXX *)
pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
pr " return NULL;\n"
+ | RBufferOut _ ->
+ pr " jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
+ pr " free (r);\n";
+ pr " return jr;\n"
);
pr "}\n";
| RInt64 _, _ -> true
| RBool _, _
| RConstString _, _
+ | RConstOptString _, _
| RString _, _
| RStringList _, _
| RStruct _, _
| RStructList _, _
- | RHashtable _, _ -> false in
+ | RHashtable _, _
+ | RBufferOut _, _ -> false in
pr "\
{-# INCLUDE <guestfs.h> #-}
pr " then do\n";
pr " err <- last_error h\n";
pr " fail err\n";
- | RConstString _ | RString _ | RStringList _ | RStruct _
- | RStructList _ | RHashtable _ ->
+ | RConstString _ | RConstOptString _ | RString _
+ | RStringList _ | RStruct _
+ | RStructList _ | RHashtable _ | RBufferOut _ ->
pr " if (r == nullPtr)\n";
pr " then do\n";
pr " err <- last_error h\n";
| RBool _ ->
pr " else return (toBool r)\n"
| RConstString _
+ | RConstOptString _
| RString _
| RStringList _
| RStruct _
| RStructList _
- | RHashtable _ ->
+ | RHashtable _
+ | RBufferOut _ ->
pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
);
pr "\n";
| RInt64 _ -> pr "%s" int64
| RBool _ -> pr "%s" bool
| RConstString _ -> pr "%s" string
+ | RConstOptString _ -> pr "Maybe %s" string
| RString _ -> pr "%s" string
| RStringList _ -> pr "[%s]" string
| RStruct (_, typ) ->
let name = java_name_of_struct typ in
pr "[%s]" name
| RHashtable _ -> pr "Hashtable"
+ | RBufferOut _ -> pr "%s" string
);
pr ")"
pr " return r;\n"
| RBool _ ->
pr " return strcmp (val, \"true\") == 0;\n"
- | RConstString _ ->
+ | RConstString _
+ | RConstOptString _ ->
(* Can't return the input string here. Return a static
* string so we ensure we get a segfault if the caller
* tries to free it.
pr " }\n";
pr " strs[n*2] = NULL;\n";
pr " return strs;\n"
+ | RBufferOut _ ->
+ pr " return strdup (val);\n"
);
pr "}\n";
pr "\n"
(match fst style with
| RErr | RInt _ | RInt64 _ | RBool _ ->
pr " return -1;\n"
- | RConstString _
+ | RConstString _ | RConstOptString _
| RString _ | RStringList _ | RStruct _
| RStructList _
- | RHashtable _ ->
+ | RHashtable _
+ | RBufferOut _ ->
pr " return NULL;\n"
);
pr "}\n";
let () =
check_functions ();
- if not (Sys.file_exists "config.status") then (
+ if not (Sys.file_exists "HACKING") then (
eprintf "\
You are probably running this from the wrong directory.
Run it from the top source directory using the command
git.annexia.org / libguestfs.git / blobdiff