(* libguestfs
- * Copyright (C) 2009-2010 Red Hat Inc.
+ * Copyright (C) 2009-2011 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
";
- 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).
*)
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 ret);
+ 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
pr " optargs->%s == NULL) {\n" n;
pr " error (g, \"%%s: %%s: optional parameter cannot be NULL\",\n";
pr " \"%s\", \"%s\");\n" shortname n;
- pr " return %s;\n" (error_code_of ret);
+ 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
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;
- pr " return %s;\n" (error_code_of ret);
+ 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
pr "\n"
);
- pr " fprintf (stderr, \"%s\");\n" shortname;
+ pr " fprintf (stderr, \"%%s: %%s: %%s\",\n";
+ pr " \"libguestfs\", \"trace\", \"%s\");\n" shortname;
(* Required arguments. *)
List.iter (
);
) optargs;
+ pr " fputc ('\\n', stderr);\n";
pr " }\n";
pr "\n";
in
- let trace_return ?(indent = 2) (ret, _, _) rv =
+ let trace_return ?(indent = 2) shortname (ret, _, _) rv =
let indent = spaces indent in
pr "%sif (trace_flag) {\n" indent;
pr "\n"
);
- pr "%s fputs (\" = \", stderr);\n" indent;
+ pr "%s fprintf (stderr, \"%%s: %%s: %%s = \",\n" indent;
+ pr "%s \"libguestfs\", \"trace\", \"%s\");\n"
+ indent shortname;
+
(match ret with
| RErr | RInt _ | RBool _ ->
pr "%s fprintf (stderr, \"%%d\", %s);\n" indent rv
pr "\n";
in
- let trace_return_error ?(indent = 2) (ret, _, _) =
+ let trace_return_error ?(indent = 2) shortname (ret, _, _) =
let indent = spaces indent in
pr "%sif (trace_flag)\n" indent;
+ pr "%s fprintf (stderr, \"%%s: %%s: %%s = %%s (error)\\n\",\n" indent;
+ pr "%s \"libguestfs\", \"trace\", \"%s\", "
+ indent shortname;
+
(match ret with
| RErr | RInt _ | RBool _
| RInt64 _ ->
- pr "%s fputs (\" = -1 (error)\\n\", stderr);\n" indent
+ pr "\"-1\""
| RConstString _ | RString _
| RConstOptString _
| RBufferOut _
| RStringList _ | RHashtable _
| RStruct _
| RStructList _ ->
- pr "%s fputs (\" = NULL (error)\\n\", stderr);\n" indent
+ pr "\"NULL\""
);
+ pr ");\n"
in
(* For non-daemon functions, generate a wrapper around each function. *)
pr " int r;\n"
| RInt64 _ ->
pr " int64_t r;\n"
- | RConstString _ | RConstOptString _ ->
+ | RConstString _ ->
+ pr " const char *r;\n"
+ | RConstOptString _ ->
pr " const char *r;\n"
| RString _ | RBufferOut _ ->
pr " char *r;\n"
pr " r = guestfs__%s " shortname;
generate_c_call_args ~handle:"g" style;
pr ";\n";
- trace_return style "r";
+ 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 shortname style "r";
+ pr " } else {\n";
+ trace_return_error ~indent:4 shortname style;
+ pr " }\n";
+ | `CannotReturnError ->
+ trace_return shortname style "r";
+ );
+ pr "\n";
pr " return r;\n";
pr "}\n";
pr "\n"
List.iter (
fun (shortname, (ret, args, optargs as style), _, _, _, _, _) ->
let name = "guestfs_" ^ shortname in
- let error_code = error_code_of ret in
+ let errcode =
+ match errcode_of_ret ret with
+ | `CannotReturnError -> assert false
+ | (`ErrorIsMinusOne | `ErrorIsNULL) as e -> e in
(* Generate the action stub. *)
if optargs = [] then
(* 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" error_code;
+ trace_return_error ~indent:4 shortname style;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr " guestfs___set_busy (g);\n";
pr "\n";
| 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;
+ trace_return_error ~indent:4 shortname style;
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 " 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
pr " else\n";
pr " args.%s = 0;\n" n
| String n ->
- pr " args.%s = (char *) %s;\n" n n;
+ pr " args.%s = (char *) optargs->%s;\n" n n;
pr " else\n";
pr " args.%s = (char *) \"\";\n" n
| _ -> assert false
);
pr " if (serial == -1) {\n";
pr " guestfs___end_busy (g);\n";
- trace_return_error ~indent:4 style;
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 shortname 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";
- trace_return_error ~indent:4 style;
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 shortname style;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr " if (r == -2) /* daemon cancelled */\n";
pr " goto read_reply;\n";
pr " if (r == -1) {\n";
pr " guestfs___end_busy (g);\n";
- trace_return_error ~indent:4 style;
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 shortname 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";
- trace_return_error ~indent:4 style;
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 shortname style;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr "\n";
pr " if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
- trace_return_error ~indent:4 style;
+ trace_return_error ~indent:4 shortname 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 " 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";
- trace_return_error ~indent:4 style;
- pr " return %s;\n" error_code;
+ trace_return_error ~indent:4 shortname style;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr "\n";
| _ -> ()
pr " ret_v = p;\n";
pr " }\n";
);
- trace_return style "ret_v";
+ trace_return shortname style "ret_v";
pr " return ret_v;\n";
pr "}\n\n"
) daemon_functions;
| [] -> "g"
| args -> name_of_argt (List.hd (List.rev args)) in
- let rerrcode, rtype =
+ let rtype =
match ret with
- | RErr | RInt _ | RBool _ -> "-1", "int "
- | RInt64 _ -> "-1", "int64_t "
- | RConstString _ | RConstOptString _ -> "NULL", "const char *"
- | RString _ | RBufferOut _ -> "NULL", "char *"
- | RStringList _ | RHashtable _ -> "NULL", "char **"
- | RStruct (_, typ) -> "NULL", sprintf "struct guestfs_%s *" typ
+ | 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) ->
- "NULL", sprintf "struct guestfs_%s_list *" typ in
+ 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
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" rerrcode;
+ 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" rerrcode;
+ pr " return %s;\n" (string_of_errcode errcode);
pr " }\n";
pr " optargs_s.bitmask |= i_mask;\n";
pr " }\n";
git.annexia.org / libguestfs.git / blobdiff