Add command trace functionality.
[libguestfs.git] / src / generator.ml
index 32537df..71aeeed 100755 (executable)
@@ -805,6 +805,32 @@ is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
 For more information on the architecture of libguestfs,
 see L<guestfs(3)>.");
 
+  ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
+   [InitNone, Always, TestOutputTrue (
+      [["set_trace"; "true"];
+       ["get_trace"]])],
+   "enable or disable command traces",
+   "\
+If the command trace flag is set to 1, then commands are
+printed on stdout before they are executed in a format
+which is very similar to the one used by guestfish.  In
+other words, you can run a program with this enabled, and
+you will get out a script which you can feed to guestfish
+to perform the same set of actions.
+
+If you want to trace C API calls into libguestfs (and
+other libraries) then possibly a better way is to use
+the external ltrace(1) command.
+
+Command traces are disabled unless the environment variable
+C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
+
+  ("get_trace", (RBool "trace", []), -1, [],
+   [],
+   "get command trace enabled flag",
+   "\
+Return the command trace flag.");
+
 ]
 
 (* daemon_functions are any functions which cause some action
@@ -4561,6 +4587,16 @@ and generate_actions_h () =
         name style
   ) all_functions
 
+(* Generate the guestfs-internal-actions.h file. *)
+and generate_internal_actions_h () =
+  generate_header CStyle LGPLv2;
+  List.iter (
+    fun (shortname, style, _, _, _, _, _) ->
+      let name = "guestfs__" ^ shortname in
+      generate_prototype ~single_line:true ~newline:true ~handle:"handle"
+        name style
+  ) non_daemon_functions
+
 (* Generate the client-side dispatch stubs. *)
 and generate_client_actions () =
   generate_header CStyle LGPLv2;
@@ -4570,6 +4606,7 @@ and generate_client_actions () =
 #include <stdlib.h>
 
 #include \"guestfs.h\"
+#include \"guestfs-internal-actions.h\"
 #include \"guestfs_protocol.h\"
 
 #define error guestfs_error
@@ -4632,6 +4669,68 @@ check_state (guestfs_h *g, const char *caller)
 
 ";
 
+  (* Generate code to generate guestfish call traces. *)
+  let trace_call shortname style =
+    pr "  if (guestfs__get_trace (g)) {\n";
+
+    let needs_i =
+      List.exists (function
+                  | StringList _ | DeviceList _ -> true
+                  | _ -> false) (snd style) in
+    if needs_i then (
+      pr "    int i;\n";
+      pr "\n"
+    );
+
+    pr "    printf (\"%s\");\n" shortname;
+    List.iter (
+      function
+      | String n                       (* strings *)
+      | Device n
+      | Pathname n
+      | Dev_or_Path n
+      | FileIn n
+      | FileOut n ->
+         (* guestfish doesn't support string escaping, so neither do we *)
+         pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
+      | OptString n ->                 (* string option *)
+         pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
+         pr "    else printf (\" null\");\n"
+      | StringList n
+      | DeviceList n ->                        (* string list *)
+         pr "    putchar (' ');\n";
+         pr "    putchar ('\"');\n";
+         pr "    for (i = 0; %s[i]; ++i) {\n" n;
+         pr "      if (i > 0) putchar (' ');\n";
+         pr "      fputs (%s[i], stdout);\n" n;
+         pr "    }\n";
+         pr "    putchar ('\"');\n";
+      | Bool n ->                      (* boolean *)
+         pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
+      | Int n ->                       (* int *)
+         pr "    printf (\" %%d\", %s);\n" n
+    ) (snd style);
+    pr "    putchar ('\\n');\n";
+    pr "  }\n";
+    pr "\n";
+  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;
+      pr "{\n";
+      trace_call shortname style;
+      pr "  return guestfs__%s " shortname;
+      generate_c_call_args ~handle:"g" style;
+      pr ";\n";
+      pr "}\n";
+      pr "\n"
+  ) non_daemon_functions;
+
   (* Client-side stubs for each function. *)
   List.iter (
     fun (shortname, style, _, _, _, _, _) ->
@@ -4732,6 +4831,7 @@ check_state (guestfs_h *g, const char *caller)
       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
       pr "  int serial;\n";
       pr "\n";
+      trace_call shortname style;
       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
       pr "  guestfs_set_busy (g);\n";
       pr "\n";
@@ -9111,6 +9211,7 @@ and generate_bindtests () =
 #include <string.h>
 
 #include \"guestfs.h\"
+#include \"guestfs-internal-actions.h\"
 #include \"guestfs_protocol.h\"
 
 #define error guestfs_error
@@ -9141,7 +9242,7 @@ print_strings (char *const *argv)
   let () =
     let (name, style, _, _, _, _, _) = test0 in
     generate_prototype ~extern:false ~semicolon:false ~newline:true
-      ~handle:"g" ~prefix:"guestfs_" name style;
+      ~handle:"g" ~prefix:"guestfs__" name style;
     pr "{\n";
     List.iter (
       function
@@ -9166,7 +9267,7 @@ print_strings (char *const *argv)
       if String.sub name (String.length name - 3) 3 <> "err" then (
         pr "/* Test normal return. */\n";
         generate_prototype ~extern:false ~semicolon:false ~newline:true
-          ~handle:"g" ~prefix:"guestfs_" name style;
+          ~handle:"g" ~prefix:"guestfs__" name style;
         pr "{\n";
         (match fst style with
          | RErr ->
@@ -9232,7 +9333,7 @@ print_strings (char *const *argv)
       ) else (
         pr "/* Test error return. */\n";
         generate_prototype ~extern:false ~semicolon:false ~newline:true
-          ~handle:"g" ~prefix:"guestfs_" name style;
+          ~handle:"g" ~prefix:"guestfs__" name style;
         pr "{\n";
         pr "  error (g, \"error\");\n";
         (match fst style with
@@ -9555,6 +9656,10 @@ Run it from the top source directory using the command
   generate_actions_h ();
   close ();
 
+  let close = output_to "src/guestfs-internal-actions.h" in
+  generate_internal_actions_h ();
+  close ();
+
   let close = output_to "src/guestfs-actions.c" in
   generate_client_actions ();
   close ();