generator: Introduce error code (errcode) concept.
[libguestfs.git] / generator / generator_c.ml
index 24f4e2c..9b88376 100644 (file)
@@ -1,5 +1,5 @@
 (* 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
@@ -637,14 +637,6 @@ check_state (guestfs_h *g, const char *caller)
 
 ";
 
-  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).
    *)
@@ -667,7 +659,17 @@ check_state (guestfs_h *g, const char *caller)
           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
 
@@ -689,7 +691,11 @@ check_state (guestfs_h *g, const char *caller)
           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
 
@@ -711,7 +717,11 @@ check_state (guestfs_h *g, const char *caller)
         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
@@ -729,7 +739,8 @@ check_state (guestfs_h *g, const char *caller)
       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 (
@@ -791,11 +802,12 @@ check_state (guestfs_h *g, const char *caller)
         );
     ) 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;
@@ -809,7 +821,10 @@ check_state (guestfs_h *g, const char *caller)
       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
@@ -845,23 +860,28 @@ check_state (guestfs_h *g, const char *caller)
     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. *)
@@ -882,7 +902,9 @@ check_state (guestfs_h *g, const char *caller)
            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"
@@ -900,7 +922,18 @@ check_state (guestfs_h *g, const char *caller)
       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"
@@ -909,19 +942,20 @@ check_state (guestfs_h *g, const char *caller)
   (* Client-side stubs for each function. *)
   List.iter (
     fun (shortname, (ret, args, optargs as style), _, _, _, _, _) ->
-      if optargs <> [] then
-        failwithf "optargs not yet implemented for daemon functions";
-
       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
         generate_prototype ~extern:false ~semicolon:false ~newline:true
-          ~handle:"g" name style
+          ~handle:"g" ~prefix:"guestfs_" shortname style
       else
         generate_prototype ~extern:false ~semicolon:false ~newline:true
-          ~handle:"g" ~suffix:"_argv" ~optarg_proto:Argv name style;
+          ~handle:"g" ~prefix:"guestfs_" ~suffix:"_argv"
+          ~optarg_proto:Argv shortname style;
 
       pr "{\n";
 
@@ -992,57 +1026,81 @@ check_state (guestfs_h *g, const char *caller)
 
       (* 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";
 
       (* Send the main header and arguments. *)
-      (match args with
-       | [] ->
-           pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, progress_hint,\n"
-             (String.uppercase shortname);
-           pr "                           NULL, NULL);\n"
-       | 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 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" (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;
-                 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" 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
-             | Pointer _ -> assert false
-           ) args;
-           pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, progress_hint,\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";
-      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";
 
@@ -1054,8 +1112,8 @@ check_state (guestfs_h *g, const char *caller)
             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";
@@ -1079,21 +1137,21 @@ check_state (guestfs_h *g, const char *caller)
 
       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";
@@ -1107,7 +1165,7 @@ check_state (guestfs_h *g, const char *caller)
       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";
 
@@ -1117,8 +1175,8 @@ check_state (guestfs_h *g, const char *caller)
         | 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";
         | _ -> ()
@@ -1165,7 +1223,7 @@ check_state (guestfs_h *g, const char *caller)
            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;
@@ -1209,16 +1267,16 @@ check_state (guestfs_h *g, const char *caller)
           | [] -> "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
@@ -1264,17 +1322,22 @@ check_state (guestfs_h *g, const char *caller)
             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";