autogen: Touch ocaml/.depend
[libguestfs.git] / generator / generator_c.ml
1 (* libguestfs
2  * Copyright (C) 2009-2010 Red Hat Inc.
3  *
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.
8  *
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.
13  *
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
17  *)
18
19 (* Please read generator/README first. *)
20
21 open Printf
22
23 open Generator_types
24 open Generator_utils
25 open Generator_pr
26 open Generator_docstrings
27 open Generator_optgroups
28 open Generator_actions
29 open Generator_structs
30
31 (* Generate C API. *)
32
33 type optarg_proto = Dots | VA | Argv
34
35 (* Generate a C function prototype. *)
36 let rec generate_prototype ?(extern = true) ?(static = false)
37     ?(semicolon = true)
38     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
39     ?(prefix = "") ?(suffix = "")
40     ?handle
41     ?(optarg_proto = Dots)
42     name (ret, args, optargs) =
43   if extern then pr "extern ";
44   if static then pr "static ";
45   (match ret with
46    | RErr -> pr "int "
47    | RInt _ -> pr "int "
48    | RInt64 _ -> pr "int64_t "
49    | RBool _ -> pr "int "
50    | RConstString _ | RConstOptString _ -> pr "const char *"
51    | RString _ | RBufferOut _ -> pr "char *"
52    | RStringList _ | RHashtable _ -> pr "char **"
53    | RStruct (_, typ) ->
54        if not in_daemon then pr "struct guestfs_%s *" typ
55        else pr "guestfs_int_%s *" typ
56    | RStructList (_, typ) ->
57        if not in_daemon then pr "struct guestfs_%s_list *" typ
58        else pr "guestfs_int_%s_list *" typ
59   );
60   let is_RBufferOut = match ret with RBufferOut _ -> true | _ -> false in
61   pr "%s%s%s (" prefix name suffix;
62   if handle = None && args = [] && optargs = [] && not is_RBufferOut then
63       pr "void"
64   else (
65     let comma = ref false in
66     (match handle with
67      | None -> ()
68      | Some handle -> pr "guestfs_h *%s" handle; comma := true
69     );
70     let next () =
71       if !comma then (
72         if single_line then pr ", " else pr ",\n\t\t"
73       );
74       comma := true
75     in
76     List.iter (
77       function
78       | Pathname n
79       | Device n | Dev_or_Path n
80       | String n
81       | OptString n
82       | Key n ->
83           next ();
84           pr "const char *%s" n
85       | StringList n | DeviceList n ->
86           next ();
87           pr "char *const *%s" n
88       | Bool n -> next (); pr "int %s" n
89       | Int n -> next (); pr "int %s" n
90       | Int64 n -> next (); pr "int64_t %s" n
91       | FileIn n
92       | FileOut n ->
93           if not in_daemon then (next (); pr "const char *%s" n)
94       | BufferIn n ->
95           next ();
96           pr "const char *%s" n;
97           next ();
98           pr "size_t %s_size" n
99     ) args;
100     if is_RBufferOut then (next (); pr "size_t *size_r");
101     if optargs <> [] then (
102       next ();
103       match optarg_proto with
104       | Dots -> pr "..."
105       | VA -> pr "va_list args"
106       | Argv -> pr "const struct guestfs_%s_argv *optargs" name
107     );
108   );
109   pr ")";
110   if semicolon then pr ";";
111   if newline then pr "\n"
112
113 (* Generate C call arguments, eg "(handle, foo, bar)" *)
114 and generate_c_call_args ?handle (ret, args, optargs) =
115   pr "(";
116   let comma = ref false in
117   let next () =
118     if !comma then pr ", ";
119     comma := true
120   in
121   (match handle with
122    | None -> ()
123    | Some handle -> pr "%s" handle; comma := true
124   );
125   List.iter (
126     function
127     | BufferIn n ->
128         next ();
129         pr "%s, %s_size" n n
130     | arg ->
131         next ();
132         pr "%s" (name_of_argt arg)
133   ) args;
134   (* For RBufferOut calls, add implicit &size parameter. *)
135   (match ret with
136    | RBufferOut _ ->
137        next ();
138        pr "&size"
139    | _ -> ()
140   );
141   (* For calls with optional arguments, add implicit optargs parameter. *)
142   if optargs <> [] then (
143     next ();
144     pr "optargs"
145   );
146   pr ")"
147
148 (* Generate the pod documentation for the C API. *)
149 and generate_actions_pod () =
150   List.iter (
151     fun (shortname, (ret, args, optargs as style), _, flags, _, _, longdesc) ->
152       if not (List.mem NotInDocs flags) then (
153         let name = "guestfs_" ^ shortname in
154         pr "=head2 %s\n\n" name;
155         pr " ";
156         generate_prototype ~extern:false ~handle:"g" name style;
157         pr "\n\n";
158
159         let uc_shortname = String.uppercase shortname in
160         if optargs <> [] then (
161           pr "You may supply a list of optional arguments to this call.\n";
162           pr "Use zero or more of the following pairs of parameters,\n";
163           pr "and terminate the list with C<-1> on its own.\n";
164           pr "See L</CALLS WITH OPTIONAL ARGUMENTS>.\n\n";
165           List.iter (
166             fun argt ->
167               let n = name_of_argt argt in
168               let uc_n = String.uppercase n in
169               pr " GUESTFS_%s_%s, " uc_shortname uc_n;
170               match argt with
171               | Bool n -> pr "int %s,\n" n
172               | Int n -> pr "int %s,\n" n
173               | Int64 n -> pr "int64_t %s,\n" n
174               | String n -> pr "const char *%s,\n" n
175               | _ -> assert false
176           ) optargs;
177           pr "\n";
178         );
179
180         pr "%s\n\n" longdesc;
181         let ret, args, optargs = style in
182         (match ret with
183          | RErr ->
184              pr "This function returns 0 on success or -1 on error.\n\n"
185          | RInt _ ->
186              pr "On error this function returns -1.\n\n"
187          | RInt64 _ ->
188              pr "On error this function returns -1.\n\n"
189          | RBool _ ->
190              pr "This function returns a C truth value on success or -1 on error.\n\n"
191          | RConstString _ ->
192              pr "This function returns a string, or NULL on error.
193 The string is owned by the guest handle and must I<not> be freed.\n\n"
194          | RConstOptString _ ->
195              pr "This function returns a string which may be NULL.
196 There is no way to return an error from this function.
197 The string is owned by the guest handle and must I<not> be freed.\n\n"
198          | RString _ ->
199              pr "This function returns a string, or NULL on error.
200 I<The caller must free the returned string after use>.\n\n"
201          | RStringList _ ->
202              pr "This function returns a NULL-terminated array of strings
203 (like L<environ(3)>), or NULL if there was an error.
204 I<The caller must free the strings and the array after use>.\n\n"
205          | RStruct (_, typ) ->
206              pr "This function returns a C<struct guestfs_%s *>,
207 or NULL if there was an error.
208 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
209          | RStructList (_, typ) ->
210              pr "This function returns a C<struct guestfs_%s_list *>
211 (see E<lt>guestfs-structs.hE<gt>),
212 or NULL if there was an error.
213 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
214          | RHashtable _ ->
215              pr "This function returns a NULL-terminated array of
216 strings, or NULL if there was an error.
217 The array of strings will always have length C<2n+1>, where
218 C<n> keys and values alternate, followed by the trailing NULL entry.
219 I<The caller must free the strings and the array after use>.\n\n"
220          | RBufferOut _ ->
221              pr "This function returns a buffer, or NULL on error.
222 The size of the returned buffer is written to C<*size_r>.
223 I<The caller must free the returned buffer after use>.\n\n"
224         );
225         if List.mem Progress flags then
226           pr "%s\n\n" progress_message;
227         if List.mem ProtocolLimitWarning flags then
228           pr "%s\n\n" protocol_limit_warning;
229         if List.mem DangerWillRobinson flags then
230           pr "%s\n\n" danger_will_robinson;
231         if List.exists (function Key _ -> true | _ -> false) (args@optargs) then
232           pr "This function takes a key or passphrase parameter which
233 could contain sensitive material.  Read the section
234 L</KEYS AND PASSPHRASES> for more information.\n\n";
235         (match deprecation_notice flags with
236          | None -> ()
237          | Some txt -> pr "%s\n\n" txt
238         );
239
240         (* Handling of optional argument variants. *)
241         if optargs <> [] then (
242           pr "=head2 %s_va\n\n" name;
243           pr " ";
244           generate_prototype ~extern:false ~handle:"g"
245             ~prefix:"guestfs_" ~suffix:"_va" ~optarg_proto:VA
246             shortname style;
247           pr "\n\n";
248           pr "This is the \"va_list variant\" of L</%s>.\n\n" name;
249           pr "See L</CALLS WITH OPTIONAL ARGUMENTS>.\n\n";
250           pr "=head2 %s_argv\n\n" name;
251           pr " ";
252           generate_prototype ~extern:false ~handle:"g"
253             ~prefix:"guestfs_" ~suffix:"_argv" ~optarg_proto:Argv
254             shortname style;
255           pr "\n\n";
256           pr "This is the \"argv variant\" of L</%s>.\n\n" name;
257           pr "See L</CALLS WITH OPTIONAL ARGUMENTS>.\n\n";
258         );
259       )
260   ) all_functions_sorted
261
262 and generate_structs_pod () =
263   (* Structs documentation. *)
264   List.iter (
265     fun (typ, cols) ->
266       pr "=head2 guestfs_%s\n" typ;
267       pr "\n";
268       pr " struct guestfs_%s {\n" typ;
269       List.iter (
270         function
271         | name, FChar -> pr "   char %s;\n" name
272         | name, FUInt32 -> pr "   uint32_t %s;\n" name
273         | name, FInt32 -> pr "   int32_t %s;\n" name
274         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
275         | name, FInt64 -> pr "   int64_t %s;\n" name
276         | name, FString -> pr "   char *%s;\n" name
277         | name, FBuffer ->
278             pr "   /* The next two fields describe a byte array. */\n";
279             pr "   uint32_t %s_len;\n" name;
280             pr "   char *%s;\n" name
281         | name, FUUID ->
282             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
283             pr "   char %s[32];\n" name
284         | name, FOptPercent ->
285             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
286             pr "   float %s;\n" name
287       ) cols;
288       pr " };\n";
289       pr " \n";
290       pr " struct guestfs_%s_list {\n" typ;
291       pr "   uint32_t len; /* Number of elements in list. */\n";
292       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
293       pr " };\n";
294       pr " \n";
295       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
296       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
297         typ typ;
298       pr "\n"
299   ) structs
300
301 and generate_availability_pod () =
302   (* Availability documentation. *)
303   pr "=over 4\n";
304   pr "\n";
305   List.iter (
306     fun (group, functions) ->
307       pr "=item B<%s>\n" group;
308       pr "\n";
309       pr "The following functions:\n";
310       List.iter (pr "L</guestfs_%s>\n") functions;
311       pr "\n"
312   ) optgroups;
313   pr "=back\n";
314   pr "\n"
315
316 (* Generate the guestfs-structs.h file. *)
317 and generate_structs_h () =
318   generate_header CStyle LGPLv2plus;
319
320   (* This is a public exported header file containing various
321    * structures.  The structures are carefully written to have
322    * exactly the same in-memory format as the XDR structures that
323    * we use on the wire to the daemon.  The reason for creating
324    * copies of these structures here is just so we don't have to
325    * export the whole of guestfs_protocol.h (which includes much
326    * unrelated and XDR-dependent stuff that we don't want to be
327    * public, or required by clients).
328    *
329    * To reiterate, we will pass these structures to and from the
330    * client with a simple assignment or memcpy, so the format
331    * must be identical to what rpcgen / the RFC defines.
332    *)
333
334   (* Public structures. *)
335   List.iter (
336     fun (typ, cols) ->
337       pr "struct guestfs_%s {\n" typ;
338       List.iter (
339         function
340         | name, FChar -> pr "  char %s;\n" name
341         | name, FString -> pr "  char *%s;\n" name
342         | name, FBuffer ->
343             pr "  uint32_t %s_len;\n" name;
344             pr "  char *%s;\n" name
345         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
346         | name, FUInt32 -> pr "  uint32_t %s;\n" name
347         | name, FInt32 -> pr "  int32_t %s;\n" name
348         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
349         | name, FInt64 -> pr "  int64_t %s;\n" name
350         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
351       ) cols;
352       pr "};\n";
353       pr "\n";
354       pr "struct guestfs_%s_list {\n" typ;
355       pr "  uint32_t len;\n";
356       pr "  struct guestfs_%s *val;\n" typ;
357       pr "};\n";
358       pr "\n";
359       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
360       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
361       pr "\n"
362   ) structs
363
364 (* Generate the guestfs-actions.h file. *)
365 and generate_actions_h () =
366   generate_header CStyle LGPLv2plus;
367   List.iter (
368     fun (shortname, (ret, args, optargs as style), _, flags, _, _, _) ->
369       let deprecated =
370         List.exists (function DeprecatedBy _ -> true | _ -> false) flags in
371       let test0 =
372         String.length shortname >= 5 && String.sub shortname 0 5 = "test0" in
373       let debug =
374         String.length shortname >= 5 && String.sub shortname 0 5 = "debug" in
375       if not deprecated && not test0 && not debug then
376         pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
377
378       generate_prototype ~single_line:true ~newline:true ~handle:"g"
379         ~prefix:"guestfs_" shortname style;
380
381       if optargs <> [] then (
382         generate_prototype ~single_line:true ~newline:true ~handle:"g"
383           ~prefix:"guestfs_" ~suffix:"_va" ~optarg_proto:VA
384           shortname style;
385
386         pr "struct guestfs_%s_argv {\n" shortname;
387         pr "  uint64_t bitmask;\n";
388         iteri (
389           fun i argt ->
390             let c_type =
391               match argt with
392               | Bool n -> "int "
393               | Int n -> "int64_t "
394               | Int64 n -> "int "
395               | String n -> "const char *"
396               | _ -> assert false (* checked in generator_checks *) in
397             let uc_shortname = String.uppercase shortname in
398             let n = name_of_argt argt in
399             let uc_n = String.uppercase n in
400             pr "#define GUESTFS_%s_%s %d\n" uc_shortname uc_n i;
401             pr "#define GUESTFS_%s_%s_BITMASK (UINT64_C(1)<<%d)\n" uc_shortname uc_n i;
402             pr "/* The field below is only valid in this struct if the\n";
403             pr " * GUESTFS_%s_%s_BITMASK bit is set\n" uc_shortname uc_n;
404             pr " * in the bitmask above, otherwise the contents are ignored.\n";
405             pr " */\n";
406             pr "  %s%s;\n" c_type n
407         ) optargs;
408         pr "};\n";
409
410         generate_prototype ~single_line:true ~newline:true ~handle:"g"
411           ~prefix:"guestfs_" ~suffix:"_argv" ~optarg_proto:Argv
412           shortname style;
413       );
414   ) all_functions_sorted
415
416 (* Generate the guestfs-internal-actions.h file. *)
417 and generate_internal_actions_h () =
418   generate_header CStyle LGPLv2plus;
419   List.iter (
420     fun (shortname, style, _, _, _, _, _) ->
421       generate_prototype ~single_line:true ~newline:true ~handle:"g"
422         ~prefix:"guestfs__" ~optarg_proto:Argv
423         shortname style
424   ) non_daemon_functions
425
426 (* Generate the client-side dispatch stubs. *)
427 and generate_client_actions () =
428   generate_header CStyle LGPLv2plus;
429
430   pr "\
431 #include <stdio.h>
432 #include <stdlib.h>
433 #include <stdint.h>
434 #include <string.h>
435 #include <inttypes.h>
436
437 #include \"guestfs.h\"
438 #include \"guestfs-internal.h\"
439 #include \"guestfs-internal-actions.h\"
440 #include \"guestfs_protocol.h\"
441
442 /* Check the return message from a call for validity. */
443 static int
444 check_reply_header (guestfs_h *g,
445                     const struct guestfs_message_header *hdr,
446                     unsigned int proc_nr, unsigned int serial)
447 {
448   if (hdr->prog != GUESTFS_PROGRAM) {
449     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
450     return -1;
451   }
452   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
453     error (g, \"wrong protocol version (%%d/%%d)\",
454            hdr->vers, GUESTFS_PROTOCOL_VERSION);
455     return -1;
456   }
457   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
458     error (g, \"unexpected message direction (%%d/%%d)\",
459            hdr->direction, GUESTFS_DIRECTION_REPLY);
460     return -1;
461   }
462   if (hdr->proc != proc_nr) {
463     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
464     return -1;
465   }
466   if (hdr->serial != serial) {
467     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
468     return -1;
469   }
470
471   return 0;
472 }
473
474 /* Check we are in the right state to run a high-level action. */
475 static int
476 check_state (guestfs_h *g, const char *caller)
477 {
478   if (!guestfs__is_ready (g)) {
479     if (guestfs__is_config (g) || guestfs__is_launching (g))
480       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
481         caller);
482     else
483       error (g, \"%%s called from the wrong state, %%d != READY\",
484         caller, guestfs__get_state (g));
485     return -1;
486   }
487   return 0;
488 }
489
490 ";
491
492   let error_code_of = function
493     | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
494     | RConstString _ | RConstOptString _
495     | RString _ | RStringList _
496     | RStruct _ | RStructList _
497     | RHashtable _ | RBufferOut _ -> "NULL"
498   in
499
500   (* Generate code to check String-like parameters are not passed in
501    * as NULL (returning an error if they are).
502    *)
503   let check_null_strings shortname (ret, args, optargs) =
504     let pr_newline = ref false in
505     List.iter (
506       function
507       (* parameters which should not be NULL *)
508       | String n
509       | Device n
510       | Pathname n
511       | Dev_or_Path n
512       | FileIn n
513       | FileOut n
514       | BufferIn n
515       | StringList n
516       | DeviceList n
517       | Key n ->
518           pr "  if (%s == NULL) {\n" n;
519           pr "    error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
520           pr "           \"%s\", \"%s\");\n" shortname n;
521           pr "    return %s;\n" (error_code_of ret);
522           pr "  }\n";
523           pr_newline := true
524
525       (* can be NULL *)
526       | OptString _
527
528       (* not applicable *)
529       | Bool _
530       | Int _
531       | Int64 _ -> ()
532     ) args;
533
534     (* For optional arguments. *)
535     List.iter (
536       function
537       | String n ->
538           pr "  if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK) &&\n"
539             (String.uppercase shortname) (String.uppercase n);
540           pr "      optargs->%s == NULL) {\n" n;
541           pr "    error (g, \"%%s: %%s: optional parameter cannot be NULL\",\n";
542           pr "           \"%s\", \"%s\");\n" shortname n;
543           pr "    return %s;\n" (error_code_of ret);
544           pr "  }\n";
545           pr_newline := true
546
547       (* not applicable *)
548       | Bool _ | Int _ | Int64 _ -> ()
549
550       | _ -> assert false
551     ) optargs;
552
553     if !pr_newline then pr "\n";
554   in
555
556   (* Generate code to reject optargs we don't know about. *)
557   let reject_unknown_optargs shortname = function
558     | _, _, [] -> ()
559     | ret, _, optargs ->
560         let len = List.length optargs in
561         let mask = Int64.lognot (Int64.pred (Int64.shift_left 1L len)) in
562         pr "  if (optargs->bitmask & UINT64_C(0x%Lx)) {\n" mask;
563         pr "    error (g, \"%%s: unknown option in guestfs_%%s_argv->bitmask (this can happen if a program is compiled against a newer version of libguestfs, then dynamically linked to an older version)\",\n";
564         pr "           \"%s\", \"%s\");\n" shortname shortname;
565         pr "    return %s;\n" (error_code_of ret);
566         pr "  }\n";
567         pr "\n";
568   in
569
570   (* Generate code to generate guestfish call traces. *)
571   let trace_call shortname (ret, args, optargs) =
572     pr "  if (guestfs__get_trace (g)) {\n";
573
574     let needs_i =
575       List.exists (function
576                    | StringList _ | DeviceList _ -> true
577                    | _ -> false) args in
578     if needs_i then (
579       pr "    size_t i;\n";
580       pr "\n"
581     );
582
583     pr "    fprintf (stderr, \"%s\");\n" shortname;
584
585     (* Required arguments. *)
586     List.iter (
587       function
588       | String n                        (* strings *)
589       | Device n
590       | Pathname n
591       | Dev_or_Path n
592       | FileIn n
593       | FileOut n
594       | Key n ->
595           (* guestfish doesn't support string escaping, so neither do we *)
596           pr "    fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n
597       | OptString n ->                  (* string option *)
598           pr "    if (%s) fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n n;
599           pr "    else fprintf (stderr, \" null\");\n"
600       | StringList n
601       | DeviceList n ->                 (* string list *)
602           pr "    fputc (' ', stderr);\n";
603           pr "    fputc ('\"', stderr);\n";
604           pr "    for (i = 0; %s[i]; ++i) {\n" n;
605           pr "      if (i > 0) fputc (' ', stderr);\n";
606           pr "      fputs (%s[i], stderr);\n" n;
607           pr "    }\n";
608           pr "    fputc ('\"', stderr);\n";
609       | Bool n ->                       (* boolean *)
610           pr "    fputs (%s ? \" true\" : \" false\", stderr);\n" n
611       | Int n ->                        (* int *)
612           pr "    fprintf (stderr, \" %%d\", %s);\n" n
613       | Int64 n ->
614           pr "    fprintf (stderr, \" %%\" PRIi64, %s);\n" n
615       | BufferIn n ->                   (* RHBZ#646822 *)
616           pr "    fputc (' ', stderr);\n";
617           pr "    guestfs___print_BufferIn (stderr, %s, %s_size);\n" n n
618     ) args;
619
620     (* Optional arguments. *)
621     List.iter (
622       fun argt ->
623         let n = name_of_argt argt in
624         let uc_shortname = String.uppercase shortname in
625         let uc_n = String.uppercase n in
626         pr "    if (optargs->bitmask & GUESTFS_%s_%s_BITMASK)\n"
627           uc_shortname uc_n;
628         (match argt with
629          | String n ->
630              pr "      fprintf (stderr, \" \\\"%%s:%%s\\\"\", \"%s\", optargs->%s);\n" n n
631          | Bool n ->
632              pr "      fprintf (stderr, \" \\\"%%s:%%s\\\"\", \"%s\", optargs->%s ? \"true\" : \"false\");\n" n n
633          | Int n ->
634              pr "      fprintf (stderr, \" \\\"%%s:%%d\\\"\", \"%s\", optargs->%s);\n" n n
635          | Int64 n ->
636              pr "      fprintf (stderr, \" \\\"%%s:%%\" PRIi64 \"\\\"\", \"%s\", optargs->%s);\n" n n
637          | _ -> assert false
638         );
639     ) optargs;
640
641     pr "    fputc ('\\n', stderr);\n";
642     pr "  }\n";
643     pr "\n";
644   in
645
646   (* For non-daemon functions, generate a wrapper around each function. *)
647   List.iter (
648     fun (shortname, (_, _, optargs as style), _, _, _, _, _) ->
649       if optargs = [] then
650         generate_prototype ~extern:false ~semicolon:false ~newline:true
651           ~handle:"g" ~prefix:"guestfs_"
652           shortname style
653       else
654         generate_prototype ~extern:false ~semicolon:false ~newline:true
655           ~handle:"g" ~prefix:"guestfs_" ~suffix:"_argv" ~optarg_proto:Argv
656           shortname style;
657       pr "{\n";
658       check_null_strings shortname style;
659       reject_unknown_optargs shortname style;
660       trace_call shortname style;
661       pr "  return guestfs__%s " shortname;
662       generate_c_call_args ~handle:"g" style;
663       pr ";\n";
664       pr "}\n";
665       pr "\n"
666   ) non_daemon_functions;
667
668   (* Client-side stubs for each function. *)
669   List.iter (
670     fun (shortname, (ret, args, optargs as style), _, _, _, _, _) ->
671       if optargs <> [] then
672         failwithf "optargs not yet implemented for daemon functions";
673
674       let name = "guestfs_" ^ shortname in
675       let error_code = error_code_of ret in
676
677       (* Generate the action stub. *)
678       if optargs = [] then
679         generate_prototype ~extern:false ~semicolon:false ~newline:true
680           ~handle:"g" name style
681       else
682         generate_prototype ~extern:false ~semicolon:false ~newline:true
683           ~handle:"g" ~suffix:"_argv" ~optarg_proto:Argv name style;
684
685       pr "{\n";
686
687       (match args with
688        | [] -> ()
689        | _ -> pr "  struct %s_args args;\n" name
690       );
691
692       pr "  guestfs_message_header hdr;\n";
693       pr "  guestfs_message_error err;\n";
694       let has_ret =
695         match ret with
696         | RErr -> false
697         | RConstString _ | RConstOptString _ ->
698             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
699         | RInt _ | RInt64 _
700         | RBool _ | RString _ | RStringList _
701         | RStruct _ | RStructList _
702         | RHashtable _ | RBufferOut _ ->
703             pr "  struct %s_ret ret;\n" name;
704             true in
705
706       pr "  int serial;\n";
707       pr "  int r;\n";
708       pr "\n";
709       check_null_strings shortname style;
710       reject_unknown_optargs shortname style;
711       trace_call shortname style;
712       pr "  if (check_state (g, \"%s\") == -1) return %s;\n"
713         shortname error_code;
714       pr "  guestfs___set_busy (g);\n";
715       pr "\n";
716
717       (* Send the main header and arguments. *)
718       (match args with
719        | [] ->
720            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
721              (String.uppercase shortname)
722        | args ->
723            List.iter (
724              function
725              | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
726                  pr "  args.%s = (char *) %s;\n" n n
727              | OptString n ->
728                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
729              | StringList n | DeviceList n ->
730                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
731                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
732              | Bool n ->
733                  pr "  args.%s = %s;\n" n n
734              | Int n ->
735                  pr "  args.%s = %s;\n" n n
736              | Int64 n ->
737                  pr "  args.%s = %s;\n" n n
738              | FileIn _ | FileOut _ -> ()
739              | BufferIn n ->
740                  pr "  /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
741                  pr "  if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
742                  pr "    error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
743                    shortname;
744                  pr "    guestfs___end_busy (g);\n";
745                  pr "    return %s;\n" error_code;
746                  pr "  }\n";
747                  pr "  args.%s.%s_val = (char *) %s;\n" n n n;
748                  pr "  args.%s.%s_len = %s_size;\n" n n n
749            ) args;
750            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
751              (String.uppercase shortname);
752            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
753              name;
754       );
755       pr "  if (serial == -1) {\n";
756       pr "    guestfs___end_busy (g);\n";
757       pr "    return %s;\n" error_code;
758       pr "  }\n";
759       pr "\n";
760
761       (* Send any additional files (FileIn) requested. *)
762       let need_read_reply_label = ref false in
763       List.iter (
764         function
765         | FileIn n ->
766             pr "  r = guestfs___send_file (g, %s);\n" n;
767             pr "  if (r == -1) {\n";
768             pr "    guestfs___end_busy (g);\n";
769             pr "    return %s;\n" error_code;
770             pr "  }\n";
771             pr "  if (r == -2) /* daemon cancelled */\n";
772             pr "    goto read_reply;\n";
773             need_read_reply_label := true;
774             pr "\n";
775         | _ -> ()
776       ) args;
777
778       (* Wait for the reply from the remote end. *)
779       if !need_read_reply_label then pr " read_reply:\n";
780       pr "  memset (&hdr, 0, sizeof hdr);\n";
781       pr "  memset (&err, 0, sizeof err);\n";
782       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
783       pr "\n";
784       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
785       if not has_ret then
786         pr "NULL, NULL"
787       else
788         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
789       pr ");\n";
790
791       pr "  if (r == -1) {\n";
792       pr "    guestfs___end_busy (g);\n";
793       pr "    return %s;\n" error_code;
794       pr "  }\n";
795       pr "\n";
796
797       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
798         (String.uppercase shortname);
799       pr "    guestfs___end_busy (g);\n";
800       pr "    return %s;\n" error_code;
801       pr "  }\n";
802       pr "\n";
803
804       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
805       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
806       pr "    free (err.error_message);\n";
807       pr "    guestfs___end_busy (g);\n";
808       pr "    return %s;\n" error_code;
809       pr "  }\n";
810       pr "\n";
811
812       (* Expecting to receive further files (FileOut)? *)
813       List.iter (
814         function
815         | FileOut n ->
816             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
817             pr "    guestfs___end_busy (g);\n";
818             pr "    return %s;\n" error_code;
819             pr "  }\n";
820             pr "\n";
821         | _ -> ()
822       ) args;
823
824       pr "  guestfs___end_busy (g);\n";
825
826       (match ret with
827        | RErr -> pr "  return 0;\n"
828        | RInt n | RInt64 n | RBool n ->
829            pr "  return ret.%s;\n" n
830        | RConstString _ | RConstOptString _ ->
831            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
832        | RString n ->
833            pr "  return ret.%s; /* caller will free */\n" n
834        | RStringList n | RHashtable n ->
835            pr "  /* caller will free this, but we need to add a NULL entry */\n";
836            pr "  ret.%s.%s_val =\n" n n;
837            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
838            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
839              n n;
840            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
841            pr "  return ret.%s.%s_val;\n" n n
842        | RStruct (n, _) ->
843            pr "  /* caller will free this */\n";
844            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
845        | RStructList (n, _) ->
846            pr "  /* caller will free this */\n";
847            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
848        | RBufferOut n ->
849            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
850            pr "   * _val might be NULL here.  To make the API saner for\n";
851            pr "   * callers, we turn this case into a unique pointer (using\n";
852            pr "   * malloc(1)).\n";
853            pr "   */\n";
854            pr "  if (ret.%s.%s_len > 0) {\n" n n;
855            pr "    *size_r = ret.%s.%s_len;\n" n n;
856            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
857            pr "  } else {\n";
858            pr "    free (ret.%s.%s_val);\n" n n;
859            pr "    char *p = safe_malloc (g, 1);\n";
860            pr "    *size_r = ret.%s.%s_len;\n" n n;
861            pr "    return p;\n";
862            pr "  }\n";
863       );
864
865       pr "}\n\n"
866   ) daemon_functions;
867
868   (* Functions to free structures. *)
869   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
870   pr " * structure format is identical to the XDR format.  See note in\n";
871   pr " * generator.ml.\n";
872   pr " */\n";
873   pr "\n";
874
875   List.iter (
876     fun (typ, _) ->
877       pr "void\n";
878       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
879       pr "{\n";
880       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
881       pr "  free (x);\n";
882       pr "}\n";
883       pr "\n";
884
885       pr "void\n";
886       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
887       pr "{\n";
888       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
889       pr "  free (x);\n";
890       pr "}\n";
891       pr "\n";
892
893   ) structs;
894
895   (* Functions which have optional arguments have two generated variants. *)
896   List.iter (
897     function
898     | shortname, (ret, args, (_::_ as optargs) as style), _, _, _, _, _ ->
899         let uc_shortname = String.uppercase shortname in
900
901         (* Get the name of the last regular argument. *)
902         let last_arg =
903           match args with
904           | [] -> "g"
905           | args -> name_of_argt (List.hd (List.rev args)) in
906
907         let rerrcode, rtype =
908           match ret with
909           | RErr | RInt _ | RBool _ -> "-1", "int "
910           | RInt64 _ -> "-1", "int64_t "
911           | RConstString _ | RConstOptString _ -> "NULL", "const char *"
912           | RString _ | RBufferOut _ -> "NULL", "char *"
913           | RStringList _ | RHashtable _ -> "NULL", "char **"
914           | RStruct (_, typ) -> "NULL", sprintf "struct guestfs_%s *" typ
915           | RStructList (_, typ) ->
916               "NULL", sprintf "struct guestfs_%s_list *" typ in
917
918         (* The regular variable args function, just calls the _va variant. *)
919         generate_prototype ~extern:false ~semicolon:false ~newline:true
920           ~handle:"g" ~prefix:"guestfs_" shortname style;
921         pr "{\n";
922         pr "  va_list optargs;\n";
923         pr "\n";
924         pr "  va_start (optargs, %s);\n" last_arg;
925         pr "  %sr = guestfs_%s_va " rtype shortname;
926         generate_c_call_args ~handle:"g" style;
927         pr ";\n";
928         pr "  va_end (optargs);\n";
929         pr "\n";
930         pr "  return r;\n";
931         pr "}\n\n";
932
933         generate_prototype ~extern:false ~semicolon:false ~newline:true
934           ~handle:"g" ~prefix:"guestfs_" ~suffix:"_va" ~optarg_proto:VA
935           shortname style;
936         pr "{\n";
937         pr "  struct guestfs_%s_argv optargs_s;\n" shortname;
938         pr "  struct guestfs_%s_argv *optargs = &optargs_s;\n" shortname;
939         pr "  int i;\n";
940         pr "\n";
941         pr "  optargs_s.bitmask = 0;\n";
942         pr "\n";
943         pr "  while ((i = va_arg (args, int)) >= 0) {\n";
944         pr "    switch (i) {\n";
945
946         List.iter (
947           fun argt ->
948             let n = name_of_argt argt in
949             let uc_n = String.uppercase n in
950             pr "    case GUESTFS_%s_%s:\n" uc_shortname uc_n;
951             pr "      optargs_s.%s = va_arg (args, " n;
952             (match argt with
953              | Bool _ | Int _ -> pr "int"
954              | Int64 _ -> pr "int64_t"
955              | String _ -> pr "const char *"
956              | _ -> assert false
957             );
958             pr ");\n";
959             pr "      break;\n";
960         ) optargs;
961
962         pr "    default:\n";
963         pr "      error (g, \"%%s: unknown option %%d (this can happen if a program is compiled against a newer version of libguestfs, then dynamically linked to an older version)\",\n";
964         pr "             \"%s\", i);\n" shortname;
965         pr "      return %s;\n" rerrcode;
966         pr "    }\n";
967         pr "\n";
968         pr "    uint64_t i_mask = UINT64_C(1) << i;\n";
969         pr "    if (optargs_s.bitmask & i_mask) {\n";
970         pr "      error (g, \"%%s: same optional argument specified more than once\",\n";
971         pr "             \"%s\");\n" shortname;
972         pr "      return %s;\n" rerrcode;
973         pr "    }\n";
974         pr "    optargs_s.bitmask |= i_mask;\n";
975         pr "  }\n";
976         pr "\n";
977         pr "  return guestfs_%s_argv " shortname;
978         generate_c_call_args ~handle:"g" style;
979         pr ";\n";
980         pr "}\n\n"
981     | _ -> ()
982   ) all_functions_sorted
983
984 (* Generate the linker script which controls the visibility of
985  * symbols in the public ABI and ensures no other symbols get
986  * exported accidentally.
987  *)
988 and generate_linker_script () =
989   generate_header HashStyle GPLv2plus;
990
991   let globals = [
992     "guestfs_create";
993     "guestfs_close";
994     "guestfs_get_error_handler";
995     "guestfs_get_out_of_memory_handler";
996     "guestfs_get_private";
997     "guestfs_last_error";
998     "guestfs_set_close_callback";
999     "guestfs_set_error_handler";
1000     "guestfs_set_launch_done_callback";
1001     "guestfs_set_log_message_callback";
1002     "guestfs_set_out_of_memory_handler";
1003     "guestfs_set_private";
1004     "guestfs_set_progress_callback";
1005     "guestfs_set_subprocess_quit_callback";
1006
1007     (* Unofficial parts of the API: the bindings code use these
1008      * functions, so it is useful to export them.
1009      *)
1010     "guestfs_safe_calloc";
1011     "guestfs_safe_malloc";
1012     "guestfs_safe_strdup";
1013     "guestfs_safe_memdup";
1014     "guestfs_tmpdir";
1015   ] in
1016   let functions =
1017     List.flatten (
1018       List.map (
1019         function
1020         | name, (_, _, []), _, _, _, _, _ -> ["guestfs_" ^ name]
1021         | name, (_, _, _), _, _, _, _, _ ->
1022             ["guestfs_" ^ name;
1023              "guestfs_" ^ name ^ "_va";
1024              "guestfs_" ^ name ^ "_argv"]
1025       ) all_functions
1026     ) in
1027   let structs =
1028     List.concat (
1029       List.map (fun (typ, _) ->
1030                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
1031         structs
1032     ) in
1033   let globals = List.sort compare (globals @ functions @ structs) in
1034
1035   pr "{\n";
1036   pr "    global:\n";
1037   List.iter (pr "        %s;\n") globals;
1038   pr "\n";
1039
1040   pr "    local:\n";
1041   pr "        *;\n";
1042   pr "};\n"
1043
1044 and generate_max_proc_nr () =
1045   pr "%d\n" max_proc_nr