src/generator.ml

   1 #!/usr/bin/env ocaml
   2 (* libguestfs
   3  * Copyright (C) 2009 Red Hat Inc.
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 2 of the License, or
   8  * (at your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this program; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18  *
  19  * This script generates a large amount of code and documentation for
  20  * all the daemon actions.  To add a new action there are only two
  21  * files you need to change, this one to describe the interface, and
  22  * daemon/<somefile>.c to write the implementation.
  23  *)
  24
  25 #load "unix.cma";;
  26
  27 open Printf
  28
  29 type style = ret * args
  30 and ret =
  31     (* "Err" as a return value means an int used as a simple error
  32      * indication, ie. 0 or -1.
  33      *)
  34   | Err
  35     (* "RString" and "RStringList" require special treatment because
  36      * the caller must free them.
  37      *)
  38   | RString of string
  39   | RStringList of string
  40     (* LVM PVs, VGs and LVs. *)
  41   | RPVList of string
  42   | RVGList of string
  43   | RLVList of string
  44 and args =
  45     (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
  46   | P0
  47   | P1 of argt
  48   | P2 of argt * argt
  49 and argt =
  50   | String of string    (* const char *name, cannot be NULL *)
  51
  52 type flags = ProtocolLimitWarning
  53
  54 let functions = [
  55   ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
  56    "mount a guest disk at a position in the filesystem",
  57    "\
  58 Mount a guest disk at a position in the filesystem.  Block devices
  59 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
  60 the guest.  If those block devices contain partitions, they will have
  61 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
  62 names can be used.
  63
  64 The rules are the same as for L<mount(2)>:  A filesystem must
  65 first be mounted on C</> before others can be mounted.  Other
  66 filesystems can only be mounted on directories which already
  67 exist.
  68
  69 The mounted filesystem is writable, if we have sufficient permissions
  70 on the underlying device.
  71
  72 The filesystem options C<sync> and C<noatime> are set with this
  73 call, in order to improve reliability.");
  74
  75   ("sync", (Err, P0), 2, [],
  76    "sync disks, writes are flushed through to the disk image",
  77    "\
  78 This syncs the disk, so that any writes are flushed through to the
  79 underlying disk image.
  80
  81 You should always call this if you have modified a disk image, before
  82 calling C<guestfs_close>.");
  83
  84   ("touch", (Err, P1 (String "path")), 3, [],
  85    "update file timestamps or create a new file",
  86    "\
  87 Touch acts like the L<touch(1)> command.  It can be used to
  88 update the timestamps on a file, or, if the file does not exist,
  89 to create a new zero-length file.");
  90
  91   ("cat", (RString "content", P1 (String "path")), 4, [ProtocolLimitWarning],
  92    "list the contents of a file",
  93    "\
  94 Return the contents of the file named C<path>.
  95
  96 Note that this function cannot correctly handle binary files
  97 (specifically, files containing C<\\0> character which is treated
  98 as end of string).  For those you need to use the C<guestfs_read_file>
  99 function which has a more complex interface.");
 100
 101   ("ll", (RString "listing", P1 (String "directory")), 5, [],
 102    "list the files in a directory (long format)",
 103    "\
 104 List the files in C<directory> (relative to the root directory,
 105 there is no cwd) in the format of 'ls -la'.
 106
 107 This command is mostly useful for interactive sessions.  It
 108 is I<not> intended that you try to parse the output string.");
 109
 110   ("ls", (RStringList "listing", P1 (String "directory")), 6, [],
 111    "list the files in a directory",
 112    "\
 113 List the files in C<directory> (relative to the root directory,
 114 there is no cwd).  The '.' and '..' entries are not returned, but
 115 hidden files are shown.
 116
 117 This command is mostly useful for interactive sessions.  Programs
 118 should probably use C<guestfs_readdir> instead.");
 119
 120   ("list_devices", (RStringList "devices", P0), 7, [],
 121    "list the block devices",
 122    "\
 123 List all the block devices.
 124
 125 The full block device names are returned, eg. C</dev/sda>
 126 ");
 127
 128   ("list_partitions", (RStringList "partitions", P0), 8, [],
 129    "list the partitions",
 130    "\
 131 List all the partitions detected on all block devices.
 132
 133 The full partition device names are returned, eg. C</dev/sda1>
 134
 135 This does not return logical volumes.  For that you will need to
 136 call C<guestfs_lvs>.");
 137
 138   ("pvs", (RStringList "physvols", P0), 9, [],
 139    "list the LVM physical volumes (PVs)",
 140    "\
 141 List all the physical volumes detected.  This is the equivalent
 142 of the L<pvs(8)> command.
 143
 144 This returns a list of just the device names that contain
 145 PVs (eg. C</dev/sda2>).
 146
 147 See also C<guestfs_pvs_full>.");
 148
 149   ("vgs", (RStringList "volgroups", P0), 10, [],
 150    "list the LVM volume groups (VGs)",
 151    "\
 152 List all the volumes groups detected.  This is the equivalent
 153 of the L<vgs(8)> command.
 154
 155 This returns a list of just the volume group names that were
 156 detected (eg. C<VolGroup00>).
 157
 158 See also C<guestfs_vgs_full>.");
 159
 160   ("lvs", (RStringList "logvols", P0), 11, [],
 161    "list the LVM logical volumes (LVs)",
 162    "\
 163 List all the logical volumes detected.  This is the equivalent
 164 of the L<lvs(8)> command.
 165
 166 This returns a list of the logical volume device names
 167 (eg. C</dev/VolGroup00/LogVol00>).
 168
 169 See also C<guestfs_lvs_full>.");
 170
 171   ("pvs_full", (RPVList "physvols", P0), 12, [],
 172    "list the LVM physical volumes (PVs)",
 173    "\
 174 List all the physical volumes detected.  This is the equivalent
 175 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
 176
 177   ("vgs_full", (RVGList "volgroups", P0), 13, [],
 178    "list the LVM volume groups (VGs)",
 179    "\
 180 List all the volumes groups detected.  This is the equivalent
 181 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
 182
 183   ("lvs_full", (RLVList "logvols", P0), 14, [],
 184    "list the LVM logical volumes (LVs)",
 185    "\
 186 List all the logical volumes detected.  This is the equivalent
 187 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
 188 ]
 189
 190 (* Column names and types from LVM PVs/VGs/LVs. *)
 191 let pv_cols = [
 192   "pv_name", `String;
 193   "pv_uuid", `UUID;
 194   "pv_fmt", `String;
 195   "pv_size", `Bytes;
 196   "dev_size", `Bytes;
 197   "pv_free", `Bytes;
 198   "pv_used", `Bytes;
 199   "pv_attr", `String (* XXX *);
 200   "pv_pe_count", `Int;
 201   "pv_pe_alloc_count", `Int;
 202   "pv_tags", `String;
 203   "pe_start", `Bytes;
 204   "pv_mda_count", `Int;
 205   "pv_mda_free", `Bytes;
 206 (* Not in Fedora 10:
 207   "pv_mda_size", `Bytes;
 208 *)
 209 ]
 210 let vg_cols = [
 211   "vg_name", `String;
 212   "vg_uuid", `UUID;
 213   "vg_fmt", `String;
 214   "vg_attr", `String (* XXX *);
 215   "vg_size", `Bytes;
 216   "vg_free", `Bytes;
 217   "vg_sysid", `String;
 218   "vg_extent_size", `Bytes;
 219   "vg_extent_count", `Int;
 220   "vg_free_count", `Int;
 221   "max_lv", `Int;
 222   "max_pv", `Int;
 223   "pv_count", `Int;
 224   "lv_count", `Int;
 225   "snap_count", `Int;
 226   "vg_seqno", `Int;
 227   "vg_tags", `String;
 228   "vg_mda_count", `Int;
 229   "vg_mda_free", `Bytes;
 230 (* Not in Fedora 10:
 231   "vg_mda_size", `Bytes;
 232 *)
 233 ]
 234 let lv_cols = [
 235   "lv_name", `String;
 236   "lv_uuid", `UUID;
 237   "lv_attr", `String (* XXX *);
 238   "lv_major", `Int;
 239   "lv_minor", `Int;
 240   "lv_kernel_major", `Int;
 241   "lv_kernel_minor", `Int;
 242   "lv_size", `Bytes;
 243   "seg_count", `Int;
 244   "origin", `String;
 245   "snap_percent", `OptPercent;
 246   "copy_percent", `OptPercent;
 247   "move_pv", `String;
 248   "lv_tags", `String;
 249   "mirror_log", `String;
 250   "modules", `String;
 251 ]
 252
 253 (* In some places we want the functions to be displayed sorted
 254  * alphabetically, so this is useful:
 255  *)
 256 let sorted_functions =
 257   List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) functions
 258
 259 (* Useful functions. *)
 260 let failwithf fs = ksprintf failwith fs
 261 let replace s c1 c2 =
 262   let s2 = String.copy s in
 263   let r = ref false in
 264   for i = 0 to String.length s2 - 1 do
 265     if String.unsafe_get s2 i = c1 then (
 266       String.unsafe_set s2 i c2;
 267       r := true
 268     )
 269   done;
 270   if not !r then s else s2
 271
 272 (* 'pr' prints to the current output file. *)
 273 let chan = ref stdout
 274 let pr fs = ksprintf (output_string !chan) fs
 275
 276 let iter_args f = function
 277   | P0 -> ()
 278   | P1 arg1 -> f arg1
 279   | P2 (arg1, arg2) -> f arg1; f arg2
 280
 281 let iteri_args f = function
 282   | P0 -> ()
 283   | P1 arg1 -> f 0 arg1
 284   | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
 285
 286 let map_args f = function
 287   | P0 -> []
 288   | P1 arg1 -> [f arg1]
 289   | P2 (arg1, arg2) -> [f arg1; f arg2]
 290
 291 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
 292
 293 (* Check function names etc. for consistency. *)
 294 let check_functions () =
 295   List.iter (
 296     fun (name, _, _, _, _, _) ->
 297       if String.contains name '-' then
 298         failwithf "Function name '%s' should not contain '-', use '_' instead."
 299           name
 300   ) functions;
 301
 302   let proc_nrs =
 303     List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr) functions in
 304   let proc_nrs =
 305     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
 306   let rec loop = function
 307     | [] -> ()
 308     | [_] -> ()
 309     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
 310         loop rest
 311     | (name1,nr1) :: (name2,nr2) :: _ ->
 312         failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
 313           name1 name2 nr1 nr2
 314   in
 315   loop proc_nrs
 316
 317 type comment_style = CStyle | HashStyle | OCamlStyle
 318 type license = GPLv2 | LGPLv2
 319
 320 (* Generate a header block in a number of standard styles. *)
 321 let rec generate_header comment license =
 322   let c = match comment with
 323     | CStyle ->     pr "/* "; " *"
 324     | HashStyle ->  pr "# ";  "#"
 325     | OCamlStyle -> pr "(* "; " *" in
 326   pr "libguestfs generated file\n";
 327   pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
 328   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
 329   pr "%s\n" c;
 330   pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
 331   pr "%s\n" c;
 332   (match license with
 333    | GPLv2 ->
 334        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
 335        pr "%s it under the terms of the GNU General Public License as published by\n" c;
 336        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
 337        pr "%s (at your option) any later version.\n" c;
 338        pr "%s\n" c;
 339        pr "%s This program is distributed in the hope that it will be useful,\n" c;
 340        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
 341        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
 342        pr "%s GNU General Public License for more details.\n" c;
 343        pr "%s\n" c;
 344        pr "%s You should have received a copy of the GNU General Public License along\n" c;
 345        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
 346        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
 347
 348    | LGPLv2 ->
 349        pr "%s This library is free software; you can redistribute it and/or\n" c;
 350        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
 351        pr "%s License as published by the Free Software Foundation; either\n" c;
 352        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
 353        pr "%s\n" c;
 354        pr "%s This library is distributed in the hope that it will be useful,\n" c;
 355        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
 356        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
 357        pr "%s Lesser General Public License for more details.\n" c;
 358        pr "%s\n" c;
 359        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
 360        pr "%s License along with this library; if not, write to the Free Software\n" c;
 361        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
 362   );
 363   (match comment with
 364    | CStyle -> pr " */\n"
 365    | HashStyle -> ()
 366    | OCamlStyle -> pr " *)\n"
 367   );
 368   pr "\n"
 369
 370 (* Generate the pod documentation for the C API. *)
 371 and generate_actions_pod () =
 372   List.iter (
 373     fun (shortname, style, _, flags, _, longdesc) ->
 374       let name = "guestfs_" ^ shortname in
 375       pr "=head2 %s\n\n" name;
 376       pr " ";
 377       generate_prototype ~extern:false ~handle:"handle" name style;
 378       pr "\n\n";
 379       pr "%s\n\n" longdesc;
 380       (match fst style with
 381        | Err ->
 382            pr "This function returns 0 on success or -1 on error.\n\n"
 383        | RString _ ->
 384            pr "This function returns a string or NULL on error.
 385 I<The caller must free the returned string after use>.\n\n"
 386        | RStringList _ ->
 387            pr "This function returns a NULL-terminated array of strings
 388 (like L<environ(3)>), or NULL if there was an error.
 389 I<The caller must free the strings and the array after use>.\n\n"
 390        | RPVList _ ->
 391            pr "This function returns a C<struct guestfs_lvm_pv_list>.
 392 I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
 393        | RVGList _ ->
 394            pr "This function returns a C<struct guestfs_lvm_vg_list>.
 395 I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
 396        | RLVList _ ->
 397            pr "This function returns a C<struct guestfs_lvm_lv_list>.
 398 I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
 399       );
 400       if List.mem ProtocolLimitWarning flags then
 401         pr "Because of the message protocol, there is a transfer limit
 402 of somewhere between 2MB and 4MB.  To transfer large files you should use
 403 FTP.\n\n";
 404   ) sorted_functions
 405
 406 and generate_structs_pod () =
 407   (* LVM structs documentation. *)
 408   List.iter (
 409     fun (typ, cols) ->
 410       pr "=head2 guestfs_lvm_%s\n" typ;
 411       pr "\n";
 412       pr " struct guestfs_lvm_%s {\n" typ;
 413       List.iter (
 414         function
 415         | name, `String -> pr "  char *%s;\n" name
 416         | name, `UUID ->
 417             pr "  /* The next field is NOT nul-terminated, be careful when printing it: */\n";
 418             pr "  char %s[32];\n" name
 419         | name, `Bytes -> pr "  uint64_t %s;\n" name
 420         | name, `Int -> pr "  int64_t %s;\n" name
 421         | name, `OptPercent ->
 422             pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
 423             pr "  float %s;\n" name
 424       ) cols;
 425       pr " \n";
 426       pr " struct guestfs_lvm_%s_list {\n" typ;
 427       pr "   uint32_t len; /* Number of elements in list. */\n";
 428       pr "   struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
 429       pr " };\n";
 430       pr " \n";
 431       pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
 432         typ typ;
 433       pr "\n"
 434   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
 435
 436 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
 437  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.  We
 438  * have to use an underscore instead of a dash because otherwise
 439  * rpcgen generates incorrect code.
 440  *
 441  * This header is NOT exported to clients, but see also generate_structs_h.
 442  *)
 443 and generate_xdr () =
 444   generate_header CStyle LGPLv2;
 445
 446   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
 447   pr "typedef string str<>;\n";
 448   pr "\n";
 449
 450   (* LVM internal structures. *)
 451   List.iter (
 452     function
 453     | typ, cols ->
 454         pr "struct guestfs_lvm_int_%s {\n" typ;
 455         List.iter (function
 456                    | name, `String -> pr "  string %s<>;\n" name
 457                    | name, `UUID -> pr "  opaque %s[32];\n" name
 458                    | name, `Bytes -> pr "  hyper %s;\n" name
 459                    | name, `Int -> pr "  hyper %s;\n" name
 460                    | name, `OptPercent -> pr "  float %s;\n" name
 461                   ) cols;
 462         pr "};\n";
 463         pr "\n";
 464         pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
 465         pr "\n";
 466   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
 467
 468   List.iter (
 469     fun (shortname, style, _, _, _, _) ->
 470       let name = "guestfs_" ^ shortname in
 471       pr "/* %s */\n\n" name;
 472       (match snd style with
 473        | P0 -> ()
 474        | args ->
 475            pr "struct %s_args {\n" name;
 476            iter_args (
 477              function
 478              | String name -> pr "  string %s<>;\n" name
 479            ) args;
 480            pr "};\n\n"
 481       );
 482       (match fst style with
 483        | Err -> ()
 484        | RString n ->
 485            pr "struct %s_ret {\n" name;
 486            pr "  string %s<>;\n" n;
 487            pr "};\n\n"
 488        | RStringList n ->
 489            pr "struct %s_ret {\n" name;
 490            pr "  str %s<>;\n" n;
 491            pr "};\n\n"
 492        | RPVList n ->
 493            pr "struct %s_ret {\n" name;
 494            pr "  guestfs_lvm_int_pv_list %s;\n" n;
 495            pr "};\n\n"
 496        | RVGList n ->
 497            pr "struct %s_ret {\n" name;
 498            pr "  guestfs_lvm_int_vg_list %s;\n" n;
 499            pr "};\n\n"
 500        | RLVList n ->
 501            pr "struct %s_ret {\n" name;
 502            pr "  guestfs_lvm_int_lv_list %s;\n" n;
 503            pr "};\n\n"
 504       );
 505   ) functions;
 506
 507   (* Table of procedure numbers. *)
 508   pr "enum guestfs_procedure {\n";
 509   List.iter (
 510     fun (shortname, _, proc_nr, _, _, _) ->
 511       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
 512   ) functions;
 513   pr "  GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
 514   pr "};\n";
 515   pr "\n";
 516
 517   (* Having to choose a maximum message size is annoying for several
 518    * reasons (it limits what we can do in the API), but it (a) makes
 519    * the protocol a lot simpler, and (b) provides a bound on the size
 520    * of the daemon which operates in limited memory space.  For large
 521    * file transfers you should use FTP.
 522    *)
 523   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
 524   pr "\n";
 525
 526   (* Message header, etc. *)
 527   pr "\
 528 const GUESTFS_PROGRAM = 0x2000F5F5;
 529 const GUESTFS_PROTOCOL_VERSION = 1;
 530
 531 enum guestfs_message_direction {
 532   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
 533   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
 534 };
 535
 536 enum guestfs_message_status {
 537   GUESTFS_STATUS_OK = 0,
 538   GUESTFS_STATUS_ERROR = 1
 539 };
 540
 541 const GUESTFS_ERROR_LEN = 256;
 542
 543 struct guestfs_message_error {
 544   string error<GUESTFS_ERROR_LEN>;   /* error message */
 545 };
 546
 547 struct guestfs_message_header {
 548   unsigned prog;                     /* GUESTFS_PROGRAM */
 549   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
 550   guestfs_procedure proc;            /* GUESTFS_PROC_x */
 551   guestfs_message_direction direction;
 552   unsigned serial;                   /* message serial number */
 553   guestfs_message_status status;
 554 };
 555 "
 556
 557 (* Generate the guestfs-structs.h file. *)
 558 and generate_structs_h () =
 559   generate_header CStyle LGPLv2;
 560
 561   (* This is a public exported header file containing various
 562    * structures.  The structures are carefully written to have
 563    * exactly the same in-memory format as the XDR structures that
 564    * we use on the wire to the daemon.  The reason for creating
 565    * copies of these structures here is just so we don't have to
 566    * export the whole of guestfs_protocol.h (which includes much
 567    * unrelated and XDR-dependent stuff that we don't want to be
 568    * public, or required by clients).
 569    *
 570    * To reiterate, we will pass these structures to and from the
 571    * client with a simple assignment or memcpy, so the format
 572    * must be identical to what rpcgen / the RFC defines.
 573    *)
 574
 575   (* LVM public structures. *)
 576   List.iter (
 577     function
 578     | typ, cols ->
 579         pr "struct guestfs_lvm_%s {\n" typ;
 580         List.iter (
 581           function
 582           | name, `String -> pr "  char *%s;\n" name
 583           | name, `UUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
 584           | name, `Bytes -> pr "  uint64_t %s;\n" name
 585           | name, `Int -> pr "  int64_t %s;\n" name
 586           | name, `OptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
 587         ) cols;
 588         pr "};\n";
 589         pr "\n";
 590         pr "struct guestfs_lvm_%s_list {\n" typ;
 591         pr "  uint32_t len;\n";
 592         pr "  struct guestfs_lvm_%s *val;\n" typ;
 593         pr "};\n";
 594         pr "\n"
 595   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
 596
 597 (* Generate the guestfs-actions.h file. *)
 598 and generate_actions_h () =
 599   generate_header CStyle LGPLv2;
 600   List.iter (
 601     fun (shortname, style, _, _, _, _) ->
 602       let name = "guestfs_" ^ shortname in
 603       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
 604         name style
 605   ) functions
 606
 607 (* Generate the client-side dispatch stubs. *)
 608 and generate_client_actions () =
 609   generate_header CStyle LGPLv2;
 610
 611   (* Client-side stubs for each function. *)
 612   List.iter (
 613     fun (shortname, style, _, _, _, _) ->
 614       let name = "guestfs_" ^ shortname in
 615
 616       (* Generate the return value struct. *)
 617       pr "struct %s_rv {\n" shortname;
 618       pr "  int cb_done;  /* flag to indicate callback was called */\n";
 619       pr "  struct guestfs_message_header hdr;\n";
 620       pr "  struct guestfs_message_error err;\n";
 621       (match fst style with
 622        | Err -> ()
 623        | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
 624            pr "  struct %s_ret ret;\n" name
 625       );
 626       pr "};\n\n";
 627
 628       (* Generate the callback function. *)
 629       pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
 630       pr "{\n";
 631       pr "  struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
 632       pr "\n";
 633       pr "  if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
 634       pr "    error (g, \"%s: failed to parse reply header\");\n" name;
 635       pr "    return;\n";
 636       pr "  }\n";
 637       pr "  if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
 638       pr "    if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
 639       pr "      error (g, \"%s: failed to parse reply error\");\n" name;
 640       pr "      return;\n";
 641       pr "    }\n";
 642       pr "    goto done;\n";
 643       pr "  }\n";
 644
 645       (match fst style with
 646        | Err -> ()
 647        | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
 648             pr "  if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
 649             pr "    error (g, \"%s: failed to parse reply\");\n" name;
 650             pr "    return;\n";
 651             pr "  }\n";
 652       );
 653
 654       pr " done:\n";
 655       pr "  rv->cb_done = 1;\n";
 656       pr "  main_loop.main_loop_quit (g);\n";
 657       pr "}\n\n";
 658
 659       (* Generate the action stub. *)
 660       generate_prototype ~extern:false ~semicolon:false ~newline:true
 661         ~handle:"g" name style;
 662
 663       let error_code =
 664         match fst style with
 665         | Err -> "-1"
 666         | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
 667             "NULL" in
 668
 669       pr "{\n";
 670
 671       (match snd style with
 672        | P0 -> ()
 673        | _ -> pr "  struct %s_args args;\n" name
 674       );
 675
 676       pr "  struct %s_rv rv;\n" shortname;
 677       pr "  int serial;\n";
 678       pr "\n";
 679       pr "  if (g->state != READY) {\n";
 680       pr "    error (g, \"%s called from the wrong state, %%d != READY\",\n"
 681         name;
 682       pr "      g->state);\n";
 683       pr "    return %s;\n" error_code;
 684       pr "  }\n";
 685       pr "\n";
 686       pr "  memset (&rv, 0, sizeof rv);\n";
 687       pr "\n";
 688
 689       (match snd style with
 690        | P0 ->
 691            pr "  serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
 692              (String.uppercase shortname)
 693        | args ->
 694            iter_args (
 695              function
 696              | String name -> pr "  args.%s = (char *) %s;\n" name name
 697            ) args;
 698            pr "  serial = dispatch (g, GUESTFS_PROC_%s,\n"
 699              (String.uppercase shortname);
 700            pr "                     (xdrproc_t) xdr_%s_args, (char *) &args);\n"
 701              name;
 702       );
 703       pr "  if (serial == -1)\n";
 704       pr "    return %s;\n" error_code;
 705       pr "\n";
 706
 707       pr "  rv.cb_done = 0;\n";
 708       pr "  g->reply_cb_internal = %s_cb;\n" shortname;
 709       pr "  g->reply_cb_internal_data = &rv;\n";
 710       pr "  main_loop.main_loop_run (g);\n";
 711       pr "  g->reply_cb_internal = NULL;\n";
 712       pr "  g->reply_cb_internal_data = NULL;\n";
 713       pr "  if (!rv.cb_done) {\n";
 714       pr "    error (g, \"%s failed, see earlier error messages\");\n" name;
 715       pr "    return %s;\n" error_code;
 716       pr "  }\n";
 717       pr "\n";
 718
 719       pr "  if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
 720         (String.uppercase shortname);
 721       pr "    return %s;\n" error_code;
 722       pr "\n";
 723
 724       pr "  if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
 725       pr "    error (g, \"%%s\", rv.err.error);\n";
 726       pr "    return %s;\n" error_code;
 727       pr "  }\n";
 728       pr "\n";
 729
 730       (match fst style with
 731        | Err -> pr "  return 0;\n"
 732        | RString n ->
 733            pr "  return rv.ret.%s; /* caller will free */\n" n
 734        | RStringList n ->
 735            pr "  /* caller will free this, but we need to add a NULL entry */\n";
 736            pr "  rv.ret.%s.%s_val =" n n;
 737            pr "    safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
 738            pr "                  sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
 739              n n;
 740            pr "  rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
 741            pr "  return rv.ret.%s.%s_val;\n" n n
 742        | RPVList n ->
 743            pr "  /* caller will free this */\n";
 744            pr "  return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
 745        | RVGList n ->
 746            pr "  /* caller will free this */\n";
 747            pr "  return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
 748        | RLVList n ->
 749            pr "  /* caller will free this */\n";
 750            pr "  return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
 751       );
 752
 753       pr "}\n\n"
 754   ) functions
 755
 756 (* Generate daemon/actions.h. *)
 757 and generate_daemon_actions_h () =
 758   generate_header CStyle GPLv2;
 759
 760   pr "#include \"../src/guestfs_protocol.h\"\n";
 761   pr "\n";
 762
 763   List.iter (
 764     fun (name, style, _, _, _, _) ->
 765       generate_prototype
 766         ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
 767   ) functions
 768
 769 (* Generate the server-side stubs. *)
 770 and generate_daemon_actions () =
 771   generate_header CStyle GPLv2;
 772
 773   pr "#define _GNU_SOURCE // for strchrnul\n";
 774   pr "\n";
 775   pr "#include <stdio.h>\n";
 776   pr "#include <stdlib.h>\n";
 777   pr "#include <string.h>\n";
 778   pr "#include <inttypes.h>\n";
 779   pr "#include <ctype.h>\n";
 780   pr "#include <rpc/types.h>\n";
 781   pr "#include <rpc/xdr.h>\n";
 782   pr "\n";
 783   pr "#include \"daemon.h\"\n";
 784   pr "#include \"../src/guestfs_protocol.h\"\n";
 785   pr "#include \"actions.h\"\n";
 786   pr "\n";
 787
 788   List.iter (
 789     fun (name, style, _, _, _, _) ->
 790       (* Generate server-side stubs. *)
 791       pr "static void %s_stub (XDR *xdr_in)\n" name;
 792       pr "{\n";
 793       let error_code =
 794         match fst style with
 795         | Err -> pr "  int r;\n"; "-1"
 796         | RString _ -> pr "  char *r;\n"; "NULL"
 797         | RStringList _ -> pr "  char **r;\n"; "NULL"
 798         | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"
 799         | RVGList _ -> pr "  guestfs_lvm_int_vg_list *r;\n"; "NULL"
 800         | RLVList _ -> pr "  guestfs_lvm_int_lv_list *r;\n"; "NULL" in
 801
 802       (match snd style with
 803        | P0 -> ()
 804        | args ->
 805            pr "  struct guestfs_%s_args args;\n" name;
 806            iter_args (
 807              function
 808              | String name -> pr "  const char *%s;\n" name
 809            ) args
 810       );
 811       pr "\n";
 812
 813       (match snd style with
 814        | P0 -> ()
 815        | args ->
 816            pr "  memset (&args, 0, sizeof args);\n";
 817            pr "\n";
 818            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
 819            pr "    reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
 820            pr "    return;\n";
 821            pr "  }\n";
 822            iter_args (
 823              function
 824              | String name -> pr "  %s = args.%s;\n" name name
 825            ) args;
 826            pr "\n"
 827       );
 828
 829       pr "  r = do_%s " name;
 830       generate_call_args style;
 831       pr ";\n";
 832
 833       pr "  if (r == %s)\n" error_code;
 834       pr "    /* do_%s has already called reply_with_error, so just return */\n" name;
 835       pr "    return;\n";
 836       pr "\n";
 837
 838       (match fst style with
 839        | Err -> pr "  reply (NULL, NULL);\n"
 840        | RString n ->
 841            pr "  struct guestfs_%s_ret ret;\n" name;
 842            pr "  ret.%s = r;\n" n;
 843            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 844            pr "  free (r);\n"
 845        | RStringList n ->
 846            pr "  struct guestfs_%s_ret ret;\n" name;
 847            pr "  ret.%s.%s_len = count_strings (r);\n" n n;
 848            pr "  ret.%s.%s_val = r;\n" n n;
 849            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 850            pr "  free_strings (r);\n"
 851        | RPVList n ->
 852            pr "  struct guestfs_%s_ret ret;\n" name;
 853            pr "  ret.%s = *r;\n" n;
 854            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 855            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
 856        | RVGList n ->
 857            pr "  struct guestfs_%s_ret ret;\n" name;
 858            pr "  ret.%s = *r;\n" n;
 859            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 860            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
 861        | RLVList n ->
 862            pr "  struct guestfs_%s_ret ret;\n" name;
 863            pr "  ret.%s = *r;\n" n;
 864            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 865            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
 866       );
 867
 868       pr "}\n\n";
 869   ) functions;
 870
 871   (* Dispatch function. *)
 872   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
 873   pr "{\n";
 874   pr "  switch (proc_nr) {\n";
 875
 876   List.iter (
 877     fun (name, style, _, _, _, _) ->
 878       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
 879       pr "      %s_stub (xdr_in);\n" name;
 880       pr "      break;\n"
 881   ) functions;
 882
 883   pr "    default:\n";
 884   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
 885   pr "  }\n";
 886   pr "}\n";
 887   pr "\n";
 888
 889   (* LVM columns and tokenization functions. *)
 890   (* XXX This generates crap code.  We should rethink how we
 891    * do this parsing.
 892    *)
 893   List.iter (
 894     function
 895     | typ, cols ->
 896         pr "static const char *lvm_%s_cols = \"%s\";\n"
 897           typ (String.concat "," (List.map fst cols));
 898         pr "\n";
 899
 900         pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
 901         pr "{\n";
 902         pr "  char *tok, *p, *next;\n";
 903         pr "  int i, j;\n";
 904         pr "\n";
 905         (*
 906         pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
 907         pr "\n";
 908         *)
 909         pr "  if (!str) {\n";
 910         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
 911         pr "    return -1;\n";
 912         pr "  }\n";
 913         pr "  if (!*str || isspace (*str)) {\n";
 914         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
 915         pr "    return -1;\n";
 916         pr "  }\n";
 917         pr "  tok = str;\n";
 918         List.iter (
 919           fun (name, coltype) ->
 920             pr "  if (!tok) {\n";
 921             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
 922             pr "    return -1;\n";
 923             pr "  }\n";
 924             pr "  p = strchrnul (tok, ',');\n";
 925             pr "  if (*p) next = p+1; else next = NULL;\n";
 926             pr "  *p = '\\0';\n";
 927             (match coltype with
 928              | `String ->
 929                  pr "  r->%s = strdup (tok);\n" name;
 930                  pr "  if (r->%s == NULL) {\n" name;
 931                  pr "    perror (\"strdup\");\n";
 932                  pr "    return -1;\n";
 933                  pr "  }\n"
 934              | `UUID ->
 935                  pr "  for (i = j = 0; i < 32; ++j) {\n";
 936                  pr "    if (tok[j] == '\\0') {\n";
 937                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
 938                  pr "      return -1;\n";
 939                  pr "    } else if (tok[j] != '-')\n";
 940                  pr "      r->%s[i++] = tok[j];\n" name;
 941                  pr "  }\n";
 942              | `Bytes ->
 943                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
 944                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
 945                  pr "    return -1;\n";
 946                  pr "  }\n";
 947              | `Int ->
 948                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
 949                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
 950                  pr "    return -1;\n";
 951                  pr "  }\n";
 952              | `OptPercent ->
 953                  pr "  if (tok[0] == '\\0')\n";
 954                  pr "    r->%s = -1;\n" name;
 955                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
 956                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
 957                  pr "    return -1;\n";
 958                  pr "  }\n";
 959             );
 960             pr "  tok = next;\n";
 961         ) cols;
 962
 963         pr "  if (tok != NULL) {\n";
 964         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
 965         pr "    return -1;\n";
 966         pr "  }\n";
 967         pr "  return 0;\n";
 968         pr "}\n";
 969         pr "\n";
 970
 971         pr "guestfs_lvm_int_%s_list *\n" typ;
 972         pr "parse_command_line_%ss (void)\n" typ;
 973         pr "{\n";
 974         pr "  char *out, *err;\n";
 975         pr "  char *p, *pend;\n";
 976         pr "  int r, i;\n";
 977         pr "  guestfs_lvm_int_%s_list *ret;\n" typ;
 978         pr "  void *newp;\n";
 979         pr "\n";
 980         pr "  ret = malloc (sizeof *ret);\n";
 981         pr "  if (!ret) {\n";
 982         pr "    reply_with_perror (\"malloc\");\n";
 983         pr "    return NULL;\n";
 984         pr "  }\n";
 985         pr "\n";
 986         pr "  ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
 987         pr "  ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
 988         pr "\n";
 989         pr "  r = command (&out, &err,\n";
 990         pr "           \"/sbin/lvm\", \"%ss\",\n" typ;
 991         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
 992         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
 993         pr "  if (r == -1) {\n";
 994         pr "    reply_with_error (\"%%s\", err);\n";
 995         pr "    free (out);\n";
 996         pr "    free (err);\n";
 997         pr "    return NULL;\n";
 998         pr "  }\n";
 999         pr "\n";
1000         pr "  free (err);\n";
1001         pr "\n";
1002         pr "  /* Tokenize each line of the output. */\n";
1003         pr "  p = out;\n";
1004         pr "  i = 0;\n";
1005         pr "  while (p) {\n";
1006         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
1007         pr "    if (pend) {\n";
1008         pr "      *pend = '\\0';\n";
1009         pr "      pend++;\n";
1010         pr "    }\n";
1011         pr "\n";
1012         pr "    while (*p && isspace (*p))      /* Skip any leading whitespace. */\n";
1013         pr "      p++;\n";
1014         pr "\n";
1015         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
1016         pr "      p = pend;\n";
1017         pr "      continue;\n";
1018         pr "    }\n";
1019         pr "\n";
1020         pr "    /* Allocate some space to store this next entry. */\n";
1021         pr "    newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1022         pr "                sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1023         pr "    if (newp == NULL) {\n";
1024         pr "      reply_with_perror (\"realloc\");\n";
1025         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1026         pr "      free (ret);\n";
1027         pr "      free (out);\n";
1028         pr "      return NULL;\n";
1029         pr "    }\n";
1030         pr "    ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1031         pr "\n";
1032         pr "    /* Tokenize the next entry. */\n";
1033         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1034         pr "    if (r == -1) {\n";
1035         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1036         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1037         pr "      free (ret);\n";
1038         pr "      free (out);\n";
1039         pr "      return NULL;\n";
1040         pr "    }\n";
1041         pr "\n";
1042         pr "    ++i;\n";
1043         pr "    p = pend;\n";
1044         pr "  }\n";
1045         pr "\n";
1046         pr "  ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1047         pr "\n";
1048         pr "  free (out);\n";
1049         pr "  return ret;\n";
1050         pr "}\n"
1051
1052   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1053
1054 (* Generate a lot of different functions for guestfish. *)
1055 and generate_fish_cmds () =
1056   generate_header CStyle GPLv2;
1057
1058   pr "#include <stdio.h>\n";
1059   pr "#include <stdlib.h>\n";
1060   pr "#include <string.h>\n";
1061   pr "#include <inttypes.h>\n";
1062   pr "\n";
1063   pr "#include <guestfs.h>\n";
1064   pr "#include \"fish.h\"\n";
1065   pr "\n";
1066
1067   (* list_commands function, which implements guestfish -h *)
1068   pr "void list_commands (void)\n";
1069   pr "{\n";
1070   pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
1071   pr "  list_builtin_commands ();\n";
1072   List.iter (
1073     fun (name, _, _, _, shortdesc, _) ->
1074       let name = replace name '_' '-' in
1075       pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1076         name shortdesc
1077   ) sorted_functions;
1078   pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1079   pr "}\n";
1080   pr "\n";
1081
1082   (* display_command function, which implements guestfish -h cmd *)
1083   pr "void display_command (const char *cmd)\n";
1084   pr "{\n";
1085   List.iter (
1086     fun (name, style, _, flags, shortdesc, longdesc) ->
1087       let name2 = replace name '_' '-' in
1088       let synopsis =
1089         match snd style with
1090         | P0 -> name2
1091         | args ->
1092             sprintf "%s <%s>"
1093               name2 (
1094                 String.concat "> <" (
1095                   map_args (function
1096                             | String n -> n) args
1097                 )
1098               ) in
1099
1100       let warnings =
1101         if List.mem ProtocolLimitWarning flags then
1102           "\n\nBecause of the message protocol, there is a transfer limit
1103 of somewhere between 2MB and 4MB.  To transfer large files you should use
1104 FTP."
1105         else "" in
1106
1107       pr "  if (";
1108       pr "strcasecmp (cmd, \"%s\") == 0" name;
1109       if name <> name2 then
1110         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1111       pr ")\n";
1112       pr "    pod2text (\"%s - %s\", %S);\n"
1113         name2 shortdesc
1114         (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings);
1115       pr "  else\n"
1116   ) functions;
1117   pr "    display_builtin_command (cmd);\n";
1118   pr "}\n";
1119   pr "\n";
1120
1121   (* print_{pv,vg,lv}_list functions *)
1122   List.iter (
1123     function
1124     | typ, cols ->
1125         pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1126         pr "{\n";
1127         pr "  int i;\n";
1128         pr "\n";
1129         List.iter (
1130           function
1131           | name, `String ->
1132               pr "  printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1133           | name, `UUID ->
1134               pr "  printf (\"%s: \");\n" name;
1135               pr "  for (i = 0; i < 32; ++i)\n";
1136               pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
1137               pr "  printf (\"\\n\");\n"
1138           | name, `Bytes ->
1139               pr "  printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1140           | name, `Int ->
1141               pr "  printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1142           | name, `OptPercent ->
1143               pr "  if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1144                 typ name name typ name;
1145               pr "  else printf (\"%s: \\n\");\n" name
1146         ) cols;
1147         pr "}\n";
1148         pr "\n";
1149         pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1150           typ typ typ;
1151         pr "{\n";
1152         pr "  int i;\n";
1153         pr "\n";
1154         pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
1155         pr "    print_%s (&%ss->val[i]);\n" typ typ;
1156         pr "}\n";
1157         pr "\n";
1158   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1159
1160   (* run_<action> actions *)
1161   List.iter (
1162     fun (name, style, _, _, _, _) ->
1163       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1164       pr "{\n";
1165       (match fst style with
1166        | Err -> pr "  int r;\n"
1167        | RString _ -> pr "  char *r;\n"
1168        | RStringList _ -> pr "  char **r;\n"
1169        | RPVList _ -> pr "  struct guestfs_lvm_pv_list *r;\n"
1170        | RVGList _ -> pr "  struct guestfs_lvm_vg_list *r;\n"
1171        | RLVList _ -> pr "  struct guestfs_lvm_lv_list *r;\n"
1172       );
1173       iter_args (
1174         function
1175         | String name -> pr "  const char *%s;\n" name
1176       ) (snd style);
1177
1178       (* Check and convert parameters. *)
1179       let argc_expected = nr_args (snd style) in
1180       pr "  if (argc != %d) {\n" argc_expected;
1181       pr "    fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1182         argc_expected;
1183       pr "    fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1184       pr "    return -1;\n";
1185       pr "  }\n";
1186       iteri_args (
1187         fun i ->
1188           function
1189           | String name -> pr "  %s = argv[%d];\n" name i
1190       ) (snd style);
1191
1192       (* Call C API function. *)
1193       pr "  r = guestfs_%s " name;
1194       generate_call_args ~handle:"g" style;
1195       pr ";\n";
1196
1197       (* Check return value for errors and display command results. *)
1198       (match fst style with
1199        | Err -> pr "  return r;\n"
1200        | RString _ ->
1201            pr "  if (r == NULL) return -1;\n";
1202            pr "  printf (\"%%s\", r);\n";
1203            pr "  free (r);\n";
1204            pr "  return 0;\n"
1205        | RStringList _ ->
1206            pr "  if (r == NULL) return -1;\n";
1207            pr "  print_strings (r);\n";
1208            pr "  free_strings (r);\n";
1209            pr "  return 0;\n"
1210        | RPVList _ ->
1211            pr "  if (r == NULL) return -1;\n";
1212            pr "  print_pv_list (r);\n";
1213            pr "  guestfs_free_lvm_pv_list (r);\n";
1214            pr "  return 0;\n"
1215        | RVGList _ ->
1216            pr "  if (r == NULL) return -1;\n";
1217            pr "  print_vg_list (r);\n";
1218            pr "  guestfs_free_lvm_vg_list (r);\n";
1219            pr "  return 0;\n"
1220        | RLVList _ ->
1221            pr "  if (r == NULL) return -1;\n";
1222            pr "  print_lv_list (r);\n";
1223            pr "  guestfs_free_lvm_lv_list (r);\n";
1224            pr "  return 0;\n"
1225       );
1226       pr "}\n";
1227       pr "\n"
1228   ) functions;
1229
1230   (* run_action function *)
1231   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1232   pr "{\n";
1233   List.iter (
1234     fun (name, _, _, _, _, _) ->
1235       let name2 = replace name '_' '-' in
1236       pr "  if (";
1237       pr "strcasecmp (cmd, \"%s\") == 0" name;
1238       if name <> name2 then
1239         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1240       pr ")\n";
1241       pr "    return run_%s (cmd, argc, argv);\n" name;
1242       pr "  else\n";
1243   ) functions;
1244   pr "    {\n";
1245   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1246   pr "      return -1;\n";
1247   pr "    }\n";
1248   pr "  return 0;\n";
1249   pr "}\n";
1250   pr "\n"
1251
1252 (* Generate a C function prototype. *)
1253 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1254     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1255     ?handle name style =
1256   if extern then pr "extern ";
1257   if static then pr "static ";
1258   (match fst style with
1259    | Err -> pr "int "
1260    | RString _ -> pr "char *"
1261    | RStringList _ -> pr "char **"
1262    | RPVList _ ->
1263        if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1264        else pr "guestfs_lvm_int_pv_list *"
1265    | RVGList _ ->
1266        if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1267        else pr "guestfs_lvm_int_vg_list *"
1268    | RLVList _ ->
1269        if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1270        else pr "guestfs_lvm_int_lv_list *"
1271   );
1272   pr "%s (" name;
1273   let comma = ref false in
1274   (match handle with
1275    | None -> ()
1276    | Some handle -> pr "guestfs_h *%s" handle; comma := true
1277   );
1278   let next () =
1279     if !comma then (
1280       if single_line then pr ", " else pr ",\n\t\t"
1281     );
1282     comma := true
1283   in
1284   iter_args (
1285     function
1286     | String name -> next (); pr "const char *%s" name
1287   ) (snd style);
1288   pr ")";
1289   if semicolon then pr ";";
1290   if newline then pr "\n"
1291
1292 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1293 and generate_call_args ?handle style =
1294   pr "(";
1295   let comma = ref false in
1296   (match handle with
1297    | None -> ()
1298    | Some handle -> pr "%s" handle; comma := true
1299   );
1300   iter_args (
1301     fun arg ->
1302       if !comma then pr ", ";
1303       comma := true;
1304       match arg with
1305       | String name -> pr "%s" name
1306   ) (snd style);
1307   pr ")"
1308
1309 let output_to filename =
1310   let filename_new = filename ^ ".new" in
1311   chan := open_out filename_new;
1312   let close () =
1313     close_out !chan;
1314     chan := stdout;
1315     Unix.rename filename_new filename;
1316     printf "written %s\n%!" filename;
1317   in
1318   close
1319
1320 (* Main program. *)
1321 let () =
1322   check_functions ();
1323
1324   let close = output_to "src/guestfs_protocol.x" in
1325   generate_xdr ();
1326   close ();
1327
1328   let close = output_to "src/guestfs-structs.h" in
1329   generate_structs_h ();
1330   close ();
1331
1332   let close = output_to "src/guestfs-actions.h" in
1333   generate_actions_h ();
1334   close ();
1335
1336   let close = output_to "src/guestfs-actions.c" in
1337   generate_client_actions ();
1338   close ();
1339
1340   let close = output_to "daemon/actions.h" in
1341   generate_daemon_actions_h ();
1342   close ();
1343
1344   let close = output_to "daemon/stubs.c" in
1345   generate_daemon_actions ();
1346   close ();
1347
1348   let close = output_to "fish/cmds.c" in
1349   generate_fish_cmds ();
1350   close ();
1351
1352   let close = output_to "guestfs-structs.pod" in
1353   generate_structs_pod ();
1354   close ();
1355
1356   let close = output_to "guestfs-actions.pod" in
1357   generate_actions_pod ();
1358   close ()