src/generator.ml

   1 #!/usr/bin/ocamlrun 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 and args =
  36     (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
  37   | P0
  38   | P1 of argt
  39   | P2 of argt * argt
  40 and argt =
  41   | String of string    (* const char *name, cannot be NULL *)
  42
  43 let functions = [
  44   ("mount", (Err, P2 (String "device", String "mountpoint")), 1,
  45    "mount a guest disk at a position in the filesystem",
  46    "\
  47 Mount a guest disk at a position in the filesystem.  Block devices
  48 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
  49 the guest.  If those block devices contain partitions, they will have
  50 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
  51 names can be used.
  52
  53 The rules are the same as for L<mount(2)>:  A filesystem must
  54 first be mounted on C</> before others can be mounted.  Other
  55 filesystems can only be mounted on directories which already
  56 exist.
  57
  58 The mounted filesystem is writable, if we have sufficient permissions
  59 on the underlying device.
  60
  61 The filesystem options C<sync> and C<noatime> are set with this
  62 call, in order to improve reliability.");
  63
  64   ("sync", (Err, P0), 2,
  65    "sync disks, writes are flushed through to the disk image",
  66    "\
  67 This syncs the disk, so that any writes are flushed through to the
  68 underlying disk image.
  69
  70 You should always call this if you have modified a disk image, before
  71 calling C<guestfs_close>.");
  72
  73   ("touch", (Err, P1 (String "path")), 3,
  74    "update file timestamps or create a new file",
  75    "\
  76 Touch acts like the L<touch(1)> command.  It can be used to
  77 update the timestamps on a file, or, if the file does not exist,
  78 to create a new zero-length file.");
  79 ]
  80
  81 (* 'pr' prints to the current output file. *)
  82 let chan = ref stdout
  83 let pr fs = ksprintf (output_string !chan) fs
  84
  85 let iter_args f = function
  86   | P0 -> ()
  87   | P1 arg1 -> f arg1
  88   | P2 (arg1, arg2) -> f arg1; f arg2
  89
  90 let iteri_args f = function
  91   | P0 -> ()
  92   | P1 arg1 -> f 0 arg1
  93   | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
  94
  95 let map_args f = function
  96   | P0 -> []
  97   | P1 arg1 -> [f arg1]
  98   | P2 (arg1, arg2) -> [f arg1; f arg2]
  99
 100 let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
 101
 102 type comment_style = CStyle | HashStyle | OCamlStyle
 103 type license = GPLv2 | LGPLv2
 104
 105 (* Generate a header block in a number of standard styles. *)
 106 let rec generate_header comment license =
 107   let c = match comment with
 108     | CStyle ->     pr "/* "; " *"
 109     | HashStyle ->  pr "# ";  "#"
 110     | OCamlStyle -> pr "(* "; " *" in
 111   pr "libguestfs generated file\n";
 112   pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
 113   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
 114   pr "%s\n" c;
 115   pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
 116   pr "%s\n" c;
 117   (match license with
 118    | GPLv2 ->
 119        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
 120        pr "%s it under the terms of the GNU General Public License as published by\n" c;
 121        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
 122        pr "%s (at your option) any later version.\n" c;
 123        pr "%s\n" c;
 124        pr "%s This program is distributed in the hope that it will be useful,\n" c;
 125        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
 126        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
 127        pr "%s GNU General Public License for more details.\n" c;
 128        pr "%s\n" c;
 129        pr "%s You should have received a copy of the GNU General Public License along\n" c;
 130        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
 131        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
 132
 133    | LGPLv2 ->
 134        pr "%s This library is free software; you can redistribute it and/or\n" c;
 135        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
 136        pr "%s License as published by the Free Software Foundation; either\n" c;
 137        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
 138        pr "%s\n" c;
 139        pr "%s This library is distributed in the hope that it will be useful,\n" c;
 140        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
 141        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
 142        pr "%s Lesser General Public License for more details.\n" c;
 143        pr "%s\n" c;
 144        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
 145        pr "%s License along with this library; if not, write to the Free Software\n" c;
 146        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
 147   );
 148   (match comment with
 149    | CStyle -> pr " */\n"
 150    | HashStyle -> ()
 151    | OCamlStyle -> pr " *)\n"
 152   );
 153   pr "\n"
 154
 155 (* Generate the pod documentation for the C API. *)
 156 and generate_pod () =
 157   List.iter (
 158     fun (shortname, style, _, _, longdesc) ->
 159       let name = "guestfs_" ^ shortname in
 160       pr "=head2 %s\n\n" name;
 161       pr " ";
 162       generate_prototype ~extern:false ~handle:"handle" name style;
 163       pr "\n\n";
 164       pr "%s\n\n" longdesc;
 165       (match style with
 166        | (Err, _) ->
 167            pr "This function return 0 on success or -1 on error.\n\n"
 168       );
 169   ) functions
 170
 171 (* Generate the protocol (XDR) file. *)
 172 and generate_xdr () =
 173   generate_header CStyle LGPLv2;
 174
 175   List.iter (
 176     fun (shortname, style, _, _, _) ->
 177       let name = "guestfs_" ^ shortname in
 178       pr "/* %s */\n\n" name;
 179       (match style with
 180        | (_, P0) -> ()
 181        | (_, args) ->
 182            pr "struct %s_args {\n" name;
 183            iter_args (
 184              function
 185              | String name -> pr "  string %s<>;\n" name
 186            ) args;
 187            pr "};\n\n"
 188       );
 189       (match style with
 190        | (Err, _) -> ()
 191            (* | ... -> pr "struct %s_ret ...\n" name; *)
 192       );
 193   ) functions;
 194
 195   (* Table of procedure numbers. *)
 196   pr "enum guestfs_procedure {\n";
 197   List.iter (
 198     fun (shortname, _, proc_nr, _, _) ->
 199       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
 200   ) functions;
 201   pr "  GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
 202   pr "};\n";
 203   pr "\n";
 204
 205   (* Having to choose a maximum message size is annoying for several
 206    * reasons (it limits what we can do in the API), but it (a) makes
 207    * the protocol a lot simpler, and (b) provides a bound on the size
 208    * of the daemon which operates in limited memory space.  For large
 209    * file transfers you should use FTP.
 210    *)
 211   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
 212   pr "\n";
 213
 214   (* Message header, etc. *)
 215   pr "\
 216 const GUESTFS_PROGRAM = 0x2000F5F5;
 217 const GUESTFS_PROTOCOL_VERSION = 1;
 218
 219 enum guestfs_message_direction {
 220   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
 221   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
 222 };
 223
 224 enum guestfs_message_status {
 225   GUESTFS_STATUS_OK = 0,
 226   GUESTFS_STATUS_ERROR = 1
 227 };
 228
 229 const GUESTFS_ERROR_LEN = 256;
 230
 231 struct guestfs_message_error {
 232   string error<GUESTFS_ERROR_LEN>;   /* error message */
 233 };
 234
 235 struct guestfs_message_header {
 236   unsigned prog;                     /* GUESTFS_PROGRAM */
 237   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
 238   guestfs_procedure proc;            /* GUESTFS_PROC_x */
 239   guestfs_message_direction direction;
 240   unsigned serial;                   /* message serial number */
 241   guestfs_message_status status;
 242 };
 243 "
 244
 245 (* Generate the guestfs-actions.h file. *)
 246 and generate_actions_h () =
 247   generate_header CStyle LGPLv2;
 248   List.iter (
 249     fun (shortname, style, _, _, _) ->
 250       let name = "guestfs_" ^ shortname in
 251       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
 252         name style
 253   ) functions
 254
 255 (* Generate the client-side dispatch stubs. *)
 256 and generate_client_actions () =
 257   generate_header CStyle LGPLv2;
 258   List.iter (
 259     fun (shortname, style, _, _, _) ->
 260       let name = "guestfs_" ^ shortname in
 261
 262       (* Generate the return value struct. *)
 263       pr "struct %s_rv {\n" shortname;
 264       pr "  int cb_done;  /* flag to indicate callback was called */\n";
 265       pr "  struct guestfs_message_header hdr;\n";
 266       pr "  struct guestfs_message_error err;\n";
 267       (match style with
 268        | (Err, _) -> ()
 269     (* | _ -> pr "  struct %s_ret ret;\n" name; *)
 270       );
 271       pr "};\n\n";
 272
 273       (* Generate the callback function. *)
 274       pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
 275       pr "{\n";
 276       pr "  struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
 277       pr "\n";
 278       pr "  if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
 279       pr "    error (g, \"%s: failed to parse reply header\");\n" name;
 280       pr "    return;\n";
 281       pr "  }\n";
 282       pr "  if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
 283       pr "    if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
 284       pr "      error (g, \"%s: failed to parse reply error\");\n" name;
 285       pr "      return;\n";
 286       pr "    }\n";
 287       pr "    goto done;\n";
 288       pr "  }\n";
 289
 290       (match style with
 291        | (Err, _) -> ()
 292     (* |  _ -> pr "  if (!xdr_%s_ret (&xdr, &rv->ret)) ..." *)
 293       );
 294
 295       pr " done:\n";
 296       pr "  rv->cb_done = 1;\n";
 297       pr "  main_loop.main_loop_quit (g);\n";
 298       pr "}\n\n";
 299
 300       (* Generate the action stub. *)
 301       generate_prototype ~extern:false ~semicolon:false ~newline:true
 302         ~handle:"g" name style;
 303
 304       let error_code =
 305         match style with
 306         | (Err, _) -> "-1" in
 307
 308       pr "{\n";
 309
 310       (match style with
 311        | (_, P0) -> ()
 312        | _ -> pr "  struct %s_args args;\n" name
 313       );
 314
 315       pr "  struct %s_rv rv;\n" shortname;
 316       pr "  int serial;\n";
 317       pr "\n";
 318       pr "  if (g->state != READY) {\n";
 319       pr "    error (g, \"%s called from the wrong state, %%d != READY\",\n"
 320         name;
 321       pr "      g->state);\n";
 322       pr "    return %s;\n" error_code;
 323       pr "  }\n";
 324       pr "\n";
 325       pr "  memset (&rv, 0, sizeof rv);\n";
 326       pr "\n";
 327
 328       (match style with
 329        | (_, P0) ->
 330            pr "  serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
 331              (String.uppercase shortname)
 332        | (_, args) ->
 333            iter_args (
 334              function
 335              | String name -> pr "  args.%s = (char *) %s;\n" name name
 336            ) args;
 337            pr "  serial = dispatch (g, GUESTFS_PROC_%s,\n"
 338              (String.uppercase shortname);
 339            pr "                     (xdrproc_t) xdr_%s_args, (char *) &args);\n"
 340              name;
 341       );
 342       pr "  if (serial == -1)\n";
 343       pr "    return %s;\n" error_code;
 344       pr "\n";
 345
 346       pr "  rv.cb_done = 0;\n";
 347       pr "  g->reply_cb_internal = %s_cb;\n" shortname;
 348       pr "  g->reply_cb_internal_data = &rv;\n";
 349       pr "  main_loop.main_loop_run (g);\n";
 350       pr "  g->reply_cb_internal = NULL;\n";
 351       pr "  g->reply_cb_internal_data = NULL;\n";
 352       pr "  if (!rv.cb_done) {\n";
 353       pr "    error (g, \"%s failed, see earlier error messages\");\n" name;
 354       pr "    return %s;\n" error_code;
 355       pr "  }\n";
 356       pr "\n";
 357
 358       pr "  if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
 359         (String.uppercase shortname);
 360       pr "    return %s;\n" error_code;
 361       pr "\n";
 362
 363       pr "  if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
 364       pr "    error (g, \"%%s\", rv.err.error);\n";
 365       pr "    return %s;\n" error_code;
 366       pr "  }\n";
 367       pr "\n";
 368
 369       (match style with
 370        | (Err, _) -> pr "  return 0;\n"
 371       );
 372
 373       pr "}\n\n"
 374   ) functions
 375
 376 (* Generate daemon/actions.h. *)
 377 and generate_daemon_actions_h () =
 378   generate_header CStyle GPLv2;
 379   List.iter (
 380     fun (name, style, _, _, _) ->
 381       generate_prototype ~single_line:true ~newline:true ("do_" ^ name) style;
 382   ) functions
 383
 384 (* Generate the server-side stubs. *)
 385 and generate_daemon_actions () =
 386   generate_header CStyle GPLv2;
 387
 388   pr "#include <rpc/types.h>\n";
 389   pr "#include <rpc/xdr.h>\n";
 390   pr "#include \"daemon.h\"\n";
 391   pr "#include \"../src/guestfs_protocol.h\"\n";
 392   pr "#include \"actions.h\"\n";
 393   pr "\n";
 394
 395   List.iter (
 396     fun (name, style, _, _, _) ->
 397       (* Generate server-side stubs. *)
 398       pr "static void %s_stub (XDR *xdr_in)\n" name;
 399       pr "{\n";
 400       let error_code =
 401         match style with
 402         | (Err, _) -> pr "  int r;\n"; "-1" in
 403       (match style with
 404        | (_, P0) -> ()
 405        | (_, args) ->
 406            pr "  struct guestfs_%s_args args;\n" name;
 407            iter_args (
 408              function
 409              | String name -> pr "  const char *%s;\n" name
 410            ) args
 411       );
 412       pr "\n";
 413
 414       (match style with
 415        | (_, P0) -> ()
 416        | (_, args) ->
 417            pr "  memset (&args, 0, sizeof args);\n";
 418            pr "\n";
 419            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
 420            pr "    reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
 421            pr "    return;\n";
 422            pr "  }\n";
 423            iter_args (
 424              function
 425              | String name -> pr "  %s = args.%s;\n" name name
 426            ) args;
 427            pr "\n"
 428       );
 429
 430       pr "  r = do_%s " name;
 431       generate_call_args style;
 432       pr ";\n";
 433
 434       pr "  if (r == %s)\n" error_code;
 435       pr "    /* do_%s has already called reply_with_error, so just return */\n" name;
 436       pr "    return;\n";
 437       pr "\n";
 438
 439       (match style with
 440        | (Err, _) -> pr "  reply (NULL, NULL);\n"
 441       );
 442
 443       pr "}\n\n";
 444   ) functions;
 445
 446   (* Dispatch function. *)
 447   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
 448   pr "{\n";
 449   pr "  switch (proc_nr) {\n";
 450
 451   List.iter (
 452     fun (name, style, _, _, _) ->
 453       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
 454       pr "      %s_stub (xdr_in);\n" name;
 455       pr "      break;\n"
 456   ) functions;
 457
 458   pr "    default:\n";
 459   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
 460   pr "  }\n";
 461   pr "}\n"
 462
 463 (* Generate a lot of different functions for guestfish. *)
 464 and generate_fish_cmds () =
 465   generate_header CStyle GPLv2;
 466
 467   pr "#include <stdio.h>\n";
 468   pr "#include <stdlib.h>\n";
 469   pr "#include <string.h>\n";
 470   pr "\n";
 471   pr "#include \"fish.h\"\n";
 472   pr "\n";
 473
 474   (* list_commands function, which implements guestfish -h *)
 475   pr "void list_commands (void)\n";
 476   pr "{\n";
 477   pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
 478   pr "  list_builtin_commands ();\n";
 479   List.iter (
 480     fun (name, _, _, shortdesc, _) ->
 481       pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
 482         name shortdesc
 483   ) functions;
 484   pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
 485   pr "}\n";
 486   pr "\n";
 487
 488   (* display_command function, which implements guestfish -h cmd *)
 489   pr "void display_command (const char *cmd)\n";
 490   pr "{\n";
 491   List.iter (
 492     fun (name, style, _, shortdesc, longdesc) ->
 493       let synopsis =
 494         match style with
 495         | (Err, P0) -> name
 496         | (Err, args) ->
 497             sprintf "%s <%s>"
 498               name (
 499                 String.concat "> <" (
 500                   map_args (function
 501                             | String n -> n) args
 502                 )
 503               ) in
 504
 505       pr "  if (strcasecmp (cmd, \"%s\") == 0)\n" name;
 506       pr "    pod2text (\"%s - %s\", %S);\n"
 507         name shortdesc
 508         (" " ^ synopsis ^ "\n\n" ^ longdesc);
 509       pr "  else\n"
 510   ) functions;
 511   pr "    display_builtin_command (cmd);\n";
 512   pr "}\n";
 513   pr "\n";
 514
 515   (* run_<action> actions *)
 516   List.iter (
 517     fun (name, style, _, _, _) ->
 518       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
 519       pr "{\n";
 520       (match style with
 521        | (Err, _) -> pr "  int r;\n"
 522       );
 523       iter_args (
 524         function
 525         | String name -> pr "  const char *%s;\n" name
 526       ) (snd style);
 527
 528       (* Check and convert parameters. *)
 529       let argc_expected = nr_args (snd style) in
 530       pr "  if (argc != %d) {\n" argc_expected;
 531       pr "    fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
 532         argc_expected;
 533       pr "    fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
 534       pr "    return -1;\n";
 535       pr "  }\n";
 536       iteri_args (
 537         fun i ->
 538           function
 539           | String name -> pr "  %s = argv[%d];\n" name i
 540       ) (snd style);
 541
 542       (* Call C API function. *)
 543       pr "  r = guestfs_%s " name;
 544       generate_call_args ~handle:"g" style;
 545       pr ";\n";
 546
 547       (* Check return value for errors. *)
 548       (match style with
 549        | (Err, _) -> pr "  return r;\n"
 550       );
 551       pr "}\n";
 552       pr "\n"
 553   ) functions;
 554
 555   (* run_action function *)
 556   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
 557   pr "{\n";
 558   List.iter (
 559     fun (name, _, _, _, _) ->
 560       pr "  if (strcasecmp (cmd, \"%s\") == 0)\n" name;
 561       pr "    return run_%s (cmd, argc, argv);\n" name;
 562       pr "  else\n";
 563   ) functions;
 564   pr "    {\n";
 565   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
 566   pr "      return -1;\n";
 567   pr "    }\n";
 568   pr "  return 0;\n";
 569   pr "}\n";
 570   pr "\n"
 571
 572 (* Generate a C function prototype. *)
 573 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
 574     ?(single_line = false) ?(newline = false)
 575     ?handle name style =
 576   if extern then pr "extern ";
 577   if static then pr "static ";
 578   (match style with
 579    | (Err, _) -> pr "int "
 580   );
 581   pr "%s (" name;
 582   let comma = ref false in
 583   (match handle with
 584    | None -> ()
 585    | Some handle -> pr "guestfs_h *%s" handle; comma := true
 586   );
 587   let next () =
 588     if !comma then (
 589       if single_line then pr ", " else pr ",\n\t\t"
 590     );
 591     comma := true
 592   in
 593   iter_args (
 594     function
 595     | String name -> next (); pr "const char *%s" name
 596   ) (snd style);
 597   pr ")";
 598   if semicolon then pr ";";
 599   if newline then pr "\n"
 600
 601 (* Generate C call arguments, eg "(handle, foo, bar)" *)
 602 and generate_call_args ?handle style =
 603   pr "(";
 604   let comma = ref false in
 605   (match handle with
 606    | None -> ()
 607    | Some handle -> pr "%s" handle; comma := true
 608   );
 609   iter_args (
 610     fun arg ->
 611       if !comma then pr ", ";
 612       comma := true;
 613       match arg with
 614       | String name -> pr "%s" name
 615   ) (snd style);
 616   pr ")"
 617
 618 let output_to filename =
 619   let filename_new = filename ^ ".new" in
 620   chan := open_out filename_new;
 621   let close () =
 622     close_out !chan;
 623     chan := stdout;
 624     Unix.rename filename_new filename;
 625     printf "written %s\n%!" filename;
 626   in
 627   close
 628
 629 (* Main program. *)
 630 let () =
 631   let close = output_to "src/guestfs_protocol.x" in
 632   generate_xdr ();
 633   close ();
 634
 635   let close = output_to "src/guestfs-actions.h" in
 636   generate_actions_h ();
 637   close ();
 638
 639   let close = output_to "src/guestfs-actions.c" in
 640   generate_client_actions ();
 641   close ();
 642
 643   let close = output_to "daemon/actions.h" in
 644   generate_daemon_actions_h ();
 645   close ();
 646
 647   let close = output_to "daemon/stubs.c" in
 648   generate_daemon_actions ();
 649   close ();
 650
 651   let close = output_to "fish/cmds.c" in
 652   generate_fish_cmds ();
 653   close ();
 654
 655   let close = output_to "guestfs-actions.pod" in
 656   generate_pod ();
 657   close ()