Lots more auto-generation.
[libguestfs.git] / src / generator.ml
index 02fe691..d08e269 100755 (executable)
 
 open Printf
 
-type styles =
-  | Int_Void           (* int foo (guestfs_h); *)
-  | Int_String         (* int foo (guestfs_h, const char * ); *)
-  | Int_StringString   (* int foo (guestfs_h, const char *, const char * ); *)
+type style = ret * args
+and ret =
+    (* "Err" as a return value means an int used as a simple error
+     * indication, ie. 0 or -1.
+     *)
+  | Err
+and args =
+    (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
+  | P0
+  | P1 of argt
+  | P2 of argt * argt
+and argt =
+  | String of string   (* const char *name, cannot be NULL *)
 
 let functions = [
-  ("mount", Int_StringString, [|"device"; "mountpoint"|],
+  ("mount", (Err, P2 (String "device", String "mountpoint")),
    "Mount a guest disk at a position in the filesystem",
    "\
 Mount a guest disk at a position in the filesystem.  Block devices
@@ -46,7 +55,7 @@ first be mounted on C</> before others can be mounted.  Other
 filesystems can only be mounted on directories which already
 exist.");
 
-  ("sync", Int_Void, [||],
+  ("sync", (Err, P0),
    "Sync disks, writes are flushed through to the disk image",
    "\
 This syncs the disk, so that any writes are flushed through to the
@@ -55,7 +64,7 @@ underlying disk image.
 You should always call this if you have modified a disk image, before
 calling C<guestfs_close>.");
 
-  ("touch", Int_String, [|"path"|],
+  ("touch", (Err, P1 (String "path")),
    "Update file timestamps or create a new file",
    "\
 Touch acts like the L<touch(1)> command.  It can be used to
@@ -67,6 +76,11 @@ to create a new zero-length file.");
 let chan = ref stdout
 let pr fs = ksprintf (output_string !chan) fs
 
+let iter_args f = function
+  | P0 -> ()
+  | P1 arg1 -> f arg1
+  | P2 (arg1, arg2) -> f arg1; f arg2
+
 type comment_style = CStyle | HashStyle | OCamlStyle
 type license = GPLv2 | LGPLv2
 
@@ -77,8 +91,8 @@ let rec generate_header comment license =
     | HashStyle ->  pr "# ";  "#"
     | OCamlStyle -> pr "(* "; " *" in
   pr "libguestfs generated file\n";
-  pr "%s WARNING: This file is generated by 'src/generator.ml'.\n" c;
-  pr "%s Any changes you make to this file will be lost.\n" c;
+  pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
+  pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
   pr "%s\n" c;
   pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
   pr "%s\n" c;
@@ -123,45 +137,241 @@ let rec generate_header comment license =
 (* Generate the pod documentation for the C API. *)
 and generate_pod () =
   List.iter (
-    fun (shortname, style, params, _, longdesc) ->
+    fun (shortname, style, _, longdesc) ->
       let name = "guestfs_" ^ shortname in
       pr "=head2 %s\n\n" name;
       pr " ";
-      generate_prototype ~extern:false name style params;
+      generate_prototype ~extern:false name style;
       pr "\n\n";
-      pr "%s\n\n" longdesc
+      pr "%s\n\n" longdesc;
+      (match style with
+       | (Err, _) ->
+          pr "This function return 0 on success or -1 on error.\n\n"
+      );
   ) functions
 
 (* Generate the protocol (XDR) file. *)
 and generate_xdr () =
   generate_header CStyle LGPLv2;
   List.iter (
-    fun (shortname, style, params, _, longdesc) ->
+    fun (shortname, style, _, _) ->
+      let name = "guestfs_" ^ shortname in
+      pr "/* %s */\n\n" name;
+      (match style with
+       | (_, P0) -> ()
+       | (_, args) ->
+          pr "struct %s_args {\n" name;
+          iter_args (
+            function
+            | String name -> pr "  string %s<>;\n" name
+          ) args;
+          pr "};\n\n"
+      );
+      (match style with
+       | (Err, _) -> () 
+    (* | ... -> pr "struct %s_ret ...\n" name; *)
+      );
+  ) functions
+
+(* Generate the guestfs-actions.h file. *)
+and generate_actions_h () =
+  generate_header CStyle LGPLv2;
+  List.iter (
+    fun (shortname, style, _, _) ->
+      let name = "guestfs_" ^ shortname in
+      generate_prototype ~single_line:true ~newline:true name style
+  ) functions
+
+(* Generate the client-side dispatch stubs. *)
+and generate_client_actions () =
+  generate_header CStyle LGPLv2;
+  List.iter (
+    fun (shortname, style, _, _) ->
       let name = "guestfs_" ^ shortname in
-      pr "/* %s */\n" name;
 
+      (* Generate the return value struct. *)
+      pr "struct %s_rv {\n" shortname;
+      pr "  int err_code; /* 0 or -1 */\n";
+      pr "  char err_str[256];\n";
+      (match style with
+       | (Err, _) -> ()
+    (* | _ -> pr "  struct %s_ret ret;\n" name; *)
+      );
+      pr "};\n\n";
+
+      (* Generate the callback function. *)
+      pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
+      pr "{\n";
+      pr "  struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
+      pr "\n";
+      pr "  /* XXX */ rv.code = 0;\n";
+      pr "  main_loop.main_loop_quit (g);\n";
+      pr "}\n\n";
+
+      (* Generate the action stub. *)
+      generate_prototype ~extern:false ~semicolon:false ~newline:true
+       ~handle:"g" name style;
+
+      let error_code =
+       match style with
+       | (Err, _) -> "-1" in
+
+      pr "{\n";
+
+      (match style with
+       | (_, P0) -> ()
+       | _ -> pr "  struct %s_args args;\n" name
+      );
+
+      pr "  struct %s_rv rv;\n" shortname;
+      pr "\n";
+      pr "  if (g->state != READY) {\n";
+      pr "    error (g, \"%s called from the wrong state, %%d != READY\",\n"
+       name;
+      pr "      g->state);\n";
+      pr "    return %s;\n" error_code;
+      pr "  }\n";
+
+      (match style with
+       | (_, P0) -> ()
+       | (_, args) ->
+          pr "\n";
+          iter_args (
+            function
+            | String name -> pr "  args.%s = (char *) %s;\n" name name
+          ) args;
+          pr "  if (dispatch (g, (xdrproc_t) xdr_%s_args, (char *) &args) == -1)\n"
+            name;
+          pr "    return %s;\n" error_code;
+          pr "\n";
+      );
+
+      pr "  rv.err_code = 42;\n";
+      pr "  g->reply_cb_internal = %s_cb;\n" shortname;
+      pr "  g->reply_cb_internal_data = &rv;\n";
+      pr "  main_loop.main_loop_run (g);\n";
+      pr "  g->reply_cb_internal = NULL;\n";
+      pr "  g->reply_cb_internal_data = NULL;\n";
+      pr "  if (rv.err_code == 42) { /* callback wasn't called */\n";
+      pr "    error (g, \"%s failed, see earlier error messages\");\n" name;
+      pr "    return %s;\n" error_code;
+      pr "  }\n";
+      pr "  else if (rv.err_code == -1) { /* error from remote end */\n";
+      pr "    error (g, \"%%s\", rv.err_str);\n";
+      pr "    return %s;\n" error_code;
+      pr "  }\n";
+      pr "\n";
+
+      (match style with
+       | (Err, _) -> pr "  return 0;\n"
+      );
+
+      pr "}\n\n"
+  ) functions
+
+(* Generate daemon/actions.h. *)
+and generate_daemon_actions_h () =
+  generate_header CStyle GPLv2;
+  List.iter (
+    fun (name, style, _, _) ->
+      generate_prototype ~single_line:true ~newline:true ("do_" ^ name) style;
+  ) functions
+
+(* Generate the server-side stubs. *)
+and generate_daemon_actions () =
+  generate_header CStyle GPLv2;
+
+  pr "#include <rpc/types.h>\n";
+  pr "#include <rpc/xdr.h>\n";
+  pr "#include \"daemon.h\"\n";
+  pr "#include \"../src/guest_protocol.h\"\n";
+  pr "#include \"actions.h\"\n";
+  pr "\n";
+
+  List.iter (
+    fun (name, style, _, _) ->
+      (* Generate server-side stubs. *)
+      pr "static void %s_stub (XDR *xdr_in)\n" name;
+      pr "{\n";
+      let error_code =
+       match style with
+       | (Err, _) -> pr "  int r;\n"; "-1" in
+      (match style with
+       | (_, P0) -> ()
+       | (_, args) ->
+          pr "  struct guestfs_%s_args args;\n" name;
+          iter_args (
+            function
+            | String name -> pr "  const char *%s;\n" name
+          ) args
+      );
+      pr "\n";
+
+      (match style with
+       | (_, P0) -> ()
+       | (_, args) ->
+          pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
+          pr "    reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
+          pr "    return;\n";
+          pr "  }\n";
+          iter_args (
+            function
+            | String name -> pr "  %s = args.%s;\n" name name
+          ) args;
+          pr "\n"
+      );
+
+      pr "  r = do_%s " name;
+      generate_call_args style;
+      pr ";\n";
 
+      pr "  if (r == %s)\n" error_code;
+      pr "    /* do_%s has already called reply_with_error, so just return */\n" name;
+      pr "    return;\n";
       pr "\n";
+
+      (match style with
+       | (Err, _) -> pr "  reply (NULL, NULL);\n"
+      );
+
+      pr "}\n\n";
   ) functions
 
-(* Generate a single line prototype. *)
-and generate_prototype ~extern ?(semi = true) ?(handle = "handle")
-    name style params =
+(* Generate a C function prototype. *)
+and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
+    ?(single_line = false) ?(newline = false)
+    ?(handle = "handle") name style =
   if extern then pr "extern ";
+  if static then pr "static ";
   (match style with
-   | Int_Void | Int_String | Int_StringString -> pr "int "
+   | (Err, _) -> pr "int "
   );
   pr "%s (guestfs_h *%s" name handle;
-  (match style with
-   | Int_Void -> ()
-   | Int_String ->
-       pr ", const char *%s" params.(0)
-   | Int_StringString ->
-       pr ", const char *%s" params.(0);
-       pr ", const char *%s" params.(1)
-  );
+  let next () = if single_line then pr ", " else pr ",\n\t\t" in
+  iter_args (
+    function
+    | String name -> next (); pr "const char *%s" name
+  ) (snd style);
   pr ")";
-  if semi then pr ";"
+  if semicolon then pr ";";
+  if newline then pr "\n"
+
+(* Generate C call arguments, eg "(handle, foo, bar)" *)
+and generate_call_args ?handle style =
+  pr "(";
+  let comma = ref false in
+  (match handle with
+   | None -> ()
+   | Some handle -> pr "%s" handle; comma := true
+  );
+  iter_args (
+    fun arg ->
+      if !comma then pr ", ";
+      comma := true;
+      match arg with
+      | String name -> pr "%s" name
+  ) (snd style);
+  pr ")"
 
 let output_to filename =
   let filename_new = filename ^ ".new" in
@@ -169,16 +379,33 @@ let output_to filename =
   let close () =
     close_out !chan;
     chan := stdout;
-    Unix.rename filename_new filename
+    Unix.rename filename_new filename;
+    printf "written %s\n%!" filename;
   in
   close
 
 (* Main program. *)
 let () =
-  let close = output_to "guestfs-actions.pod" in
-  generate_pod ();
-  close ();
-
   let close = output_to "src/guestfs_protocol.x" in
   generate_xdr ();
   close ();
+
+  let close = output_to "src/guestfs-actions.h" in
+  generate_actions_h ();
+  close ();
+
+  let close = output_to "src/guestfs-actions.c" in
+  generate_client_actions ();
+  close ();
+
+  let close = output_to "daemon/actions.h" in
+  generate_daemon_actions_h ();
+  close ();
+
+  let close = output_to "daemon/stubs.c" in
+  generate_daemon_actions ();
+  close ();
+
+  let close = output_to "guestfs-actions.pod" in
+  generate_pod ();
+  close ()