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 filesystems 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 type comment_style = CStyle | HashStyle | OCamlStyle
91 type license = GPLv2 | LGPLv2
93 (* Generate a header block in a number of standard styles. *)
94 let rec generate_header comment license =
95 let c = match comment with
96 | CStyle -> pr "/* "; " *"
97 | HashStyle -> pr "# "; "#"
98 | OCamlStyle -> pr "(* "; " *" in
99 pr "libguestfs generated file\n";
100 pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
101 pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
103 pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
107 pr "%s This program is free software; you can redistribute it and/or modify\n" c;
108 pr "%s it under the terms of the GNU General Public License as published by\n" c;
109 pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
110 pr "%s (at your option) any later version.\n" c;
112 pr "%s This program is distributed in the hope that it will be useful,\n" c;
113 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
114 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
115 pr "%s GNU General Public License for more details.\n" c;
117 pr "%s You should have received a copy of the GNU General Public License along\n" c;
118 pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
119 pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
122 pr "%s This library is free software; you can redistribute it and/or\n" c;
123 pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
124 pr "%s License as published by the Free Software Foundation; either\n" c;
125 pr "%s version 2 of the License, or (at your option) any later version.\n" c;
127 pr "%s This library is distributed in the hope that it will be useful,\n" c;
128 pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
129 pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
130 pr "%s Lesser General Public License for more details.\n" c;
132 pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
133 pr "%s License along with this library; if not, write to the Free Software\n" c;
134 pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
137 | CStyle -> pr " */\n"
139 | OCamlStyle -> pr " *)\n"
143 (* Generate the pod documentation for the C API. *)
144 and generate_pod () =
146 fun (shortname, style, _, _, longdesc) ->
147 let name = "guestfs_" ^ shortname in
148 pr "=head2 %s\n\n" name;
150 generate_prototype ~extern:false ~handle:"handle" name style;
152 pr "%s\n\n" longdesc;
155 pr "This function return 0 on success or -1 on error.\n\n"
159 (* Generate the protocol (XDR) file. *)
160 and generate_xdr () =
161 generate_header CStyle LGPLv2;
164 fun (shortname, style, _, _, _) ->
165 let name = "guestfs_" ^ shortname in
166 pr "/* %s */\n\n" name;
170 pr "struct %s_args {\n" name;
173 | String name -> pr " string %s<>;\n" name
179 (* | ... -> pr "struct %s_ret ...\n" name; *)
183 (* Table of procedure numbers. *)
184 pr "enum guestfs_procedure {\n";
186 fun (shortname, _, proc_nr, _, _) ->
187 pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
189 pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
193 (* Having to choose a maximum message size is annoying for several
194 * reasons (it limits what we can do in the API), but it (a) makes
195 * the protocol a lot simpler, and (b) provides a bound on the size
196 * of the daemon which operates in limited memory space. For large
197 * file transfers you should use FTP.
199 pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
202 (* Message header, etc. *)
204 const GUESTFS_PROGRAM = 0x2000F5F5;
205 const GUESTFS_PROTOCOL_VERSION = 1;
207 enum guestfs_message_direction {
208 GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
209 GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
212 enum guestfs_message_status {
213 GUESTFS_STATUS_OK = 0,
214 GUESTFS_STATUS_ERROR = 1
217 const GUESTFS_ERROR_LEN = 256;
219 struct guestfs_message_error {
220 string error<GUESTFS_ERROR_LEN>; /* error message */
223 struct guestfs_message_header {
224 unsigned prog; /* GUESTFS_PROGRAM */
225 unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
226 guestfs_procedure proc; /* GUESTFS_PROC_x */
227 guestfs_message_direction direction;
228 unsigned serial; /* message serial number */
229 guestfs_message_status status;
233 (* Generate the guestfs-actions.h file. *)
234 and generate_actions_h () =
235 generate_header CStyle LGPLv2;
237 fun (shortname, style, _, _, _) ->
238 let name = "guestfs_" ^ shortname in
239 generate_prototype ~single_line:true ~newline:true ~handle:"handle"
243 (* Generate the client-side dispatch stubs. *)
244 and generate_client_actions () =
245 generate_header CStyle LGPLv2;
247 fun (shortname, style, _, _, _) ->
248 let name = "guestfs_" ^ shortname in
250 (* Generate the return value struct. *)
251 pr "struct %s_rv {\n" shortname;
252 pr " int cb_done; /* flag to indicate callback was called */\n";
253 pr " struct guestfs_message_header hdr;\n";
254 pr " struct guestfs_message_error err;\n";
257 (* | _ -> pr " struct %s_ret ret;\n" name; *)
261 (* Generate the callback function. *)
262 pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
264 pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
266 pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
267 pr " error (g, \"%s: failed to parse reply header\");\n" name;
270 pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
271 pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
272 pr " error (g, \"%s: failed to parse reply error\");\n" name;
280 (* | _ -> pr " if (!xdr_%s_ret (&xdr, &rv->ret)) ..." *)
284 pr " rv->cb_done = 1;\n";
285 pr " main_loop.main_loop_quit (g);\n";
288 (* Generate the action stub. *)
289 generate_prototype ~extern:false ~semicolon:false ~newline:true
290 ~handle:"g" name style;
294 | (Err, _) -> "-1" in
300 | _ -> pr " struct %s_args args;\n" name
303 pr " struct %s_rv rv;\n" shortname;
306 pr " if (g->state != READY) {\n";
307 pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
310 pr " return %s;\n" error_code;
313 pr " memset (&rv, 0, sizeof rv);\n";
318 pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
319 (String.uppercase shortname)
323 | String name -> pr " args.%s = (char *) %s;\n" name name
325 pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
326 (String.uppercase shortname);
327 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
330 pr " if (serial == -1)\n";
331 pr " return %s;\n" error_code;
334 pr " rv.cb_done = 0;\n";
335 pr " g->reply_cb_internal = %s_cb;\n" shortname;
336 pr " g->reply_cb_internal_data = &rv;\n";
337 pr " main_loop.main_loop_run (g);\n";
338 pr " g->reply_cb_internal = NULL;\n";
339 pr " g->reply_cb_internal_data = NULL;\n";
340 pr " if (!rv.cb_done) {\n";
341 pr " error (g, \"%s failed, see earlier error messages\");\n" name;
342 pr " return %s;\n" error_code;
346 pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
347 (String.uppercase shortname);
348 pr " return %s;\n" error_code;
351 pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
352 pr " error (g, \"%%s\", rv.err.error);\n";
353 pr " return %s;\n" error_code;
358 | (Err, _) -> pr " return 0;\n"
364 (* Generate daemon/actions.h. *)
365 and generate_daemon_actions_h () =
366 generate_header CStyle GPLv2;
368 fun (name, style, _, _, _) ->
369 generate_prototype ~single_line:true ~newline:true ("do_" ^ name) style;
372 (* Generate the server-side stubs. *)
373 and generate_daemon_actions () =
374 generate_header CStyle GPLv2;
376 pr "#include <rpc/types.h>\n";
377 pr "#include <rpc/xdr.h>\n";
378 pr "#include \"daemon.h\"\n";
379 pr "#include \"../src/guestfs_protocol.h\"\n";
380 pr "#include \"actions.h\"\n";
384 fun (name, style, _, _, _) ->
385 (* Generate server-side stubs. *)
386 pr "static void %s_stub (XDR *xdr_in)\n" name;
390 | (Err, _) -> pr " int r;\n"; "-1" in
394 pr " struct guestfs_%s_args args;\n" name;
397 | String name -> pr " const char *%s;\n" name
405 pr " memset (&args, 0, sizeof args);\n";
407 pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
408 pr " reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
413 | String name -> pr " %s = args.%s;\n" name name
418 pr " r = do_%s " name;
419 generate_call_args style;
422 pr " if (r == %s)\n" error_code;
423 pr " /* do_%s has already called reply_with_error, so just return */\n" name;
428 | (Err, _) -> pr " reply (NULL, NULL);\n"
434 (* Dispatch function. *)
435 pr "void dispatch_incoming_message (XDR *xdr_in)\n";
437 pr " switch (proc_nr) {\n";
440 fun (name, style, _, _, _) ->
441 pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
442 pr " %s_stub (xdr_in);\n" name;
447 pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
451 (* Generate a C function prototype. *)
452 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
453 ?(single_line = false) ?(newline = false)
455 if extern then pr "extern ";
456 if static then pr "static ";
458 | (Err, _) -> pr "int "
461 let comma = ref false in
464 | Some handle -> pr "guestfs_h *%s" handle; comma := true
468 if single_line then pr ", " else pr ",\n\t\t"
474 | String name -> next (); pr "const char *%s" name
477 if semicolon then pr ";";
478 if newline then pr "\n"
480 (* Generate C call arguments, eg "(handle, foo, bar)" *)
481 and generate_call_args ?handle style =
483 let comma = ref false in
486 | Some handle -> pr "%s" handle; comma := true
490 if !comma then pr ", ";
493 | String name -> pr "%s" name
497 let output_to filename =
498 let filename_new = filename ^ ".new" in
499 chan := open_out filename_new;
503 Unix.rename filename_new filename;
504 printf "written %s\n%!" filename;
510 let close = output_to "src/guestfs_protocol.x" in
514 let close = output_to "src/guestfs-actions.h" in
515 generate_actions_h ();
518 let close = output_to "src/guestfs-actions.c" in
519 generate_client_actions ();
522 let close = output_to "daemon/actions.h" in
523 generate_daemon_actions_h ();
526 let close = output_to "daemon/stubs.c" in
527 generate_daemon_actions ();
530 let close = output_to "guestfs-actions.pod" in