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 #include \"errnostring.h\"
 442
 443 /* Check the return message from a call for validity. */
 444 static int
 445 check_reply_header (guestfs_h *g,
 446                     const struct guestfs_message_header *hdr,
 447                     unsigned int proc_nr, unsigned int serial)
 448 {
 449   if (hdr->prog != GUESTFS_PROGRAM) {
 450     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
 451     return -1;
 452   }
 453   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
 454     error (g, \"wrong protocol version (%%d/%%d)\",
 455            hdr->vers, GUESTFS_PROTOCOL_VERSION);
 456     return -1;
 457   }
 458   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
 459     error (g, \"unexpected message direction (%%d/%%d)\",
 460            hdr->direction, GUESTFS_DIRECTION_REPLY);
 461     return -1;
 462   }
 463   if (hdr->proc != proc_nr) {
 464     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
 465     return -1;
 466   }
 467   if (hdr->serial != serial) {
 468     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
 469     return -1;
 470   }
 471
 472   return 0;
 473 }
 474
 475 /* Check we are in the right state to run a high-level action. */
 476 static int
 477 check_state (guestfs_h *g, const char *caller)
 478 {
 479   if (!guestfs__is_ready (g)) {
 480     if (guestfs__is_config (g) || guestfs__is_launching (g))
 481       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
 482         caller);
 483     else
 484       error (g, \"%%s called from the wrong state, %%d != READY\",
 485         caller, guestfs__get_state (g));
 486     return -1;
 487   }
 488   return 0;
 489 }
 490
 491 ";
 492
 493   let error_code_of = function
 494     | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
 495     | RConstString _ | RConstOptString _
 496     | RString _ | RStringList _
 497     | RStruct _ | RStructList _
 498     | RHashtable _ | RBufferOut _ -> "NULL"
 499   in
 500
 501   (* Generate code to check String-like parameters are not passed in
 502    * as NULL (returning an error if they are).
 503    *)
 504   let check_null_strings shortname (ret, args, optargs) =
 505     let pr_newline = ref false in
 506     List.iter (
 507       function
 508       (* parameters which should not be NULL *)
 509       | String n
 510       | Device n
 511       | Pathname n
 512       | Dev_or_Path n
 513       | FileIn n
 514       | FileOut n
 515       | BufferIn n
 516       | StringList n
 517       | DeviceList n
 518       | Key n ->
 519           pr "  if (%s == NULL) {\n" n;
 520           pr "    error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
 521           pr "           \"%s\", \"%s\");\n" shortname n;
 522           pr "    return %s;\n" (error_code_of ret);
 523           pr "  }\n";
 524           pr_newline := true
 525
 526       (* can be NULL *)
 527       | OptString _
 528
 529       (* not applicable *)
 530       | Bool _
 531       | Int _
 532       | Int64 _ -> ()
 533     ) args;
 534
 535     (* For optional arguments. *)
 536     List.iter (
 537       function
 538       | String n ->
 539           pr "  if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK) &&\n"
 540             (String.uppercase shortname) (String.uppercase n);
 541           pr "      optargs->%s == NULL) {\n" n;
 542           pr "    error (g, \"%%s: %%s: optional parameter cannot be NULL\",\n";
 543           pr "           \"%s\", \"%s\");\n" shortname n;
 544           pr "    return %s;\n" (error_code_of ret);
 545           pr "  }\n";
 546           pr_newline := true
 547
 548       (* not applicable *)
 549       | Bool _ | Int _ | Int64 _ -> ()
 550
 551       | _ -> assert false
 552     ) optargs;
 553
 554     if !pr_newline then pr "\n";
 555   in
 556
 557   (* Generate code to reject optargs we don't know about. *)
 558   let reject_unknown_optargs shortname = function
 559     | _, _, [] -> ()
 560     | ret, _, optargs ->
 561         let len = List.length optargs in
 562         let mask = Int64.lognot (Int64.pred (Int64.shift_left 1L len)) in
 563         pr "  if (optargs->bitmask & UINT64_C(0x%Lx)) {\n" mask;
 564         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";
 565         pr "           \"%s\", \"%s\");\n" shortname shortname;
 566         pr "    return %s;\n" (error_code_of ret);
 567         pr "  }\n";
 568         pr "\n";
 569   in
 570
 571   (* Generate code to generate guestfish call traces. *)
 572   let trace_call shortname (ret, args, optargs) =
 573     pr "  if (guestfs__get_trace (g)) {\n";
 574
 575     let needs_i =
 576       List.exists (function
 577                    | StringList _ | DeviceList _ -> true
 578                    | _ -> false) args in
 579     if needs_i then (
 580       pr "    size_t i;\n";
 581       pr "\n"
 582     );
 583
 584     pr "    fprintf (stderr, \"%s\");\n" shortname;
 585
 586     (* Required arguments. *)
 587     List.iter (
 588       function
 589       | String n                        (* strings *)
 590       | Device n
 591       | Pathname n
 592       | Dev_or_Path n
 593       | FileIn n
 594       | FileOut n
 595       | Key n ->
 596           (* guestfish doesn't support string escaping, so neither do we *)
 597           pr "    fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n
 598       | OptString n ->                  (* string option *)
 599           pr "    if (%s) fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n n;
 600           pr "    else fprintf (stderr, \" null\");\n"
 601       | StringList n
 602       | DeviceList n ->                 (* string list *)
 603           pr "    fputc (' ', stderr);\n";
 604           pr "    fputc ('\"', stderr);\n";
 605           pr "    for (i = 0; %s[i]; ++i) {\n" n;
 606           pr "      if (i > 0) fputc (' ', stderr);\n";
 607           pr "      fputs (%s[i], stderr);\n" n;
 608           pr "    }\n";
 609           pr "    fputc ('\"', stderr);\n";
 610       | Bool n ->                       (* boolean *)
 611           pr "    fputs (%s ? \" true\" : \" false\", stderr);\n" n
 612       | Int n ->                        (* int *)
 613           pr "    fprintf (stderr, \" %%d\", %s);\n" n
 614       | Int64 n ->
 615           pr "    fprintf (stderr, \" %%\" PRIi64, %s);\n" n
 616       | BufferIn n ->                   (* RHBZ#646822 *)
 617           pr "    fputc (' ', stderr);\n";
 618           pr "    guestfs___print_BufferIn (stderr, %s, %s_size);\n" n n
 619     ) args;
 620
 621     (* Optional arguments. *)
 622     List.iter (
 623       fun argt ->
 624         let n = name_of_argt argt in
 625         let uc_shortname = String.uppercase shortname in
 626         let uc_n = String.uppercase n in
 627         pr "    if (optargs->bitmask & GUESTFS_%s_%s_BITMASK)\n"
 628           uc_shortname uc_n;
 629         (match argt with
 630          | String n ->
 631              pr "      fprintf (stderr, \" \\\"%%s:%%s\\\"\", \"%s\", optargs->%s);\n" n n
 632          | Bool n ->
 633              pr "      fprintf (stderr, \" \\\"%%s:%%s\\\"\", \"%s\", optargs->%s ? \"true\" : \"false\");\n" n n
 634          | Int n ->
 635              pr "      fprintf (stderr, \" \\\"%%s:%%d\\\"\", \"%s\", optargs->%s);\n" n n
 636          | Int64 n ->
 637              pr "      fprintf (stderr, \" \\\"%%s:%%\" PRIi64 \"\\\"\", \"%s\", optargs->%s);\n" n n
 638          | _ -> assert false
 639         );
 640     ) optargs;
 641
 642     pr "    fputc ('\\n', stderr);\n";
 643     pr "  }\n";
 644     pr "\n";
 645   in
 646
 647   (* For non-daemon functions, generate a wrapper around each function. *)
 648   List.iter (
 649     fun (shortname, (_, _, optargs as style), _, _, _, _, _) ->
 650       if optargs = [] then
 651         generate_prototype ~extern:false ~semicolon:false ~newline:true
 652           ~handle:"g" ~prefix:"guestfs_"
 653           shortname style
 654       else
 655         generate_prototype ~extern:false ~semicolon:false ~newline:true
 656           ~handle:"g" ~prefix:"guestfs_" ~suffix:"_argv" ~optarg_proto:Argv
 657           shortname style;
 658       pr "{\n";
 659       check_null_strings shortname style;
 660       reject_unknown_optargs shortname style;
 661       trace_call shortname style;
 662       pr "  return guestfs__%s " shortname;
 663       generate_c_call_args ~handle:"g" style;
 664       pr ";\n";
 665       pr "}\n";
 666       pr "\n"
 667   ) non_daemon_functions;
 668
 669   (* Client-side stubs for each function. *)
 670   List.iter (
 671     fun (shortname, (ret, args, optargs as style), _, _, _, _, _) ->
 672       if optargs <> [] then
 673         failwithf "optargs not yet implemented for daemon functions";
 674
 675       let name = "guestfs_" ^ shortname in
 676       let error_code = error_code_of ret in
 677
 678       (* Generate the action stub. *)
 679       if optargs = [] then
 680         generate_prototype ~extern:false ~semicolon:false ~newline:true
 681           ~handle:"g" name style
 682       else
 683         generate_prototype ~extern:false ~semicolon:false ~newline:true
 684           ~handle:"g" ~suffix:"_argv" ~optarg_proto:Argv name style;
 685
 686       pr "{\n";
 687
 688       (match args with
 689        | [] -> ()
 690        | _ -> pr "  struct %s_args args;\n" name
 691       );
 692
 693       pr "  guestfs_message_header hdr;\n";
 694       pr "  guestfs_message_error err;\n";
 695       let has_ret =
 696         match ret with
 697         | RErr -> false
 698         | RConstString _ | RConstOptString _ ->
 699             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
 700         | RInt _ | RInt64 _
 701         | RBool _ | RString _ | RStringList _
 702         | RStruct _ | RStructList _
 703         | RHashtable _ | RBufferOut _ ->
 704             pr "  struct %s_ret ret;\n" name;
 705             true in
 706
 707       pr "  int serial;\n";
 708       pr "  int r;\n";
 709       pr "\n";
 710       check_null_strings shortname style;
 711       reject_unknown_optargs shortname style;
 712       trace_call shortname style;
 713       pr "  if (check_state (g, \"%s\") == -1) return %s;\n"
 714         shortname error_code;
 715       pr "  guestfs___set_busy (g);\n";
 716       pr "\n";
 717
 718       (* Send the main header and arguments. *)
 719       (match args with
 720        | [] ->
 721            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
 722              (String.uppercase shortname)
 723        | args ->
 724            List.iter (
 725              function
 726              | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
 727                  pr "  args.%s = (char *) %s;\n" n n
 728              | OptString n ->
 729                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
 730              | StringList n | DeviceList n ->
 731                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
 732                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
 733              | Bool n ->
 734                  pr "  args.%s = %s;\n" n n
 735              | Int n ->
 736                  pr "  args.%s = %s;\n" n n
 737              | Int64 n ->
 738                  pr "  args.%s = %s;\n" n n
 739              | FileIn _ | FileOut _ -> ()
 740              | BufferIn n ->
 741                  pr "  /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
 742                  pr "  if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
 743                  pr "    error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
 744                    shortname;
 745                  pr "    guestfs___end_busy (g);\n";
 746                  pr "    return %s;\n" error_code;
 747                  pr "  }\n";
 748                  pr "  args.%s.%s_val = (char *) %s;\n" n n n;
 749                  pr "  args.%s.%s_len = %s_size;\n" n n n
 750            ) args;
 751            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
 752              (String.uppercase shortname);
 753            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
 754              name;
 755       );
 756       pr "  if (serial == -1) {\n";
 757       pr "    guestfs___end_busy (g);\n";
 758       pr "    return %s;\n" error_code;
 759       pr "  }\n";
 760       pr "\n";
 761
 762       (* Send any additional files (FileIn) requested. *)
 763       let need_read_reply_label = ref false in
 764       List.iter (
 765         function
 766         | FileIn n ->
 767             pr "  r = guestfs___send_file (g, %s);\n" n;
 768             pr "  if (r == -1) {\n";
 769             pr "    guestfs___end_busy (g);\n";
 770             pr "    return %s;\n" error_code;
 771             pr "  }\n";
 772             pr "  if (r == -2) /* daemon cancelled */\n";
 773             pr "    goto read_reply;\n";
 774             need_read_reply_label := true;
 775             pr "\n";
 776         | _ -> ()
 777       ) args;
 778
 779       (* Wait for the reply from the remote end. *)
 780       if !need_read_reply_label then pr " read_reply:\n";
 781       pr "  memset (&hdr, 0, sizeof hdr);\n";
 782       pr "  memset (&err, 0, sizeof err);\n";
 783       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
 784       pr "\n";
 785       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
 786       if not has_ret then
 787         pr "NULL, NULL"
 788       else
 789         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
 790       pr ");\n";
 791
 792       pr "  if (r == -1) {\n";
 793       pr "    guestfs___end_busy (g);\n";
 794       pr "    return %s;\n" error_code;
 795       pr "  }\n";
 796       pr "\n";
 797
 798       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
 799         (String.uppercase shortname);
 800       pr "    guestfs___end_busy (g);\n";
 801       pr "    return %s;\n" error_code;
 802       pr "  }\n";
 803       pr "\n";
 804
 805       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
 806       pr "    int errnum = 0;\n";
 807       pr "    if (err.errno_string[0] != '\\0')\n";
 808       pr "      errnum = guestfs___string_to_errno (err.errno_string);\n";
 809       pr "    if (errnum <= 0)\n";
 810       pr "      error (g, \"%%s: %%s\", \"%s\", err.error_message);\n"
 811         shortname;
 812       pr "    else\n";
 813       pr "      guestfs_error_errno (g, errnum, \"%%s: %%s\", \"%s\",\n"
 814         shortname;
 815       pr "                           err.error_message);\n";
 816       pr "    free (err.error_message);\n";
 817       pr "    free (err.errno_string);\n";
 818       pr "    guestfs___end_busy (g);\n";
 819       pr "    return %s;\n" error_code;
 820       pr "  }\n";
 821       pr "\n";
 822
 823       (* Expecting to receive further files (FileOut)? *)
 824       List.iter (
 825         function
 826         | FileOut n ->
 827             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
 828             pr "    guestfs___end_busy (g);\n";
 829             pr "    return %s;\n" error_code;
 830             pr "  }\n";
 831             pr "\n";
 832         | _ -> ()
 833       ) args;
 834
 835       pr "  guestfs___end_busy (g);\n";
 836
 837       (match ret with
 838        | RErr -> pr "  return 0;\n"
 839        | RInt n | RInt64 n | RBool n ->
 840            pr "  return ret.%s;\n" n
 841        | RConstString _ | RConstOptString _ ->
 842            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
 843        | RString n ->
 844            pr "  return ret.%s; /* caller will free */\n" n
 845        | RStringList n | RHashtable n ->
 846            pr "  /* caller will free this, but we need to add a NULL entry */\n";
 847            pr "  ret.%s.%s_val =\n" n n;
 848            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
 849            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
 850              n n;
 851            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
 852            pr "  return ret.%s.%s_val;\n" n n
 853        | RStruct (n, _) ->
 854            pr "  /* caller will free this */\n";
 855            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
 856        | RStructList (n, _) ->
 857            pr "  /* caller will free this */\n";
 858            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
 859        | RBufferOut n ->
 860            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
 861            pr "   * _val might be NULL here.  To make the API saner for\n";
 862            pr "   * callers, we turn this case into a unique pointer (using\n";
 863            pr "   * malloc(1)).\n";
 864            pr "   */\n";
 865            pr "  if (ret.%s.%s_len > 0) {\n" n n;
 866            pr "    *size_r = ret.%s.%s_len;\n" n n;
 867            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
 868            pr "  } else {\n";
 869            pr "    free (ret.%s.%s_val);\n" n n;
 870            pr "    char *p = safe_malloc (g, 1);\n";
 871            pr "    *size_r = ret.%s.%s_len;\n" n n;
 872            pr "    return p;\n";
 873            pr "  }\n";
 874       );
 875
 876       pr "}\n\n"
 877   ) daemon_functions;
 878
 879   (* Functions to free structures. *)
 880   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
 881   pr " * structure format is identical to the XDR format.  See note in\n";
 882   pr " * generator.ml.\n";
 883   pr " */\n";
 884   pr "\n";
 885
 886   List.iter (
 887     fun (typ, _) ->
 888       pr "void\n";
 889       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
 890       pr "{\n";
 891       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
 892       pr "  free (x);\n";
 893       pr "}\n";
 894       pr "\n";
 895
 896       pr "void\n";
 897       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
 898       pr "{\n";
 899       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
 900       pr "  free (x);\n";
 901       pr "}\n";
 902       pr "\n";
 903
 904   ) structs;
 905
 906   (* Functions which have optional arguments have two generated variants. *)
 907   List.iter (
 908     function
 909     | shortname, (ret, args, (_::_ as optargs) as style), _, _, _, _, _ ->
 910         let uc_shortname = String.uppercase shortname in
 911
 912         (* Get the name of the last regular argument. *)
 913         let last_arg =
 914           match args with
 915           | [] -> "g"
 916           | args -> name_of_argt (List.hd (List.rev args)) in
 917
 918         let rerrcode, rtype =
 919           match ret with
 920           | RErr | RInt _ | RBool _ -> "-1", "int "
 921           | RInt64 _ -> "-1", "int64_t "
 922           | RConstString _ | RConstOptString _ -> "NULL", "const char *"
 923           | RString _ | RBufferOut _ -> "NULL", "char *"
 924           | RStringList _ | RHashtable _ -> "NULL", "char **"
 925           | RStruct (_, typ) -> "NULL", sprintf "struct guestfs_%s *" typ
 926           | RStructList (_, typ) ->
 927               "NULL", sprintf "struct guestfs_%s_list *" typ in
 928
 929         (* The regular variable args function, just calls the _va variant. *)
 930         generate_prototype ~extern:false ~semicolon:false ~newline:true
 931           ~handle:"g" ~prefix:"guestfs_" shortname style;
 932         pr "{\n";
 933         pr "  va_list optargs;\n";
 934         pr "\n";
 935         pr "  va_start (optargs, %s);\n" last_arg;
 936         pr "  %sr = guestfs_%s_va " rtype shortname;
 937         generate_c_call_args ~handle:"g" style;
 938         pr ";\n";
 939         pr "  va_end (optargs);\n";
 940         pr "\n";
 941         pr "  return r;\n";
 942         pr "}\n\n";
 943
 944         generate_prototype ~extern:false ~semicolon:false ~newline:true
 945           ~handle:"g" ~prefix:"guestfs_" ~suffix:"_va" ~optarg_proto:VA
 946           shortname style;
 947         pr "{\n";
 948         pr "  struct guestfs_%s_argv optargs_s;\n" shortname;
 949         pr "  struct guestfs_%s_argv *optargs = &optargs_s;\n" shortname;
 950         pr "  int i;\n";
 951         pr "\n";
 952         pr "  optargs_s.bitmask = 0;\n";
 953         pr "\n";
 954         pr "  while ((i = va_arg (args, int)) >= 0) {\n";
 955         pr "    switch (i) {\n";
 956
 957         List.iter (
 958           fun argt ->
 959             let n = name_of_argt argt in
 960             let uc_n = String.uppercase n in
 961             pr "    case GUESTFS_%s_%s:\n" uc_shortname uc_n;
 962             pr "      optargs_s.%s = va_arg (args, " n;
 963             (match argt with
 964              | Bool _ | Int _ -> pr "int"
 965              | Int64 _ -> pr "int64_t"
 966              | String _ -> pr "const char *"
 967              | _ -> assert false
 968             );
 969             pr ");\n";
 970             pr "      break;\n";
 971         ) optargs;
 972
 973         pr "    default:\n";
 974         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";
 975         pr "             \"%s\", i);\n" shortname;
 976         pr "      return %s;\n" rerrcode;
 977         pr "    }\n";
 978         pr "\n";
 979         pr "    uint64_t i_mask = UINT64_C(1) << i;\n";
 980         pr "    if (optargs_s.bitmask & i_mask) {\n";
 981         pr "      error (g, \"%%s: same optional argument specified more than once\",\n";
 982         pr "             \"%s\");\n" shortname;
 983         pr "      return %s;\n" rerrcode;
 984         pr "    }\n";
 985         pr "    optargs_s.bitmask |= i_mask;\n";
 986         pr "  }\n";
 987         pr "\n";
 988         pr "  return guestfs_%s_argv " shortname;
 989         generate_c_call_args ~handle:"g" style;
 990         pr ";\n";
 991         pr "}\n\n"
 992     | _ -> ()
 993   ) all_functions_sorted
 994
 995 (* Generate the linker script which controls the visibility of
 996  * symbols in the public ABI and ensures no other symbols get
 997  * exported accidentally.
 998  *)
 999 and generate_linker_script () =
1000   generate_header HashStyle GPLv2plus;
1001
1002   let globals = [
1003     "guestfs_create";
1004     "guestfs_close";
1005     "guestfs_get_error_handler";
1006     "guestfs_get_out_of_memory_handler";
1007     "guestfs_get_private";
1008     "guestfs_last_errno";
1009     "guestfs_last_error";
1010     "guestfs_set_close_callback";
1011     "guestfs_set_error_handler";
1012     "guestfs_set_launch_done_callback";
1013     "guestfs_set_log_message_callback";
1014     "guestfs_set_out_of_memory_handler";
1015     "guestfs_set_private";
1016     "guestfs_set_progress_callback";
1017     "guestfs_set_subprocess_quit_callback";
1018
1019     (* Unofficial parts of the API: the bindings code use these
1020      * functions, so it is useful to export them.
1021      *)
1022     "guestfs_safe_calloc";
1023     "guestfs_safe_malloc";
1024     "guestfs_safe_strdup";
1025     "guestfs_safe_memdup";
1026     "guestfs_tmpdir";
1027   ] in
1028   let functions =
1029     List.flatten (
1030       List.map (
1031         function
1032         | name, (_, _, []), _, _, _, _, _ -> ["guestfs_" ^ name]
1033         | name, (_, _, _), _, _, _, _, _ ->
1034             ["guestfs_" ^ name;
1035              "guestfs_" ^ name ^ "_va";
1036              "guestfs_" ^ name ^ "_argv"]
1037       ) all_functions
1038     ) in
1039   let structs =
1040     List.concat (
1041       List.map (fun (typ, _) ->
1042                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
1043         structs
1044     ) in
1045   let globals = List.sort compare (globals @ functions @ structs) in
1046
1047   pr "{\n";
1048   pr "    global:\n";
1049   List.iter (pr "        %s;\n") globals;
1050   pr "\n";
1051
1052   pr "    local:\n";
1053   pr "        *;\n";
1054   pr "};\n"
1055
1056 and generate_max_proc_nr () =
1057   pr "%d\n" max_proc_nr