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 iteri_args f = function
93 | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
95 let map_args f = function
98 | P2 (arg1, arg2) -> [f arg1; f arg2]
100 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
102 type comment_style = CStyle | HashStyle | OCamlStyle
103 type license = GPLv2 | LGPLv2
105 (* Generate a header block in a number of standard styles. *)
106 let rec generate_header comment license =
107 let c = match comment with
108 | CStyle -> pr "/* "; " *"
109 | HashStyle -> pr "# "; "#"
110 | OCamlStyle -> pr "(* "; " *" in
111 pr "libguestfs generated file\n";
112 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
113 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
115 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
119 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
120 pr "%s it under the terms of the GNU General Public License as published by\n" c;
121 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
122 pr "%s (at your option) any later version.\n" c;
124 pr "%s This program is distributed in the hope that it will be useful,\n" c;
125 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
126 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
127 pr "%s GNU General Public License for more details.\n" c;
129 pr "%s You should have received a copy of the GNU General Public License along\n" c;
130 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
131 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
134 pr "%s This library is free software; you can redistribute it and/or\n" c;
135 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
136 pr "%s License as published by the Free Software Foundation; either\n" c;
137 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
139 pr "%s This library is distributed in the hope that it will be useful,\n" c;
140 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
141 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
142 pr "%s Lesser General Public License for more details.\n" c;
144 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
145 pr "%s License along with this library; if not, write to the Free Software\n" c;
146 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
149 | CStyle -> pr " */\n"
151 | OCamlStyle -> pr " *)\n"
155 (* Generate the pod documentation for the C API. *)
156 and generate_pod () =
158 fun (shortname, style, _, _, longdesc) ->
159 let name = "guestfs_" ^ shortname in
160 pr "=head2 %s\n\n" name;
162 generate_prototype ~extern:false ~handle:"handle" name style;
164 pr "%s\n\n" longdesc;
167 pr "This function return 0 on success or -1 on error.\n\n"
171 (* Generate the protocol (XDR) file. *)
172 and generate_xdr () =
173 generate_header CStyle LGPLv2;
176 fun (shortname, style, _, _, _) ->
177 let name = "guestfs_" ^ shortname in
178 pr "/* %s */\n\n" name;
182 pr "struct %s_args {\n" name;
185 | String name -> pr " string %s<>;\n" name
191 (* | ... -> pr "struct %s_ret ...\n" name; *)
195 (* Table of procedure numbers. *)
196 pr "enum guestfs_procedure {\n";
198 fun (shortname, _, proc_nr, _, _) ->
199 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
201 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
205 (* Having to choose a maximum message size is annoying for several
206 * reasons (it limits what we can do in the API), but it (a) makes
207 * the protocol a lot simpler, and (b) provides a bound on the size
208 * of the daemon which operates in limited memory space. For large
209 * file transfers you should use FTP.
211 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
214 (* Message header, etc. *)
216 const GUESTFS_PROGRAM = 0x2000F5F5;
217 const GUESTFS_PROTOCOL_VERSION = 1;
219 enum guestfs_message_direction {
220 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
221 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
224 enum guestfs_message_status {
225 GUESTFS_STATUS_OK = 0,
226 GUESTFS_STATUS_ERROR = 1
229 const GUESTFS_ERROR_LEN = 256;
231 struct guestfs_message_error {
232 string error<GUESTFS_ERROR_LEN>; /* error message */
235 struct guestfs_message_header {
236 unsigned prog; /* GUESTFS_PROGRAM */
237 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
238 guestfs_procedure proc; /* GUESTFS_PROC_x */
239 guestfs_message_direction direction;
240 unsigned serial; /* message serial number */
241 guestfs_message_status status;
245 (* Generate the guestfs-actions.h file. *)
246 and generate_actions_h () =
247 generate_header CStyle LGPLv2;
249 fun (shortname, style, _, _, _) ->
250 let name = "guestfs_" ^ shortname in
251 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
255 (* Generate the client-side dispatch stubs. *)
256 and generate_client_actions () =
257 generate_header CStyle LGPLv2;
259 fun (shortname, style, _, _, _) ->
260 let name = "guestfs_" ^ shortname in
262 (* Generate the return value struct. *)
263 pr "struct %s_rv {\n" shortname;
264 pr " int cb_done; /* flag to indicate callback was called */\n";
265 pr " struct guestfs_message_header hdr;\n";
266 pr " struct guestfs_message_error err;\n";
269 (* | _ -> pr " struct %s_ret ret;\n" name; *)
273 (* Generate the callback function. *)
274 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
276 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
278 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
279 pr " error (g, \"%s: failed to parse reply header\");\n" name;
282 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
283 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
284 pr " error (g, \"%s: failed to parse reply error\");\n" name;
292 (* | _ -> pr " if (!xdr_%s_ret (&xdr, &rv->ret)) ..." *)
296 pr " rv->cb_done = 1;\n";
297 pr " main_loop.main_loop_quit (g);\n";
300 (* Generate the action stub. *)
301 generate_prototype ~extern:false ~semicolon:false ~newline:true
302 ~handle:"g" name style;
306 | (Err, _) -> "-1" in
312 | _ -> pr " struct %s_args args;\n" name
315 pr " struct %s_rv rv;\n" shortname;
318 pr " if (g->state != READY) {\n";
319 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
322 pr " return %s;\n" error_code;
325 pr " memset (&rv, 0, sizeof rv);\n";
330 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
331 (String.uppercase shortname)
335 | String name -> pr " args.%s = (char *) %s;\n" name name
337 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
338 (String.uppercase shortname);
339 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
342 pr " if (serial == -1)\n";
343 pr " return %s;\n" error_code;
346 pr " rv.cb_done = 0;\n";
347 pr " g->reply_cb_internal = %s_cb;\n" shortname;
348 pr " g->reply_cb_internal_data = &rv;\n";
349 pr " main_loop.main_loop_run (g);\n";
350 pr " g->reply_cb_internal = NULL;\n";
351 pr " g->reply_cb_internal_data = NULL;\n";
352 pr " if (!rv.cb_done) {\n";
353 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
354 pr " return %s;\n" error_code;
358 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
359 (String.uppercase shortname);
360 pr " return %s;\n" error_code;
363 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
364 pr " error (g, \"%%s\", rv.err.error);\n";
365 pr " return %s;\n" error_code;
370 | (Err, _) -> pr " return 0;\n"
376 (* Generate daemon/actions.h. *)
377 and generate_daemon_actions_h () =
378 generate_header CStyle GPLv2;
380 fun (name, style, _, _, _) ->
381 generate_prototype ~single_line:true ~newline:true ("do_" ^ name) style;
384 (* Generate the server-side stubs. *)
385 and generate_daemon_actions () =
386 generate_header CStyle GPLv2;
388 pr "#include <rpc/types.h>\n";
389 pr "#include <rpc/xdr.h>\n";
390 pr "#include \"daemon.h\"\n";
391 pr "#include \"../src/guestfs_protocol.h\"\n";
392 pr "#include \"actions.h\"\n";
396 fun (name, style, _, _, _) ->
397 (* Generate server-side stubs. *)
398 pr "static void %s_stub (XDR *xdr_in)\n" name;
402 | (Err, _) -> pr " int r;\n"; "-1" in
406 pr " struct guestfs_%s_args args;\n" name;
409 | String name -> pr " const char *%s;\n" name
417 pr " memset (&args, 0, sizeof args);\n";
419 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
420 pr " reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
425 | String name -> pr " %s = args.%s;\n" name name
430 pr " r = do_%s " name;
431 generate_call_args style;
434 pr " if (r == %s)\n" error_code;
435 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
440 | (Err, _) -> pr " reply (NULL, NULL);\n"
446 (* Dispatch function. *)
447 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
449 pr " switch (proc_nr) {\n";
452 fun (name, style, _, _, _) ->
453 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
454 pr " %s_stub (xdr_in);\n" name;
459 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
463 (* Generate a lot of different functions for guestfish. *)
464 and generate_fish_cmds () =
465 generate_header CStyle GPLv2;
467 pr "#include <stdio.h>\n";
468 pr "#include <stdlib.h>\n";
469 pr "#include <string.h>\n";
471 pr "#include \"fish.h\"\n";
474 (* list_commands function, which implements guestfish -h *)
475 pr "void list_commands (void)\n";
477 pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
478 pr " list_builtin_commands ();\n";
480 fun (name, _, _, shortdesc, _) ->
481 pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
484 pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
488 (* display_command function, which implements guestfish -h cmd *)
489 pr "void display_command (const char *cmd)\n";
492 fun (name, style, _, shortdesc, longdesc) ->
499 String.concat "> <" (
501 | String n -> n) args
505 pr " if (strcasecmp (cmd, \"%s\") == 0)\n" name;
506 pr " pod2text (\"%s - %s\", %S);\n"
508 (" " ^ synopsis ^ "\n\n" ^ longdesc);
511 pr " display_builtin_command (cmd);\n";
515 (* run_<action> actions *)
517 fun (name, style, _, _, _) ->
518 pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
521 | (Err, _) -> pr " int r;\n"
525 | String name -> pr " const char *%s;\n" name
528 (* Check and convert parameters. *)
529 let argc_expected = nr_args (snd style) in
530 pr " if (argc != %d) {\n" argc_expected;
531 pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
533 pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
539 | String name -> pr " %s = argv[%d];\n" name i
542 (* Call C API function. *)
543 pr " r = guestfs_%s " name;
544 generate_call_args ~handle:"g" style;
547 (* Check return value for errors. *)
549 | (Err, _) -> pr " return r;\n"
555 (* run_action function *)
556 pr "int run_action (const char *cmd, int argc, char *argv[])\n";
559 fun (name, _, _, _, _) ->
560 pr " if (strcasecmp (cmd, \"%s\") == 0)\n" name;
561 pr " return run_%s (cmd, argc, argv);\n" name;
565 pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
572 (* Generate a C function prototype. *)
573 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
574 ?(single_line = false) ?(newline = false)
576 if extern then pr "extern ";
577 if static then pr "static ";
579 | (Err, _) -> pr "int "
582 let comma = ref false in
585 | Some handle -> pr "guestfs_h *%s" handle; comma := true
589 if single_line then pr ", " else pr ",\n\t\t"
595 | String name -> next (); pr "const char *%s" name
598 if semicolon then pr ";";
599 if newline then pr "\n"
601 (* Generate C call arguments, eg "(handle, foo, bar)" *)
602 and generate_call_args ?handle style =
604 let comma = ref false in
607 | Some handle -> pr "%s" handle; comma := true
611 if !comma then pr ", ";
614 | String name -> pr "%s" name
618 let output_to filename =
619 let filename_new = filename ^ ".new" in
620 chan := open_out filename_new;
624 Unix.rename filename_new filename;
625 printf "written %s\n%!" filename;
631 let close = output_to "src/guestfs_protocol.x" in
635 let close = output_to "src/guestfs-actions.h" in
636 generate_actions_h ();
639 let close = output_to "src/guestfs-actions.c" in
640 generate_client_actions ();
643 let close = output_to "daemon/actions.h" in
644 generate_daemon_actions_h ();
647 let close = output_to "daemon/stubs.c" in
648 generate_daemon_actions ();
651 let close = output_to "fish/cmds.c" in
652 generate_fish_cmds ();
655 let close = output_to "guestfs-actions.pod" in