open Generator_utils
open Generator_pr
open Generator_docstrings
+open Generator_api_versions
open Generator_optgroups
open Generator_actions
open Generator_structs
(* Generate C API. *)
+type optarg_proto = Dots | VA | Argv
+
(* Generate a C function prototype. *)
let rec generate_prototype ?(extern = true) ?(static = false)
?(semicolon = true)
- ?(single_line = false) ?(newline = false) ?(in_daemon = false)
- ?(prefix = "")
- ?handle name style =
+ ?(single_line = false) ?(indent = "") ?(newline = false)
+ ?(in_daemon = false)
+ ?(prefix = "") ?(suffix = "")
+ ?handle
+ ?(optarg_proto = Dots)
+ name (ret, args, optargs) =
+ pr "%s" indent;
if extern then pr "extern ";
if static then pr "static ";
- (match fst style with
- | RErr -> pr "int "
- | RInt _ -> pr "int "
- | RInt64 _ -> pr "int64_t "
- | RBool _ -> pr "int "
- | RConstString _ | RConstOptString _ -> pr "const char *"
- | RString _ | RBufferOut _ -> pr "char *"
- | RStringList _ | RHashtable _ -> pr "char **"
+ (match ret with
+ | RErr
+ | RInt _
+ | RBool _ ->
+ pr "int";
+ if single_line then pr " " else pr "\n%s" indent
+ | RInt64 _ ->
+ pr "int64_t";
+ if single_line then pr " " else pr "\n%s" indent
+ | RConstString _ | RConstOptString _ ->
+ pr "const char *";
+ if not single_line then pr "\n%s" indent
+ | RString _ | RBufferOut _ ->
+ pr "char *";
+ if not single_line then pr "\n%s" indent
+ | RStringList _ | RHashtable _ ->
+ pr "char **";
+ if not single_line then pr "\n%s" indent
| RStruct (_, typ) ->
if not in_daemon then pr "struct guestfs_%s *" typ
- else pr "guestfs_int_%s *" typ
+ else pr "guestfs_int_%s *" typ;
+ if not single_line then pr "\n%s" indent
| RStructList (_, typ) ->
if not in_daemon then pr "struct guestfs_%s_list *" typ
- else pr "guestfs_int_%s_list *" typ
+ else pr "guestfs_int_%s_list *" typ;
+ if not single_line then pr "\n%s" indent
);
- let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
- pr "%s%s (" prefix name;
- if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
- pr "void"
+ let is_RBufferOut = match ret with RBufferOut _ -> true | _ -> false in
+ pr "%s%s%s (" prefix name suffix;
+ if handle = None && args = [] && optargs = [] && not is_RBufferOut then
+ pr "void"
else (
let comma = ref false in
(match handle with
);
let next () =
if !comma then (
- if single_line then pr ", " else pr ",\n\t\t"
+ if single_line then pr ", "
+ else (
+ let namelen = String.length prefix + String.length name +
+ String.length suffix + 2 in
+ pr ",\n%s%s" indent (spaces namelen)
+ )
);
comma := true
in
pr "const char *%s" n;
next ();
pr "size_t %s_size" n
- ) (snd style);
+ | Pointer (t, n) ->
+ next ();
+ pr "%s %s" t n
+ ) args;
if is_RBufferOut then (next (); pr "size_t *size_r");
+ if optargs <> [] then (
+ next ();
+ match optarg_proto with
+ | Dots -> pr "..."
+ | VA -> pr "va_list args"
+ | Argv -> pr "const struct guestfs_%s_argv *optargs" name
+ );
);
pr ")";
if semicolon then pr ";";
if newline then pr "\n"
(* Generate C call arguments, eg "(handle, foo, bar)" *)
-and generate_c_call_args ?handle ?(decl = false) style =
+and generate_c_call_args ?handle (ret, args, optargs) =
pr "(";
let comma = ref false in
let next () =
| arg ->
next ();
pr "%s" (name_of_argt arg)
- ) (snd style);
+ ) args;
(* For RBufferOut calls, add implicit &size parameter. *)
- if not decl then (
- match fst style with
- | RBufferOut _ ->
- next ();
- pr "&size"
- | _ -> ()
+ (match ret with
+ | RBufferOut _ ->
+ next ();
+ pr "&size"
+ | _ -> ()
+ );
+ (* For calls with optional arguments, add implicit optargs parameter. *)
+ if optargs <> [] then (
+ next ();
+ pr "optargs"
);
pr ")"
(* Generate the pod documentation for the C API. *)
and generate_actions_pod () =
List.iter (
- fun (shortname, style, _, flags, _, _, longdesc) ->
+ fun (shortname, (ret, args, optargs as style), _, flags, _, _, longdesc) ->
if not (List.mem NotInDocs flags) then (
let name = "guestfs_" ^ shortname in
pr "=head2 %s\n\n" name;
- pr " ";
- generate_prototype ~extern:false ~handle:"g" name style;
+ generate_prototype ~extern:false ~indent:" " ~handle:"g" name style;
pr "\n\n";
+
+ let uc_shortname = String.uppercase shortname in
+ if optargs <> [] then (
+ pr "You may supply a list of optional arguments to this call.\n";
+ pr "Use zero or more of the following pairs of parameters,\n";
+ pr "and terminate the list with C<-1> on its own.\n";
+ pr "See L</CALLS WITH OPTIONAL ARGUMENTS>.\n\n";
+ List.iter (
+ fun argt ->
+ let n = name_of_argt argt in
+ let uc_n = String.uppercase n in
+ pr " GUESTFS_%s_%s, " uc_shortname uc_n;
+ match argt with
+ | Bool n -> pr "int %s,\n" n
+ | Int n -> pr "int %s,\n" n
+ | Int64 n -> pr "int64_t %s,\n" n
+ | String n -> pr "const char *%s,\n" n
+ | _ -> assert false
+ ) optargs;
+ pr "\n";
+ );
+
pr "%s\n\n" longdesc;
- (match fst style with
+ let ret, args, optargs = style in
+ (match ret with
| RErr ->
pr "This function returns 0 on success or -1 on error.\n\n"
| RInt _ ->
or NULL if there was an error.
I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
| RStructList (_, typ) ->
- pr "This function returns a C<struct guestfs_%s_list *>
-(see E<lt>guestfs-structs.hE<gt>),
+ pr "This function returns a C<struct guestfs_%s_list *>,
or NULL if there was an error.
I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
| RHashtable _ ->
pr "%s\n\n" protocol_limit_warning;
if List.mem DangerWillRobinson flags then
pr "%s\n\n" danger_will_robinson;
- if List.exists (function Key _ -> true | _ -> false) (snd style) then
+ if List.exists (function Key _ -> true | _ -> false) (args@optargs) then
pr "This function takes a key or passphrase parameter which
could contain sensitive material. Read the section
L</KEYS AND PASSPHRASES> for more information.\n\n";
- match deprecation_notice flags with
- | None -> ()
- | Some txt -> pr "%s\n\n" txt
+ (match deprecation_notice ~prefix:"guestfs_" flags with
+ | None -> ()
+ | Some txt -> pr "%s\n\n" txt
+ );
+ (match lookup_api_version name with
+ | Some version -> pr "(Added in %s)\n\n" version
+ | None -> ()
+ );
+
+ (* Handling of optional argument variants. *)
+ if optargs <> [] then (
+ pr "=head2 %s_va\n\n" name;
+ generate_prototype ~extern:false ~indent:" " ~handle:"g"
+ ~prefix:"guestfs_" ~suffix:"_va" ~optarg_proto:VA
+ shortname style;
+ pr "\n\n";
+ pr "This is the \"va_list variant\" of L</%s>.\n\n" name;
+ pr "See L</CALLS WITH OPTIONAL ARGUMENTS>.\n\n";
+ pr "=head2 %s_argv\n\n" name;
+ generate_prototype ~extern:false ~indent:" " ~handle:"g"
+ ~prefix:"guestfs_" ~suffix:"_argv" ~optarg_proto:Argv
+ shortname style;
+ pr "\n\n";
+ pr "This is the \"argv variant\" of L</%s>.\n\n" name;
+ pr "See L</CALLS WITH OPTIONAL ARGUMENTS>.\n\n";
+ );
)
) all_functions_sorted
pr "=back\n";
pr "\n"
-(* Generate the guestfs-structs.h file. *)
-and generate_structs_h () =
+(* Generate the guestfs.h file. *)
+and generate_guestfs_h () =
generate_header CStyle LGPLv2plus;
- (* This is a public exported header file containing various
- * structures. The structures are carefully written to have
- * exactly the same in-memory format as the XDR structures that
- * we use on the wire to the daemon. The reason for creating
- * copies of these structures here is just so we don't have to
- * export the whole of guestfs_protocol.h (which includes much
- * unrelated and XDR-dependent stuff that we don't want to be
- * public, or required by clients).
- *
- * To reiterate, we will pass these structures to and from the
- * client with a simple assignment or memcpy, so the format
- * must be identical to what rpcgen / the RFC defines.
+ pr "\
+/* ---------- IMPORTANT NOTE ----------
+ *
+ * All API documentation is in the manpage, 'guestfs(3)'.
+ * To read it, type: man 3 guestfs
+ * Or read it online here: http://libguestfs.org/guestfs.3.html
+ *
+ * Go and read it now, I'll be right here waiting for you
+ * when you come back.
+ *
+ * ------------------------------------
+ */
+
+#ifndef GUESTFS_H_
+#define GUESTFS_H_
+
+#ifdef __cplusplus
+extern \"C\" {
+#endif
+
+#include <stddef.h>
+#include <stdint.h>
+#include <stdarg.h>
+
+/* The handle. */
+#ifndef GUESTFS_TYPEDEF_H
+#define GUESTFS_TYPEDEF_H 1
+typedef struct guestfs_h guestfs_h;
+#endif
+
+/* Connection management. */
+extern guestfs_h *guestfs_create (void);
+extern void guestfs_close (guestfs_h *g);
+
+/* Error handling. */
+extern const char *guestfs_last_error (guestfs_h *g);
+#define LIBGUESTFS_HAVE_LAST_ERRNO 1
+extern int guestfs_last_errno (guestfs_h *g);
+
+#ifndef GUESTFS_TYPEDEF_ERROR_HANDLER_CB
+#define GUESTFS_TYPEDEF_ERROR_HANDLER_CB 1
+typedef void (*guestfs_error_handler_cb) (guestfs_h *g, void *opaque, const char *msg);
+#endif
+
+#ifndef GUESTFS_TYPEDEF_ABORT_CB
+#define GUESTFS_TYPEDEF_ABORT_CB 1
+typedef void (*guestfs_abort_cb) (void) __attribute__((__noreturn__));
+#endif
+
+extern void guestfs_set_error_handler (guestfs_h *g, guestfs_error_handler_cb cb, void *opaque);
+extern guestfs_error_handler_cb guestfs_get_error_handler (guestfs_h *g, void **opaque_rtn);
+
+extern void guestfs_set_out_of_memory_handler (guestfs_h *g, guestfs_abort_cb);
+extern guestfs_abort_cb guestfs_get_out_of_memory_handler (guestfs_h *g);
+
+/* Events. */
+#ifndef GUESTFS_TYPEDEF_LOG_MESSAGE_CB
+#define GUESTFS_TYPEDEF_LOG_MESSAGE_CB 1
+typedef void (*guestfs_log_message_cb) (guestfs_h *g, void *opaque, char *buf, int len);
+#endif
+
+#ifndef GUESTFS_TYPEDEF_SUBPROCESS_QUIT_CB
+#define GUESTFS_TYPEDEF_SUBPROCESS_QUIT_CB 1
+typedef void (*guestfs_subprocess_quit_cb) (guestfs_h *g, void *opaque);
+#endif
+
+#ifndef GUESTFS_TYPEDEF_LAUNCH_DONE_CB
+#define GUESTFS_TYPEDEF_LAUNCH_DONE_CB 1
+typedef void (*guestfs_launch_done_cb) (guestfs_h *g, void *opaque);
+#endif
+
+#ifndef GUESTFS_TYPEDEF_CLOSE_CB
+#define GUESTFS_TYPEDEF_CLOSE_CB 1
+typedef void (*guestfs_close_cb) (guestfs_h *g, void *opaque);
+#endif
+
+#ifndef GUESTFS_TYPEDEF_PROGRESS_CB
+#define GUESTFS_TYPEDEF_PROGRESS_CB 1
+typedef void (*guestfs_progress_cb) (guestfs_h *g, void *opaque, int proc_nr, int serial, uint64_t position, uint64_t total);
+#endif
+
+extern void guestfs_set_log_message_callback (guestfs_h *g, guestfs_log_message_cb cb, void *opaque);
+extern void guestfs_set_subprocess_quit_callback (guestfs_h *g, guestfs_subprocess_quit_cb cb, void *opaque);
+extern void guestfs_set_launch_done_callback (guestfs_h *g, guestfs_launch_done_cb cb, void *opaque);
+#define LIBGUESTFS_HAVE_SET_CLOSE_CALLBACK 1
+extern void guestfs_set_close_callback (guestfs_h *g, guestfs_close_cb cb, void *opaque);
+#define LIBGUESTFS_HAVE_SET_PROGRESS_CALLBACK 1
+extern void guestfs_set_progress_callback (guestfs_h *g, guestfs_progress_cb cb, void *opaque);
+
+/* Private data area. */
+#define LIBGUESTFS_HAVE_SET_PRIVATE 1
+extern void guestfs_set_private (guestfs_h *g, const char *key, void *data);
+#define LIBGUESTFS_HAVE_GET_PRIVATE 1
+extern void *guestfs_get_private (guestfs_h *g, const char *key);
+
+/* Structures. */
+";
+
+ (* The structures are carefully written to have exactly the same
+ * in-memory format as the XDR structures that we use on the wire to
+ * the daemon. The reason for creating copies of these structures
+ * here is just so we don't have to export the whole of
+ * guestfs_protocol.h (which includes much unrelated and
+ * XDR-dependent stuff that we don't want to be public, or required
+ * by clients).
+ *
+ * To reiterate, we will pass these structures to and from the client
+ * with a simple assignment or memcpy, so the format must be
+ * identical to what rpcgen / the RFC defines.
*)
(* Public structures. *)
pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
pr "\n"
- ) structs
+ ) structs;
-(* Generate the guestfs-actions.h file. *)
-and generate_actions_h () =
- generate_header CStyle LGPLv2plus;
- List.iter (
- fun (shortname, style, _, flags, _, _, _) ->
- let name = "guestfs_" ^ shortname in
+ pr "\
+/* Actions. */
+";
+ List.iter (
+ fun (shortname, (ret, args, optargs as style), _, flags, _, _, _) ->
let deprecated =
List.exists (function DeprecatedBy _ -> true | _ -> false) flags in
let test0 =
pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
generate_prototype ~single_line:true ~newline:true ~handle:"g"
- name style
- ) all_functions_sorted
+ ~prefix:"guestfs_" shortname style;
+
+ if optargs <> [] then (
+ generate_prototype ~single_line:true ~newline:true ~handle:"g"
+ ~prefix:"guestfs_" ~suffix:"_va" ~optarg_proto:VA
+ shortname style;
+
+ pr "struct guestfs_%s_argv {\n" shortname;
+ pr " uint64_t bitmask;\n";
+ iteri (
+ fun i argt ->
+ let c_type =
+ match argt with
+ | Bool n -> "int "
+ | Int n -> "int "
+ | Int64 n -> "int64_t "
+ | String n -> "const char *"
+ | _ -> assert false (* checked in generator_checks *) in
+ let uc_shortname = String.uppercase shortname in
+ let n = name_of_argt argt in
+ let uc_n = String.uppercase n in
+ pr "#define GUESTFS_%s_%s %d\n" uc_shortname uc_n i;
+ pr "#define GUESTFS_%s_%s_BITMASK (UINT64_C(1)<<%d)\n" uc_shortname uc_n i;
+ pr "/* The field below is only valid in this struct if the\n";
+ pr " * GUESTFS_%s_%s_BITMASK bit is set\n" uc_shortname uc_n;
+ pr " * in the bitmask above, otherwise the contents are ignored.\n";
+ pr " */\n";
+ pr " %s%s;\n" c_type n
+ ) optargs;
+ pr "};\n";
+
+ generate_prototype ~single_line:true ~newline:true ~handle:"g"
+ ~prefix:"guestfs_" ~suffix:"_argv" ~optarg_proto:Argv
+ shortname style;
+ );
+ ) all_functions_sorted;
+
+ pr "\
+
+/* Private functions.
+ *
+ * These are NOT part of the public, stable API, and can change at any
+ * time! We export them because they are used by some of the language
+ * bindings.
+ */
+extern void *guestfs_safe_malloc (guestfs_h *g, size_t nbytes);
+extern void *guestfs_safe_calloc (guestfs_h *g, size_t n, size_t s);
+extern const char *guestfs_tmpdir (void);
+#ifdef GUESTFS_PRIVATE_FOR_EACH_DISK
+extern int guestfs___for_each_disk (guestfs_h *g, virDomainPtr dom, int (*)(guestfs_h *g, const char *filename, const char *format, void *data), void *data);
+#endif
+/* End of private functions. */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* GUESTFS_H_ */
+"
(* Generate the guestfs-internal-actions.h file. *)
and generate_internal_actions_h () =
generate_header CStyle LGPLv2plus;
List.iter (
fun (shortname, style, _, _, _, _, _) ->
- let name = "guestfs__" ^ shortname in
generate_prototype ~single_line:true ~newline:true ~handle:"g"
- name style
+ ~prefix:"guestfs__" ~optarg_proto:Argv
+ shortname style
) non_daemon_functions
(* Generate the client-side dispatch stubs. *)
#include <stdint.h>
#include <string.h>
#include <inttypes.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/stat.h>
#include \"guestfs.h\"
#include \"guestfs-internal.h\"
#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
+#include \"errnostring.h\"
/* Check the return message from a call for validity. */
static int
";
- let error_code_of = function
- | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
- | RConstString _ | RConstOptString _
- | RString _ | RStringList _
- | RStruct _ | RStructList _
- | RHashtable _ | RBufferOut _ -> "NULL"
- in
-
(* Generate code to check String-like parameters are not passed in
* as NULL (returning an error if they are).
*)
- let check_null_strings shortname style =
+ let check_null_strings shortname (ret, args, optargs) =
let pr_newline = ref false in
List.iter (
function
| BufferIn n
| StringList n
| DeviceList n
- | Key n ->
+ | Key n
+ | Pointer (_, n) ->
pr " if (%s == NULL) {\n" n;
pr " error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
pr " \"%s\", \"%s\");\n" shortname n;
- pr " return %s;\n" (error_code_of (fst style));
+ let errcode =
+ match errcode_of_ret ret with
+ | `CannotReturnError ->
+ if shortname = "test0rconstoptstring" then (* XXX hack *)
+ `ErrorIsNULL
+ else
+ failwithf
+ "%s: RConstOptString function has invalid parameter '%s'"
+ shortname n
+ | (`ErrorIsMinusOne |`ErrorIsNULL) as e -> e in
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr_newline := true
| Bool _
| Int _
| Int64 _ -> ()
- ) (snd style);
+ ) args;
+
+ (* For optional arguments. *)
+ List.iter (
+ function
+ | String n ->
+ pr " if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK) &&\n"
+ (String.uppercase shortname) (String.uppercase n);
+ pr " optargs->%s == NULL) {\n" n;
+ pr " error (g, \"%%s: %%s: optional parameter cannot be NULL\",\n";
+ pr " \"%s\", \"%s\");\n" shortname n;
+ let errcode =
+ match errcode_of_ret ret with
+ | `CannotReturnError -> assert false
+ | (`ErrorIsMinusOne |`ErrorIsNULL) as e -> e in
+ pr " return %s;\n" (string_of_errcode errcode);
+ pr " }\n";
+ pr_newline := true
+
+ (* not applicable *)
+ | Bool _ | Int _ | Int64 _ -> ()
+
+ | _ -> assert false
+ ) optargs;
if !pr_newline then pr "\n";
in
+ (* Generate code to reject optargs we don't know about. *)
+ let reject_unknown_optargs shortname = function
+ | _, _, [] -> ()
+ | ret, _, optargs ->
+ let len = List.length optargs in
+ let mask = Int64.lognot (Int64.pred (Int64.shift_left 1L len)) in
+ pr " if (optargs->bitmask & UINT64_C(0x%Lx)) {\n" mask;
+ pr " error (g, \"%%s: unknown option in guestfs_%%s_argv->bitmask (this can happen if a program is compiled against a newer version of libguestfs, then dynamically linked to an older version)\",\n";
+ pr " \"%s\", \"%s\");\n" shortname shortname;
+ let errcode =
+ match errcode_of_ret ret with
+ | `CannotReturnError -> assert false
+ | (`ErrorIsMinusOne |`ErrorIsNULL) as e -> e in
+ pr " return %s;\n" (string_of_errcode errcode);
+ pr " }\n";
+ pr "\n";
+ in
+
(* Generate code to generate guestfish call traces. *)
- let trace_call shortname style =
- pr " if (guestfs__get_trace (g)) {\n";
+ let trace_call shortname (ret, args, optargs) =
+ pr " if (trace_flag) {\n";
let needs_i =
List.exists (function
| StringList _ | DeviceList _ -> true
- | _ -> false) (snd style) in
+ | _ -> false) args in
if needs_i then (
pr " size_t i;\n";
pr "\n"
);
pr " fprintf (stderr, \"%s\");\n" shortname;
+
+ (* Required arguments. *)
List.iter (
function
| String n (* strings *)
| Pathname n
| Dev_or_Path n
| FileIn n
- | FileOut n
- | BufferIn n
- | Key n ->
+ | FileOut n ->
(* guestfish doesn't support string escaping, so neither do we *)
pr " fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n
+ | Key n ->
+ (* don't print keys *)
+ pr " fprintf (stderr, \" \\\"***\\\"\");\n"
| OptString n -> (* string option *)
pr " if (%s) fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n n;
pr " else fprintf (stderr, \" null\");\n"
pr " fprintf (stderr, \" %%d\", %s);\n" n
| Int64 n ->
pr " fprintf (stderr, \" %%\" PRIi64, %s);\n" n
- ) (snd style);
- pr " fputc ('\\n', stderr);\n";
+ | BufferIn n -> (* RHBZ#646822 *)
+ pr " fputc (' ', stderr);\n";
+ pr " guestfs___print_BufferIn (stderr, %s, %s_size);\n" n n
+ | Pointer (t, n) ->
+ pr " fprintf (stderr, \" (%s)%%p\", %s);\n" t n
+ ) args;
+
+ (* Optional arguments. *)
+ List.iter (
+ fun argt ->
+ let n = name_of_argt argt in
+ let uc_shortname = String.uppercase shortname in
+ let uc_n = String.uppercase n in
+ pr " if (optargs->bitmask & GUESTFS_%s_%s_BITMASK)\n"
+ uc_shortname uc_n;
+ (match argt with
+ | String n ->
+ pr " fprintf (stderr, \" \\\"%%s:%%s\\\"\", \"%s\", optargs->%s);\n" n n
+ | Bool n ->
+ pr " fprintf (stderr, \" \\\"%%s:%%s\\\"\", \"%s\", optargs->%s ? \"true\" : \"false\");\n" n n
+ | Int n ->
+ pr " fprintf (stderr, \" \\\"%%s:%%d\\\"\", \"%s\", optargs->%s);\n" n n
+ | Int64 n ->
+ pr " fprintf (stderr, \" \\\"%%s:%%\" PRIi64 \"\\\"\", \"%s\", optargs->%s);\n" n n
+ | _ -> assert false
+ );
+ ) optargs;
+
pr " }\n";
pr "\n";
in
+ let trace_return ?(indent = 2) (ret, _, _) rv =
+ let indent = spaces indent in
+
+ pr "%sif (trace_flag) {\n" indent;
+
+ let needs_i =
+ match ret with
+ | RStringList _ | RHashtable _ -> true
+ | _ -> false in
+ if needs_i then (
+ pr "%s size_t i;\n" indent;
+ pr "\n"
+ );
+
+ pr "%s fputs (\" = \", stderr);\n" indent;
+ (match ret with
+ | RErr | RInt _ | RBool _ ->
+ pr "%s fprintf (stderr, \"%%d\", %s);\n" indent rv
+ | RInt64 _ ->
+ pr "%s fprintf (stderr, \"%%\" PRIi64, %s);\n" indent rv
+ | RConstString _ | RString _ ->
+ pr "%s fprintf (stderr, \"\\\"%%s\\\"\", %s);\n" indent rv
+ | RConstOptString _ ->
+ pr "%s fprintf (stderr, \"\\\"%%s\\\"\", %s != NULL ? %s : \"NULL\");\n"
+ indent rv rv
+ | RBufferOut _ ->
+ pr "%s guestfs___print_BufferOut (stderr, %s, *size_r);\n" indent rv
+ | RStringList _ | RHashtable _ ->
+ pr "%s fputs (\"[\", stderr);\n" indent;
+ pr "%s for (i = 0; %s[i]; ++i) {\n" indent rv;
+ pr "%s if (i > 0) fputs (\", \", stderr);\n" indent;
+ pr "%s fputs (\"\\\"\", stderr);\n" indent;
+ pr "%s fputs (%s[i], stderr);\n" indent rv;
+ pr "%s fputs (\"\\\"\", stderr);\n" indent;
+ pr "%s }\n" indent;
+ pr "%s fputs (\"]\", stderr);\n" indent;
+ | RStruct (_, typ) ->
+ (* XXX There is code generated for guestfish for printing
+ * these structures. We need to make it generally available
+ * for all callers
+ *)
+ pr "%s fprintf (stderr, \"<struct guestfs_%s *>\");\n"
+ indent typ (* XXX *)
+ | RStructList (_, typ) ->
+ pr "%s fprintf (stderr, \"<struct guestfs_%s_list *>\");\n"
+ indent typ (* XXX *)
+ );
+ pr "%s fputc ('\\n', stderr);\n" indent;
+ pr "%s}\n" indent;
+ pr "\n";
+ in
+
+ let trace_return_error ?(indent = 2) (ret, _, _) =
+ let indent = spaces indent in
+
+ pr "%sif (trace_flag)\n" indent;
+
+ (match ret with
+ | RErr | RInt _ | RBool _
+ | RInt64 _ ->
+ pr "%s fputs (\" = -1 (error)\\n\", stderr);\n" indent
+ | RConstString _ | RString _
+ | RConstOptString _
+ | RBufferOut _
+ | RStringList _ | RHashtable _
+ | RStruct _
+ | RStructList _ ->
+ pr "%s fputs (\" = NULL (error)\\n\", stderr);\n" indent
+ );
+ in
+
(* For non-daemon functions, generate a wrapper around each function. *)
List.iter (
- fun (shortname, style, _, _, _, _, _) ->
- let name = "guestfs_" ^ shortname in
-
- generate_prototype ~extern:false ~semicolon:false ~newline:true
- ~handle:"g" name style;
+ fun (shortname, (ret, _, optargs as style), _, _, _, _, _) ->
+ if optargs = [] then
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_"
+ shortname style
+ else
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" ~suffix:"_argv" ~optarg_proto:Argv
+ shortname style;
pr "{\n";
+ pr " int trace_flag = g->trace;\n";
+ (match ret with
+ | RErr | RInt _ | RBool _ ->
+ pr " int r;\n"
+ | RInt64 _ ->
+ pr " int64_t r;\n"
+ | RConstString _ ->
+ pr " const char *r;\n"
+ | RConstOptString _ ->
+ pr " const char *r;\n"
+ | RString _ | RBufferOut _ ->
+ 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
+ );
+ pr "\n";
check_null_strings shortname style;
+ reject_unknown_optargs shortname style;
trace_call shortname style;
- pr " return guestfs__%s " shortname;
+ pr " r = guestfs__%s " shortname;
generate_c_call_args ~handle:"g" style;
pr ";\n";
+ pr "\n";
+ (match errcode_of_ret ret with
+ | (`ErrorIsMinusOne | `ErrorIsNULL) as errcode ->
+ pr " if (r != %s) {\n" (string_of_errcode errcode);
+ trace_return ~indent:4 style "r";
+ pr " } else {\n";
+ trace_return_error ~indent:4 style;
+ pr " }\n";
+ | `CannotReturnError ->
+ trace_return style "r";
+ );
+ pr "\n";
+ pr " return r;\n";
pr "}\n";
pr "\n"
) non_daemon_functions;
(* Client-side stubs for each function. *)
List.iter (
- fun (shortname, style, _, _, _, _, _) ->
+ fun (shortname, (ret, args, optargs as style), _, _, _, _, _) ->
let name = "guestfs_" ^ shortname in
- let error_code = error_code_of (fst style) in
+ let errcode =
+ match errcode_of_ret ret with
+ | `CannotReturnError -> assert false
+ | (`ErrorIsMinusOne | `ErrorIsNULL) as e -> e in
(* Generate the action stub. *)
- generate_prototype ~extern:false ~semicolon:false ~newline:true
- ~handle:"g" name style;
+ if optargs = [] then
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" shortname style
+ else
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" ~suffix:"_argv"
+ ~optarg_proto:Argv shortname style;
pr "{\n";
- (match snd style with
+ (match args with
| [] -> ()
| _ -> pr " struct %s_args args;\n" name
);
pr " guestfs_message_header hdr;\n";
pr " guestfs_message_error err;\n";
let has_ret =
- match fst style with
+ match ret with
| RErr -> false
| RConstString _ | RConstOptString _ ->
failwithf "RConstString|RConstOptString cannot be used by daemon functions"
pr " int serial;\n";
pr " int r;\n";
+ pr " int trace_flag = g->trace;\n";
+ (match ret with
+ | RErr | RInt _ | RBool _ ->
+ pr " int ret_v;\n"
+ | RInt64 _ ->
+ pr " int64_t ret_v;\n"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *ret_v;\n"
+ | RString _ | RBufferOut _ ->
+ pr " char *ret_v;\n"
+ | RStringList _ | RHashtable _ ->
+ pr " char **ret_v;\n"
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *ret_v;\n" typ
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *ret_v;\n" typ
+ );
+
+ let has_filein =
+ List.exists (function FileIn _ -> true | _ -> false) args in
+ if has_filein then (
+ pr " uint64_t progress_hint = 0;\n";
+ pr " struct stat progress_stat;\n";
+ ) else
+ pr " const uint64_t progress_hint = 0;\n";
+
pr "\n";
check_null_strings shortname style;
+ reject_unknown_optargs shortname style;
trace_call shortname style;
- pr " if (check_state (g, \"%s\") == -1) return %s;\n"
- shortname error_code;
+
+ (* Calculate the total size of all FileIn arguments to pass
+ * as a progress bar hint.
+ *)
+ List.iter (
+ function
+ | FileIn n ->
+ pr " if (stat (%s, &progress_stat) == 0 &&\n" n;
+ pr " S_ISREG (progress_stat.st_mode))\n";
+ pr " progress_hint += progress_stat.st_size;\n";
+ pr "\n";
+ | _ -> ()
+ ) args;
+
+ (* Check we are in the right state for sending a request. *)
+ pr " if (check_state (g, \"%s\") == -1) {\n" shortname;
+ trace_return_error ~indent:4 style;
+ pr " return %s;\n" (string_of_errcode errcode);
+ pr " }\n";
pr " guestfs___set_busy (g);\n";
pr "\n";
(* Send the main header and arguments. *)
- (match snd style with
- | [] ->
- pr " serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
- (String.uppercase shortname)
- | args ->
- List.iter (
- function
- | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
- pr " args.%s = (char *) %s;\n" n n
- | OptString n ->
- pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
- | StringList n | DeviceList n ->
- pr " args.%s.%s_val = (char **) %s;\n" n n n;
- pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
- | Bool n ->
- pr " args.%s = %s;\n" n n
- | Int n ->
- pr " args.%s = %s;\n" n n
+ if args = [] && optargs = [] then (
+ pr " serial = guestfs___send (g, GUESTFS_PROC_%s, progress_hint, 0,\n"
+ (String.uppercase shortname);
+ pr " NULL, NULL);\n"
+ ) else (
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
+ pr " args.%s = (char *) %s;\n" n n
+ | OptString n ->
+ pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
+ | StringList n | DeviceList n ->
+ pr " args.%s.%s_val = (char **) %s;\n" n n n;
+ pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
+ | Bool n ->
+ pr " args.%s = %s;\n" n n
+ | Int n ->
+ pr " args.%s = %s;\n" n n
+ | Int64 n ->
+ pr " args.%s = %s;\n" n n
+ | FileIn _ | FileOut _ -> ()
+ | BufferIn n ->
+ pr " /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
+ pr " if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
+ trace_return_error ~indent:4 style;
+ pr " error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
+ shortname;
+ pr " guestfs___end_busy (g);\n";
+ pr " return %s;\n" (string_of_errcode errcode);
+ pr " }\n";
+ pr " args.%s.%s_val = (char *) %s;\n" n n n;
+ pr " args.%s.%s_len = %s_size;\n" n n n
+ | Pointer _ -> assert false
+ ) args;
+
+ List.iter (
+ fun argt ->
+ let n = name_of_argt argt in
+ let uc_shortname = String.uppercase shortname in
+ let uc_n = String.uppercase n in
+ pr " if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK))\n"
+ uc_shortname uc_n;
+ (match argt with
+ | Bool n
+ | Int n
| Int64 n ->
- pr " args.%s = %s;\n" n n
- | FileIn _ | FileOut _ -> ()
- | BufferIn n ->
- pr " /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
- pr " if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
- pr " error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
- shortname;
- pr " guestfs___end_busy (g);\n";
- pr " return %s;\n" error_code;
- pr " }\n";
- pr " args.%s.%s_val = (char *) %s;\n" n n n;
- pr " args.%s.%s_len = %s_size;\n" n n n
- ) args;
- pr " serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
- (String.uppercase shortname);
- pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
- name;
+ pr " args.%s = optargs->%s;\n" n n;
+ pr " else\n";
+ pr " args.%s = 0;\n" n
+ | String n ->
+ pr " args.%s = (char *) optargs->%s;\n" n n;
+ pr " else\n";
+ pr " args.%s = (char *) \"\";\n" n
+ | _ -> assert false
+ )
+ ) optargs;
+
+ pr " serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
+ (String.uppercase shortname);
+ pr " progress_hint, %s,\n"
+ (if optargs <> [] then "optargs->bitmask" else "0");
+ pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
+ name;
);
pr " if (serial == -1) {\n";
pr " guestfs___end_busy (g);\n";
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 style;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr "\n";
pr " r = guestfs___send_file (g, %s);\n" n;
pr " if (r == -1) {\n";
pr " guestfs___end_busy (g);\n";
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 style;
+ pr " /* daemon will send an error reply which we discard */\n";
+ pr " guestfs___recv_discard (g, \"%s\");\n" shortname;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr " if (r == -2) /* daemon cancelled */\n";
pr " goto read_reply;\n";
need_read_reply_label := true;
pr "\n";
| _ -> ()
- ) (snd style);
+ ) args;
(* Wait for the reply from the remote end. *)
if !need_read_reply_label then pr " read_reply:\n";
pr " if (r == -1) {\n";
pr " guestfs___end_busy (g);\n";
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 style;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr "\n";
pr " if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
(String.uppercase shortname);
pr " guestfs___end_busy (g);\n";
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 style;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr "\n";
pr " if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
- pr " error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
+ trace_return_error ~indent:4 style;
+ pr " int errnum = 0;\n";
+ pr " if (err.errno_string[0] != '\\0')\n";
+ pr " errnum = guestfs___string_to_errno (err.errno_string);\n";
+ pr " if (errnum <= 0)\n";
+ pr " error (g, \"%%s: %%s\", \"%s\", err.error_message);\n"
+ shortname;
+ pr " else\n";
+ pr " guestfs_error_errno (g, errnum, \"%%s: %%s\", \"%s\",\n"
+ shortname;
+ pr " err.error_message);\n";
pr " free (err.error_message);\n";
+ pr " free (err.errno_string);\n";
pr " guestfs___end_busy (g);\n";
- pr " return %s;\n" error_code;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr "\n";
| FileOut n ->
pr " if (guestfs___recv_file (g, %s) == -1) {\n" n;
pr " guestfs___end_busy (g);\n";
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 style;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr "\n";
| _ -> ()
- ) (snd style);
+ ) args;
pr " guestfs___end_busy (g);\n";
- (match fst style with
- | RErr -> pr " return 0;\n"
+ (match ret with
+ | RErr ->
+ pr " ret_v = 0;\n"
| RInt n | RInt64 n | RBool n ->
- pr " return ret.%s;\n" n
+ pr " ret_v = ret.%s;\n" n
| RConstString _ | RConstOptString _ ->
failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RString n ->
- pr " return ret.%s; /* caller will free */\n" n
+ pr " ret_v = ret.%s; /* caller will free */\n" n
| RStringList n | RHashtable n ->
pr " /* caller will free this, but we need to add a NULL entry */\n";
pr " ret.%s.%s_val =\n" n n;
pr " sizeof (char *) * (ret.%s.%s_len + 1));\n"
n n;
pr " ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
- pr " return ret.%s.%s_val;\n" n n
+ pr " ret_v = ret.%s.%s_val;\n" n n
| RStruct (n, _) ->
pr " /* caller will free this */\n";
- pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
+ pr " ret_v = safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
| RStructList (n, _) ->
pr " /* caller will free this */\n";
- pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
+ pr " ret_v = safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
| RBufferOut n ->
pr " /* RBufferOut is tricky: If the buffer is zero-length, then\n";
pr " * _val might be NULL here. To make the API saner for\n";
pr " */\n";
pr " if (ret.%s.%s_len > 0) {\n" n n;
pr " *size_r = ret.%s.%s_len;\n" n n;
- pr " return ret.%s.%s_val; /* caller will free */\n" n n;
+ pr " ret_v = ret.%s.%s_val; /* caller will free */\n" n n;
pr " } else {\n";
pr " free (ret.%s.%s_val);\n" n n;
pr " char *p = safe_malloc (g, 1);\n";
pr " *size_r = ret.%s.%s_len;\n" n n;
- pr " return p;\n";
+ pr " ret_v = p;\n";
pr " }\n";
);
-
+ trace_return style "ret_v";
+ pr " return ret_v;\n";
pr "}\n\n"
) daemon_functions;
) structs;
+ (* Functions which have optional arguments have two generated variants. *)
+ List.iter (
+ function
+ | shortname, (ret, args, (_::_ as optargs) as style), _, _, _, _, _ ->
+ let uc_shortname = String.uppercase shortname in
+
+ (* Get the name of the last regular argument. *)
+ let last_arg =
+ match args with
+ | [] -> "g"
+ | args -> name_of_argt (List.hd (List.rev args)) in
+
+ let rtype =
+ match ret with
+ | RErr | RInt _ | RBool _ -> "int "
+ | RInt64 _ -> "int64_t "
+ | RConstString _ | RConstOptString _ -> "const char *"
+ | RString _ | RBufferOut _ -> "char *"
+ | RStringList _ | RHashtable _ -> "char **"
+ | RStruct (_, typ) -> sprintf "struct guestfs_%s *" typ
+ | RStructList (_, typ) ->
+ sprintf "struct guestfs_%s_list *" typ in
+
+ (* The regular variable args function, just calls the _va variant. *)
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" shortname style;
+ pr "{\n";
+ pr " va_list optargs;\n";
+ pr "\n";
+ pr " va_start (optargs, %s);\n" last_arg;
+ pr " %sr = guestfs_%s_va " rtype shortname;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ pr " va_end (optargs);\n";
+ pr "\n";
+ pr " return r;\n";
+ pr "}\n\n";
+
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" ~suffix:"_va" ~optarg_proto:VA
+ shortname style;
+ pr "{\n";
+ pr " struct guestfs_%s_argv optargs_s;\n" shortname;
+ pr " struct guestfs_%s_argv *optargs = &optargs_s;\n" shortname;
+ pr " int i;\n";
+ pr "\n";
+ pr " optargs_s.bitmask = 0;\n";
+ pr "\n";
+ pr " while ((i = va_arg (args, int)) >= 0) {\n";
+ pr " switch (i) {\n";
+
+ List.iter (
+ fun argt ->
+ let n = name_of_argt argt in
+ let uc_n = String.uppercase n in
+ pr " case GUESTFS_%s_%s:\n" uc_shortname uc_n;
+ pr " optargs_s.%s = va_arg (args, " n;
+ (match argt with
+ | Bool _ | Int _ -> pr "int"
+ | Int64 _ -> pr "int64_t"
+ | String _ -> pr "const char *"
+ | _ -> assert false
+ );
+ pr ");\n";
+ pr " break;\n";
+ ) optargs;
+
+ let errcode =
+ match errcode_of_ret ret with
+ | `CannotReturnError -> assert false
+ | (`ErrorIsMinusOne | `ErrorIsNULL) as e -> e in
+
+ pr " default:\n";
+ pr " error (g, \"%%s: unknown option %%d (this can happen if a program is compiled against a newer version of libguestfs, then dynamically linked to an older version)\",\n";
+ pr " \"%s\", i);\n" shortname;
+ pr " return %s;\n" (string_of_errcode errcode);
+ pr " }\n";
+ pr "\n";
+ pr " uint64_t i_mask = UINT64_C(1) << i;\n";
+ pr " if (optargs_s.bitmask & i_mask) {\n";
+ pr " error (g, \"%%s: same optional argument specified more than once\",\n";
+ pr " \"%s\");\n" shortname;
+ pr " return %s;\n" (string_of_errcode errcode);
+ pr " }\n";
+ pr " optargs_s.bitmask |= i_mask;\n";
+ pr " }\n";
+ pr "\n";
+ pr " return guestfs_%s_argv " shortname;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ pr "}\n\n"
+ | _ -> ()
+ ) all_functions_sorted
+
(* Generate the linker script which controls the visibility of
* symbols in the public ABI and ensures no other symbols get
* exported accidentally.
"guestfs_get_error_handler";
"guestfs_get_out_of_memory_handler";
"guestfs_get_private";
+ "guestfs_last_errno";
"guestfs_last_error";
"guestfs_set_close_callback";
"guestfs_set_error_handler";
"guestfs_safe_strdup";
"guestfs_safe_memdup";
"guestfs_tmpdir";
+ "guestfs___for_each_disk";
] in
let functions =
- List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
- all_functions in
+ List.flatten (
+ List.map (
+ function
+ | name, (_, _, []), _, _, _, _, _ -> ["guestfs_" ^ name]
+ | name, (_, _, _), _, _, _, _, _ ->
+ ["guestfs_" ^ name;
+ "guestfs_" ^ name ^ "_va";
+ "guestfs_" ^ name ^ "_argv"]
+ ) all_functions
+ ) in
let structs =
List.concat (
List.map (fun (typ, _) ->