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 = safe_realloc (g, rv.ret.%s.%s_val, rv.ret.%s.%s_len + 1);\n" n n n n n n;
 737            pr "  rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
 738            pr "  return rv.ret.%s.%s_val;\n" n n
 739        | RPVList n ->
 740            pr "  /* caller will free this */\n";
 741            pr "  return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
 742        | RVGList 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        | RLVList 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       );
 749
 750       pr "}\n\n"
 751   ) functions
 752
 753 (* Generate daemon/actions.h. *)
 754 and generate_daemon_actions_h () =
 755   generate_header CStyle GPLv2;
 756
 757   pr "#include \"../src/guestfs_protocol.h\"\n";
 758   pr "\n";
 759
 760   List.iter (
 761     fun (name, style, _, _, _, _) ->
 762       generate_prototype
 763         ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
 764   ) functions
 765
 766 (* Generate the server-side stubs. *)
 767 and generate_daemon_actions () =
 768   generate_header CStyle GPLv2;
 769
 770   pr "#define _GNU_SOURCE // for strchrnul\n";
 771   pr "\n";
 772   pr "#include <stdio.h>\n";
 773   pr "#include <stdlib.h>\n";
 774   pr "#include <string.h>\n";
 775   pr "#include <inttypes.h>\n";
 776   pr "#include <ctype.h>\n";
 777   pr "#include <rpc/types.h>\n";
 778   pr "#include <rpc/xdr.h>\n";
 779   pr "\n";
 780   pr "#include \"daemon.h\"\n";
 781   pr "#include \"../src/guestfs_protocol.h\"\n";
 782   pr "#include \"actions.h\"\n";
 783   pr "\n";
 784
 785   List.iter (
 786     fun (name, style, _, _, _, _) ->
 787       (* Generate server-side stubs. *)
 788       pr "static void %s_stub (XDR *xdr_in)\n" name;
 789       pr "{\n";
 790       let error_code =
 791         match fst style with
 792         | Err -> pr "  int r;\n"; "-1"
 793         | RString _ -> pr "  char *r;\n"; "NULL"
 794         | RStringList _ -> pr "  char **r;\n"; "NULL"
 795         | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"
 796         | RVGList _ -> pr "  guestfs_lvm_int_vg_list *r;\n"; "NULL"
 797         | RLVList _ -> pr "  guestfs_lvm_int_lv_list *r;\n"; "NULL" in
 798
 799       (match snd style with
 800        | P0 -> ()
 801        | args ->
 802            pr "  struct guestfs_%s_args args;\n" name;
 803            iter_args (
 804              function
 805              | String name -> pr "  const char *%s;\n" name
 806            ) args
 807       );
 808       pr "\n";
 809
 810       (match snd style with
 811        | P0 -> ()
 812        | args ->
 813            pr "  memset (&args, 0, sizeof args);\n";
 814            pr "\n";
 815            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
 816            pr "    reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
 817            pr "    return;\n";
 818            pr "  }\n";
 819            iter_args (
 820              function
 821              | String name -> pr "  %s = args.%s;\n" name name
 822            ) args;
 823            pr "\n"
 824       );
 825
 826       pr "  r = do_%s " name;
 827       generate_call_args style;
 828       pr ";\n";
 829
 830       pr "  if (r == %s)\n" error_code;
 831       pr "    /* do_%s has already called reply_with_error, so just return */\n" name;
 832       pr "    return;\n";
 833       pr "\n";
 834
 835       (match fst style with
 836        | Err -> pr "  reply (NULL, NULL);\n"
 837        | RString n ->
 838            pr "  struct guestfs_%s_ret ret;\n" name;
 839            pr "  ret.%s = r;\n" n;
 840            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 841            pr "  free (r);\n"
 842        | RStringList n ->
 843            pr "  struct guestfs_%s_ret ret;\n" name;
 844            pr "  ret.%s.%s_len = count_strings (r);\n" n n;
 845            pr "  ret.%s.%s_val = r;\n" n n;
 846            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 847            pr "  free_strings (r);\n"
 848        | RPVList n ->
 849            pr "  struct guestfs_%s_ret ret;\n" name;
 850            pr "  ret.%s = *r;\n" n;
 851            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 852            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
 853        | RVGList n ->
 854            pr "  struct guestfs_%s_ret ret;\n" name;
 855            pr "  ret.%s = *r;\n" n;
 856            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 857            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
 858        | RLVList n ->
 859            pr "  struct guestfs_%s_ret ret;\n" name;
 860            pr "  ret.%s = *r;\n" n;
 861            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
 862            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
 863       );
 864
 865       pr "}\n\n";
 866   ) functions;
 867
 868   (* Dispatch function. *)
 869   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
 870   pr "{\n";
 871   pr "  switch (proc_nr) {\n";
 872
 873   List.iter (
 874     fun (name, style, _, _, _, _) ->
 875       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
 876       pr "      %s_stub (xdr_in);\n" name;
 877       pr "      break;\n"
 878   ) functions;
 879
 880   pr "    default:\n";
 881   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
 882   pr "  }\n";
 883   pr "}\n";
 884   pr "\n";
 885
 886   (* LVM columns and tokenization functions. *)
 887   (* XXX This generates crap code.  We should rethink how we
 888    * do this parsing.
 889    *)
 890   List.iter (
 891     function
 892     | typ, cols ->
 893         pr "static const char *lvm_%s_cols = \"%s\";\n"
 894           typ (String.concat "," (List.map fst cols));
 895         pr "\n";
 896
 897         pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
 898         pr "{\n";
 899         pr "  char *tok, *p, *next;\n";
 900         pr "  int i, j;\n";
 901         pr "\n";
 902         (*
 903         pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
 904         pr "\n";
 905         *)
 906         pr "  if (!str) {\n";
 907         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
 908         pr "    return -1;\n";
 909         pr "  }\n";
 910         pr "  if (!*str || isspace (*str)) {\n";
 911         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
 912         pr "    return -1;\n";
 913         pr "  }\n";
 914         pr "  tok = str;\n";
 915         List.iter (
 916           fun (name, coltype) ->
 917             pr "  if (!tok) {\n";
 918             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
 919             pr "    return -1;\n";
 920             pr "  }\n";
 921             pr "  p = strchrnul (tok, ',');\n";
 922             pr "  if (*p) next = p+1; else next = NULL;\n";
 923             pr "  *p = '\\0';\n";
 924             (match coltype with
 925              | `String ->
 926                  pr "  r->%s = strdup (tok);\n" name;
 927                  pr "  if (r->%s == NULL) {\n" name;
 928                  pr "    perror (\"strdup\");\n";
 929                  pr "    return -1;\n";
 930                  pr "  }\n"
 931              | `UUID ->
 932                  pr "  for (i = j = 0; i < 32; ++j) {\n";
 933                  pr "    if (tok[j] == '\\0') {\n";
 934                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
 935                  pr "      return -1;\n";
 936                  pr "    } else if (tok[j] != '-')\n";
 937                  pr "      r->%s[i++] = tok[j];\n" name;
 938                  pr "  }\n";
 939              | `Bytes ->
 940                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
 941                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
 942                  pr "    return -1;\n";
 943                  pr "  }\n";
 944              | `Int ->
 945                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
 946                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
 947                  pr "    return -1;\n";
 948                  pr "  }\n";
 949              | `OptPercent ->
 950                  pr "  if (tok[0] == '\\0')\n";
 951                  pr "    r->%s = -1;\n" name;
 952                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
 953                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
 954                  pr "    return -1;\n";
 955                  pr "  }\n";
 956             );
 957             pr "  tok = next;\n";
 958         ) cols;
 959
 960         pr "  if (tok != NULL) {\n";
 961         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
 962         pr "    return -1;\n";
 963         pr "  }\n";
 964         pr "  return 0;\n";
 965         pr "}\n";
 966         pr "\n";
 967
 968         pr "guestfs_lvm_int_%s_list *\n" typ;
 969         pr "parse_command_line_%ss (void)\n" typ;
 970         pr "{\n";
 971         pr "  char *out, *err;\n";
 972         pr "  char *p, *pend;\n";
 973         pr "  int r, i;\n";
 974         pr "  guestfs_lvm_int_%s_list *ret;\n" typ;
 975         pr "  void *newp;\n";
 976         pr "\n";
 977         pr "  ret = malloc (sizeof *ret);\n";
 978         pr "  if (!ret) {\n";
 979         pr "    reply_with_perror (\"malloc\");\n";
 980         pr "    return NULL;\n";
 981         pr "  }\n";
 982         pr "\n";
 983         pr "  ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
 984         pr "  ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
 985         pr "\n";
 986         pr "  r = command (&out, &err,\n";
 987         pr "           \"/sbin/lvm\", \"%ss\",\n" typ;
 988         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
 989         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
 990         pr "  if (r == -1) {\n";
 991         pr "    reply_with_error (\"%%s\", err);\n";
 992         pr "    free (out);\n";
 993         pr "    free (err);\n";
 994         pr "    return NULL;\n";
 995         pr "  }\n";
 996         pr "\n";
 997         pr "  free (err);\n";
 998         pr "\n";
 999         pr "  /* Tokenize each line of the output. */\n";
1000         pr "  p = out;\n";
1001         pr "  i = 0;\n";
1002         pr "  while (p) {\n";
1003         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
1004         pr "    if (pend) {\n";
1005         pr "      *pend = '\\0';\n";
1006         pr "      pend++;\n";
1007         pr "    }\n";
1008         pr "\n";
1009         pr "    while (*p && isspace (*p))      /* Skip any leading whitespace. */\n";
1010         pr "      p++;\n";
1011         pr "\n";
1012         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
1013         pr "      p = pend;\n";
1014         pr "      continue;\n";
1015         pr "    }\n";
1016         pr "\n";
1017         pr "    /* Allocate some space to store this next entry. */\n";
1018         pr "    newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
1019         pr "                sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
1020         pr "    if (newp == NULL) {\n";
1021         pr "      reply_with_perror (\"realloc\");\n";
1022         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1023         pr "      free (ret);\n";
1024         pr "      free (out);\n";
1025         pr "      return NULL;\n";
1026         pr "    }\n";
1027         pr "    ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
1028         pr "\n";
1029         pr "    /* Tokenize the next entry. */\n";
1030         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
1031         pr "    if (r == -1) {\n";
1032         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
1033         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
1034         pr "      free (ret);\n";
1035         pr "      free (out);\n";
1036         pr "      return NULL;\n";
1037         pr "    }\n";
1038         pr "\n";
1039         pr "    ++i;\n";
1040         pr "    p = pend;\n";
1041         pr "  }\n";
1042         pr "\n";
1043         pr "  ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
1044         pr "\n";
1045         pr "  free (out);\n";
1046         pr "  return ret;\n";
1047         pr "}\n"
1048
1049   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
1050
1051 (* Generate a lot of different functions for guestfish. *)
1052 and generate_fish_cmds () =
1053   generate_header CStyle GPLv2;
1054
1055   pr "#include <stdio.h>\n";
1056   pr "#include <stdlib.h>\n";
1057   pr "#include <string.h>\n";
1058   pr "#include <inttypes.h>\n";
1059   pr "\n";
1060   pr "#include <guestfs.h>\n";
1061   pr "#include \"fish.h\"\n";
1062   pr "\n";
1063
1064   (* list_commands function, which implements guestfish -h *)
1065   pr "void list_commands (void)\n";
1066   pr "{\n";
1067   pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
1068   pr "  list_builtin_commands ();\n";
1069   List.iter (
1070     fun (name, _, _, _, shortdesc, _) ->
1071       let name = replace name '_' '-' in
1072       pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
1073         name shortdesc
1074   ) sorted_functions;
1075   pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
1076   pr "}\n";
1077   pr "\n";
1078
1079   (* display_command function, which implements guestfish -h cmd *)
1080   pr "void display_command (const char *cmd)\n";
1081   pr "{\n";
1082   List.iter (
1083     fun (name, style, _, flags, shortdesc, longdesc) ->
1084       let name2 = replace name '_' '-' in
1085       let synopsis =
1086         match snd style with
1087         | P0 -> name2
1088         | args ->
1089             sprintf "%s <%s>"
1090               name2 (
1091                 String.concat "> <" (
1092                   map_args (function
1093                             | String n -> n) args
1094                 )
1095               ) in
1096
1097       let warnings =
1098         if List.mem ProtocolLimitWarning flags then
1099           "\n\nBecause of the message protocol, there is a transfer limit
1100 of somewhere between 2MB and 4MB.  To transfer large files you should use
1101 FTP."
1102         else "" in
1103
1104       pr "  if (";
1105       pr "strcasecmp (cmd, \"%s\") == 0" name;
1106       if name <> name2 then
1107         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1108       pr ")\n";
1109       pr "    pod2text (\"%s - %s\", %S);\n"
1110         name2 shortdesc
1111         (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings);
1112       pr "  else\n"
1113   ) functions;
1114   pr "    display_builtin_command (cmd);\n";
1115   pr "}\n";
1116   pr "\n";
1117
1118   (* print_{pv,vg,lv}_list functions *)
1119   List.iter (
1120     function
1121     | typ, cols ->
1122         pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
1123         pr "{\n";
1124         pr "  int i;\n";
1125         pr "\n";
1126         List.iter (
1127           function
1128           | name, `String ->
1129               pr "  printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
1130           | name, `UUID ->
1131               pr "  printf (\"%s: \");\n" name;
1132               pr "  for (i = 0; i < 32; ++i)\n";
1133               pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
1134               pr "  printf (\"\\n\");\n"
1135           | name, `Bytes ->
1136               pr "  printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
1137           | name, `Int ->
1138               pr "  printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
1139           | name, `OptPercent ->
1140               pr "  if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
1141                 typ name name typ name;
1142               pr "  else printf (\"%s: \\n\");\n" name
1143         ) cols;
1144         pr "}\n";
1145         pr "\n";
1146         pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
1147           typ typ typ;
1148         pr "{\n";
1149         pr "  int i;\n";
1150         pr "\n";
1151         pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
1152         pr "    print_%s (&%ss->val[i]);\n" typ typ;
1153         pr "}\n";
1154         pr "\n";
1155   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
1156
1157   (* run_<action> actions *)
1158   List.iter (
1159     fun (name, style, _, _, _, _) ->
1160       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
1161       pr "{\n";
1162       (match fst style with
1163        | Err -> pr "  int r;\n"
1164        | RString _ -> pr "  char *r;\n"
1165        | RStringList _ -> pr "  char **r;\n"
1166        | RPVList _ -> pr "  struct guestfs_lvm_pv_list *r;\n"
1167        | RVGList _ -> pr "  struct guestfs_lvm_vg_list *r;\n"
1168        | RLVList _ -> pr "  struct guestfs_lvm_lv_list *r;\n"
1169       );
1170       iter_args (
1171         function
1172         | String name -> pr "  const char *%s;\n" name
1173       ) (snd style);
1174
1175       (* Check and convert parameters. *)
1176       let argc_expected = nr_args (snd style) in
1177       pr "  if (argc != %d) {\n" argc_expected;
1178       pr "    fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
1179         argc_expected;
1180       pr "    fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
1181       pr "    return -1;\n";
1182       pr "  }\n";
1183       iteri_args (
1184         fun i ->
1185           function
1186           | String name -> pr "  %s = argv[%d];\n" name i
1187       ) (snd style);
1188
1189       (* Call C API function. *)
1190       pr "  r = guestfs_%s " name;
1191       generate_call_args ~handle:"g" style;
1192       pr ";\n";
1193
1194       (* Check return value for errors and display command results. *)
1195       (match fst style with
1196        | Err -> pr "  return r;\n"
1197        | RString _ ->
1198            pr "  if (r == NULL) return -1;\n";
1199            pr "  printf (\"%%s\", r);\n";
1200            pr "  free (r);\n";
1201            pr "  return 0;\n"
1202        | RStringList _ ->
1203            pr "  if (r == NULL) return -1;\n";
1204            pr "  print_strings (r);\n";
1205            pr "  free_strings (r);\n";
1206            pr "  return 0;\n"
1207        | RPVList _ ->
1208            pr "  if (r == NULL) return -1;\n";
1209            pr "  print_pv_list (r);\n";
1210            pr "  guestfs_free_lvm_pv_list (r);\n";
1211            pr "  return 0;\n"
1212        | RVGList _ ->
1213            pr "  if (r == NULL) return -1;\n";
1214            pr "  print_vg_list (r);\n";
1215            pr "  guestfs_free_lvm_vg_list (r);\n";
1216            pr "  return 0;\n"
1217        | RLVList _ ->
1218            pr "  if (r == NULL) return -1;\n";
1219            pr "  print_lv_list (r);\n";
1220            pr "  guestfs_free_lvm_lv_list (r);\n";
1221            pr "  return 0;\n"
1222       );
1223       pr "}\n";
1224       pr "\n"
1225   ) functions;
1226
1227   (* run_action function *)
1228   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
1229   pr "{\n";
1230   List.iter (
1231     fun (name, _, _, _, _, _) ->
1232       let name2 = replace name '_' '-' in
1233       pr "  if (";
1234       pr "strcasecmp (cmd, \"%s\") == 0" name;
1235       if name <> name2 then
1236         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
1237       pr ")\n";
1238       pr "    return run_%s (cmd, argc, argv);\n" name;
1239       pr "  else\n";
1240   ) functions;
1241   pr "    {\n";
1242   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
1243   pr "      return -1;\n";
1244   pr "    }\n";
1245   pr "  return 0;\n";
1246   pr "}\n";
1247   pr "\n"
1248
1249 (* Generate a C function prototype. *)
1250 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
1251     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
1252     ?handle name style =
1253   if extern then pr "extern ";
1254   if static then pr "static ";
1255   (match fst style with
1256    | Err -> pr "int "
1257    | RString _ -> pr "char *"
1258    | RStringList _ -> pr "char **"
1259    | RPVList _ ->
1260        if not in_daemon then pr "struct guestfs_lvm_pv_list *"
1261        else pr "guestfs_lvm_int_pv_list *"
1262    | RVGList _ ->
1263        if not in_daemon then pr "struct guestfs_lvm_vg_list *"
1264        else pr "guestfs_lvm_int_vg_list *"
1265    | RLVList _ ->
1266        if not in_daemon then pr "struct guestfs_lvm_lv_list *"
1267        else pr "guestfs_lvm_int_lv_list *"
1268   );
1269   pr "%s (" name;
1270   let comma = ref false in
1271   (match handle with
1272    | None -> ()
1273    | Some handle -> pr "guestfs_h *%s" handle; comma := true
1274   );
1275   let next () =
1276     if !comma then (
1277       if single_line then pr ", " else pr ",\n\t\t"
1278     );
1279     comma := true
1280   in
1281   iter_args (
1282     function
1283     | String name -> next (); pr "const char *%s" name
1284   ) (snd style);
1285   pr ")";
1286   if semicolon then pr ";";
1287   if newline then pr "\n"
1288
1289 (* Generate C call arguments, eg "(handle, foo, bar)" *)
1290 and generate_call_args ?handle style =
1291   pr "(";
1292   let comma = ref false in
1293   (match handle with
1294    | None -> ()
1295    | Some handle -> pr "%s" handle; comma := true
1296   );
1297   iter_args (
1298     fun arg ->
1299       if !comma then pr ", ";
1300       comma := true;
1301       match arg with
1302       | String name -> pr "%s" name
1303   ) (snd style);
1304   pr ")"
1305
1306 let output_to filename =
1307   let filename_new = filename ^ ".new" in
1308   chan := open_out filename_new;
1309   let close () =
1310     close_out !chan;
1311     chan := stdout;
1312     Unix.rename filename_new filename;
1313     printf "written %s\n%!" filename;
1314   in
1315   close
1316
1317 (* Main program. *)
1318 let () =
1319   check_functions ();
1320
1321   let close = output_to "src/guestfs_protocol.x" in
1322   generate_xdr ();
1323   close ();
1324
1325   let close = output_to "src/guestfs-structs.h" in
1326   generate_structs_h ();
1327   close ();
1328
1329   let close = output_to "src/guestfs-actions.h" in
1330   generate_actions_h ();
1331   close ();
1332
1333   let close = output_to "src/guestfs-actions.c" in
1334   generate_client_actions ();
1335   close ();
1336
1337   let close = output_to "daemon/actions.h" in
1338   generate_daemon_actions_h ();
1339   close ();
1340
1341   let close = output_to "daemon/stubs.c" in
1342   generate_daemon_actions ();
1343   close ();
1344
1345   let close = output_to "fish/cmds.c" in
1346   generate_fish_cmds ();
1347   close ();
1348
1349   let close = output_to "guestfs-structs.pod" in
1350   generate_structs_pod ();
1351   close ();
1352
1353   let close = output_to "guestfs-actions.pod" in
1354   generate_actions_pod ();
1355   close ()