1 #!/usr/bin/ocamlrun ocaml
3 * Copyright (C) 2009 Red Hat Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 * This script generates a large amount of code and documentation for
20 * all the daemon actions. To add a new action there are only two
21 * files you need to change, this one to describe the interface, and
22 * daemon/<somefile>.c to write the implementation.
29 type style = ret * args
31 (* "Err" as a return value means an int used as a simple error
32 * indication, ie. 0 or -1.
36 (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
41 | String of string (* const char *name, cannot be NULL *)
44 ("mount", (Err, P2 (String "device", String "mountpoint")), 1,
45 "mount a guest disk at a position in the filesystem",
47 Mount a guest disk at a position in the filesystem. Block devices
48 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
49 the guest. If those block devices contain partitions, they will have
50 the usual names (eg. C</dev/sda1>). Also LVM C</dev/VG/LV>-style
53 The rules are the same as for L<mount(2)>: A filesystem must
54 first be mounted on C</> before others can be mounted. Other
55 filesystems can only be mounted on directories which already
58 The mounted filesystem is writable, if we have sufficient permissions
59 on the underlying device.
61 The filesystem options C<sync> and C<noatime> are set with this
62 call, in order to improve reliability.");
64 ("sync", (Err, P0), 2,
65 "sync disks, writes are flushed through to the disk image",
67 This syncs the disk, so that any writes are flushed through to the
68 underlying disk image.
70 You should always call this if you have modified a disk image, before
71 calling C<guestfs_close>.");
73 ("touch", (Err, P1 (String "path")), 3,
74 "update file timestamps or create a new file",
76 Touch acts like the L<touch(1)> command. It can be used to
77 update the timestamps on a file, or, if the file does not exist,
78 to create a new zero-length file.");
81 (* 'pr' prints to the current output file. *)
83 let pr fs = ksprintf (output_string !chan) fs
85 let iter_args f = function
88 | P2 (arg1, arg2) -> f arg1; f arg2
90 let map_args f = function
93 | P2 (arg1, arg2) -> [f arg1; f arg2]
95 type comment_style = CStyle | HashStyle | OCamlStyle
96 type license = GPLv2 | LGPLv2
98 (* Generate a header block in a number of standard styles. *)
99 let rec generate_header comment license =
100 let c = match comment with
101 | CStyle -> pr "/* "; " *"
102 | HashStyle -> pr "# "; "#"
103 | OCamlStyle -> pr "(* "; " *" in
104 pr "libguestfs generated file\n";
105 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
106 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
108 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
112 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
113 pr "%s it under the terms of the GNU General Public License as published by\n" c;
114 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
115 pr "%s (at your option) any later version.\n" c;
117 pr "%s This program is distributed in the hope that it will be useful,\n" c;
118 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
119 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
120 pr "%s GNU General Public License for more details.\n" c;
122 pr "%s You should have received a copy of the GNU General Public License along\n" c;
123 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
124 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
127 pr "%s This library is free software; you can redistribute it and/or\n" c;
128 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
129 pr "%s License as published by the Free Software Foundation; either\n" c;
130 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
132 pr "%s This library is distributed in the hope that it will be useful,\n" c;
133 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
134 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
135 pr "%s Lesser General Public License for more details.\n" c;
137 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
138 pr "%s License along with this library; if not, write to the Free Software\n" c;
139 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
142 | CStyle -> pr " */\n"
144 | OCamlStyle -> pr " *)\n"
148 (* Generate the pod documentation for the C API. *)
149 and generate_pod () =
151 fun (shortname, style, _, _, longdesc) ->
152 let name = "guestfs_" ^ shortname in
153 pr "=head2 %s\n\n" name;
155 generate_prototype ~extern:false ~handle:"handle" name style;
157 pr "%s\n\n" longdesc;
160 pr "This function return 0 on success or -1 on error.\n\n"
164 (* Generate the protocol (XDR) file. *)
165 and generate_xdr () =
166 generate_header CStyle LGPLv2;
169 fun (shortname, style, _, _, _) ->
170 let name = "guestfs_" ^ shortname in
171 pr "/* %s */\n\n" name;
175 pr "struct %s_args {\n" name;
178 | String name -> pr " string %s<>;\n" name
184 (* | ... -> pr "struct %s_ret ...\n" name; *)
188 (* Table of procedure numbers. *)
189 pr "enum guestfs_procedure {\n";
191 fun (shortname, _, proc_nr, _, _) ->
192 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
194 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
198 (* Having to choose a maximum message size is annoying for several
199 * reasons (it limits what we can do in the API), but it (a) makes
200 * the protocol a lot simpler, and (b) provides a bound on the size
201 * of the daemon which operates in limited memory space. For large
202 * file transfers you should use FTP.
204 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
207 (* Message header, etc. *)
209 const GUESTFS_PROGRAM = 0x2000F5F5;
210 const GUESTFS_PROTOCOL_VERSION = 1;
212 enum guestfs_message_direction {
213 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
214 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
217 enum guestfs_message_status {
218 GUESTFS_STATUS_OK = 0,
219 GUESTFS_STATUS_ERROR = 1
222 const GUESTFS_ERROR_LEN = 256;
224 struct guestfs_message_error {
225 string error<GUESTFS_ERROR_LEN>; /* error message */
228 struct guestfs_message_header {
229 unsigned prog; /* GUESTFS_PROGRAM */
230 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
231 guestfs_procedure proc; /* GUESTFS_PROC_x */
232 guestfs_message_direction direction;
233 unsigned serial; /* message serial number */
234 guestfs_message_status status;
238 (* Generate the guestfs-actions.h file. *)
239 and generate_actions_h () =
240 generate_header CStyle LGPLv2;
242 fun (shortname, style, _, _, _) ->
243 let name = "guestfs_" ^ shortname in
244 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
248 (* Generate the client-side dispatch stubs. *)
249 and generate_client_actions () =
250 generate_header CStyle LGPLv2;
252 fun (shortname, style, _, _, _) ->
253 let name = "guestfs_" ^ shortname in
255 (* Generate the return value struct. *)
256 pr "struct %s_rv {\n" shortname;
257 pr " int cb_done; /* flag to indicate callback was called */\n";
258 pr " struct guestfs_message_header hdr;\n";
259 pr " struct guestfs_message_error err;\n";
262 (* | _ -> pr " struct %s_ret ret;\n" name; *)
266 (* Generate the callback function. *)
267 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
269 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
271 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
272 pr " error (g, \"%s: failed to parse reply header\");\n" name;
275 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
276 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
277 pr " error (g, \"%s: failed to parse reply error\");\n" name;
285 (* | _ -> pr " if (!xdr_%s_ret (&xdr, &rv->ret)) ..." *)
289 pr " rv->cb_done = 1;\n";
290 pr " main_loop.main_loop_quit (g);\n";
293 (* Generate the action stub. *)
294 generate_prototype ~extern:false ~semicolon:false ~newline:true
295 ~handle:"g" name style;
299 | (Err, _) -> "-1" in
305 | _ -> pr " struct %s_args args;\n" name
308 pr " struct %s_rv rv;\n" shortname;
311 pr " if (g->state != READY) {\n";
312 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
315 pr " return %s;\n" error_code;
318 pr " memset (&rv, 0, sizeof rv);\n";
323 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
324 (String.uppercase shortname)
328 | String name -> pr " args.%s = (char *) %s;\n" name name
330 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
331 (String.uppercase shortname);
332 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
335 pr " if (serial == -1)\n";
336 pr " return %s;\n" error_code;
339 pr " rv.cb_done = 0;\n";
340 pr " g->reply_cb_internal = %s_cb;\n" shortname;
341 pr " g->reply_cb_internal_data = &rv;\n";
342 pr " main_loop.main_loop_run (g);\n";
343 pr " g->reply_cb_internal = NULL;\n";
344 pr " g->reply_cb_internal_data = NULL;\n";
345 pr " if (!rv.cb_done) {\n";
346 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
347 pr " return %s;\n" error_code;
351 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
352 (String.uppercase shortname);
353 pr " return %s;\n" error_code;
356 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
357 pr " error (g, \"%%s\", rv.err.error);\n";
358 pr " return %s;\n" error_code;
363 | (Err, _) -> pr " return 0;\n"
369 (* Generate daemon/actions.h. *)
370 and generate_daemon_actions_h () =
371 generate_header CStyle GPLv2;
373 fun (name, style, _, _, _) ->
374 generate_prototype ~single_line:true ~newline:true ("do_" ^ name) style;
377 (* Generate the server-side stubs. *)
378 and generate_daemon_actions () =
379 generate_header CStyle GPLv2;
381 pr "#include <rpc/types.h>\n";
382 pr "#include <rpc/xdr.h>\n";
383 pr "#include \"daemon.h\"\n";
384 pr "#include \"../src/guestfs_protocol.h\"\n";
385 pr "#include \"actions.h\"\n";
389 fun (name, style, _, _, _) ->
390 (* Generate server-side stubs. *)
391 pr "static void %s_stub (XDR *xdr_in)\n" name;
395 | (Err, _) -> pr " int r;\n"; "-1" in
399 pr " struct guestfs_%s_args args;\n" name;
402 | String name -> pr " const char *%s;\n" name
410 pr " memset (&args, 0, sizeof args);\n";
412 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
413 pr " reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
418 | String name -> pr " %s = args.%s;\n" name name
423 pr " r = do_%s " name;
424 generate_call_args style;
427 pr " if (r == %s)\n" error_code;
428 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
433 | (Err, _) -> pr " reply (NULL, NULL);\n"
439 (* Dispatch function. *)
440 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
442 pr " switch (proc_nr) {\n";
445 fun (name, style, _, _, _) ->
446 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
447 pr " %s_stub (xdr_in);\n" name;
452 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
456 and generate_fish_cmds () =
457 generate_header CStyle GPLv2;
459 pr "#include <stdio.h>\n";
460 pr "#include <stdlib.h>\n";
461 pr "#include <string.h>\n";
463 pr "#include \"fish.h\"\n";
466 (* list_commands function, which implements guestfish -h *)
467 pr "void list_commands (void)\n";
469 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
470 pr " list_builtin_commands ();\n";
472 fun (name, _, _, shortdesc, _) ->
473 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
476 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
480 (* display_command function, which implements guestfish -h cmd *)
481 pr "void display_command (const char *cmd)\n";
484 fun (name, style, _, shortdesc, longdesc) ->
491 String.concat "> <" (
493 | String n -> n) args
497 pr " if (strcasecmp (cmd, \"%s\") == 0)\n" name;
498 pr " pod2text (\"%s - %s\", %S);\n"
500 (" " ^ synopsis ^ "\n\n" ^ longdesc);
503 pr " display_builtin_command (cmd);\n";
507 (* run_action function *)
508 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
511 fun (name, style, _, _, _) ->
512 pr " if (strcasecmp (cmd, \"%s\") == 0)\n" name;
513 pr " printf (\"running %s ...\\n\");\n" name;
517 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
524 (* Generate a C function prototype. *)
525 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
526 ?(single_line = false) ?(newline = false)
528 if extern then pr "extern ";
529 if static then pr "static ";
531 | (Err, _) -> pr "int "
534 let comma = ref false in
537 | Some handle -> pr "guestfs_h *%s" handle; comma := true
541 if single_line then pr ", " else pr ",\n\t\t"
547 | String name -> next (); pr "const char *%s" name
550 if semicolon then pr ";";
551 if newline then pr "\n"
553 (* Generate C call arguments, eg "(handle, foo, bar)" *)
554 and generate_call_args ?handle style =
556 let comma = ref false in
559 | Some handle -> pr "%s" handle; comma := true
563 if !comma then pr ", ";
566 | String name -> pr "%s" name
570 let output_to filename =
571 let filename_new = filename ^ ".new" in
572 chan := open_out filename_new;
576 Unix.rename filename_new filename;
577 printf "written %s\n%!" filename;
583 let close = output_to "src/guestfs_protocol.x" in
587 let close = output_to "src/guestfs-actions.h" in
588 generate_actions_h ();
591 let close = output_to "src/guestfs-actions.c" in
592 generate_client_actions ();
595 let close = output_to "daemon/actions.h" in
596 generate_daemon_actions_h ();
599 let close = output_to "daemon/stubs.c" in
600 generate_daemon_actions ();
603 let close = output_to "fish/cmds.c" in
604 generate_fish_cmds ();
607 let close = output_to "guestfs-actions.pod" in