X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=39f363d68d403e54f49efda13eaea8d33bdf125e;hp=de7a75f4d544b33336efd08fdcbab7e67be3ab4a;hb=9add3c10a3b769e309f476bd0fd05e2a7126d31d;hpb=2f3a0e3975ddecce2330324a152530c5b99f22f9 diff --git a/src/generator.ml b/src/generator.ml index de7a75f..39f363d 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -440,13 +440,18 @@ You should call this after configuring the handle ("wait_ready", (RErr, []), -1, [NotInFish], [], - "wait until the qemu subprocess launches", + "wait until the qemu subprocess launches (no op)", "\ -Internally libguestfs is implemented by running a virtual machine -using L. +This function is a no op. + +In versions of the API E 1.0.71 you had to call this function +just after calling C to wait for the launch +to complete. However this is no longer necessary because +C now does the waiting. -You should call this after C to wait for the launch -to complete."); +If you see any calls to this function in code then you can just +remove them, unless you want to retain compatibility with older +versions of the API."); ("kill_subprocess", (RErr, []), -1, [], [], @@ -680,34 +685,6 @@ only useful for printing debug and internal error messages. For more information on states, see L."); - ("set_busy", (RErr, []), -1, [NotInFish], - [], - "set state to busy", - "\ -This sets the state to C. This is only used when implementing -actions using the low-level API. - -For more information on states, see L."); - - ("set_ready", (RErr, []), -1, [NotInFish], - [], - "set state to ready", - "\ -This sets the state to C. This is only used when implementing -actions using the low-level API. - -For more information on states, see L."); - - ("end_busy", (RErr, []), -1, [NotInFish], - [], - "leave the busy state", - "\ -This sets the state to C, or if in C then it leaves the -state as is. This is only used when implementing -actions using the low-level API. - -For more information on states, see L."); - ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"], [InitNone, Always, TestOutputInt ( [["set_memsize"; "500"]; @@ -805,6 +782,57 @@ 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, TestOutputFalse ( + [["set_trace"; "false"]; + ["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."); + + ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"], + [InitNone, Always, TestOutputFalse ( + [["set_direct"; "false"]; + ["get_direct"]])], + "enable or disable direct appliance mode", + "\ +If the direct appliance mode flag is enabled, then stdin and +stdout are passed directly through to the appliance once it +is launched. + +One consequence of this is that log messages aren't caught +by the library and handled by C, +but go straight to stdout. + +You probably don't want to use this unless you know what you +are doing. + +The default is disabled."); + + ("get_direct", (RBool "direct", []), -1, [], + [], + "get direct appliance mode flag", + "\ +Return the direct appliance mode flag."); + ] (* daemon_functions are any functions which cause some action @@ -1669,7 +1697,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. @@ -2460,7 +2488,7 @@ C sometimes gives an error about this and sometimes not. In any case, it is always safe to call C before calling this function."); - ("find", (RStringList "names", [Pathname "directory"]), 107, [], + ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning], [InitBasicFS, Always, TestOutputList ( [["find"; "/"]], ["lost+found"]); InitBasicFS, Always, TestOutputList ( @@ -2497,7 +2525,9 @@ then the returned list from C C would be If C is not a directory, then this command returns an error. -The returned list is sorted."); +The returned list is sorted. + +See also C."); ("e2fsck_f", (RErr, [Device "device"]), 108, [], [], (* lvresize tests this *) @@ -3569,6 +3599,110 @@ 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."); + + ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [], + [], (* There is a regression test for this. *) + "find all files and directories, returning NUL-separated list", + "\ +This command lists out all files and directories, recursively, +starting at C, placing the resulting list in the +external file called C. + +This command works the same way as C with the +following exceptions: + +=over 4 + +=item * + +The resulting list is written to an external file. + +=item * + +Items (filenames) in the result are separated +by C<\\0> characters. See L option I<-print0>. + +=item * + +This command is not limited in the number of names that it +can return. + +=item * + +The result list is not sorted. + +=back"); + + ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [], + [InitISOFS, Always, TestOutput ( + [["case_sensitive_path"; "/DIRECTORY"]], "/directory"); + InitISOFS, Always, TestOutput ( + [["case_sensitive_path"; "/DIRECTORY/"]], "/directory"); + InitISOFS, Always, TestOutput ( + [["case_sensitive_path"; "/Known-1"]], "/known-1"); + InitISOFS, Always, TestLastFail ( + [["case_sensitive_path"; "/Known-1/"]]); + InitBasicFS, Always, TestOutput ( + [["mkdir"; "/a"]; + ["mkdir"; "/a/bbb"]; + ["touch"; "/a/bbb/c"]; + ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c"); + InitBasicFS, Always, TestOutput ( + [["mkdir"; "/a"]; + ["mkdir"; "/a/bbb"]; + ["touch"; "/a/bbb/c"]; + ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c"); + InitBasicFS, Always, TestLastFail ( + [["mkdir"; "/a"]; + ["mkdir"; "/a/bbb"]; + ["touch"; "/a/bbb/c"]; + ["case_sensitive_path"; "/A/bbb/../bbb/C"]])], + "return true path on case-insensitive filesystem", + "\ +This can be used to resolve case insensitive paths on +a filesystem which is case sensitive. The use case is +to resolve paths which you have read from Windows configuration +files or the Windows Registry, to the true path. + +The command handles a peculiarity of the Linux ntfs-3g +filesystem driver (and probably others), which is that although +the underlying filesystem is case-insensitive, the driver +exports the filesystem to Linux as case-sensitive. + +One consequence of this is that special directories such +as C may appear as C or C +(or other things) depending on the precise details of how +they were created. In Windows itself this would not be +a problem. + +Bug or feature? You decide: +L + +This function resolves the true case of each element in the +path and returns the case-sensitive path. + +Thus C (\"/Windows/System32\") +might return C<\"/WINDOWS/system32\"> (the exact return value +would depend on details of how the directories were originally +created under Windows). + +I: +This function does not handle drive names, backslashes etc. + +See also C."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -4548,6 +4682,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 +4701,7 @@ and generate_client_actions () = #include #include \"guestfs.h\" +#include \"guestfs-internal-actions.h\" #include \"guestfs_protocol.h\" #define error guestfs_error @@ -4602,16 +4747,13 @@ check_reply_header (guestfs_h *g, static int check_state (guestfs_h *g, const char *caller) { - if (!guestfs_is_ready (g)) { - if (guestfs_is_config (g)) + if (!guestfs__is_ready (g)) { + if (guestfs__is_config (g) || guestfs__is_launching (g)) error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\", caller); - else if (guestfs_is_launching (g)) - error (g, \"%%s: call wait_ready() before using this function\", - caller); else error (g, \"%%s called from the wrong state, %%d != READY\", - caller, guestfs_get_state (g)); + caller, guestfs__get_state (g)); return -1; } return 0; @@ -4619,80 +4761,72 @@ check_state (guestfs_h *g, const char *caller) "; - (* Client-side stubs for each function. *) + (* 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 the context struct which stores the high-level - * state between callback functions. - *) - pr "struct %s_ctx {\n" shortname; - pr " /* This flag is set by the callbacks, so we know we've done\n"; - pr " * the callbacks as expected, and in the right sequence.\n"; - pr " * 0 = not called, 1 = reply_cb called.\n"; - pr " */\n"; - pr " int cb_sequence;\n"; - pr " struct guestfs_message_header hdr;\n"; - pr " struct guestfs_message_error err;\n"; - (match fst style with - | RErr -> () - | RConstString _ | RConstOptString _ -> - failwithf "RConstString|RConstOptString cannot be used by daemon functions" - | RInt _ | RInt64 _ - | RBool _ | RString _ | RStringList _ - | RStruct _ | RStructList _ - | RHashtable _ | RBufferOut _ -> - pr " struct %s_ret ret;\n" name - ); - pr "};\n"; - pr "\n"; - - (* Generate the reply callback function. *) - pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname; + generate_prototype ~extern:false ~semicolon:false ~newline:true + ~handle:"g" name style; pr "{\n"; - pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n"; - pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname; - pr "\n"; - pr " /* This should definitely not happen. */\n"; - pr " if (ctx->cb_sequence != 0) {\n"; - pr " ctx->cb_sequence = 9999;\n"; - pr " error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name; - pr " return;\n"; - pr " }\n"; - pr "\n"; - pr " ml->main_loop_quit (ml, g);\n"; - pr "\n"; - pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n"; - pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name; - pr " return;\n"; - pr " }\n"; - pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n"; - pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n"; - pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n" - name; - pr " return;\n"; - pr " }\n"; - pr " goto done;\n"; - pr " }\n"; - - (match fst style with - | RErr -> () - | RConstString _ | RConstOptString _ -> - failwithf "RConstString|RConstOptString cannot be used by daemon functions" - | RInt _ | RInt64 _ - | RBool _ | RString _ | RStringList _ - | RStruct _ | RStructList _ - | RHashtable _ | RBufferOut _ -> - pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name; - pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name; - pr " return;\n"; - 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; - pr " done:\n"; - pr " ctx->cb_sequence = 1;\n"; - pr "}\n\n"; + (* Client-side stubs for each function. *) + List.iter ( + fun (shortname, style, _, _, _, _, _) -> + let name = "guestfs_" ^ shortname in (* Generate the action stub. *) generate_prototype ~extern:false ~semicolon:false ~newline:true @@ -4715,20 +4849,32 @@ check_state (guestfs_h *g, const char *caller) | _ -> pr " struct %s_args args;\n" name ); - pr " struct %s_ctx ctx;\n" shortname; - pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n"; + pr " guestfs_message_header hdr;\n"; + pr " guestfs_message_error err;\n"; + let has_ret = + match fst style with + | RErr -> false + | RConstString _ | RConstOptString _ -> + failwithf "RConstString|RConstOptString cannot be used by daemon functions" + | RInt _ | RInt64 _ + | RBool _ | RString _ | RStringList _ + | RStruct _ | RStructList _ + | RHashtable _ | RBufferOut _ -> + pr " struct %s_ret ret;\n" name; + true in + pr " int serial;\n"; + pr " int r;\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"; - pr " memset (&ctx, 0, sizeof ctx);\n"; + pr " guestfs___set_busy (g);\n"; pr "\n"; (* Send the main header and arguments. *) (match snd style with | [] -> - pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n" + pr " serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n" (String.uppercase shortname) | args -> List.iter ( @@ -4746,13 +4892,13 @@ check_state (guestfs_h *g, const char *caller) pr " args.%s = %s;\n" n n | FileIn _ | FileOut _ -> () ) args; - pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n" + pr " serial = guestfs___send (g, GUESTFS_PROC_%s,\n" (String.uppercase shortname); pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n" name; ); pr " if (serial == -1) {\n"; - pr " guestfs_end_busy (g);\n"; + pr " guestfs___end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; @@ -4762,47 +4908,48 @@ check_state (guestfs_h *g, const char *caller) List.iter ( function | FileIn n -> - pr " {\n"; - pr " int r;\n"; - pr "\n"; - pr " r = guestfs__send_file_sync (g, %s);\n" n; - pr " if (r == -1) {\n"; - pr " guestfs_end_busy (g);\n"; - pr " return %s;\n" error_code; - pr " }\n"; - pr " if (r == -2) /* daemon cancelled */\n"; - pr " goto read_reply;\n"; - need_read_reply_label := true; + pr " r = guestfs___send_file (g, %s);\n" n; + pr " if (r == -1) {\n"; + pr " guestfs___end_busy (g);\n"; + pr " return %s;\n" error_code; pr " }\n"; + pr " if (r == -2) /* daemon cancelled */\n"; + pr " goto read_reply;\n"; + need_read_reply_label := true; pr "\n"; | _ -> () ) (snd style); (* Wait for the reply from the remote end. *) if !need_read_reply_label then pr " read_reply:\n"; - pr " guestfs__switch_to_receiving (g);\n"; - pr " ctx.cb_sequence = 0;\n"; - pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname; - pr " (void) ml->main_loop_run (ml, g);\n"; - pr " guestfs_set_reply_callback (g, NULL, NULL);\n"; - pr " if (ctx.cb_sequence != 1) {\n"; - pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name; - pr " guestfs_end_busy (g);\n"; + pr " memset (&hdr, 0, sizeof hdr);\n"; + pr " memset (&err, 0, sizeof err);\n"; + if has_ret then pr " memset (&ret, 0, sizeof ret);\n"; + pr "\n"; + pr " r = guestfs___recv (g, \"%s\", &hdr, &err,\n " shortname; + if not has_ret then + pr "NULL, NULL" + else + pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname; + pr ");\n"; + + pr " if (r == -1) {\n"; + pr " guestfs___end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; - pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n" + pr " if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n" (String.uppercase shortname); - pr " guestfs_end_busy (g);\n"; + pr " guestfs___end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; - pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n"; - pr " error (g, \"%%s\", ctx.err.error_message);\n"; - pr " free (ctx.err.error_message);\n"; - pr " guestfs_end_busy (g);\n"; + pr " if (hdr.status == GUESTFS_STATUS_ERROR) {\n"; + pr " error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname; + pr " free (err.error_message);\n"; + pr " guestfs___end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; @@ -4811,41 +4958,41 @@ check_state (guestfs_h *g, const char *caller) List.iter ( function | FileOut n -> - pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n; - pr " guestfs_end_busy (g);\n"; + pr " if (guestfs___recv_file (g, %s) == -1) {\n" n; + pr " guestfs___end_busy (g);\n"; pr " return %s;\n" error_code; pr " }\n"; pr "\n"; | _ -> () ) (snd style); - pr " guestfs_end_busy (g);\n"; + pr " guestfs___end_busy (g);\n"; (match fst style with | RErr -> pr " return 0;\n" | RInt n | RInt64 n | RBool n -> - pr " return ctx.ret.%s;\n" n + pr " return ret.%s;\n" n | RConstString _ | RConstOptString _ -> failwithf "RConstString|RConstOptString cannot be used by daemon functions" | RString n -> - pr " return ctx.ret.%s; /* caller will free */\n" n + pr " return ret.%s; /* caller will free */\n" n | RStringList n | RHashtable n -> pr " /* caller will free this, but we need to add a NULL entry */\n"; - pr " ctx.ret.%s.%s_val =\n" n n; - pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n; - pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n" + pr " ret.%s.%s_val =\n" n n; + pr " safe_realloc (g, ret.%s.%s_val,\n" n n; + pr " sizeof (char *) * (ret.%s.%s_len + 1));\n" n n; - pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n; - pr " return ctx.ret.%s.%s_val;\n" n n + pr " ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n; + pr " return ret.%s.%s_val;\n" n n | RStruct (n, _) -> pr " /* caller will free this */\n"; - pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n + pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n | RStructList (n, _) -> pr " /* caller will free this */\n"; - pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n + pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n | RBufferOut n -> - pr " *size_r = ctx.ret.%s.%s_len;\n" n n; - pr " return ctx.ret.%s.%s_val; /* caller will free */\n" n n + pr " *size_r = ret.%s.%s_len;\n" n n; + pr " return ret.%s.%s_val; /* caller will free */\n" n n ); pr "}\n\n" @@ -4902,11 +5049,11 @@ and generate_daemon_actions () = pr "#include \n"; pr "#include \n"; pr "#include \n"; - pr "#include \n"; pr "#include \n"; pr "#include \n"; pr "\n"; pr "#include \"daemon.h\"\n"; + pr "#include \"c-ctype.h\"\n"; pr "#include \"../src/guestfs_protocol.h\"\n"; pr "#include \"actions.h\"\n"; pr "\n"; @@ -5132,7 +5279,7 @@ and generate_daemon_actions () = pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n"; pr " return -1;\n"; pr " }\n"; - pr " if (!*str || isspace (*str)) {\n"; + pr " if (!*str || c_isspace (*str)) {\n"; pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n"; pr " return -1;\n"; pr " }\n"; @@ -5234,7 +5381,7 @@ and generate_daemon_actions () = pr " pend++;\n"; pr " }\n"; pr "\n"; - pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n"; + pr " while (*p && c_isspace (*p)) /* Skip any leading whitespace. */\n"; pr " p++;\n"; pr "\n"; pr " if (!*p) { /* Empty line? Skip it. */\n"; @@ -5379,7 +5526,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; @@ -5495,11 +5642,6 @@ int main (int argc, char *argv[]) /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */ alarm (600); - if (guestfs_wait_ready (g) == -1) { - printf (\"guestfs_wait_ready FAILED\\n\"); - exit (1); - } - /* Cancel previous alarm. */ alarm (0); @@ -5513,7 +5655,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 +5666,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"; @@ -6024,9 +6166,9 @@ and generate_fish_cmds () = pr "#include \n"; pr "#include \n"; pr "#include \n"; - pr "#include \n"; pr "\n"; pr "#include \n"; + pr "#include \"c-ctype.h\"\n"; pr "#include \"fish.h\"\n"; pr "\n"; @@ -6109,7 +6251,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 +6271,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 ( @@ -6144,7 +6286,7 @@ and generate_fish_cmds () = | name, FBuffer -> pr " printf (\"%%s%s: \", indent);\n" name; pr " for (i = 0; i < %s->%s_len; ++i)\n" typ name; - pr " if (isprint (%s->%s[i]))\n" typ name; + pr " if (c_isprint (%s->%s[i]))\n" typ name; pr " printf (\"%%s%%c\", indent, %s->%s[i]);\n" typ name; pr " else\n"; pr " printf (\"%%s\\\\x%%02x\", indent, %s->%s[i]);\n" typ name; @@ -6221,7 +6363,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); @@ -6249,7 +6391,8 @@ and generate_fish_cmds () = pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n" name i i | StringList name | DeviceList name -> - pr " %s = parse_string_list (argv[%d]);\n" name i + pr " %s = parse_string_list (argv[%d]);\n" name i; + pr " if (%s == NULL) return -1;\n" name; | Bool name -> pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i | Int name -> @@ -6264,6 +6407,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 +6844,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 +6913,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 +6933,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 +7070,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"; @@ -7335,7 +7505,6 @@ Sys::Guestfs - Perl bindings for libguestfs my $h = Sys::Guestfs->new (); $h->add_drive ('guest.img'); $h->launch (); - $h->wait_ready (); $h->mount ('/dev/sda1', '/'); $h->touch ('/hello'); $h->sync (); @@ -7873,7 +8042,6 @@ import guestfs g = guestfs.GuestFS () g.add_drive (\"guest.img\") g.launch () -g.wait_ready () parts = g.list_partitions () The guestfs module provides a Python binding to the libguestfs API @@ -7908,7 +8076,6 @@ g.add_drive (\"guest.img\") # Launch the qemu subprocess and wait for it to become ready: g.launch () -g.wait_ready () # Now you can issue commands, for example: logvols = g.lvs () @@ -9071,6 +9238,7 @@ and generate_bindtests () = #include #include \"guestfs.h\" +#include \"guestfs-internal-actions.h\" #include \"guestfs_protocol.h\" #define error guestfs_error @@ -9101,7 +9269,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 +9294,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 +9360,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 +9683,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 ();