X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=14b5155434ef0d7dca8a64f75ae003f544e0db1d;hp=02fe6912c0d2eb7411a10a87b97483cd4cedee1c;hb=843514eef9dc6d04d71e031ba9ddb16e2beb9a04;hpb=8d0068a752ee8e6bc223de5cb7cac5d190a8855e diff --git a/src/generator.ml b/src/generator.ml index 02fe691..14b5155 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -26,14 +26,53 @@ 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 + (* "RString" and "RStringList" require special treatment because + * the caller must free them. + *) + | RString of string + | RStringList of string +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 *) + +type flags = ProtocolLimitWarning let functions = [ - ("mount", Int_StringString, [|"device"; "mountpoint"|], - "Mount a guest disk at a position in the filesystem", + ("cat", (RString "content", P1 (String "path")), 4, [ProtocolLimitWarning], + "list the files in a directory (long format)", + "\ +Return the contents of the file named C."); + + ("ll", (RString "listing", P1 (String "directory")), 5, [], + "list the files in a directory (long format)", + "\ +List the files in C (relative to the root directory, +there is no cwd) in the format of 'ls -la'. + +This command is mostly useful for interactive sessions. It +is I intended that you try to parse the output string."); + + ("ls", (RStringList "listing", P1 (String "directory")), 6, [], + "list the files in a directory", + "\ +List the files in C (relative to the root directory, +there is no cwd). The '.' and '..' entries are not returned, but +hidden files are shown. + +This command is mostly useful for interactive sessions."); + + ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [], + "mount a guest disk at a position in the filesystem", "\ Mount a guest disk at a position in the filesystem. Block devices are named C, C and so on, as they were added to @@ -44,10 +83,16 @@ names can be used. The rules are the same as for L: A filesystem must first be mounted on C before others can be mounted. Other filesystems can only be mounted on directories which already -exist."); +exist. + +The mounted filesystem is writable, if we have sufficient permissions +on the underlying device. + +The filesystem options C and C are set with this +call, in order to improve reliability."); - ("sync", Int_Void, [||], - "Sync disks, writes are flushed through to the disk image", + ("sync", (Err, P0), 2, [], + "sync disks, writes are flushed through to the disk image", "\ This syncs the disk, so that any writes are flushed through to the underlying disk image. @@ -55,11 +100,11 @@ underlying disk image. You should always call this if you have modified a disk image, before calling C."); - ("touch", Int_String, [|"path"|], - "Update file timestamps or create a new file", + ("touch", (Err, P1 (String "path")), 3, [], + "update file timestamps or create a new file", "\ Touch acts like the L command. It can be used to -update the filesystems on a file, or, if the file does not exist, +update the timestamps on a file, or, if the file does not exist, to create a new zero-length file."); ] @@ -67,6 +112,23 @@ 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 + +let iteri_args f = function + | P0 -> () + | P1 arg1 -> f 0 arg1 + | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2 + +let map_args f = function + | P0 -> [] + | P1 arg1 -> [f arg1] + | P2 (arg1, arg2) -> [f arg1; f arg2] + +let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2 + type comment_style = CStyle | HashStyle | OCamlStyle type license = GPLv2 | LGPLv2 @@ -77,8 +139,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 +185,534 @@ 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, _, flags, _, longdesc) -> let name = "guestfs_" ^ shortname in pr "=head2 %s\n\n" name; pr " "; - generate_prototype ~extern:false name style params; + generate_prototype ~extern:false ~handle:"handle" name style; pr "\n\n"; - pr "%s\n\n" longdesc + pr "%s\n\n" longdesc; + (match fst style with + | Err -> + pr "This function returns 0 on success or -1 on error.\n\n" + | RString _ -> + pr "This function returns a string or NULL on error. The caller +must free the returned string after use.\n\n" + | RStringList _ -> + pr "This function returns a NULL-terminated array of strings +(like L), or NULL if there was an error. + +The caller must free the strings I the array after use.\n\n" + ); + if List.mem ProtocolLimitWarning flags then + pr "Because of the message protocol, there is a transfer limit +of somewhere between 2MB and 4MB. To transfer large files you should use +FTP.\n\n"; ) functions (* Generate the protocol (XDR) file. *) and generate_xdr () = generate_header CStyle LGPLv2; + + (* This has to be defined to get around a limitation in Sun's rpcgen. *) + pr "typedef string str<>;\n"; + pr "\n"; + List.iter ( - fun (shortname, style, params, _, longdesc) -> + fun (shortname, style, _, _, _, _) -> let name = "guestfs_" ^ shortname in - pr "/* %s */\n" name; + pr "/* %s */\n\n" name; + (match snd 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 fst style with + | Err -> () + | RString n -> + pr "struct %s_ret {\n" name; + pr " string %s<>;\n" n; + pr "};\n\n" + | RStringList n -> + pr "struct %s_ret {\n" name; + pr " str %s<>;\n" n; + pr "};\n\n" + ); + ) functions; + + (* Table of procedure numbers. *) + pr "enum guestfs_procedure {\n"; + List.iter ( + fun (shortname, _, proc_nr, _, _, _) -> + pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr + ) functions; + pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *) + pr "};\n"; + pr "\n"; + + (* Having to choose a maximum message size is annoying for several + * reasons (it limits what we can do in the API), but it (a) makes + * the protocol a lot simpler, and (b) provides a bound on the size + * of the daemon which operates in limited memory space. For large + * file transfers you should use FTP. + *) + pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024); + pr "\n"; + (* Message header, etc. *) + pr "\ +const GUESTFS_PROGRAM = 0x2000F5F5; +const GUESTFS_PROTOCOL_VERSION = 1; +enum guestfs_message_direction { + GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */ + GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */ +}; + +enum guestfs_message_status { + GUESTFS_STATUS_OK = 0, + GUESTFS_STATUS_ERROR = 1 +}; + +const GUESTFS_ERROR_LEN = 256; + +struct guestfs_message_error { + string error; /* error message */ +}; + +struct guestfs_message_header { + unsigned prog; /* GUESTFS_PROGRAM */ + unsigned vers; /* GUESTFS_PROTOCOL_VERSION */ + guestfs_procedure proc; /* GUESTFS_PROC_x */ + guestfs_message_direction direction; + unsigned serial; /* message serial number */ + guestfs_message_status status; +}; +" + +(* 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 ~handle:"handle" + 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 + + (* Generate the return value struct. *) + pr "struct %s_rv {\n" shortname; + pr " int cb_done; /* flag to indicate callback was called */\n"; + pr " struct guestfs_message_header hdr;\n"; + pr " struct guestfs_message_error err;\n"; + (match fst style with + | Err -> () + | RString _ | RStringList _ -> 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 " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n"; + pr " error (g, \"%s: failed to parse reply header\");\n" name; + pr " return;\n"; + pr " }\n"; + pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n"; + pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n"; + pr " error (g, \"%s: failed to parse reply error\");\n" name; + pr " return;\n"; + pr " }\n"; + pr " goto done;\n"; + pr " }\n"; + + (match fst style with + | Err -> () + | RString _ | RStringList _ -> + pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name; + pr " error (g, \"%s: failed to parse reply\");\n" name; + pr " return;\n"; + pr " }\n"; + ); + + pr " done:\n"; + pr " rv->cb_done = 1;\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 fst style with + | Err -> "-1" + | RString _ | RStringList _ -> "NULL" in + + pr "{\n"; + + (match snd style with + | P0 -> () + | _ -> pr " struct %s_args args;\n" name + ); + + pr " struct %s_rv rv;\n" shortname; + pr " int serial;\n"; + 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"; + pr "\n"; + pr " memset (&rv, 0, sizeof rv);\n"; + pr "\n"; + + (match snd style with + | P0 -> + pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n" + (String.uppercase shortname) + | args -> + iter_args ( + function + | String name -> pr " args.%s = (char *) %s;\n" name name + ) args; + pr " serial = dispatch (g, GUESTFS_PROC_%s,\n" + (String.uppercase shortname); + pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n" + name; + ); + pr " if (serial == -1)\n"; + pr " return %s;\n" error_code; + pr "\n"; + + pr " rv.cb_done = 0;\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.cb_done) {\n"; + pr " error (g, \"%s failed, see earlier error messages\");\n" name; + pr " return %s;\n" error_code; + pr " }\n"; + pr "\n"; + + pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n" + (String.uppercase shortname); + pr " return %s;\n" error_code; + pr "\n"; + + pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n"; + pr " error (g, \"%%s\", rv.err.error);\n"; + pr " return %s;\n" error_code; + pr " }\n"; + pr "\n"; + + (match fst style with + | Err -> pr " return 0;\n" + | RString n -> + pr " return rv.ret.%s; /* caller will free */\n" n + | RStringList n -> + pr " /* caller will free this, but we need to add a NULL entry */\n"; + pr " rv.ret.%s.%s_val = safe_realloc (g, rv.ret.%s.%s_val, rv.ret.%s.%s_len + 1);\n" n n n n n n; + pr " rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n; + pr " return rv.ret.%s.%s_val;\n" n 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 a single line prototype. *) -and generate_prototype ~extern ?(semi = true) ?(handle = "handle") - name style params = +(* Generate the server-side stubs. *) +and generate_daemon_actions () = + generate_header CStyle GPLv2; + + pr "#include \n"; + pr "#include \n"; + pr "#include \"daemon.h\"\n"; + pr "#include \"../src/guestfs_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 fst style with + | Err -> pr " int r;\n"; "-1" + | RString _ -> pr " char *r;\n"; "NULL" + | RStringList _ -> pr " char **r;\n"; "NULL" in + (match snd 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 snd style with + | P0 -> () + | args -> + pr " memset (&args, 0, sizeof args);\n"; + pr "\n"; + 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 fst style with + | Err -> pr " reply (NULL, NULL);\n" + | RString n -> + pr " struct guestfs_%s_ret ret;\n" name; + pr " ret.%s = r;\n" n; + pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name; + pr " free (r);\n" + | RStringList n -> + pr " struct guestfs_%s_ret ret;\n" name; + pr " ret.%s.%s_len = count_strings (r);\n" n n; + pr " ret.%s.%s_val = r;\n" n n; + pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name; + pr " free_strings (r);\n" + ); + + pr "}\n\n"; + ) functions; + + (* Dispatch function. *) + pr "void dispatch_incoming_message (XDR *xdr_in)\n"; + pr "{\n"; + pr " switch (proc_nr) {\n"; + + List.iter ( + fun (name, style, _, _, _, _) -> + pr " case GUESTFS_PROC_%s:\n" (String.uppercase name); + pr " %s_stub (xdr_in);\n" name; + pr " break;\n" + ) functions; + + pr " default:\n"; + pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n"; + pr " }\n"; + pr "}\n" + +(* Generate a lot of different functions for guestfish. *) +and generate_fish_cmds () = + generate_header CStyle GPLv2; + + pr "#include \n"; + pr "#include \n"; + pr "#include \n"; + pr "\n"; + pr "#include \"fish.h\"\n"; + pr "\n"; + + (* list_commands function, which implements guestfish -h *) + pr "void list_commands (void)\n"; + pr "{\n"; + pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n"; + pr " list_builtin_commands ();\n"; + List.iter ( + fun (name, _, _, _, shortdesc, _) -> + pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n" + name shortdesc + ) functions; + pr " printf (\" Use -h / help to show detailed help for a command.\\n\");\n"; + pr "}\n"; + pr "\n"; + + (* display_command function, which implements guestfish -h cmd *) + pr "void display_command (const char *cmd)\n"; + pr "{\n"; + List.iter ( + fun (name, style, _, flags, shortdesc, longdesc) -> + let synopsis = + match snd style with + | P0 -> name + | args -> + sprintf "%s <%s>" + name ( + String.concat "> <" ( + map_args (function + | String n -> n) args + ) + ) in + + let warnings = + if List.mem ProtocolLimitWarning flags then + "\n\nBecause of the message protocol, there is a transfer limit +of somewhere between 2MB and 4MB. To transfer large files you should use +FTP." + else "" in + + pr " if (strcasecmp (cmd, \"%s\") == 0)\n" name; + pr " pod2text (\"%s - %s\", %S);\n" + name shortdesc + (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings); + pr " else\n" + ) functions; + pr " display_builtin_command (cmd);\n"; + pr "}\n"; + pr "\n"; + + (* run_ actions *) + List.iter ( + fun (name, style, _, _, _, _) -> + pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name; + pr "{\n"; + (match fst style with + | Err -> pr " int r;\n" + | RString _ -> pr " char *r;\n" + | RStringList _ -> pr " char **r;\n" + ); + iter_args ( + function + | String name -> pr " const char *%s;\n" name + ) (snd style); + + (* Check and convert parameters. *) + let argc_expected = nr_args (snd style) in + pr " if (argc != %d) {\n" argc_expected; + pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n" + argc_expected; + pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n"; + pr " return -1;\n"; + pr " }\n"; + iteri_args ( + fun i -> + function + | String name -> pr " %s = argv[%d];\n" name i + ) (snd style); + + (* Call C API function. *) + pr " r = guestfs_%s " name; + generate_call_args ~handle:"g" style; + pr ";\n"; + + (* Check return value for errors and display command results. *) + (match fst style with + | Err -> pr " return r;\n" + | RString _ -> + pr " if (r == NULL) return -1;\n"; + pr " printf (\"%%s\", r);\n"; + pr " free (r);\n"; + pr " return 0;\n" + | RStringList _ -> + pr " if (r == NULL) return -1;\n"; + pr " print_strings (r);\n"; + pr " free_strings (r);\n"; + pr " return 0;\n" + ); + pr "}\n"; + pr "\n" + ) functions; + + (* run_action function *) + pr "int run_action (const char *cmd, int argc, char *argv[])\n"; + pr "{\n"; + List.iter ( + fun (name, _, _, _, _, _) -> + pr " if (strcasecmp (cmd, \"%s\") == 0)\n" name; + pr " return run_%s (cmd, argc, argv);\n" name; + pr " else\n"; + ) functions; + pr " {\n"; + pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n"; + pr " return -1;\n"; + pr " }\n"; + pr " return 0;\n"; + pr "}\n"; + pr "\n" + +(* Generate a C function prototype. *) +and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) + ?(single_line = false) ?(newline = false) + ?handle name style = if extern then pr "extern "; - (match style with - | Int_Void | Int_String | Int_StringString -> pr "int " + if static then pr "static "; + (match fst style with + | Err -> pr "int " + | RString _ -> pr "char *" + | RStringList _ -> pr "char **" ); - 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) + pr "%s (" name; + let comma = ref false in + (match handle with + | None -> () + | Some handle -> pr "guestfs_h *%s" handle; comma := true ); + let next () = + if !comma then ( + if single_line then pr ", " else pr ",\n\t\t" + ); + comma := true + 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 +720,37 @@ 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 "fish/cmds.c" in + generate_fish_cmds (); + close (); + + let close = output_to "guestfs-actions.pod" in + generate_pod (); + close ()