2 * Copyright (C) 2009-2010 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 (* Please read generator/README first. *)
26 open Generator_docstrings
27 open Generator_optgroups
28 open Generator_actions
29 open Generator_structs
33 (* Generate a C function prototype. *)
34 let rec generate_prototype ?(extern = true) ?(static = false)
36 ?(single_line = false) ?(newline = false) ?(in_daemon = false)
39 if extern then pr "extern ";
40 if static then pr "static ";
44 | RInt64 _ -> pr "int64_t "
45 | RBool _ -> pr "int "
46 | RConstString _ | RConstOptString _ -> pr "const char *"
47 | RString _ | RBufferOut _ -> pr "char *"
48 | RStringList _ | RHashtable _ -> pr "char **"
50 if not in_daemon then pr "struct guestfs_%s *" typ
51 else pr "guestfs_int_%s *" typ
52 | RStructList (_, typ) ->
53 if not in_daemon then pr "struct guestfs_%s_list *" typ
54 else pr "guestfs_int_%s_list *" typ
56 let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
57 pr "%s%s (" prefix name;
58 if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
61 let comma = ref false in
64 | Some handle -> pr "guestfs_h *%s" handle; comma := true
68 if single_line then pr ", " else pr ",\n\t\t"
75 | Device n | Dev_or_Path n
81 | StringList n | DeviceList n ->
83 pr "char *const *%s" n
84 | Bool n -> next (); pr "int %s" n
85 | Int n -> next (); pr "int %s" n
86 | Int64 n -> next (); pr "int64_t %s" n
89 if not in_daemon then (next (); pr "const char *%s" n)
92 pr "const char *%s" n;
96 if is_RBufferOut then (next (); pr "size_t *size_r");
99 if semicolon then pr ";";
100 if newline then pr "\n"
102 (* Generate C call arguments, eg "(handle, foo, bar)" *)
103 and generate_c_call_args ?handle ?(decl = false) style =
105 let comma = ref false in
107 if !comma then pr ", ";
112 | Some handle -> pr "%s" handle; comma := true
121 pr "%s" (name_of_argt arg)
123 (* For RBufferOut calls, add implicit &size parameter. *)
133 (* Generate the pod documentation for the C API. *)
134 and generate_actions_pod () =
136 fun (shortname, style, _, flags, _, _, longdesc) ->
137 if not (List.mem NotInDocs flags) then (
138 let name = "guestfs_" ^ shortname in
139 pr "=head2 %s\n\n" name;
141 generate_prototype ~extern:false ~handle:"g" name style;
143 pr "%s\n\n" longdesc;
144 (match fst style with
146 pr "This function returns 0 on success or -1 on error.\n\n"
148 pr "On error this function returns -1.\n\n"
150 pr "On error this function returns -1.\n\n"
152 pr "This function returns a C truth value on success or -1 on error.\n\n"
154 pr "This function returns a string, or NULL on error.
155 The string is owned by the guest handle and must I<not> be freed.\n\n"
156 | RConstOptString _ ->
157 pr "This function returns a string which may be NULL.
158 There is no way to return an error from this function.
159 The string is owned by the guest handle and must I<not> be freed.\n\n"
161 pr "This function returns a string, or NULL on error.
162 I<The caller must free the returned string after use>.\n\n"
164 pr "This function returns a NULL-terminated array of strings
165 (like L<environ(3)>), or NULL if there was an error.
166 I<The caller must free the strings and the array after use>.\n\n"
167 | RStruct (_, typ) ->
168 pr "This function returns a C<struct guestfs_%s *>,
169 or NULL if there was an error.
170 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
171 | RStructList (_, typ) ->
172 pr "This function returns a C<struct guestfs_%s_list *>
173 (see E<lt>guestfs-structs.hE<gt>),
174 or NULL if there was an error.
175 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
177 pr "This function returns a NULL-terminated array of
178 strings, or NULL if there was an error.
179 The array of strings will always have length C<2n+1>, where
180 C<n> keys and values alternate, followed by the trailing NULL entry.
181 I<The caller must free the strings and the array after use>.\n\n"
183 pr "This function returns a buffer, or NULL on error.
184 The size of the returned buffer is written to C<*size_r>.
185 I<The caller must free the returned buffer after use>.\n\n"
187 if List.mem Progress flags then
188 pr "%s\n\n" progress_message;
189 if List.mem ProtocolLimitWarning flags then
190 pr "%s\n\n" protocol_limit_warning;
191 if List.mem DangerWillRobinson flags then
192 pr "%s\n\n" danger_will_robinson;
193 if List.exists (function Key _ -> true | _ -> false) (snd style) then
194 pr "This function takes a key or passphrase parameter which
195 could contain sensitive material. Read the section
196 L</KEYS AND PASSPHRASES> for more information.\n\n";
197 match deprecation_notice flags with
199 | Some txt -> pr "%s\n\n" txt
201 ) all_functions_sorted
203 and generate_structs_pod () =
204 (* Structs documentation. *)
207 pr "=head2 guestfs_%s\n" typ;
209 pr " struct guestfs_%s {\n" typ;
212 | name, FChar -> pr " char %s;\n" name
213 | name, FUInt32 -> pr " uint32_t %s;\n" name
214 | name, FInt32 -> pr " int32_t %s;\n" name
215 | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name
216 | name, FInt64 -> pr " int64_t %s;\n" name
217 | name, FString -> pr " char *%s;\n" name
219 pr " /* The next two fields describe a byte array. */\n";
220 pr " uint32_t %s_len;\n" name;
221 pr " char *%s;\n" name
223 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
224 pr " char %s[32];\n" name
225 | name, FOptPercent ->
226 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
227 pr " float %s;\n" name
231 pr " struct guestfs_%s_list {\n" typ;
232 pr " uint32_t len; /* Number of elements in list. */\n";
233 pr " struct guestfs_%s *val; /* Elements. */\n" typ;
236 pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
237 pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
242 and generate_availability_pod () =
243 (* Availability documentation. *)
247 fun (group, functions) ->
248 pr "=item B<%s>\n" group;
250 pr "The following functions:\n";
251 List.iter (pr "L</guestfs_%s>\n") functions;
257 (* Generate the guestfs-structs.h file. *)
258 and generate_structs_h () =
259 generate_header CStyle LGPLv2plus;
261 (* This is a public exported header file containing various
262 * structures. The structures are carefully written to have
263 * exactly the same in-memory format as the XDR structures that
264 * we use on the wire to the daemon. The reason for creating
265 * copies of these structures here is just so we don't have to
266 * export the whole of guestfs_protocol.h (which includes much
267 * unrelated and XDR-dependent stuff that we don't want to be
268 * public, or required by clients).
270 * To reiterate, we will pass these structures to and from the
271 * client with a simple assignment or memcpy, so the format
272 * must be identical to what rpcgen / the RFC defines.
275 (* Public structures. *)
278 pr "struct guestfs_%s {\n" typ;
281 | name, FChar -> pr " char %s;\n" name
282 | name, FString -> pr " char *%s;\n" name
284 pr " uint32_t %s_len;\n" name;
285 pr " char *%s;\n" name
286 | name, FUUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
287 | name, FUInt32 -> pr " uint32_t %s;\n" name
288 | name, FInt32 -> pr " int32_t %s;\n" name
289 | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name
290 | name, FInt64 -> pr " int64_t %s;\n" name
291 | name, FOptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
295 pr "struct guestfs_%s_list {\n" typ;
296 pr " uint32_t len;\n";
297 pr " struct guestfs_%s *val;\n" typ;
300 pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
301 pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
305 (* Generate the guestfs-actions.h file. *)
306 and generate_actions_h () =
307 generate_header CStyle LGPLv2plus;
309 fun (shortname, style, _, flags, _, _, _) ->
310 let name = "guestfs_" ^ shortname in
313 List.exists (function DeprecatedBy _ -> true | _ -> false) flags in
315 String.length shortname >= 5 && String.sub shortname 0 5 = "test0" in
317 String.length shortname >= 5 && String.sub shortname 0 5 = "debug" in
318 if not deprecated && not test0 && not debug then
319 pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
321 generate_prototype ~single_line:true ~newline:true ~handle:"g"
323 ) all_functions_sorted
325 (* Generate the guestfs-internal-actions.h file. *)
326 and generate_internal_actions_h () =
327 generate_header CStyle LGPLv2plus;
329 fun (shortname, style, _, _, _, _, _) ->
330 let name = "guestfs__" ^ shortname in
331 generate_prototype ~single_line:true ~newline:true ~handle:"g"
333 ) non_daemon_functions
335 (* Generate the client-side dispatch stubs. *)
336 and generate_client_actions () =
337 generate_header CStyle LGPLv2plus;
344 #include <inttypes.h>
346 #include \"guestfs.h\"
347 #include \"guestfs-internal.h\"
348 #include \"guestfs-internal-actions.h\"
349 #include \"guestfs_protocol.h\"
351 /* Check the return message from a call for validity. */
353 check_reply_header (guestfs_h *g,
354 const struct guestfs_message_header *hdr,
355 unsigned int proc_nr, unsigned int serial)
357 if (hdr->prog != GUESTFS_PROGRAM) {
358 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
361 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
362 error (g, \"wrong protocol version (%%d/%%d)\",
363 hdr->vers, GUESTFS_PROTOCOL_VERSION);
366 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
367 error (g, \"unexpected message direction (%%d/%%d)\",
368 hdr->direction, GUESTFS_DIRECTION_REPLY);
371 if (hdr->proc != proc_nr) {
372 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
375 if (hdr->serial != serial) {
376 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
383 /* Check we are in the right state to run a high-level action. */
385 check_state (guestfs_h *g, const char *caller)
387 if (!guestfs__is_ready (g)) {
388 if (guestfs__is_config (g) || guestfs__is_launching (g))
389 error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
392 error (g, \"%%s called from the wrong state, %%d != READY\",
393 caller, guestfs__get_state (g));
401 let error_code_of = function
402 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
403 | RConstString _ | RConstOptString _
404 | RString _ | RStringList _
405 | RStruct _ | RStructList _
406 | RHashtable _ | RBufferOut _ -> "NULL"
409 (* Generate code to check String-like parameters are not passed in
410 * as NULL (returning an error if they are).
412 let check_null_strings shortname style =
413 let pr_newline = ref false in
416 (* parameters which should not be NULL *)
427 pr " if (%s == NULL) {\n" n;
428 pr " error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
429 pr " \"%s\", \"%s\");\n" shortname n;
430 pr " return %s;\n" (error_code_of (fst style));
443 if !pr_newline then pr "\n";
446 (* Generate code to generate guestfish call traces. *)
447 let trace_call shortname style =
448 pr " if (guestfs__get_trace (g)) {\n";
451 List.exists (function
452 | StringList _ | DeviceList _ -> true
453 | _ -> false) (snd style) in
459 pr " fprintf (stderr, \"%s\");\n" shortname;
462 | String n (* strings *)
470 (* guestfish doesn't support string escaping, so neither do we *)
471 pr " fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n
472 | OptString n -> (* string option *)
473 pr " if (%s) fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n n;
474 pr " else fprintf (stderr, \" null\");\n"
476 | DeviceList n -> (* string list *)
477 pr " fputc (' ', stderr);\n";
478 pr " fputc ('\"', stderr);\n";
479 pr " for (i = 0; %s[i]; ++i) {\n" n;
480 pr " if (i > 0) fputc (' ', stderr);\n";
481 pr " fputs (%s[i], stderr);\n" n;
483 pr " fputc ('\"', stderr);\n";
484 | Bool n -> (* boolean *)
485 pr " fputs (%s ? \" true\" : \" false\", stderr);\n" n
487 pr " fprintf (stderr, \" %%d\", %s);\n" n
489 pr " fprintf (stderr, \" %%\" PRIi64, %s);\n" n
491 pr " fputc ('\\n', stderr);\n";
496 (* For non-daemon functions, generate a wrapper around each function. *)
498 fun (shortname, style, _, _, _, _, _) ->
499 let name = "guestfs_" ^ shortname in
501 generate_prototype ~extern:false ~semicolon:false ~newline:true
502 ~handle:"g" name style;
504 check_null_strings shortname style;
505 trace_call shortname style;
506 pr " return guestfs__%s " shortname;
507 generate_c_call_args ~handle:"g" style;
511 ) non_daemon_functions;
513 (* Client-side stubs for each function. *)
515 fun (shortname, style, _, _, _, _, _) ->
516 let name = "guestfs_" ^ shortname in
517 let error_code = error_code_of (fst style) in
519 (* Generate the action stub. *)
520 generate_prototype ~extern:false ~semicolon:false ~newline:true
521 ~handle:"g" name style;
525 (match snd style with
527 | _ -> pr " struct %s_args args;\n" name
530 pr " guestfs_message_header hdr;\n";
531 pr " guestfs_message_error err;\n";
535 | RConstString _ | RConstOptString _ ->
536 failwithf "RConstString|RConstOptString cannot be used by daemon functions"
538 | RBool _ | RString _ | RStringList _
539 | RStruct _ | RStructList _
540 | RHashtable _ | RBufferOut _ ->
541 pr " struct %s_ret ret;\n" name;
547 check_null_strings shortname style;
548 trace_call shortname style;
549 pr " if (check_state (g, \"%s\") == -1) return %s;\n"
550 shortname error_code;
551 pr " guestfs___set_busy (g);\n";
554 (* Send the main header and arguments. *)
555 (match snd style with
557 pr " serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
558 (String.uppercase shortname)
562 | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
563 pr " args.%s = (char *) %s;\n" n n
565 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
566 | StringList n | DeviceList n ->
567 pr " args.%s.%s_val = (char **) %s;\n" n n n;
568 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
570 pr " args.%s = %s;\n" n n
572 pr " args.%s = %s;\n" n n
574 pr " args.%s = %s;\n" n n
575 | FileIn _ | FileOut _ -> ()
577 pr " /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
578 pr " if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
579 pr " error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
581 pr " guestfs___end_busy (g);\n";
582 pr " return %s;\n" error_code;
584 pr " args.%s.%s_val = (char *) %s;\n" n n n;
585 pr " args.%s.%s_len = %s_size;\n" n n n
587 pr " serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
588 (String.uppercase shortname);
589 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
592 pr " if (serial == -1) {\n";
593 pr " guestfs___end_busy (g);\n";
594 pr " return %s;\n" error_code;
598 (* Send any additional files (FileIn) requested. *)
599 let need_read_reply_label = ref false in
603 pr " r = guestfs___send_file (g, %s);\n" n;
604 pr " if (r == -1) {\n";
605 pr " guestfs___end_busy (g);\n";
606 pr " return %s;\n" error_code;
608 pr " if (r == -2) /* daemon cancelled */\n";
609 pr " goto read_reply;\n";
610 need_read_reply_label := true;
615 (* Wait for the reply from the remote end. *)
616 if !need_read_reply_label then pr " read_reply:\n";
617 pr " memset (&hdr, 0, sizeof hdr);\n";
618 pr " memset (&err, 0, sizeof err);\n";
619 if has_ret then pr " memset (&ret, 0, sizeof ret);\n";
621 pr " r = guestfs___recv (g, \"%s\", &hdr, &err,\n " shortname;
625 pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
628 pr " if (r == -1) {\n";
629 pr " guestfs___end_busy (g);\n";
630 pr " return %s;\n" error_code;
634 pr " if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
635 (String.uppercase shortname);
636 pr " guestfs___end_busy (g);\n";
637 pr " return %s;\n" error_code;
641 pr " if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
642 pr " error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
643 pr " free (err.error_message);\n";
644 pr " guestfs___end_busy (g);\n";
645 pr " return %s;\n" error_code;
649 (* Expecting to receive further files (FileOut)? *)
653 pr " if (guestfs___recv_file (g, %s) == -1) {\n" n;
654 pr " guestfs___end_busy (g);\n";
655 pr " return %s;\n" error_code;
661 pr " guestfs___end_busy (g);\n";
663 (match fst style with
664 | RErr -> pr " return 0;\n"
665 | RInt n | RInt64 n | RBool n ->
666 pr " return ret.%s;\n" n
667 | RConstString _ | RConstOptString _ ->
668 failwithf "RConstString|RConstOptString cannot be used by daemon functions"
670 pr " return ret.%s; /* caller will free */\n" n
671 | RStringList n | RHashtable n ->
672 pr " /* caller will free this, but we need to add a NULL entry */\n";
673 pr " ret.%s.%s_val =\n" n n;
674 pr " safe_realloc (g, ret.%s.%s_val,\n" n n;
675 pr " sizeof (char *) * (ret.%s.%s_len + 1));\n"
677 pr " ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
678 pr " return ret.%s.%s_val;\n" n n
680 pr " /* caller will free this */\n";
681 pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
682 | RStructList (n, _) ->
683 pr " /* caller will free this */\n";
684 pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
686 pr " /* RBufferOut is tricky: If the buffer is zero-length, then\n";
687 pr " * _val might be NULL here. To make the API saner for\n";
688 pr " * callers, we turn this case into a unique pointer (using\n";
689 pr " * malloc(1)).\n";
691 pr " if (ret.%s.%s_len > 0) {\n" n n;
692 pr " *size_r = ret.%s.%s_len;\n" n n;
693 pr " return ret.%s.%s_val; /* caller will free */\n" n n;
695 pr " free (ret.%s.%s_val);\n" n n;
696 pr " char *p = safe_malloc (g, 1);\n";
697 pr " *size_r = ret.%s.%s_len;\n" n n;
705 (* Functions to free structures. *)
706 pr "/* Structure-freeing functions. These rely on the fact that the\n";
707 pr " * structure format is identical to the XDR format. See note in\n";
708 pr " * generator.ml.\n";
715 pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
717 pr " xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
723 pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
725 pr " xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
732 (* Generate the linker script which controls the visibility of
733 * symbols in the public ABI and ensures no other symbols get
734 * exported accidentally.
736 and generate_linker_script () =
737 generate_header HashStyle GPLv2plus;
742 "guestfs_get_error_handler";
743 "guestfs_get_out_of_memory_handler";
744 "guestfs_get_private";
745 "guestfs_last_error";
746 "guestfs_set_close_callback";
747 "guestfs_set_error_handler";
748 "guestfs_set_launch_done_callback";
749 "guestfs_set_log_message_callback";
750 "guestfs_set_out_of_memory_handler";
751 "guestfs_set_private";
752 "guestfs_set_progress_callback";
753 "guestfs_set_subprocess_quit_callback";
755 (* Unofficial parts of the API: the bindings code use these
756 * functions, so it is useful to export them.
758 "guestfs_safe_calloc";
759 "guestfs_safe_malloc";
760 "guestfs_safe_strdup";
761 "guestfs_safe_memdup";
765 List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
769 List.map (fun (typ, _) ->
770 ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
773 let globals = List.sort compare (globals @ functions @ structs) in
777 List.iter (pr " %s;\n") globals;
784 and generate_max_proc_nr () =
785 pr "%d\n" max_proc_nr