X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=71aeeed84f7c8fb4e29b4a8412e5ce08dd4f00ef;hp=de7a75f4d544b33336efd08fdcbab7e67be3ab4a;hb=f04ee08806ec7bd313e9d54f48f2eb911fcb3067;hpb=2f3a0e3975ddecce2330324a152530c5b99f22f9 diff --git a/src/generator.ml b/src/generator.ml index de7a75f..71aeeed 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -805,6 +805,32 @@ is passed to the appliance at boot time. See C. For more information on the architecture of libguestfs, see L."); + ("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 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 @@ -1669,7 +1695,7 @@ This is the same as the C system call."); ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [], [InitISOFS, Always, TestOutputStruct ( - [["statvfs"; "/"]], [CompareWithInt ("namemax", 256)])], + [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])], "get file system statistics", "\ Returns file system statistics for any mounted file system. @@ -3569,6 +3595,19 @@ This loads a kernel module in the appliance. The kernel module must have been whitelisted when libguestfs was built (see C in the source)."); + ("echo_daemon", (RString "output", [StringList "words"]), 195, [], + [InitNone, Always, TestOutput ( + [["echo_daemon"; "This is a test"]], "This is a test" + )], + "echo arguments back to the client", + "\ +This command concatenate the list of C passed with single spaces between +them and returns the resulting string. + +You can use this command to test the connection through to the daemon. + +See also C."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -4548,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; @@ -4557,6 +4606,7 @@ and generate_client_actions () = #include #include \"guestfs.h\" +#include \"guestfs-internal-actions.h\" #include \"guestfs_protocol.h\" #define error guestfs_error @@ -4619,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, _, _, _, _, _) -> @@ -4719,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"; @@ -5379,7 +5492,7 @@ static void print_table (char const *const *argv) int main (int argc, char *argv[]) { char c = 0; - int failed = 0; + unsigned long int n_failed = 0; const char *filename; int fd; int nr_tests, test_num = 0; @@ -5513,7 +5626,7 @@ int main (int argc, char *argv[]) pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name; pr " if (%s () == -1) {\n" test_name; pr " printf (\"%s FAILED\\n\");\n" test_name; - pr " failed++;\n"; + pr " n_failed++;\n"; pr " }\n"; ) test_names; pr "\n"; @@ -5524,8 +5637,8 @@ int main (int argc, char *argv[]) pr " unlink (\"test3.img\");\n"; pr "\n"; - pr " if (failed > 0) {\n"; - pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n"; + pr " if (n_failed > 0) {\n"; + pr " printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n"; pr " exit (1);\n"; pr " }\n"; pr "\n"; @@ -6109,7 +6222,7 @@ and generate_fish_cmds () = pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ; pr "{\n"; - pr " int i;\n"; + pr " unsigned int i;\n"; pr "\n"; pr " for (i = 0; i < %ss->len; ++i) {\n" typ; pr " printf (\"[%%d] = {\\n\", i);\n"; @@ -6129,7 +6242,7 @@ and generate_fish_cmds () = pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ; pr "{\n"; if needs_i then ( - pr " int i;\n"; + pr " unsigned int i;\n"; pr "\n" ); List.iter ( @@ -6221,7 +6334,7 @@ and generate_fish_cmds () = | OptString n | FileIn n | FileOut n -> pr " const char *%s;\n" n - | StringList n | DeviceList n -> pr " char *const *%s;\n" n + | StringList n | DeviceList n -> pr " char **%s;\n" n | Bool n -> pr " int %s;\n" n | Int n -> pr " int %s;\n" n ) (snd style); @@ -6264,6 +6377,15 @@ and generate_fish_cmds () = generate_c_call_args ~handle:"g" style; pr ";\n"; + List.iter ( + function + | Pathname name | Device name | Dev_or_Path name | String name + | OptString name | FileIn name | FileOut name | Bool name + | Int name -> () + | StringList name | DeviceList name -> + pr " free_strings (%s);\n" name + ) (snd style); + (* Check return value for errors and display command results. *) (match fst style with | RErr -> pr " return r;\n" @@ -6692,6 +6814,29 @@ copy_table (char * const * argv) "; (* Struct copy functions. *) + + let emit_ocaml_copy_list_function typ = + pr "static CAMLprim value\n"; + pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ; + pr "{\n"; + pr " CAMLparam0 ();\n"; + pr " CAMLlocal2 (rv, v);\n"; + pr " unsigned int i;\n"; + pr "\n"; + pr " if (%ss->len == 0)\n" typ; + pr " CAMLreturn (Atom (0));\n"; + pr " else {\n"; + pr " rv = caml_alloc (%ss->len, 0);\n" typ; + pr " for (i = 0; i < %ss->len; ++i) {\n" typ; + pr " v = copy_%s (&%ss->val[i]);\n" typ typ; + pr " caml_modify (&Field (rv, i), v);\n"; + pr " }\n"; + pr " CAMLreturn (rv);\n"; + pr " }\n"; + pr "}\n"; + pr "\n"; + in + List.iter ( fun (typ, cols) -> let has_optpercent_col = @@ -6738,29 +6883,17 @@ copy_table (char * const * argv) pr " CAMLreturn (rv);\n"; pr "}\n"; pr "\n"; - - pr "static CAMLprim value\n"; - pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" - typ typ typ; - pr "{\n"; - pr " CAMLparam0 ();\n"; - pr " CAMLlocal2 (rv, v);\n"; - pr " int i;\n"; - pr "\n"; - pr " if (%ss->len == 0)\n" typ; - pr " CAMLreturn (Atom (0));\n"; - pr " else {\n"; - pr " rv = caml_alloc (%ss->len, 0);\n" typ; - pr " for (i = 0; i < %ss->len; ++i) {\n" typ; - pr " v = copy_%s (&%ss->val[i]);\n" typ typ; - pr " caml_modify (&Field (rv, i), v);\n"; - pr " }\n"; - pr " CAMLreturn (rv);\n"; - pr " }\n"; - pr "}\n"; - pr "\n"; ) structs; + (* Emit a copy_TYPE_list function definition only if that function is used. *) + List.iter ( + function + | typ, (RStructListOnly | RStructAndList) -> + (* generate the function for typ *) + emit_ocaml_copy_list_function typ + | typ, _ -> () (* empty *) + ) rstructs_used; + (* The wrappers. *) List.iter ( fun (name, style, _, _, _, _, _) -> @@ -6770,6 +6903,10 @@ copy_table (char * const * argv) let needs_extra_vs = match fst style with RConstOptString _ -> true | _ -> false in + pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n"; + pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params); + List.iter (pr ", value %s") (List.tl params); pr ");\n"; + pr "CAMLprim value\n"; pr "ocaml_guestfs_%s (value %s" name (List.hd params); List.iter (pr ", value %s") (List.tl params); @@ -6903,6 +7040,9 @@ copy_table (char * const * argv) pr "\n"; if List.length params > 5 then ( + pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n"; + pr "CAMLprim value "; + pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name; pr "CAMLprim value\n"; pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name; pr "{\n"; @@ -9071,6 +9211,7 @@ and generate_bindtests () = #include #include \"guestfs.h\" +#include \"guestfs-internal-actions.h\" #include \"guestfs_protocol.h\" #define error guestfs_error @@ -9101,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 @@ -9126,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 -> @@ -9192,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 @@ -9515,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 ();