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