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