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 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. *)
124 (match fst style with
132 (* Generate the pod documentation for the C API. *)
133 and generate_actions_pod () =
135 fun (shortname, style, _, flags, _, _, longdesc) ->
136 if not (List.mem NotInDocs flags) then (
137 let name = "guestfs_" ^ shortname in
138 pr "=head2 %s\n\n" name;
140 generate_prototype ~extern:false ~handle:"g" name style;
142 pr "%s\n\n" longdesc;
143 (match fst style with
145 pr "This function returns 0 on success or -1 on error.\n\n"
147 pr "On error this function returns -1.\n\n"
149 pr "On error this function returns -1.\n\n"
151 pr "This function returns a C truth value on success or -1 on error.\n\n"
153 pr "This function returns a string, or NULL on error.
154 The string is owned by the guest handle and must I<not> be freed.\n\n"
155 | RConstOptString _ ->
156 pr "This function returns a string which may be NULL.
157 There is no way to return an error from this function.
158 The string is owned by the guest handle and must I<not> be freed.\n\n"
160 pr "This function returns a string, or NULL on error.
161 I<The caller must free the returned string after use>.\n\n"
163 pr "This function returns a NULL-terminated array of strings
164 (like L<environ(3)>), or NULL if there was an error.
165 I<The caller must free the strings and the array after use>.\n\n"
166 | RStruct (_, typ) ->
167 pr "This function returns a C<struct guestfs_%s *>,
168 or NULL if there was an error.
169 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
170 | RStructList (_, typ) ->
171 pr "This function returns a C<struct guestfs_%s_list *>
172 (see E<lt>guestfs-structs.hE<gt>),
173 or NULL if there was an error.
174 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
176 pr "This function returns a NULL-terminated array of
177 strings, or NULL if there was an error.
178 The array of strings will always have length C<2n+1>, where
179 C<n> keys and values alternate, followed by the trailing NULL entry.
180 I<The caller must free the strings and the array after use>.\n\n"
182 pr "This function returns a buffer, or NULL on error.
183 The size of the returned buffer is written to C<*size_r>.
184 I<The caller must free the returned buffer after use>.\n\n"
186 if List.mem Progress flags then
187 pr "%s\n\n" progress_message;
188 if List.mem ProtocolLimitWarning flags then
189 pr "%s\n\n" protocol_limit_warning;
190 if List.mem DangerWillRobinson flags then
191 pr "%s\n\n" danger_will_robinson;
192 if List.exists (function Key _ -> true | _ -> false) (snd style) then
193 pr "This function takes a key or passphrase parameter which
194 could contain sensitive material. Read the section
195 L</KEYS AND PASSPHRASES> for more information.\n\n";
196 match deprecation_notice flags with
198 | Some txt -> pr "%s\n\n" txt
200 ) all_functions_sorted
202 and generate_structs_pod () =
203 (* Structs documentation. *)
206 pr "=head2 guestfs_%s\n" typ;
208 pr " struct guestfs_%s {\n" typ;
211 | name, FChar -> pr " char %s;\n" name
212 | name, FUInt32 -> pr " uint32_t %s;\n" name
213 | name, FInt32 -> pr " int32_t %s;\n" name
214 | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name
215 | name, FInt64 -> pr " int64_t %s;\n" name
216 | name, FString -> pr " char *%s;\n" name
218 pr " /* The next two fields describe a byte array. */\n";
219 pr " uint32_t %s_len;\n" name;
220 pr " char *%s;\n" name
222 pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
223 pr " char %s[32];\n" name
224 | name, FOptPercent ->
225 pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
226 pr " float %s;\n" name
230 pr " struct guestfs_%s_list {\n" typ;
231 pr " uint32_t len; /* Number of elements in list. */\n";
232 pr " struct guestfs_%s *val; /* Elements. */\n" typ;
235 pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
236 pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
241 and generate_availability_pod () =
242 (* Availability documentation. *)
246 fun (group, functions) ->
247 pr "=item B<%s>\n" group;
249 pr "The following functions:\n";
250 List.iter (pr "L</guestfs_%s>\n") functions;
256 (* Generate the guestfs-structs.h file. *)
257 and generate_structs_h () =
258 generate_header CStyle LGPLv2plus;
260 (* This is a public exported header file containing various
261 * structures. The structures are carefully written to have
262 * exactly the same in-memory format as the XDR structures that
263 * we use on the wire to the daemon. The reason for creating
264 * copies of these structures here is just so we don't have to
265 * export the whole of guestfs_protocol.h (which includes much
266 * unrelated and XDR-dependent stuff that we don't want to be
267 * public, or required by clients).
269 * To reiterate, we will pass these structures to and from the
270 * client with a simple assignment or memcpy, so the format
271 * must be identical to what rpcgen / the RFC defines.
274 (* Public structures. *)
277 pr "struct guestfs_%s {\n" typ;
280 | name, FChar -> pr " char %s;\n" name
281 | name, FString -> pr " char *%s;\n" name
283 pr " uint32_t %s_len;\n" name;
284 pr " char *%s;\n" name
285 | name, FUUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
286 | name, FUInt32 -> pr " uint32_t %s;\n" name
287 | name, FInt32 -> pr " int32_t %s;\n" name
288 | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name
289 | name, FInt64 -> pr " int64_t %s;\n" name
290 | name, FOptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
294 pr "struct guestfs_%s_list {\n" typ;
295 pr " uint32_t len;\n";
296 pr " struct guestfs_%s *val;\n" typ;
299 pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
300 pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
304 (* Generate the guestfs-actions.h file. *)
305 and generate_actions_h () =
306 generate_header CStyle LGPLv2plus;
308 fun (shortname, style, _, flags, _, _, _) ->
309 let name = "guestfs_" ^ shortname in
312 List.exists (function DeprecatedBy _ -> true | _ -> false) flags in
314 String.length shortname >= 5 && String.sub shortname 0 5 = "test0" in
316 String.length shortname >= 5 && String.sub shortname 0 5 = "debug" in
317 if not deprecated && not test0 && not debug then
318 pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
320 generate_prototype ~single_line:true ~newline:true ~handle:"g"
322 ) all_functions_sorted
324 (* Generate the guestfs-internal-actions.h file. *)
325 and generate_internal_actions_h () =
326 generate_header CStyle LGPLv2plus;
328 fun (shortname, style, _, _, _, _, _) ->
329 let name = "guestfs__" ^ shortname in
330 generate_prototype ~single_line:true ~newline:true ~handle:"g"
332 ) non_daemon_functions
334 (* Generate the client-side dispatch stubs. *)
335 and generate_client_actions () =
336 generate_header CStyle LGPLv2plus;
343 #include <inttypes.h>
345 #include \"guestfs.h\"
346 #include \"guestfs-internal.h\"
347 #include \"guestfs-internal-actions.h\"
348 #include \"guestfs_protocol.h\"
350 /* Check the return message from a call for validity. */
352 check_reply_header (guestfs_h *g,
353 const struct guestfs_message_header *hdr,
354 unsigned int proc_nr, unsigned int serial)
356 if (hdr->prog != GUESTFS_PROGRAM) {
357 error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
360 if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
361 error (g, \"wrong protocol version (%%d/%%d)\",
362 hdr->vers, GUESTFS_PROTOCOL_VERSION);
365 if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
366 error (g, \"unexpected message direction (%%d/%%d)\",
367 hdr->direction, GUESTFS_DIRECTION_REPLY);
370 if (hdr->proc != proc_nr) {
371 error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
374 if (hdr->serial != serial) {
375 error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
382 /* Check we are in the right state to run a high-level action. */
384 check_state (guestfs_h *g, const char *caller)
386 if (!guestfs__is_ready (g)) {
387 if (guestfs__is_config (g) || guestfs__is_launching (g))
388 error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
391 error (g, \"%%s called from the wrong state, %%d != READY\",
392 caller, guestfs__get_state (g));
400 let error_code_of = function
401 | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
402 | RConstString _ | RConstOptString _
403 | RString _ | RStringList _
404 | RStruct _ | RStructList _
405 | RHashtable _ | RBufferOut _ -> "NULL"
408 (* Generate code to check String-like parameters are not passed in
409 * as NULL (returning an error if they are).
411 let check_null_strings shortname style =
412 let pr_newline = ref false in
415 (* parameters which should not be NULL *)
426 pr " if (%s == NULL) {\n" n;
427 pr " error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
428 pr " \"%s\", \"%s\");\n" shortname n;
429 pr " return %s;\n" (error_code_of (fst style));
442 if !pr_newline then pr "\n";
445 (* Generate code to generate guestfish call traces. *)
446 let trace_call shortname style =
447 pr " if (guestfs__get_trace (g)) {\n";
450 List.exists (function
451 | StringList _ | DeviceList _ -> true
452 | _ -> false) (snd style) in
458 pr " fprintf (stderr, \"%s\");\n" shortname;
461 | String n (* strings *)
469 (* guestfish doesn't support string escaping, so neither do we *)
470 pr " fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n
471 | OptString n -> (* string option *)
472 pr " if (%s) fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n n;
473 pr " else fprintf (stderr, \" null\");\n"
475 | DeviceList n -> (* string list *)
476 pr " fputc (' ', stderr);\n";
477 pr " fputc ('\"', stderr);\n";
478 pr " for (i = 0; %s[i]; ++i) {\n" n;
479 pr " if (i > 0) fputc (' ', stderr);\n";
480 pr " fputs (%s[i], stderr);\n" n;
482 pr " fputc ('\"', stderr);\n";
483 | Bool n -> (* boolean *)
484 pr " fputs (%s ? \" true\" : \" false\", stderr);\n" n
486 pr " fprintf (stderr, \" %%d\", %s);\n" n
488 pr " fprintf (stderr, \" %%\" PRIi64, %s);\n" n
490 pr " fputc ('\\n', stderr);\n";
495 (* For non-daemon functions, generate a wrapper around each function. *)
497 fun (shortname, style, _, _, _, _, _) ->
498 let name = "guestfs_" ^ shortname in
500 generate_prototype ~extern:false ~semicolon:false ~newline:true
501 ~handle:"g" name style;
503 check_null_strings shortname style;
504 trace_call shortname style;
505 pr " return guestfs__%s " shortname;
506 generate_c_call_args ~handle:"g" style;
510 ) non_daemon_functions;
512 (* Client-side stubs for each function. *)
514 fun (shortname, style, _, _, _, _, _) ->
515 let name = "guestfs_" ^ shortname in
516 let error_code = error_code_of (fst style) in
518 (* Generate the action stub. *)
519 generate_prototype ~extern:false ~semicolon:false ~newline:true
520 ~handle:"g" name style;
524 (match snd style with
526 | _ -> pr " struct %s_args args;\n" name
529 pr " guestfs_message_header hdr;\n";
530 pr " guestfs_message_error err;\n";
534 | RConstString _ | RConstOptString _ ->
535 failwithf "RConstString|RConstOptString cannot be used by daemon functions"
537 | RBool _ | RString _ | RStringList _
538 | RStruct _ | RStructList _
539 | RHashtable _ | RBufferOut _ ->
540 pr " struct %s_ret ret;\n" name;
546 check_null_strings shortname style;
547 trace_call shortname style;
548 pr " if (check_state (g, \"%s\") == -1) return %s;\n"
549 shortname error_code;
550 pr " guestfs___set_busy (g);\n";
553 (* Send the main header and arguments. *)
554 (match snd style with
556 pr " serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
557 (String.uppercase shortname)
561 | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
562 pr " args.%s = (char *) %s;\n" n n
564 pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
565 | StringList n | DeviceList n ->
566 pr " args.%s.%s_val = (char **) %s;\n" n n n;
567 pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
569 pr " args.%s = %s;\n" n n
571 pr " args.%s = %s;\n" n n
573 pr " args.%s = %s;\n" n n
574 | FileIn _ | FileOut _ -> ()
576 pr " /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
577 pr " if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
578 pr " error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
580 pr " guestfs___end_busy (g);\n";
581 pr " return %s;\n" error_code;
583 pr " args.%s.%s_val = (char *) %s;\n" n n n;
584 pr " args.%s.%s_len = %s_size;\n" n n n
586 pr " serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
587 (String.uppercase shortname);
588 pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
591 pr " if (serial == -1) {\n";
592 pr " guestfs___end_busy (g);\n";
593 pr " return %s;\n" error_code;
597 (* Send any additional files (FileIn) requested. *)
598 let need_read_reply_label = ref false in
602 pr " r = guestfs___send_file (g, %s);\n" n;
603 pr " if (r == -1) {\n";
604 pr " guestfs___end_busy (g);\n";
605 pr " return %s;\n" error_code;
607 pr " if (r == -2) /* daemon cancelled */\n";
608 pr " goto read_reply;\n";
609 need_read_reply_label := true;
614 (* Wait for the reply from the remote end. *)
615 if !need_read_reply_label then pr " read_reply:\n";
616 pr " memset (&hdr, 0, sizeof hdr);\n";
617 pr " memset (&err, 0, sizeof err);\n";
618 if has_ret then pr " memset (&ret, 0, sizeof ret);\n";
620 pr " r = guestfs___recv (g, \"%s\", &hdr, &err,\n " shortname;
624 pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
627 pr " if (r == -1) {\n";
628 pr " guestfs___end_busy (g);\n";
629 pr " return %s;\n" error_code;
633 pr " if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
634 (String.uppercase shortname);
635 pr " guestfs___end_busy (g);\n";
636 pr " return %s;\n" error_code;
640 pr " if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
641 pr " error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
642 pr " free (err.error_message);\n";
643 pr " guestfs___end_busy (g);\n";
644 pr " return %s;\n" error_code;
648 (* Expecting to receive further files (FileOut)? *)
652 pr " if (guestfs___recv_file (g, %s) == -1) {\n" n;
653 pr " guestfs___end_busy (g);\n";
654 pr " return %s;\n" error_code;
660 pr " guestfs___end_busy (g);\n";
662 (match fst style with
663 | RErr -> pr " return 0;\n"
664 | RInt n | RInt64 n | RBool n ->
665 pr " return ret.%s;\n" n
666 | RConstString _ | RConstOptString _ ->
667 failwithf "RConstString|RConstOptString cannot be used by daemon functions"
669 pr " return ret.%s; /* caller will free */\n" n
670 | RStringList n | RHashtable n ->
671 pr " /* caller will free this, but we need to add a NULL entry */\n";
672 pr " ret.%s.%s_val =\n" n n;
673 pr " safe_realloc (g, ret.%s.%s_val,\n" n n;
674 pr " sizeof (char *) * (ret.%s.%s_len + 1));\n"
676 pr " ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
677 pr " return ret.%s.%s_val;\n" n n
679 pr " /* caller will free this */\n";
680 pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
681 | RStructList (n, _) ->
682 pr " /* caller will free this */\n";
683 pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
685 pr " /* RBufferOut is tricky: If the buffer is zero-length, then\n";
686 pr " * _val might be NULL here. To make the API saner for\n";
687 pr " * callers, we turn this case into a unique pointer (using\n";
688 pr " * malloc(1)).\n";
690 pr " if (ret.%s.%s_len > 0) {\n" n n;
691 pr " *size_r = ret.%s.%s_len;\n" n n;
692 pr " return ret.%s.%s_val; /* caller will free */\n" n n;
694 pr " free (ret.%s.%s_val);\n" n n;
695 pr " char *p = safe_malloc (g, 1);\n";
696 pr " *size_r = ret.%s.%s_len;\n" n n;
704 (* Functions to free structures. *)
705 pr "/* Structure-freeing functions. These rely on the fact that the\n";
706 pr " * structure format is identical to the XDR format. See note in\n";
707 pr " * generator.ml.\n";
714 pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
716 pr " xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
722 pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
724 pr " xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
731 (* Generate the linker script which controls the visibility of
732 * symbols in the public ABI and ensures no other symbols get
733 * exported accidentally.
735 and generate_linker_script () =
736 generate_header HashStyle GPLv2plus;
741 "guestfs_get_error_handler";
742 "guestfs_get_out_of_memory_handler";
743 "guestfs_get_private";
744 "guestfs_last_error";
745 "guestfs_set_close_callback";
746 "guestfs_set_error_handler";
747 "guestfs_set_launch_done_callback";
748 "guestfs_set_log_message_callback";
749 "guestfs_set_out_of_memory_handler";
750 "guestfs_set_private";
751 "guestfs_set_progress_callback";
752 "guestfs_set_subprocess_quit_callback";
754 (* Unofficial parts of the API: the bindings code use these
755 * functions, so it is useful to export them.
757 "guestfs_safe_calloc";
758 "guestfs_safe_malloc";
759 "guestfs_safe_strdup";
760 "guestfs_safe_memdup";
764 List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
768 List.map (fun (typ, _) ->
769 ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
772 let globals = List.sort compare (globals @ functions @ structs) in
776 List.iter (pr " %s;\n") globals;
783 and generate_max_proc_nr () =
784 pr "%d\n" max_proc_nr