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