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
  20 (* This script generates a large amount of code and documentation for
  21  * all the daemon actions.
  22  *
  23  * To add a new action there are only two files you need to change,
  24  * this one to describe the interface (see the big table below), and
  25  * daemon/<somefile>.c to write the implementation.
  26  *
  27  * After editing this file, run it (./src/generator.ml) to regenerate
  28  * all the output files.
  29  *
  30  * IMPORTANT: This script should NOT print any warnings.  If it prints
  31  * warnings, you should treat them as errors.
  32  * [Need to add -warn-error to ocaml command line]
  33  *)
  34
  35 #load "unix.cma";;
  36 #load "str.cma";;
  37
  38 open Printf
  39
  40 type style = ret * args
  41 and ret =
  42     (* "RErr" as a return value means an int used as a simple error
  43      * indication, ie. 0 or -1.
  44      *)
  45   | RErr
  46     (* "RInt" as a return value means an int which is -1 for error
  47      * or any value >= 0 on success.  Only use this for smallish
  48      * positive ints (0 <= i < 2^30).
  49      *)
  50   | RInt of string
  51     (* "RInt64" is the same as RInt, but is guaranteed to be able
  52      * to return a full 64 bit value, _except_ that -1 means error
  53      * (so -1 cannot be a valid, non-error return value).
  54      *)
  55   | RInt64 of string
  56     (* "RBool" is a bool return value which can be true/false or
  57      * -1 for error.
  58      *)
  59   | RBool of string
  60     (* "RConstString" is a string that refers to a constant value.
  61      * Try to avoid using this.  In particular you cannot use this
  62      * for values returned from the daemon, because there is no
  63      * thread-safe way to return them in the C API.
  64      *)
  65   | RConstString of string
  66     (* "RString" and "RStringList" are caller-frees. *)
  67   | RString of string
  68   | RStringList of string
  69     (* Some limited tuples are possible: *)
  70   | RIntBool of string * string
  71     (* LVM PVs, VGs and LVs. *)
  72   | RPVList of string
  73   | RVGList of string
  74   | RLVList of string
  75     (* Stat buffers. *)
  76   | RStat of string
  77   | RStatVFS of string
  78     (* Key-value pairs of untyped strings.  Turns into a hashtable or
  79      * dictionary in languages which support it.  DON'T use this as a
  80      * general "bucket" for results.  Prefer a stronger typed return
  81      * value if one is available, or write a custom struct.  Don't use
  82      * this if the list could potentially be very long, since it is
  83      * inefficient.  Keys should be unique.  NULLs are not permitted.
  84      *)
  85   | RHashtable of string
  86
  87 and args = argt list    (* Function parameters, guestfs handle is implicit. *)
  88
  89     (* Note in future we should allow a "variable args" parameter as
  90      * the final parameter, to allow commands like
  91      *   chmod mode file [file(s)...]
  92      * This is not implemented yet, but many commands (such as chmod)
  93      * are currently defined with the argument order keeping this future
  94      * possibility in mind.
  95      *)
  96 and argt =
  97   | String of string    (* const char *name, cannot be NULL *)
  98   | OptString of string (* const char *name, may be NULL *)
  99   | StringList of string(* list of strings (each string cannot be NULL) *)
 100   | Bool of string      (* boolean *)
 101   | Int of string       (* int (smallish ints, signed, <= 31 bits) *)
 102     (* These are treated as filenames (simple string parameters) in
 103      * the C API and bindings.  But in the RPC protocol, we transfer
 104      * the actual file content up to or down from the daemon.
 105      * FileIn: local machine -> daemon (in request)
 106      * FileOut: daemon -> local machine (in reply)
 107      * In guestfish (only), the special name "-" means read from
 108      * stdin or write to stdout.
 109      *)
 110   | FileIn of string
 111   | FileOut of string
 112
 113 type flags =
 114   | ProtocolLimitWarning  (* display warning about protocol size limits *)
 115   | DangerWillRobinson    (* flags particularly dangerous commands *)
 116   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
 117   | FishAction of string  (* call this function in guestfish *)
 118   | NotInFish             (* do not export via guestfish *)
 119   | NotInDocs             (* do not add this function to documentation *)
 120
 121 let protocol_limit_warning =
 122   "Because of the message protocol, there is a transfer limit
 123 of somewhere between 2MB and 4MB.  To transfer large files you should use
 124 FTP."
 125
 126 let danger_will_robinson =
 127   "B<This command is dangerous.  Without careful use you
 128 can easily destroy all your data>."
 129
 130 (* You can supply zero or as many tests as you want per API call.
 131  *
 132  * Note that the test environment has 3 block devices, of size 500MB,
 133  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
 134  * a fourth squashfs block device with some known files on it (/dev/sdd).
 135  *
 136  * Note for partitioning purposes, the 500MB device has 63 cylinders.
 137  *
 138  * The squashfs block device (/dev/sdd) comes from images/test.sqsh.
 139  *
 140  * To be able to run the tests in a reasonable amount of time,
 141  * the virtual machine and block devices are reused between tests.
 142  * So don't try testing kill_subprocess :-x
 143  *
 144  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
 145  *
 146  * If the appliance is running an older Linux kernel (eg. RHEL 5) then
 147  * devices are named /dev/hda etc.  To cope with this, the test suite
 148  * adds some hairly logic to detect this case, and then automagically
 149  * replaces all strings which match "/dev/sd.*" with "/dev/hd.*".
 150  * When writing test cases you shouldn't have to worry about this
 151  * difference.
 152  *
 153  * Don't assume anything about the previous contents of the block
 154  * devices.  Use 'Init*' to create some initial scenarios.
 155  *
 156  * You can add a prerequisite clause to any individual test.  This
 157  * is a run-time check, which, if it fails, causes the test to be
 158  * skipped.  Useful if testing a command which might not work on
 159  * all variations of libguestfs builds.  A test that has prerequisite
 160  * of 'Always' is run unconditionally.
 161  *
 162  * In addition, packagers can skip individual tests by setting the
 163  * environment variables:     eg:
 164  *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
 165  *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)
 166  *)
 167 type tests = (test_init * test_prereq * test) list
 168 and test =
 169     (* Run the command sequence and just expect nothing to fail. *)
 170   | TestRun of seq
 171     (* Run the command sequence and expect the output of the final
 172      * command to be the string.
 173      *)
 174   | TestOutput of seq * string
 175     (* Run the command sequence and expect the output of the final
 176      * command to be the list of strings.
 177      *)
 178   | TestOutputList of seq * string list
 179     (* Run the command sequence and expect the output of the final
 180      * command to be the integer.
 181      *)
 182   | TestOutputInt of seq * int
 183     (* Run the command sequence and expect the output of the final
 184      * command to be a true value (!= 0 or != NULL).
 185      *)
 186   | TestOutputTrue of seq
 187     (* Run the command sequence and expect the output of the final
 188      * command to be a false value (== 0 or == NULL, but not an error).
 189      *)
 190   | TestOutputFalse of seq
 191     (* Run the command sequence and expect the output of the final
 192      * command to be a list of the given length (but don't care about
 193      * content).
 194      *)
 195   | TestOutputLength of seq * int
 196     (* Run the command sequence and expect the output of the final
 197      * command to be a structure.
 198      *)
 199   | TestOutputStruct of seq * test_field_compare list
 200     (* Run the command sequence and expect the final command (only)
 201      * to fail.
 202      *)
 203   | TestLastFail of seq
 204
 205 and test_field_compare =
 206   | CompareWithInt of string * int
 207   | CompareWithString of string * string
 208   | CompareFieldsIntEq of string * string
 209   | CompareFieldsStrEq of string * string
 210
 211 (* Test prerequisites. *)
 212 and test_prereq =
 213     (* Test always runs. *)
 214   | Always
 215     (* Test is currently disabled - eg. it fails, or it tests some
 216      * unimplemented feature.
 217      *)
 218   | Disabled
 219     (* 'string' is some C code (a function body) that should return
 220      * true or false.  The test will run if the code returns true.
 221      *)
 222   | If of string
 223     (* As for 'If' but the test runs _unless_ the code returns true. *)
 224   | Unless of string
 225
 226 (* Some initial scenarios for testing. *)
 227 and test_init =
 228     (* Do nothing, block devices could contain random stuff including
 229      * LVM PVs, and some filesystems might be mounted.  This is usually
 230      * a bad idea.
 231      *)
 232   | InitNone
 233     (* Block devices are empty and no filesystems are mounted. *)
 234   | InitEmpty
 235     (* /dev/sda contains a single partition /dev/sda1, which is formatted
 236      * as ext2, empty [except for lost+found] and mounted on /.
 237      * /dev/sdb and /dev/sdc may have random content.
 238      * No LVM.
 239      *)
 240   | InitBasicFS
 241     (* /dev/sda:
 242      *   /dev/sda1 (is a PV):
 243      *     /dev/VG/LV (size 8MB):
 244      *       formatted as ext2, empty [except for lost+found], mounted on /
 245      * /dev/sdb and /dev/sdc may have random content.
 246      *)
 247   | InitBasicFSonLVM
 248
 249 (* Sequence of commands for testing. *)
 250 and seq = cmd list
 251 and cmd = string list
 252
 253 (* Note about long descriptions: When referring to another
 254  * action, use the format C<guestfs_other> (ie. the full name of
 255  * the C function).  This will be replaced as appropriate in other
 256  * language bindings.
 257  *
 258  * Apart from that, long descriptions are just perldoc paragraphs.
 259  *)
 260
 261 (* These test functions are used in the language binding tests. *)
 262
 263 let test_all_args = [
 264   String "str";
 265   OptString "optstr";
 266   StringList "strlist";
 267   Bool "b";
 268   Int "integer";
 269   FileIn "filein";
 270   FileOut "fileout";
 271 ]
 272
 273 let test_all_rets = [
 274   (* except for RErr, which is tested thoroughly elsewhere *)
 275   "test0rint",         RInt "valout";
 276   "test0rint64",       RInt64 "valout";
 277   "test0rbool",        RBool "valout";
 278   "test0rconststring", RConstString "valout";
 279   "test0rstring",      RString "valout";
 280   "test0rstringlist",  RStringList "valout";
 281   "test0rintbool",     RIntBool ("valout", "valout");
 282   "test0rpvlist",      RPVList "valout";
 283   "test0rvglist",      RVGList "valout";
 284   "test0rlvlist",      RLVList "valout";
 285   "test0rstat",        RStat "valout";
 286   "test0rstatvfs",     RStatVFS "valout";
 287   "test0rhashtable",   RHashtable "valout";
 288 ]
 289
 290 let test_functions = [
 291   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
 292    [],
 293    "internal test function - do not use",
 294    "\
 295 This is an internal test function which is used to test whether
 296 the automatically generated bindings can handle every possible
 297 parameter type correctly.
 298
 299 It echos the contents of each parameter to stdout.
 300
 301 You probably don't want to call this function.");
 302 ] @ List.flatten (
 303   List.map (
 304     fun (name, ret) ->
 305       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
 306         [],
 307         "internal test function - do not use",
 308         "\
 309 This is an internal test function which is used to test whether
 310 the automatically generated bindings can handle every possible
 311 return type correctly.
 312
 313 It converts string C<val> to the return type.
 314
 315 You probably don't want to call this function.");
 316        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
 317         [],
 318         "internal test function - do not use",
 319         "\
 320 This is an internal test function which is used to test whether
 321 the automatically generated bindings can handle every possible
 322 return type correctly.
 323
 324 This function always returns an error.
 325
 326 You probably don't want to call this function.")]
 327   ) test_all_rets
 328 )
 329
 330 (* non_daemon_functions are any functions which don't get processed
 331  * in the daemon, eg. functions for setting and getting local
 332  * configuration values.
 333  *)
 334
 335 let non_daemon_functions = test_functions @ [
 336   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
 337    [],
 338    "launch the qemu subprocess",
 339    "\
 340 Internally libguestfs is implemented by running a virtual machine
 341 using L<qemu(1)>.
 342
 343 You should call this after configuring the handle
 344 (eg. adding drives) but before performing any actions.");
 345
 346   ("wait_ready", (RErr, []), -1, [NotInFish],
 347    [],
 348    "wait until the qemu subprocess launches",
 349    "\
 350 Internally libguestfs is implemented by running a virtual machine
 351 using L<qemu(1)>.
 352
 353 You should call this after C<guestfs_launch> to wait for the launch
 354 to complete.");
 355
 356   ("kill_subprocess", (RErr, []), -1, [],
 357    [],
 358    "kill the qemu subprocess",
 359    "\
 360 This kills the qemu subprocess.  You should never need to call this.");
 361
 362   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
 363    [],
 364    "add an image to examine or modify",
 365    "\
 366 This function adds a virtual machine disk image C<filename> to the
 367 guest.  The first time you call this function, the disk appears as IDE
 368 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
 369 so on.
 370
 371 You don't necessarily need to be root when using libguestfs.  However
 372 you obviously do need sufficient permissions to access the filename
 373 for whatever operations you want to perform (ie. read access if you
 374 just want to read the image or write access if you want to modify the
 375 image).
 376
 377 This is equivalent to the qemu parameter C<-drive file=filename>.
 378
 379 Note that this call checks for the existence of C<filename>.  This
 380 stops you from specifying other types of drive which are supported
 381 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
 382 the general C<guestfs_config> call instead.");
 383
 384   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
 385    [],
 386    "add a CD-ROM disk image to examine",
 387    "\
 388 This function adds a virtual CD-ROM disk image to the guest.
 389
 390 This is equivalent to the qemu parameter C<-cdrom filename>.
 391
 392 Note that this call checks for the existence of C<filename>.  This
 393 stops you from specifying other types of drive which are supported
 394 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
 395 the general C<guestfs_config> call instead.");
 396
 397   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
 398    [],
 399    "add a drive in snapshot mode (read-only)",
 400    "\
 401 This adds a drive in snapshot mode, making it effectively
 402 read-only.
 403
 404 Note that writes to the device are allowed, and will be seen for
 405 the duration of the guestfs handle, but they are written
 406 to a temporary file which is discarded as soon as the guestfs
 407 handle is closed.  We don't currently have any method to enable
 408 changes to be committed, although qemu can support this.
 409
 410 This is equivalent to the qemu parameter
 411 C<-drive file=filename,snapshot=on>.
 412
 413 Note that this call checks for the existence of C<filename>.  This
 414 stops you from specifying other types of drive which are supported
 415 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
 416 the general C<guestfs_config> call instead.");
 417
 418   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
 419    [],
 420    "add qemu parameters",
 421    "\
 422 This can be used to add arbitrary qemu command line parameters
 423 of the form C<-param value>.  Actually it's not quite arbitrary - we
 424 prevent you from setting some parameters which would interfere with
 425 parameters that we use.
 426
 427 The first character of C<param> string must be a C<-> (dash).
 428
 429 C<value> can be NULL.");
 430
 431   ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
 432    [],
 433    "set the qemu binary",
 434    "\
 435 Set the qemu binary that we will use.
 436
 437 The default is chosen when the library was compiled by the
 438 configure script.
 439
 440 You can also override this by setting the C<LIBGUESTFS_QEMU>
 441 environment variable.
 442
 443 Setting C<qemu> to C<NULL> restores the default qemu binary.");
 444
 445   ("get_qemu", (RConstString "qemu", []), -1, [],
 446    [],
 447    "get the qemu binary",
 448    "\
 449 Return the current qemu binary.
 450
 451 This is always non-NULL.  If it wasn't set already, then this will
 452 return the default qemu binary name.");
 453
 454   ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
 455    [],
 456    "set the search path",
 457    "\
 458 Set the path that libguestfs searches for kernel and initrd.img.
 459
 460 The default is C<$libdir/guestfs> unless overridden by setting
 461 C<LIBGUESTFS_PATH> environment variable.
 462
 463 Setting C<path> to C<NULL> restores the default path.");
 464
 465   ("get_path", (RConstString "path", []), -1, [],
 466    [],
 467    "get the search path",
 468    "\
 469 Return the current search path.
 470
 471 This is always non-NULL.  If it wasn't set already, then this will
 472 return the default path.");
 473
 474   ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"],
 475    [],
 476    "add options to kernel command line",
 477    "\
 478 This function is used to add additional options to the
 479 guest kernel command line.
 480
 481 The default is C<NULL> unless overridden by setting
 482 C<LIBGUESTFS_APPEND> environment variable.
 483
 484 Setting C<append> to C<NULL> means I<no> additional options
 485 are passed (libguestfs always adds a few of its own).");
 486
 487   ("get_append", (RConstString "append", []), -1, [],
 488    [],
 489    "get the additional kernel options",
 490    "\
 491 Return the additional kernel options which are added to the
 492 guest kernel command line.
 493
 494 If C<NULL> then no options are added.");
 495
 496   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
 497    [],
 498    "set autosync mode",
 499    "\
 500 If C<autosync> is true, this enables autosync.  Libguestfs will make a
 501 best effort attempt to run C<guestfs_umount_all> followed by
 502 C<guestfs_sync> when the handle is closed
 503 (also if the program exits without closing handles).
 504
 505 This is disabled by default (except in guestfish where it is
 506 enabled by default).");
 507
 508   ("get_autosync", (RBool "autosync", []), -1, [],
 509    [],
 510    "get autosync mode",
 511    "\
 512 Get the autosync flag.");
 513
 514   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
 515    [],
 516    "set verbose mode",
 517    "\
 518 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
 519
 520 Verbose messages are disabled unless the environment variable
 521 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
 522
 523   ("get_verbose", (RBool "verbose", []), -1, [],
 524    [],
 525    "get verbose mode",
 526    "\
 527 This returns the verbose messages flag.");
 528
 529   ("is_ready", (RBool "ready", []), -1, [],
 530    [],
 531    "is ready to accept commands",
 532    "\
 533 This returns true iff this handle is ready to accept commands
 534 (in the C<READY> state).
 535
 536 For more information on states, see L<guestfs(3)>.");
 537
 538   ("is_config", (RBool "config", []), -1, [],
 539    [],
 540    "is in configuration state",
 541    "\
 542 This returns true iff this handle is being configured
 543 (in the C<CONFIG> state).
 544
 545 For more information on states, see L<guestfs(3)>.");
 546
 547   ("is_launching", (RBool "launching", []), -1, [],
 548    [],
 549    "is launching subprocess",
 550    "\
 551 This returns true iff this handle is launching the subprocess
 552 (in the C<LAUNCHING> state).
 553
 554 For more information on states, see L<guestfs(3)>.");
 555
 556   ("is_busy", (RBool "busy", []), -1, [],
 557    [],
 558    "is busy processing a command",
 559    "\
 560 This returns true iff this handle is busy processing a command
 561 (in the C<BUSY> state).
 562
 563 For more information on states, see L<guestfs(3)>.");
 564
 565   ("get_state", (RInt "state", []), -1, [],
 566    [],
 567    "get the current state",
 568    "\
 569 This returns the current state as an opaque integer.  This is
 570 only useful for printing debug and internal error messages.
 571
 572 For more information on states, see L<guestfs(3)>.");
 573
 574   ("set_busy", (RErr, []), -1, [NotInFish],
 575    [],
 576    "set state to busy",
 577    "\
 578 This sets the state to C<BUSY>.  This is only used when implementing
 579 actions using the low-level API.
 580
 581 For more information on states, see L<guestfs(3)>.");
 582
 583   ("set_ready", (RErr, []), -1, [NotInFish],
 584    [],
 585    "set state to ready",
 586    "\
 587 This sets the state to C<READY>.  This is only used when implementing
 588 actions using the low-level API.
 589
 590 For more information on states, see L<guestfs(3)>.");
 591
 592   ("end_busy", (RErr, []), -1, [NotInFish],
 593    [],
 594    "leave the busy state",
 595    "\
 596 This sets the state to C<READY>, or if in C<CONFIG> then it leaves the
 597 state as is.  This is only used when implementing
 598 actions using the low-level API.
 599
 600 For more information on states, see L<guestfs(3)>.");
 601
 602 ]
 603
 604 (* daemon_functions are any functions which cause some action
 605  * to take place in the daemon.
 606  *)
 607
 608 let daemon_functions = [
 609   ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
 610    [InitEmpty, Always, TestOutput (
 611       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
 612        ["mkfs"; "ext2"; "/dev/sda1"];
 613        ["mount"; "/dev/sda1"; "/"];
 614        ["write_file"; "/new"; "new file contents"; "0"];
 615        ["cat"; "/new"]], "new file contents")],
 616    "mount a guest disk at a position in the filesystem",
 617    "\
 618 Mount a guest disk at a position in the filesystem.  Block devices
 619 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
 620 the guest.  If those block devices contain partitions, they will have
 621 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
 622 names can be used.
 623
 624 The rules are the same as for L<mount(2)>:  A filesystem must
 625 first be mounted on C</> before others can be mounted.  Other
 626 filesystems can only be mounted on directories which already
 627 exist.
 628
 629 The mounted filesystem is writable, if we have sufficient permissions
 630 on the underlying device.
 631
 632 The filesystem options C<sync> and C<noatime> are set with this
 633 call, in order to improve reliability.");
 634
 635   ("sync", (RErr, []), 2, [],
 636    [ InitEmpty, Always, TestRun [["sync"]]],
 637    "sync disks, writes are flushed through to the disk image",
 638    "\
 639 This syncs the disk, so that any writes are flushed through to the
 640 underlying disk image.
 641
 642 You should always call this if you have modified a disk image, before
 643 closing the handle.");
 644
 645   ("touch", (RErr, [String "path"]), 3, [],
 646    [InitBasicFS, Always, TestOutputTrue (
 647       [["touch"; "/new"];
 648        ["exists"; "/new"]])],
 649    "update file timestamps or create a new file",
 650    "\
 651 Touch acts like the L<touch(1)> command.  It can be used to
 652 update the timestamps on a file, or, if the file does not exist,
 653 to create a new zero-length file.");
 654
 655   ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
 656    [InitBasicFS, Always, TestOutput (
 657       [["write_file"; "/new"; "new file contents"; "0"];
 658        ["cat"; "/new"]], "new file contents")],
 659    "list the contents of a file",
 660    "\
 661 Return the contents of the file named C<path>.
 662
 663 Note that this function cannot correctly handle binary files
 664 (specifically, files containing C<\\0> character which is treated
 665 as end of string).  For those you need to use the C<guestfs_download>
 666 function which has a more complex interface.");
 667
 668   ("ll", (RString "listing", [String "directory"]), 5, [],
 669    [], (* XXX Tricky to test because it depends on the exact format
 670         * of the 'ls -l' command, which changes between F10 and F11.
 671         *)
 672    "list the files in a directory (long format)",
 673    "\
 674 List the files in C<directory> (relative to the root directory,
 675 there is no cwd) in the format of 'ls -la'.
 676
 677 This command is mostly useful for interactive sessions.  It
 678 is I<not> intended that you try to parse the output string.");
 679
 680   ("ls", (RStringList "listing", [String "directory"]), 6, [],
 681    [InitBasicFS, Always, TestOutputList (
 682       [["touch"; "/new"];
 683        ["touch"; "/newer"];
 684        ["touch"; "/newest"];
 685        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
 686    "list the files in a directory",
 687    "\
 688 List the files in C<directory> (relative to the root directory,
 689 there is no cwd).  The '.' and '..' entries are not returned, but
 690 hidden files are shown.
 691
 692 This command is mostly useful for interactive sessions.  Programs
 693 should probably use C<guestfs_readdir> instead.");
 694
 695   ("list_devices", (RStringList "devices", []), 7, [],
 696    [InitEmpty, Always, TestOutputList (
 697       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
 698    "list the block devices",
 699    "\
 700 List all the block devices.
 701
 702 The full block device names are returned, eg. C</dev/sda>");
 703
 704   ("list_partitions", (RStringList "partitions", []), 8, [],
 705    [InitBasicFS, Always, TestOutputList (
 706       [["list_partitions"]], ["/dev/sda1"]);
 707     InitEmpty, Always, TestOutputList (
 708       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
 709        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
 710    "list the partitions",
 711    "\
 712 List all the partitions detected on all block devices.
 713
 714 The full partition device names are returned, eg. C</dev/sda1>
 715
 716 This does not return logical volumes.  For that you will need to
 717 call C<guestfs_lvs>.");
 718
 719   ("pvs", (RStringList "physvols", []), 9, [],
 720    [InitBasicFSonLVM, Always, TestOutputList (
 721       [["pvs"]], ["/dev/sda1"]);
 722     InitEmpty, Always, TestOutputList (
 723       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
 724        ["pvcreate"; "/dev/sda1"];
 725        ["pvcreate"; "/dev/sda2"];
 726        ["pvcreate"; "/dev/sda3"];
 727        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
 728    "list the LVM physical volumes (PVs)",
 729    "\
 730 List all the physical volumes detected.  This is the equivalent
 731 of the L<pvs(8)> command.
 732
 733 This returns a list of just the device names that contain
 734 PVs (eg. C</dev/sda2>).
 735
 736 See also C<guestfs_pvs_full>.");
 737
 738   ("vgs", (RStringList "volgroups", []), 10, [],
 739    [InitBasicFSonLVM, Always, TestOutputList (
 740       [["vgs"]], ["VG"]);
 741     InitEmpty, Always, TestOutputList (
 742       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
 743        ["pvcreate"; "/dev/sda1"];
 744        ["pvcreate"; "/dev/sda2"];
 745        ["pvcreate"; "/dev/sda3"];
 746        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
 747        ["vgcreate"; "VG2"; "/dev/sda3"];
 748        ["vgs"]], ["VG1"; "VG2"])],
 749    "list the LVM volume groups (VGs)",
 750    "\
 751 List all the volumes groups detected.  This is the equivalent
 752 of the L<vgs(8)> command.
 753
 754 This returns a list of just the volume group names that were
 755 detected (eg. C<VolGroup00>).
 756
 757 See also C<guestfs_vgs_full>.");
 758
 759   ("lvs", (RStringList "logvols", []), 11, [],
 760    [InitBasicFSonLVM, Always, TestOutputList (
 761       [["lvs"]], ["/dev/VG/LV"]);
 762     InitEmpty, Always, TestOutputList (
 763       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
 764        ["pvcreate"; "/dev/sda1"];
 765        ["pvcreate"; "/dev/sda2"];
 766        ["pvcreate"; "/dev/sda3"];
 767        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
 768        ["vgcreate"; "VG2"; "/dev/sda3"];
 769        ["lvcreate"; "LV1"; "VG1"; "50"];
 770        ["lvcreate"; "LV2"; "VG1"; "50"];
 771        ["lvcreate"; "LV3"; "VG2"; "50"];
 772        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
 773    "list the LVM logical volumes (LVs)",
 774    "\
 775 List all the logical volumes detected.  This is the equivalent
 776 of the L<lvs(8)> command.
 777
 778 This returns a list of the logical volume device names
 779 (eg. C</dev/VolGroup00/LogVol00>).
 780
 781 See also C<guestfs_lvs_full>.");
 782
 783   ("pvs_full", (RPVList "physvols", []), 12, [],
 784    [], (* XXX how to test? *)
 785    "list the LVM physical volumes (PVs)",
 786    "\
 787 List all the physical volumes detected.  This is the equivalent
 788 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
 789
 790   ("vgs_full", (RVGList "volgroups", []), 13, [],
 791    [], (* XXX how to test? *)
 792    "list the LVM volume groups (VGs)",
 793    "\
 794 List all the volumes groups detected.  This is the equivalent
 795 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
 796
 797   ("lvs_full", (RLVList "logvols", []), 14, [],
 798    [], (* XXX how to test? *)
 799    "list the LVM logical volumes (LVs)",
 800    "\
 801 List all the logical volumes detected.  This is the equivalent
 802 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
 803
 804   ("read_lines", (RStringList "lines", [String "path"]), 15, [],
 805    [InitBasicFS, Always, TestOutputList (
 806       [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
 807        ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
 808     InitBasicFS, Always, TestOutputList (
 809       [["write_file"; "/new"; ""; "0"];
 810        ["read_lines"; "/new"]], [])],
 811    "read file as lines",
 812    "\
 813 Return the contents of the file named C<path>.
 814
 815 The file contents are returned as a list of lines.  Trailing
 816 C<LF> and C<CRLF> character sequences are I<not> returned.
 817
 818 Note that this function cannot correctly handle binary files
 819 (specifically, files containing C<\\0> character which is treated
 820 as end of line).  For those you need to use the C<guestfs_read_file>
 821 function which has a more complex interface.");
 822
 823   ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
 824    [], (* XXX Augeas code needs tests. *)
 825    "create a new Augeas handle",
 826    "\
 827 Create a new Augeas handle for editing configuration files.
 828 If there was any previous Augeas handle associated with this
 829 guestfs session, then it is closed.
 830
 831 You must call this before using any other C<guestfs_aug_*>
 832 commands.
 833
 834 C<root> is the filesystem root.  C<root> must not be NULL,
 835 use C</> instead.
 836
 837 The flags are the same as the flags defined in
 838 E<lt>augeas.hE<gt>, the logical I<or> of the following
 839 integers:
 840
 841 =over 4
 842
 843 =item C<AUG_SAVE_BACKUP> = 1
 844
 845 Keep the original file with a C<.augsave> extension.
 846
 847 =item C<AUG_SAVE_NEWFILE> = 2
 848
 849 Save changes into a file with extension C<.augnew>, and
 850 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
 851
 852 =item C<AUG_TYPE_CHECK> = 4
 853
 854 Typecheck lenses (can be expensive).
 855
 856 =item C<AUG_NO_STDINC> = 8
 857
 858 Do not use standard load path for modules.
 859
 860 =item C<AUG_SAVE_NOOP> = 16
 861
 862 Make save a no-op, just record what would have been changed.
 863
 864 =item C<AUG_NO_LOAD> = 32
 865
 866 Do not load the tree in C<guestfs_aug_init>.
 867
 868 =back
 869
 870 To close the handle, you can call C<guestfs_aug_close>.
 871
 872 To find out more about Augeas, see L<http://augeas.net/>.");
 873
 874   ("aug_close", (RErr, []), 26, [],
 875    [], (* XXX Augeas code needs tests. *)
 876    "close the current Augeas handle",
 877    "\
 878 Close the current Augeas handle and free up any resources
 879 used by it.  After calling this, you have to call
 880 C<guestfs_aug_init> again before you can use any other
 881 Augeas functions.");
 882
 883   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
 884    [], (* XXX Augeas code needs tests. *)
 885    "define an Augeas variable",
 886    "\
 887 Defines an Augeas variable C<name> whose value is the result
 888 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
 889 undefined.
 890
 891 On success this returns the number of nodes in C<expr>, or
 892 C<0> if C<expr> evaluates to something which is not a nodeset.");
 893
 894   ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
 895    [], (* XXX Augeas code needs tests. *)
 896    "define an Augeas node",
 897    "\
 898 Defines a variable C<name> whose value is the result of
 899 evaluating C<expr>.
 900
 901 If C<expr> evaluates to an empty nodeset, a node is created,
 902 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
 903 C<name> will be the nodeset containing that single node.
 904
 905 On success this returns a pair containing the
 906 number of nodes in the nodeset, and a boolean flag
 907 if a node was created.");
 908
 909   ("aug_get", (RString "val", [String "path"]), 19, [],
 910    [], (* XXX Augeas code needs tests. *)
 911    "look up the value of an Augeas path",
 912    "\
 913 Look up the value associated with C<path>.  If C<path>
 914 matches exactly one node, the C<value> is returned.");
 915
 916   ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
 917    [], (* XXX Augeas code needs tests. *)
 918    "set Augeas path to value",
 919    "\
 920 Set the value associated with C<path> to C<value>.");
 921
 922   ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
 923    [], (* XXX Augeas code needs tests. *)
 924    "insert a sibling Augeas node",
 925    "\
 926 Create a new sibling C<label> for C<path>, inserting it into
 927 the tree before or after C<path> (depending on the boolean
 928 flag C<before>).
 929
 930 C<path> must match exactly one existing node in the tree, and
 931 C<label> must be a label, ie. not contain C</>, C<*> or end
 932 with a bracketed index C<[N]>.");
 933
 934   ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
 935    [], (* XXX Augeas code needs tests. *)
 936    "remove an Augeas path",
 937    "\
 938 Remove C<path> and all of its children.
 939
 940 On success this returns the number of entries which were removed.");
 941
 942   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
 943    [], (* XXX Augeas code needs tests. *)
 944    "move Augeas node",
 945    "\
 946 Move the node C<src> to C<dest>.  C<src> must match exactly
 947 one node.  C<dest> is overwritten if it exists.");
 948
 949   ("aug_match", (RStringList "matches", [String "path"]), 24, [],
 950    [], (* XXX Augeas code needs tests. *)
 951    "return Augeas nodes which match path",
 952    "\
 953 Returns a list of paths which match the path expression C<path>.
 954 The returned paths are sufficiently qualified so that they match
 955 exactly one node in the current tree.");
 956
 957   ("aug_save", (RErr, []), 25, [],
 958    [], (* XXX Augeas code needs tests. *)
 959    "write all pending Augeas changes to disk",
 960    "\
 961 This writes all pending changes to disk.
 962
 963 The flags which were passed to C<guestfs_aug_init> affect exactly
 964 how files are saved.");
 965
 966   ("aug_load", (RErr, []), 27, [],
 967    [], (* XXX Augeas code needs tests. *)
 968    "load files into the tree",
 969    "\
 970 Load files into the tree.
 971
 972 See C<aug_load> in the Augeas documentation for the full gory
 973 details.");
 974
 975   ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
 976    [], (* XXX Augeas code needs tests. *)
 977    "list Augeas nodes under a path",
 978    "\
 979 This is just a shortcut for listing C<guestfs_aug_match>
 980 C<path/*> and sorting the resulting nodes into alphabetical order.");
 981
 982   ("rm", (RErr, [String "path"]), 29, [],
 983    [InitBasicFS, Always, TestRun
 984       [["touch"; "/new"];
 985        ["rm"; "/new"]];
 986     InitBasicFS, Always, TestLastFail
 987       [["rm"; "/new"]];
 988     InitBasicFS, Always, TestLastFail
 989       [["mkdir"; "/new"];
 990        ["rm"; "/new"]]],
 991    "remove a file",
 992    "\
 993 Remove the single file C<path>.");
 994
 995   ("rmdir", (RErr, [String "path"]), 30, [],
 996    [InitBasicFS, Always, TestRun
 997       [["mkdir"; "/new"];
 998        ["rmdir"; "/new"]];
 999     InitBasicFS, Always, TestLastFail
1000       [["rmdir"; "/new"]];
1001     InitBasicFS, Always, TestLastFail
1002       [["touch"; "/new"];
1003        ["rmdir"; "/new"]]],
1004    "remove a directory",
1005    "\
1006 Remove the single directory C<path>.");
1007
1008   ("rm_rf", (RErr, [String "path"]), 31, [],
1009    [InitBasicFS, Always, TestOutputFalse
1010       [["mkdir"; "/new"];
1011        ["mkdir"; "/new/foo"];
1012        ["touch"; "/new/foo/bar"];
1013        ["rm_rf"; "/new"];
1014        ["exists"; "/new"]]],
1015    "remove a file or directory recursively",
1016    "\
1017 Remove the file or directory C<path>, recursively removing the
1018 contents if its a directory.  This is like the C<rm -rf> shell
1019 command.");
1020
1021   ("mkdir", (RErr, [String "path"]), 32, [],
1022    [InitBasicFS, Always, TestOutputTrue
1023       [["mkdir"; "/new"];
1024        ["is_dir"; "/new"]];
1025     InitBasicFS, Always, TestLastFail
1026       [["mkdir"; "/new/foo/bar"]]],
1027    "create a directory",
1028    "\
1029 Create a directory named C<path>.");
1030
1031   ("mkdir_p", (RErr, [String "path"]), 33, [],
1032    [InitBasicFS, Always, TestOutputTrue
1033       [["mkdir_p"; "/new/foo/bar"];
1034        ["is_dir"; "/new/foo/bar"]];
1035     InitBasicFS, Always, TestOutputTrue
1036       [["mkdir_p"; "/new/foo/bar"];
1037        ["is_dir"; "/new/foo"]];
1038     InitBasicFS, Always, TestOutputTrue
1039       [["mkdir_p"; "/new/foo/bar"];
1040        ["is_dir"; "/new"]];
1041     (* Regression tests for RHBZ#503133: *)
1042     InitBasicFS, Always, TestRun
1043       [["mkdir"; "/new"];
1044        ["mkdir_p"; "/new"]];
1045     InitBasicFS, Always, TestLastFail
1046       [["touch"; "/new"];
1047        ["mkdir_p"; "/new"]]],
1048    "create a directory and parents",
1049    "\
1050 Create a directory named C<path>, creating any parent directories
1051 as necessary.  This is like the C<mkdir -p> shell command.");
1052
1053   ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
1054    [], (* XXX Need stat command to test *)
1055    "change file mode",
1056    "\
1057 Change the mode (permissions) of C<path> to C<mode>.  Only
1058 numeric modes are supported.");
1059
1060   ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
1061    [], (* XXX Need stat command to test *)
1062    "change file owner and group",
1063    "\
1064 Change the file owner to C<owner> and group to C<group>.
1065
1066 Only numeric uid and gid are supported.  If you want to use
1067 names, you will need to locate and parse the password file
1068 yourself (Augeas support makes this relatively easy).");
1069
1070   ("exists", (RBool "existsflag", [String "path"]), 36, [],
1071    [InitBasicFS, Always, TestOutputTrue (
1072       [["touch"; "/new"];
1073        ["exists"; "/new"]]);
1074     InitBasicFS, Always, TestOutputTrue (
1075       [["mkdir"; "/new"];
1076        ["exists"; "/new"]])],
1077    "test if file or directory exists",
1078    "\
1079 This returns C<true> if and only if there is a file, directory
1080 (or anything) with the given C<path> name.
1081
1082 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1083
1084   ("is_file", (RBool "fileflag", [String "path"]), 37, [],
1085    [InitBasicFS, Always, TestOutputTrue (
1086       [["touch"; "/new"];
1087        ["is_file"; "/new"]]);
1088     InitBasicFS, Always, TestOutputFalse (
1089       [["mkdir"; "/new"];
1090        ["is_file"; "/new"]])],
1091    "test if file exists",
1092    "\
1093 This returns C<true> if and only if there is a file
1094 with the given C<path> name.  Note that it returns false for
1095 other objects like directories.
1096
1097 See also C<guestfs_stat>.");
1098
1099   ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
1100    [InitBasicFS, Always, TestOutputFalse (
1101       [["touch"; "/new"];
1102        ["is_dir"; "/new"]]);
1103     InitBasicFS, Always, TestOutputTrue (
1104       [["mkdir"; "/new"];
1105        ["is_dir"; "/new"]])],
1106    "test if file exists",
1107    "\
1108 This returns C<true> if and only if there is a directory
1109 with the given C<path> name.  Note that it returns false for
1110 other objects like files.
1111
1112 See also C<guestfs_stat>.");
1113
1114   ("pvcreate", (RErr, [String "device"]), 39, [],
1115    [InitEmpty, Always, TestOutputList (
1116       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1117        ["pvcreate"; "/dev/sda1"];
1118        ["pvcreate"; "/dev/sda2"];
1119        ["pvcreate"; "/dev/sda3"];
1120        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1121    "create an LVM physical volume",
1122    "\
1123 This creates an LVM physical volume on the named C<device>,
1124 where C<device> should usually be a partition name such
1125 as C</dev/sda1>.");
1126
1127   ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
1128    [InitEmpty, Always, TestOutputList (
1129       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1130        ["pvcreate"; "/dev/sda1"];
1131        ["pvcreate"; "/dev/sda2"];
1132        ["pvcreate"; "/dev/sda3"];
1133        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1134        ["vgcreate"; "VG2"; "/dev/sda3"];
1135        ["vgs"]], ["VG1"; "VG2"])],
1136    "create an LVM volume group",
1137    "\
1138 This creates an LVM volume group called C<volgroup>
1139 from the non-empty list of physical volumes C<physvols>.");
1140
1141   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
1142    [InitEmpty, Always, TestOutputList (
1143       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1144        ["pvcreate"; "/dev/sda1"];
1145        ["pvcreate"; "/dev/sda2"];
1146        ["pvcreate"; "/dev/sda3"];
1147        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1148        ["vgcreate"; "VG2"; "/dev/sda3"];
1149        ["lvcreate"; "LV1"; "VG1"; "50"];
1150        ["lvcreate"; "LV2"; "VG1"; "50"];
1151        ["lvcreate"; "LV3"; "VG2"; "50"];
1152        ["lvcreate"; "LV4"; "VG2"; "50"];
1153        ["lvcreate"; "LV5"; "VG2"; "50"];
1154        ["lvs"]],
1155       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1156        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1157    "create an LVM volume group",
1158    "\
1159 This creates an LVM volume group called C<logvol>
1160 on the volume group C<volgroup>, with C<size> megabytes.");
1161
1162   ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
1163    [InitEmpty, Always, TestOutput (
1164       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1165        ["mkfs"; "ext2"; "/dev/sda1"];
1166        ["mount"; "/dev/sda1"; "/"];
1167        ["write_file"; "/new"; "new file contents"; "0"];
1168        ["cat"; "/new"]], "new file contents")],
1169    "make a filesystem",
1170    "\
1171 This creates a filesystem on C<device> (usually a partition
1172 or LVM logical volume).  The filesystem type is C<fstype>, for
1173 example C<ext3>.");
1174
1175   ("sfdisk", (RErr, [String "device";
1176                      Int "cyls"; Int "heads"; Int "sectors";
1177                      StringList "lines"]), 43, [DangerWillRobinson],
1178    [],
1179    "create partitions on a block device",
1180    "\
1181 This is a direct interface to the L<sfdisk(8)> program for creating
1182 partitions on block devices.
1183
1184 C<device> should be a block device, for example C</dev/sda>.
1185
1186 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1187 and sectors on the device, which are passed directly to sfdisk as
1188 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1189 of these, then the corresponding parameter is omitted.  Usually for
1190 'large' disks, you can just pass C<0> for these, but for small
1191 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1192 out the right geometry and you will need to tell it.
1193
1194 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1195 information refer to the L<sfdisk(8)> manpage.
1196
1197 To create a single partition occupying the whole disk, you would
1198 pass C<lines> as a single element list, when the single element being
1199 the string C<,> (comma).
1200
1201 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>");
1202
1203   ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1204    [InitBasicFS, Always, TestOutput (
1205       [["write_file"; "/new"; "new file contents"; "0"];
1206        ["cat"; "/new"]], "new file contents");
1207     InitBasicFS, Always, TestOutput (
1208       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1209        ["cat"; "/new"]], "\nnew file contents\n");
1210     InitBasicFS, Always, TestOutput (
1211       [["write_file"; "/new"; "\n\n"; "0"];
1212        ["cat"; "/new"]], "\n\n");
1213     InitBasicFS, Always, TestOutput (
1214       [["write_file"; "/new"; ""; "0"];
1215        ["cat"; "/new"]], "");
1216     InitBasicFS, Always, TestOutput (
1217       [["write_file"; "/new"; "\n\n\n"; "0"];
1218        ["cat"; "/new"]], "\n\n\n");
1219     InitBasicFS, Always, TestOutput (
1220       [["write_file"; "/new"; "\n"; "0"];
1221        ["cat"; "/new"]], "\n")],
1222    "create a file",
1223    "\
1224 This call creates a file called C<path>.  The contents of the
1225 file is the string C<content> (which can contain any 8 bit data),
1226 with length C<size>.
1227
1228 As a special case, if C<size> is C<0>
1229 then the length is calculated using C<strlen> (so in this case
1230 the content cannot contain embedded ASCII NULs).
1231
1232 I<NB.> Owing to a bug, writing content containing ASCII NUL
1233 characters does I<not> work, even if the length is specified.
1234 We hope to resolve this bug in a future version.  In the meantime
1235 use C<guestfs_upload>.");
1236
1237   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1238    [InitEmpty, Always, TestOutputList (
1239       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1240        ["mkfs"; "ext2"; "/dev/sda1"];
1241        ["mount"; "/dev/sda1"; "/"];
1242        ["mounts"]], ["/dev/sda1"]);
1243     InitEmpty, Always, TestOutputList (
1244       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1245        ["mkfs"; "ext2"; "/dev/sda1"];
1246        ["mount"; "/dev/sda1"; "/"];
1247        ["umount"; "/"];
1248        ["mounts"]], [])],
1249    "unmount a filesystem",
1250    "\
1251 This unmounts the given filesystem.  The filesystem may be
1252 specified either by its mountpoint (path) or the device which
1253 contains the filesystem.");
1254
1255   ("mounts", (RStringList "devices", []), 46, [],
1256    [InitBasicFS, Always, TestOutputList (
1257       [["mounts"]], ["/dev/sda1"])],
1258    "show mounted filesystems",
1259    "\
1260 This returns the list of currently mounted filesystems.  It returns
1261 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1262
1263 Some internal mounts are not shown.");
1264
1265   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1266    [InitBasicFS, Always, TestOutputList (
1267       [["umount_all"];
1268        ["mounts"]], []);
1269     (* check that umount_all can unmount nested mounts correctly: *)
1270     InitEmpty, Always, TestOutputList (
1271       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
1272        ["mkfs"; "ext2"; "/dev/sda1"];
1273        ["mkfs"; "ext2"; "/dev/sda2"];
1274        ["mkfs"; "ext2"; "/dev/sda3"];
1275        ["mount"; "/dev/sda1"; "/"];
1276        ["mkdir"; "/mp1"];
1277        ["mount"; "/dev/sda2"; "/mp1"];
1278        ["mkdir"; "/mp1/mp2"];
1279        ["mount"; "/dev/sda3"; "/mp1/mp2"];
1280        ["mkdir"; "/mp1/mp2/mp3"];
1281        ["umount_all"];
1282        ["mounts"]], [])],
1283    "unmount all filesystems",
1284    "\
1285 This unmounts all mounted filesystems.
1286
1287 Some internal mounts are not unmounted by this call.");
1288
1289   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
1290    [],
1291    "remove all LVM LVs, VGs and PVs",
1292    "\
1293 This command removes all LVM logical volumes, volume groups
1294 and physical volumes.");
1295
1296   ("file", (RString "description", [String "path"]), 49, [],
1297    [InitBasicFS, Always, TestOutput (
1298       [["touch"; "/new"];
1299        ["file"; "/new"]], "empty");
1300     InitBasicFS, Always, TestOutput (
1301       [["write_file"; "/new"; "some content\n"; "0"];
1302        ["file"; "/new"]], "ASCII text");
1303     InitBasicFS, Always, TestLastFail (
1304       [["file"; "/nofile"]])],
1305    "determine file type",
1306    "\
1307 This call uses the standard L<file(1)> command to determine
1308 the type or contents of the file.  This also works on devices,
1309 for example to find out whether a partition contains a filesystem.
1310
1311 The exact command which runs is C<file -bsL path>.  Note in
1312 particular that the filename is not prepended to the output
1313 (the C<-b> option).");
1314
1315   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1316    [InitBasicFS, Always, TestOutput (
1317       [["upload"; "test-command"; "/test-command"];
1318        ["chmod"; "493"; "/test-command"];
1319        ["command"; "/test-command 1"]], "Result1");
1320     InitBasicFS, Always, TestOutput (
1321       [["upload"; "test-command"; "/test-command"];
1322        ["chmod"; "493"; "/test-command"];
1323        ["command"; "/test-command 2"]], "Result2\n");
1324     InitBasicFS, Always, TestOutput (
1325       [["upload"; "test-command"; "/test-command"];
1326        ["chmod"; "493"; "/test-command"];
1327        ["command"; "/test-command 3"]], "\nResult3");
1328     InitBasicFS, Always, TestOutput (
1329       [["upload"; "test-command"; "/test-command"];
1330        ["chmod"; "493"; "/test-command"];
1331        ["command"; "/test-command 4"]], "\nResult4\n");
1332     InitBasicFS, Always, TestOutput (
1333       [["upload"; "test-command"; "/test-command"];
1334        ["chmod"; "493"; "/test-command"];
1335        ["command"; "/test-command 5"]], "\nResult5\n\n");
1336     InitBasicFS, Always, TestOutput (
1337       [["upload"; "test-command"; "/test-command"];
1338        ["chmod"; "493"; "/test-command"];
1339        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1340     InitBasicFS, Always, TestOutput (
1341       [["upload"; "test-command"; "/test-command"];
1342        ["chmod"; "493"; "/test-command"];
1343        ["command"; "/test-command 7"]], "");
1344     InitBasicFS, Always, TestOutput (
1345       [["upload"; "test-command"; "/test-command"];
1346        ["chmod"; "493"; "/test-command"];
1347        ["command"; "/test-command 8"]], "\n");
1348     InitBasicFS, Always, TestOutput (
1349       [["upload"; "test-command"; "/test-command"];
1350        ["chmod"; "493"; "/test-command"];
1351        ["command"; "/test-command 9"]], "\n\n");
1352     InitBasicFS, Always, TestOutput (
1353       [["upload"; "test-command"; "/test-command"];
1354        ["chmod"; "493"; "/test-command"];
1355        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1356     InitBasicFS, Always, TestOutput (
1357       [["upload"; "test-command"; "/test-command"];
1358        ["chmod"; "493"; "/test-command"];
1359        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1360     InitBasicFS, Always, TestLastFail (
1361       [["upload"; "test-command"; "/test-command"];
1362        ["chmod"; "493"; "/test-command"];
1363        ["command"; "/test-command"]])],
1364    "run a command from the guest filesystem",
1365    "\
1366 This call runs a command from the guest filesystem.  The
1367 filesystem must be mounted, and must contain a compatible
1368 operating system (ie. something Linux, with the same
1369 or compatible processor architecture).
1370
1371 The single parameter is an argv-style list of arguments.
1372 The first element is the name of the program to run.
1373 Subsequent elements are parameters.  The list must be
1374 non-empty (ie. must contain a program name).
1375
1376 The return value is anything printed to I<stdout> by
1377 the command.
1378
1379 If the command returns a non-zero exit status, then
1380 this function returns an error message.  The error message
1381 string is the content of I<stderr> from the command.
1382
1383 The C<$PATH> environment variable will contain at least
1384 C</usr/bin> and C</bin>.  If you require a program from
1385 another location, you should provide the full path in the
1386 first parameter.
1387
1388 Shared libraries and data files required by the program
1389 must be available on filesystems which are mounted in the
1390 correct places.  It is the caller's responsibility to ensure
1391 all filesystems that are needed are mounted at the right
1392 locations.");
1393
1394   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1395    [InitBasicFS, Always, TestOutputList (
1396       [["upload"; "test-command"; "/test-command"];
1397        ["chmod"; "493"; "/test-command"];
1398        ["command_lines"; "/test-command 1"]], ["Result1"]);
1399     InitBasicFS, Always, TestOutputList (
1400       [["upload"; "test-command"; "/test-command"];
1401        ["chmod"; "493"; "/test-command"];
1402        ["command_lines"; "/test-command 2"]], ["Result2"]);
1403     InitBasicFS, Always, TestOutputList (
1404       [["upload"; "test-command"; "/test-command"];
1405        ["chmod"; "493"; "/test-command"];
1406        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1407     InitBasicFS, Always, TestOutputList (
1408       [["upload"; "test-command"; "/test-command"];
1409        ["chmod"; "493"; "/test-command"];
1410        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1411     InitBasicFS, Always, TestOutputList (
1412       [["upload"; "test-command"; "/test-command"];
1413        ["chmod"; "493"; "/test-command"];
1414        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1415     InitBasicFS, Always, TestOutputList (
1416       [["upload"; "test-command"; "/test-command"];
1417        ["chmod"; "493"; "/test-command"];
1418        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1419     InitBasicFS, Always, TestOutputList (
1420       [["upload"; "test-command"; "/test-command"];
1421        ["chmod"; "493"; "/test-command"];
1422        ["command_lines"; "/test-command 7"]], []);
1423     InitBasicFS, Always, TestOutputList (
1424       [["upload"; "test-command"; "/test-command"];
1425        ["chmod"; "493"; "/test-command"];
1426        ["command_lines"; "/test-command 8"]], [""]);
1427     InitBasicFS, Always, TestOutputList (
1428       [["upload"; "test-command"; "/test-command"];
1429        ["chmod"; "493"; "/test-command"];
1430        ["command_lines"; "/test-command 9"]], ["";""]);
1431     InitBasicFS, Always, TestOutputList (
1432       [["upload"; "test-command"; "/test-command"];
1433        ["chmod"; "493"; "/test-command"];
1434        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1435     InitBasicFS, Always, TestOutputList (
1436       [["upload"; "test-command"; "/test-command"];
1437        ["chmod"; "493"; "/test-command"];
1438        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1439    "run a command, returning lines",
1440    "\
1441 This is the same as C<guestfs_command>, but splits the
1442 result into a list of lines.");
1443
1444   ("stat", (RStat "statbuf", [String "path"]), 52, [],
1445    [InitBasicFS, Always, TestOutputStruct (
1446       [["touch"; "/new"];
1447        ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
1448    "get file information",
1449    "\
1450 Returns file information for the given C<path>.
1451
1452 This is the same as the C<stat(2)> system call.");
1453
1454   ("lstat", (RStat "statbuf", [String "path"]), 53, [],
1455    [InitBasicFS, Always, TestOutputStruct (
1456       [["touch"; "/new"];
1457        ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
1458    "get file information for a symbolic link",
1459    "\
1460 Returns file information for the given C<path>.
1461
1462 This is the same as C<guestfs_stat> except that if C<path>
1463 is a symbolic link, then the link is stat-ed, not the file it
1464 refers to.
1465
1466 This is the same as the C<lstat(2)> system call.");
1467
1468   ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
1469    [InitBasicFS, Always, TestOutputStruct (
1470       [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
1471                            CompareWithInt ("blocks", 490020);
1472                            CompareWithInt ("bsize", 1024)])],
1473    "get file system statistics",
1474    "\
1475 Returns file system statistics for any mounted file system.
1476 C<path> should be a file or directory in the mounted file system
1477 (typically it is the mount point itself, but it doesn't need to be).
1478
1479 This is the same as the C<statvfs(2)> system call.");
1480
1481   ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
1482    [], (* XXX test *)
1483    "get ext2/ext3/ext4 superblock details",
1484    "\
1485 This returns the contents of the ext2, ext3 or ext4 filesystem
1486 superblock on C<device>.
1487
1488 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1489 manpage for more details.  The list of fields returned isn't
1490 clearly defined, and depends on both the version of C<tune2fs>
1491 that libguestfs was built against, and the filesystem itself.");
1492
1493   ("blockdev_setro", (RErr, [String "device"]), 56, [],
1494    [InitEmpty, Always, TestOutputTrue (
1495       [["blockdev_setro"; "/dev/sda"];
1496        ["blockdev_getro"; "/dev/sda"]])],
1497    "set block device to read-only",
1498    "\
1499 Sets the block device named C<device> to read-only.
1500
1501 This uses the L<blockdev(8)> command.");
1502
1503   ("blockdev_setrw", (RErr, [String "device"]), 57, [],
1504    [InitEmpty, Always, TestOutputFalse (
1505       [["blockdev_setrw"; "/dev/sda"];
1506        ["blockdev_getro"; "/dev/sda"]])],
1507    "set block device to read-write",
1508    "\
1509 Sets the block device named C<device> to read-write.
1510
1511 This uses the L<blockdev(8)> command.");
1512
1513   ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
1514    [InitEmpty, Always, TestOutputTrue (
1515       [["blockdev_setro"; "/dev/sda"];
1516        ["blockdev_getro"; "/dev/sda"]])],
1517    "is block device set to read-only",
1518    "\
1519 Returns a boolean indicating if the block device is read-only
1520 (true if read-only, false if not).
1521
1522 This uses the L<blockdev(8)> command.");
1523
1524   ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
1525    [InitEmpty, Always, TestOutputInt (
1526       [["blockdev_getss"; "/dev/sda"]], 512)],
1527    "get sectorsize of block device",
1528    "\
1529 This returns the size of sectors on a block device.
1530 Usually 512, but can be larger for modern devices.
1531
1532 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1533 for that).
1534
1535 This uses the L<blockdev(8)> command.");
1536
1537   ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
1538    [InitEmpty, Always, TestOutputInt (
1539       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1540    "get blocksize of block device",
1541    "\
1542 This returns the block size of a device.
1543
1544 (Note this is different from both I<size in blocks> and
1545 I<filesystem block size>).
1546
1547 This uses the L<blockdev(8)> command.");
1548
1549   ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
1550    [], (* XXX test *)
1551    "set blocksize of block device",
1552    "\
1553 This sets the block size of a device.
1554
1555 (Note this is different from both I<size in blocks> and
1556 I<filesystem block size>).
1557
1558 This uses the L<blockdev(8)> command.");
1559
1560   ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
1561    [InitEmpty, Always, TestOutputInt (
1562       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1563    "get total size of device in 512-byte sectors",
1564    "\
1565 This returns the size of the device in units of 512-byte sectors
1566 (even if the sectorsize isn't 512 bytes ... weird).
1567
1568 See also C<guestfs_blockdev_getss> for the real sector size of
1569 the device, and C<guestfs_blockdev_getsize64> for the more
1570 useful I<size in bytes>.
1571
1572 This uses the L<blockdev(8)> command.");
1573
1574   ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
1575    [InitEmpty, Always, TestOutputInt (
1576       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1577    "get total size of device in bytes",
1578    "\
1579 This returns the size of the device in bytes.
1580
1581 See also C<guestfs_blockdev_getsz>.
1582
1583 This uses the L<blockdev(8)> command.");
1584
1585   ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
1586    [InitEmpty, Always, TestRun
1587       [["blockdev_flushbufs"; "/dev/sda"]]],
1588    "flush device buffers",
1589    "\
1590 This tells the kernel to flush internal buffers associated
1591 with C<device>.
1592
1593 This uses the L<blockdev(8)> command.");
1594
1595   ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
1596    [InitEmpty, Always, TestRun
1597       [["blockdev_rereadpt"; "/dev/sda"]]],
1598    "reread partition table",
1599    "\
1600 Reread the partition table on C<device>.
1601
1602 This uses the L<blockdev(8)> command.");
1603
1604   ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
1605    [InitBasicFS, Always, TestOutput (
1606       (* Pick a file from cwd which isn't likely to change. *)
1607     [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1608      ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1609    "upload a file from the local machine",
1610    "\
1611 Upload local file C<filename> to C<remotefilename> on the
1612 filesystem.
1613
1614 C<filename> can also be a named pipe.
1615
1616 See also C<guestfs_download>.");
1617
1618   ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
1619    [InitBasicFS, Always, TestOutput (
1620       (* Pick a file from cwd which isn't likely to change. *)
1621     [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1622      ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1623      ["upload"; "testdownload.tmp"; "/upload"];
1624      ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
1625    "download a file to the local machine",
1626    "\
1627 Download file C<remotefilename> and save it as C<filename>
1628 on the local machine.
1629
1630 C<filename> can also be a named pipe.
1631
1632 See also C<guestfs_upload>, C<guestfs_cat>.");
1633
1634   ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
1635    [InitBasicFS, Always, TestOutput (
1636       [["write_file"; "/new"; "test\n"; "0"];
1637        ["checksum"; "crc"; "/new"]], "935282863");
1638     InitBasicFS, Always, TestLastFail (
1639       [["checksum"; "crc"; "/new"]]);
1640     InitBasicFS, Always, TestOutput (
1641       [["write_file"; "/new"; "test\n"; "0"];
1642        ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
1643     InitBasicFS, Always, TestOutput (
1644       [["write_file"; "/new"; "test\n"; "0"];
1645        ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
1646     InitBasicFS, Always, TestOutput (
1647       [["write_file"; "/new"; "test\n"; "0"];
1648        ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
1649     InitBasicFS, Always, TestOutput (
1650       [["write_file"; "/new"; "test\n"; "0"];
1651        ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
1652     InitBasicFS, Always, TestOutput (
1653       [["write_file"; "/new"; "test\n"; "0"];
1654        ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
1655     InitBasicFS, Always, TestOutput (
1656       [["write_file"; "/new"; "test\n"; "0"];
1657        ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123");
1658     InitBasicFS, Always, TestOutput (
1659       [["mount"; "/dev/sdd"; "/"];
1660        ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")],
1661    "compute MD5, SHAx or CRC checksum of file",
1662    "\
1663 This call computes the MD5, SHAx or CRC checksum of the
1664 file named C<path>.
1665
1666 The type of checksum to compute is given by the C<csumtype>
1667 parameter which must have one of the following values:
1668
1669 =over 4
1670
1671 =item C<crc>
1672
1673 Compute the cyclic redundancy check (CRC) specified by POSIX
1674 for the C<cksum> command.
1675
1676 =item C<md5>
1677
1678 Compute the MD5 hash (using the C<md5sum> program).
1679
1680 =item C<sha1>
1681
1682 Compute the SHA1 hash (using the C<sha1sum> program).
1683
1684 =item C<sha224>
1685
1686 Compute the SHA224 hash (using the C<sha224sum> program).
1687
1688 =item C<sha256>
1689
1690 Compute the SHA256 hash (using the C<sha256sum> program).
1691
1692 =item C<sha384>
1693
1694 Compute the SHA384 hash (using the C<sha384sum> program).
1695
1696 =item C<sha512>
1697
1698 Compute the SHA512 hash (using the C<sha512sum> program).
1699
1700 =back
1701
1702 The checksum is returned as a printable string.");
1703
1704   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
1705    [InitBasicFS, Always, TestOutput (
1706       [["tar_in"; "../images/helloworld.tar"; "/"];
1707        ["cat"; "/hello"]], "hello\n")],
1708    "unpack tarfile to directory",
1709    "\
1710 This command uploads and unpacks local file C<tarfile> (an
1711 I<uncompressed> tar file) into C<directory>.
1712
1713 To upload a compressed tarball, use C<guestfs_tgz_in>.");
1714
1715   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
1716    [],
1717    "pack directory into tarfile",
1718    "\
1719 This command packs the contents of C<directory> and downloads
1720 it to local file C<tarfile>.
1721
1722 To download a compressed tarball, use C<guestfs_tgz_out>.");
1723
1724   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
1725    [InitBasicFS, Always, TestOutput (
1726       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
1727        ["cat"; "/hello"]], "hello\n")],
1728    "unpack compressed tarball to directory",
1729    "\
1730 This command uploads and unpacks local file C<tarball> (a
1731 I<gzip compressed> tar file) into C<directory>.
1732
1733 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
1734
1735   ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
1736    [],
1737    "pack directory into compressed tarball",
1738    "\
1739 This command packs the contents of C<directory> and downloads
1740 it to local file C<tarball>.
1741
1742 To download an uncompressed tarball, use C<guestfs_tar_out>.");
1743
1744   ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
1745    [InitBasicFS, Always, TestLastFail (
1746       [["umount"; "/"];
1747        ["mount_ro"; "/dev/sda1"; "/"];
1748        ["touch"; "/new"]]);
1749     InitBasicFS, Always, TestOutput (
1750       [["write_file"; "/new"; "data"; "0"];
1751        ["umount"; "/"];
1752        ["mount_ro"; "/dev/sda1"; "/"];
1753        ["cat"; "/new"]], "data")],
1754    "mount a guest disk, read-only",
1755    "\
1756 This is the same as the C<guestfs_mount> command, but it
1757 mounts the filesystem with the read-only (I<-o ro>) flag.");
1758
1759   ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
1760    [],
1761    "mount a guest disk with mount options",
1762    "\
1763 This is the same as the C<guestfs_mount> command, but it
1764 allows you to set the mount options as for the
1765 L<mount(8)> I<-o> flag.");
1766
1767   ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
1768    [],
1769    "mount a guest disk with mount options and vfstype",
1770    "\
1771 This is the same as the C<guestfs_mount> command, but it
1772 allows you to set both the mount options and the vfstype
1773 as for the L<mount(8)> I<-o> and I<-t> flags.");
1774
1775   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
1776    [],
1777    "debugging and internals",
1778    "\
1779 The C<guestfs_debug> command exposes some internals of
1780 C<guestfsd> (the guestfs daemon) that runs inside the
1781 qemu subprocess.
1782
1783 There is no comprehensive help for this command.  You have
1784 to look at the file C<daemon/debug.c> in the libguestfs source
1785 to find out what you can do.");
1786
1787   ("lvremove", (RErr, [String "device"]), 77, [],
1788    [InitEmpty, Always, TestOutputList (
1789       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1790        ["pvcreate"; "/dev/sda1"];
1791        ["vgcreate"; "VG"; "/dev/sda1"];
1792        ["lvcreate"; "LV1"; "VG"; "50"];
1793        ["lvcreate"; "LV2"; "VG"; "50"];
1794        ["lvremove"; "/dev/VG/LV1"];
1795        ["lvs"]], ["/dev/VG/LV2"]);
1796     InitEmpty, Always, TestOutputList (
1797       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1798        ["pvcreate"; "/dev/sda1"];
1799        ["vgcreate"; "VG"; "/dev/sda1"];
1800        ["lvcreate"; "LV1"; "VG"; "50"];
1801        ["lvcreate"; "LV2"; "VG"; "50"];
1802        ["lvremove"; "/dev/VG"];
1803        ["lvs"]], []);
1804     InitEmpty, Always, TestOutputList (
1805       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1806        ["pvcreate"; "/dev/sda1"];
1807        ["vgcreate"; "VG"; "/dev/sda1"];
1808        ["lvcreate"; "LV1"; "VG"; "50"];
1809        ["lvcreate"; "LV2"; "VG"; "50"];
1810        ["lvremove"; "/dev/VG"];
1811        ["vgs"]], ["VG"])],
1812    "remove an LVM logical volume",
1813    "\
1814 Remove an LVM logical volume C<device>, where C<device> is
1815 the path to the LV, such as C</dev/VG/LV>.
1816
1817 You can also remove all LVs in a volume group by specifying
1818 the VG name, C</dev/VG>.");
1819
1820   ("vgremove", (RErr, [String "vgname"]), 78, [],
1821    [InitEmpty, Always, TestOutputList (
1822       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1823        ["pvcreate"; "/dev/sda1"];
1824        ["vgcreate"; "VG"; "/dev/sda1"];
1825        ["lvcreate"; "LV1"; "VG"; "50"];
1826        ["lvcreate"; "LV2"; "VG"; "50"];
1827        ["vgremove"; "VG"];
1828        ["lvs"]], []);
1829     InitEmpty, Always, TestOutputList (
1830       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1831        ["pvcreate"; "/dev/sda1"];
1832        ["vgcreate"; "VG"; "/dev/sda1"];
1833        ["lvcreate"; "LV1"; "VG"; "50"];
1834        ["lvcreate"; "LV2"; "VG"; "50"];
1835        ["vgremove"; "VG"];
1836        ["vgs"]], [])],
1837    "remove an LVM volume group",
1838    "\
1839 Remove an LVM volume group C<vgname>, (for example C<VG>).
1840
1841 This also forcibly removes all logical volumes in the volume
1842 group (if any).");
1843
1844   ("pvremove", (RErr, [String "device"]), 79, [],
1845    [InitEmpty, Always, TestOutputList (
1846       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1847        ["pvcreate"; "/dev/sda1"];
1848        ["vgcreate"; "VG"; "/dev/sda1"];
1849        ["lvcreate"; "LV1"; "VG"; "50"];
1850        ["lvcreate"; "LV2"; "VG"; "50"];
1851        ["vgremove"; "VG"];
1852        ["pvremove"; "/dev/sda1"];
1853        ["lvs"]], []);
1854     InitEmpty, Always, TestOutputList (
1855       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1856        ["pvcreate"; "/dev/sda1"];
1857        ["vgcreate"; "VG"; "/dev/sda1"];
1858        ["lvcreate"; "LV1"; "VG"; "50"];
1859        ["lvcreate"; "LV2"; "VG"; "50"];
1860        ["vgremove"; "VG"];
1861        ["pvremove"; "/dev/sda1"];
1862        ["vgs"]], []);
1863     InitEmpty, Always, TestOutputList (
1864       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
1865        ["pvcreate"; "/dev/sda1"];
1866        ["vgcreate"; "VG"; "/dev/sda1"];
1867        ["lvcreate"; "LV1"; "VG"; "50"];
1868        ["lvcreate"; "LV2"; "VG"; "50"];
1869        ["vgremove"; "VG"];
1870        ["pvremove"; "/dev/sda1"];
1871        ["pvs"]], [])],
1872    "remove an LVM physical volume",
1873    "\
1874 This wipes a physical volume C<device> so that LVM will no longer
1875 recognise it.
1876
1877 The implementation uses the C<pvremove> command which refuses to
1878 wipe physical volumes that contain any volume groups, so you have
1879 to remove those first.");
1880
1881   ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
1882    [InitBasicFS, Always, TestOutput (
1883       [["set_e2label"; "/dev/sda1"; "testlabel"];
1884        ["get_e2label"; "/dev/sda1"]], "testlabel")],
1885    "set the ext2/3/4 filesystem label",
1886    "\
1887 This sets the ext2/3/4 filesystem label of the filesystem on
1888 C<device> to C<label>.  Filesystem labels are limited to
1889 16 characters.
1890
1891 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
1892 to return the existing label on a filesystem.");
1893
1894   ("get_e2label", (RString "label", [String "device"]), 81, [],
1895    [],
1896    "get the ext2/3/4 filesystem label",
1897    "\
1898 This returns the ext2/3/4 filesystem label of the filesystem on
1899 C<device>.");
1900
1901   ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
1902    [InitBasicFS, Always, TestOutput (
1903       [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
1904        ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
1905     InitBasicFS, Always, TestOutput (
1906       [["set_e2uuid"; "/dev/sda1"; "clear"];
1907        ["get_e2uuid"; "/dev/sda1"]], "");
1908     (* We can't predict what UUIDs will be, so just check the commands run. *)
1909     InitBasicFS, Always, TestRun (
1910       [["set_e2uuid"; "/dev/sda1"; "random"]]);
1911     InitBasicFS, Always, TestRun (
1912       [["set_e2uuid"; "/dev/sda1"; "time"]])],
1913    "set the ext2/3/4 filesystem UUID",
1914    "\
1915 This sets the ext2/3/4 filesystem UUID of the filesystem on
1916 C<device> to C<uuid>.  The format of the UUID and alternatives
1917 such as C<clear>, C<random> and C<time> are described in the
1918 L<tune2fs(8)> manpage.
1919
1920 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
1921 to return the existing UUID of a filesystem.");
1922
1923   ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
1924    [],
1925    "get the ext2/3/4 filesystem UUID",
1926    "\
1927 This returns the ext2/3/4 filesystem UUID of the filesystem on
1928 C<device>.");
1929
1930   ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
1931    [InitBasicFS, Always, TestOutputInt (
1932       [["umount"; "/dev/sda1"];
1933        ["fsck"; "ext2"; "/dev/sda1"]], 0);
1934     InitBasicFS, Always, TestOutputInt (
1935       [["umount"; "/dev/sda1"];
1936        ["zero"; "/dev/sda1"];
1937        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
1938    "run the filesystem checker",
1939    "\
1940 This runs the filesystem checker (fsck) on C<device> which
1941 should have filesystem type C<fstype>.
1942
1943 The returned integer is the status.  See L<fsck(8)> for the
1944 list of status codes from C<fsck>.
1945
1946 Notes:
1947
1948 =over 4
1949
1950 =item *
1951
1952 Multiple status codes can be summed together.
1953
1954 =item *
1955
1956 A non-zero return code can mean \"success\", for example if
1957 errors have been corrected on the filesystem.
1958
1959 =item *
1960
1961 Checking or repairing NTFS volumes is not supported
1962 (by linux-ntfs).
1963
1964 =back
1965
1966 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
1967
1968   ("zero", (RErr, [String "device"]), 85, [],
1969    [InitBasicFS, Always, TestOutput (
1970       [["umount"; "/dev/sda1"];
1971        ["zero"; "/dev/sda1"];
1972        ["file"; "/dev/sda1"]], "data")],
1973    "write zeroes to the device",
1974    "\
1975 This command writes zeroes over the first few blocks of C<device>.
1976
1977 How many blocks are zeroed isn't specified (but it's I<not> enough
1978 to securely wipe the device).  It should be sufficient to remove
1979 any partition tables, filesystem superblocks and so on.");
1980
1981   ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
1982    [InitBasicFS, Always, TestOutputTrue (
1983       [["grub_install"; "/"; "/dev/sda1"];
1984        ["is_dir"; "/boot"]])],
1985    "install GRUB",
1986    "\
1987 This command installs GRUB (the Grand Unified Bootloader) on
1988 C<device>, with the root directory being C<root>.");
1989
1990   ("cp", (RErr, [String "src"; String "dest"]), 87, [],
1991    [InitBasicFS, Always, TestOutput (
1992       [["write_file"; "/old"; "file content"; "0"];
1993        ["cp"; "/old"; "/new"];
1994        ["cat"; "/new"]], "file content");
1995     InitBasicFS, Always, TestOutputTrue (
1996       [["write_file"; "/old"; "file content"; "0"];
1997        ["cp"; "/old"; "/new"];
1998        ["is_file"; "/old"]]);
1999     InitBasicFS, Always, TestOutput (
2000       [["write_file"; "/old"; "file content"; "0"];
2001        ["mkdir"; "/dir"];
2002        ["cp"; "/old"; "/dir/new"];
2003        ["cat"; "/dir/new"]], "file content")],
2004    "copy a file",
2005    "\
2006 This copies a file from C<src> to C<dest> where C<dest> is
2007 either a destination filename or destination directory.");
2008
2009   ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
2010    [InitBasicFS, Always, TestOutput (
2011       [["mkdir"; "/olddir"];
2012        ["mkdir"; "/newdir"];
2013        ["write_file"; "/olddir/file"; "file content"; "0"];
2014        ["cp_a"; "/olddir"; "/newdir"];
2015        ["cat"; "/newdir/olddir/file"]], "file content")],
2016    "copy a file or directory recursively",
2017    "\
2018 This copies a file or directory from C<src> to C<dest>
2019 recursively using the C<cp -a> command.");
2020
2021   ("mv", (RErr, [String "src"; String "dest"]), 89, [],
2022    [InitBasicFS, Always, TestOutput (
2023       [["write_file"; "/old"; "file content"; "0"];
2024        ["mv"; "/old"; "/new"];
2025        ["cat"; "/new"]], "file content");
2026     InitBasicFS, Always, TestOutputFalse (
2027       [["write_file"; "/old"; "file content"; "0"];
2028        ["mv"; "/old"; "/new"];
2029        ["is_file"; "/old"]])],
2030    "move a file",
2031    "\
2032 This moves a file from C<src> to C<dest> where C<dest> is
2033 either a destination filename or destination directory.");
2034
2035   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2036    [InitEmpty, Always, TestRun (
2037       [["drop_caches"; "3"]])],
2038    "drop kernel page cache, dentries and inodes",
2039    "\
2040 This instructs the guest kernel to drop its page cache,
2041 and/or dentries and inode caches.  The parameter C<whattodrop>
2042 tells the kernel what precisely to drop, see
2043 L<http://linux-mm.org/Drop_Caches>
2044
2045 Setting C<whattodrop> to 3 should drop everything.
2046
2047 This automatically calls L<sync(2)> before the operation,
2048 so that the maximum guest memory is freed.");
2049
2050   ("dmesg", (RString "kmsgs", []), 91, [],
2051    [InitEmpty, Always, TestRun (
2052       [["dmesg"]])],
2053    "return kernel messages",
2054    "\
2055 This returns the kernel messages (C<dmesg> output) from
2056 the guest kernel.  This is sometimes useful for extended
2057 debugging of problems.
2058
2059 Another way to get the same information is to enable
2060 verbose messages with C<guestfs_set_verbose> or by setting
2061 the environment variable C<LIBGUESTFS_DEBUG=1> before
2062 running the program.");
2063
2064   ("ping_daemon", (RErr, []), 92, [],
2065    [InitEmpty, Always, TestRun (
2066       [["ping_daemon"]])],
2067    "ping the guest daemon",
2068    "\
2069 This is a test probe into the guestfs daemon running inside
2070 the qemu subprocess.  Calling this function checks that the
2071 daemon responds to the ping message, without affecting the daemon
2072 or attached block device(s) in any other way.");
2073
2074   ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
2075    [InitBasicFS, Always, TestOutputTrue (
2076       [["write_file"; "/file1"; "contents of a file"; "0"];
2077        ["cp"; "/file1"; "/file2"];
2078        ["equal"; "/file1"; "/file2"]]);
2079     InitBasicFS, Always, TestOutputFalse (
2080       [["write_file"; "/file1"; "contents of a file"; "0"];
2081        ["write_file"; "/file2"; "contents of another file"; "0"];
2082        ["equal"; "/file1"; "/file2"]]);
2083     InitBasicFS, Always, TestLastFail (
2084       [["equal"; "/file1"; "/file2"]])],
2085    "test if two files have equal contents",
2086    "\
2087 This compares the two files C<file1> and C<file2> and returns
2088 true if their content is exactly equal, or false otherwise.
2089
2090 The external L<cmp(1)> program is used for the comparison.");
2091
2092   ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning],
2093    [InitBasicFS, Always, TestOutputList (
2094       [["write_file"; "/new"; "hello\nworld\n"; "0"];
2095        ["strings"; "/new"]], ["hello"; "world"]);
2096     InitBasicFS, Always, TestOutputList (
2097       [["touch"; "/new"];
2098        ["strings"; "/new"]], [])],
2099    "print the printable strings in a file",
2100    "\
2101 This runs the L<strings(1)> command on a file and returns
2102 the list of printable strings found.");
2103
2104   ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning],
2105    [InitBasicFS, Always, TestOutputList (
2106       [["write_file"; "/new"; "hello\nworld\n"; "0"];
2107        ["strings_e"; "b"; "/new"]], []);
2108     InitBasicFS, Disabled, TestOutputList (
2109       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2110        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2111    "print the printable strings in a file",
2112    "\
2113 This is like the C<guestfs_strings> command, but allows you to
2114 specify the encoding.
2115
2116 See the L<strings(1)> manpage for the full list of encodings.
2117
2118 Commonly useful encodings are C<l> (lower case L) which will
2119 show strings inside Windows/x86 files.
2120
2121 The returned strings are transcoded to UTF-8.");
2122
2123   ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
2124    [InitBasicFS, Always, TestOutput (
2125       [["write_file"; "/new"; "hello\nworld\n"; "12"];
2126        ["hexdump"; "/new"]], "00000000  68 65 6c 6c 6f 0a 77 6f  72 6c 64 0a              |hello.world.|\n0000000c\n")],
2127    "dump a file in hexadecimal",
2128    "\
2129 This runs C<hexdump -C> on the given C<path>.  The result is
2130 the human-readable, canonical hex dump of the file.");
2131
2132   ("zerofree", (RErr, [String "device"]), 97, [],
2133    [InitNone, Always, TestOutput (
2134       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2135        ["mkfs"; "ext3"; "/dev/sda1"];
2136        ["mount"; "/dev/sda1"; "/"];
2137        ["write_file"; "/new"; "test file"; "0"];
2138        ["umount"; "/dev/sda1"];
2139        ["zerofree"; "/dev/sda1"];
2140        ["mount"; "/dev/sda1"; "/"];
2141        ["cat"; "/new"]], "test file")],
2142    "zero unused inodes and disk blocks on ext2/3 filesystem",
2143    "\
2144 This runs the I<zerofree> program on C<device>.  This program
2145 claims to zero unused inodes and disk blocks on an ext2/3
2146 filesystem, thus making it possible to compress the filesystem
2147 more effectively.
2148
2149 You should B<not> run this program if the filesystem is
2150 mounted.
2151
2152 It is possible that using this program can damage the filesystem
2153 or data on the filesystem.");
2154
2155   ("pvresize", (RErr, [String "device"]), 98, [],
2156    [],
2157    "resize an LVM physical volume",
2158    "\
2159 This resizes (expands or shrinks) an existing LVM physical
2160 volume to match the new size of the underlying device.");
2161
2162   ("sfdisk_N", (RErr, [String "device"; Int "n";
2163                        Int "cyls"; Int "heads"; Int "sectors";
2164                        String "line"]), 99, [DangerWillRobinson],
2165    [],
2166    "modify a single partition on a block device",
2167    "\
2168 This runs L<sfdisk(8)> option to modify just the single
2169 partition C<n> (note: C<n> counts from 1).
2170
2171 For other parameters, see C<guestfs_sfdisk>.  You should usually
2172 pass C<0> for the cyls/heads/sectors parameters.");
2173
2174   ("sfdisk_l", (RString "partitions", [String "device"]), 100, [],
2175    [],
2176    "display the partition table",
2177    "\
2178 This displays the partition table on C<device>, in the
2179 human-readable output of the L<sfdisk(8)> command.  It is
2180 not intended to be parsed.");
2181
2182   ("sfdisk_kernel_geometry", (RString "partitions", [String "device"]), 101, [],
2183    [],
2184    "display the kernel geometry",
2185    "\
2186 This displays the kernel's idea of the geometry of C<device>.
2187
2188 The result is in human-readable format, and not designed to
2189 be parsed.");
2190
2191   ("sfdisk_disk_geometry", (RString "partitions", [String "device"]), 102, [],
2192    [],
2193    "display the disk geometry from the partition table",
2194    "\
2195 This displays the disk geometry of C<device> read from the
2196 partition table.  Especially in the case where the underlying
2197 block device has been resized, this can be different from the
2198 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2199
2200 The result is in human-readable format, and not designed to
2201 be parsed.");
2202
2203   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [],
2204    [],
2205    "activate or deactivate all volume groups",
2206    "\
2207 This command activates or (if C<activate> is false) deactivates
2208 all logical volumes in all volume groups.
2209 If activated, then they are made known to the
2210 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2211 then those devices disappear.
2212
2213 This command is the same as running C<vgchange -a y|n>");
2214
2215   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [],
2216    [],
2217    "activate or deactivate some volume groups",
2218    "\
2219 This command activates or (if C<activate> is false) deactivates
2220 all logical volumes in the listed volume groups C<volgroups>.
2221 If activated, then they are made known to the
2222 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2223 then those devices disappear.
2224
2225 This command is the same as running C<vgchange -a y|n volgroups...>
2226
2227 Note that if C<volgroups> is an empty list then B<all> volume groups
2228 are activated or deactivated.");
2229
2230   ("lvresize", (RErr, [String "device"; Int "mbytes"]), 105, [],
2231    [InitNone, Always, TestOutput (
2232     [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
2233      ["pvcreate"; "/dev/sda1"];
2234      ["vgcreate"; "VG"; "/dev/sda1"];
2235      ["lvcreate"; "LV"; "VG"; "10"];
2236      ["mkfs"; "ext2"; "/dev/VG/LV"];
2237      ["mount"; "/dev/VG/LV"; "/"];
2238      ["write_file"; "/new"; "test content"; "0"];
2239      ["umount"; "/"];
2240      ["lvresize"; "/dev/VG/LV"; "20"];
2241      ["e2fsck_f"; "/dev/VG/LV"];
2242      ["resize2fs"; "/dev/VG/LV"];
2243      ["mount"; "/dev/VG/LV"; "/"];
2244      ["cat"; "/new"]], "test content")],
2245    "resize an LVM logical volume",
2246    "\
2247 This resizes (expands or shrinks) an existing LVM logical
2248 volume to C<mbytes>.  When reducing, data in the reduced part
2249 is lost.");
2250
2251   ("resize2fs", (RErr, [String "device"]), 106, [],
2252    [], (* lvresize tests this *)
2253    "resize an ext2/ext3 filesystem",
2254    "\
2255 This resizes an ext2 or ext3 filesystem to match the size of
2256 the underlying device.
2257
2258 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2259 on the C<device> before calling this command.  For unknown reasons
2260 C<resize2fs> sometimes gives an error about this and sometimes not.
2261 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2262 calling this function.");
2263
2264   ("find", (RStringList "names", [String "directory"]), 107, [],
2265    [InitBasicFS, Always, TestOutputList (
2266       [["find"; "/"]], ["lost+found"]);
2267     InitBasicFS, Always, TestOutputList (
2268       [["touch"; "/a"];
2269        ["mkdir"; "/b"];
2270        ["touch"; "/b/c"];
2271        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2272     InitBasicFS, Always, TestOutputList (
2273       [["mkdir_p"; "/a/b/c"];
2274        ["touch"; "/a/b/c/d"];
2275        ["find"; "/a/b/"]], ["c"; "c/d"])],
2276    "find all files and directories",
2277    "\
2278 This command lists out all files and directories, recursively,
2279 starting at C<directory>.  It is essentially equivalent to
2280 running the shell command C<find directory -print> but some
2281 post-processing happens on the output, described below.
2282
2283 This returns a list of strings I<without any prefix>.  Thus
2284 if the directory structure was:
2285
2286  /tmp/a
2287  /tmp/b
2288  /tmp/c/d
2289
2290 then the returned list from C<guestfs_find> C</tmp> would be
2291 4 elements:
2292
2293  a
2294  b
2295  c
2296  c/d
2297
2298 If C<directory> is not a directory, then this command returns
2299 an error.
2300
2301 The returned list is sorted.");
2302
2303   ("e2fsck_f", (RErr, [String "device"]), 108, [],
2304    [], (* lvresize tests this *)
2305    "check an ext2/ext3 filesystem",
2306    "\
2307 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2308 filesystem checker on C<device>, noninteractively (C<-p>),
2309 even if the filesystem appears to be clean (C<-f>).
2310
2311 This command is only needed because of C<guestfs_resize2fs>
2312 (q.v.).  Normally you should use C<guestfs_fsck>.");
2313
2314 ]
2315
2316 let all_functions = non_daemon_functions @ daemon_functions
2317
2318 (* In some places we want the functions to be displayed sorted
2319  * alphabetically, so this is useful:
2320  *)
2321 let all_functions_sorted =
2322   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
2323                compare n1 n2) all_functions
2324
2325 (* Column names and types from LVM PVs/VGs/LVs. *)
2326 let pv_cols = [
2327   "pv_name", `String;
2328   "pv_uuid", `UUID;
2329   "pv_fmt", `String;
2330   "pv_size", `Bytes;
2331   "dev_size", `Bytes;
2332   "pv_free", `Bytes;
2333   "pv_used", `Bytes;
2334   "pv_attr", `String (* XXX *);
2335   "pv_pe_count", `Int;
2336   "pv_pe_alloc_count", `Int;
2337   "pv_tags", `String;
2338   "pe_start", `Bytes;
2339   "pv_mda_count", `Int;
2340   "pv_mda_free", `Bytes;
2341 (* Not in Fedora 10:
2342   "pv_mda_size", `Bytes;
2343 *)
2344 ]
2345 let vg_cols = [
2346   "vg_name", `String;
2347   "vg_uuid", `UUID;
2348   "vg_fmt", `String;
2349   "vg_attr", `String (* XXX *);
2350   "vg_size", `Bytes;
2351   "vg_free", `Bytes;
2352   "vg_sysid", `String;
2353   "vg_extent_size", `Bytes;
2354   "vg_extent_count", `Int;
2355   "vg_free_count", `Int;
2356   "max_lv", `Int;
2357   "max_pv", `Int;
2358   "pv_count", `Int;
2359   "lv_count", `Int;
2360   "snap_count", `Int;
2361   "vg_seqno", `Int;
2362   "vg_tags", `String;
2363   "vg_mda_count", `Int;
2364   "vg_mda_free", `Bytes;
2365 (* Not in Fedora 10:
2366   "vg_mda_size", `Bytes;
2367 *)
2368 ]
2369 let lv_cols = [
2370   "lv_name", `String;
2371   "lv_uuid", `UUID;
2372   "lv_attr", `String (* XXX *);
2373   "lv_major", `Int;
2374   "lv_minor", `Int;
2375   "lv_kernel_major", `Int;
2376   "lv_kernel_minor", `Int;
2377   "lv_size", `Bytes;
2378   "seg_count", `Int;
2379   "origin", `String;
2380   "snap_percent", `OptPercent;
2381   "copy_percent", `OptPercent;
2382   "move_pv", `String;
2383   "lv_tags", `String;
2384   "mirror_log", `String;
2385   "modules", `String;
2386 ]
2387
2388 (* Column names and types from stat structures.
2389  * NB. Can't use things like 'st_atime' because glibc header files
2390  * define some of these as macros.  Ugh.
2391  *)
2392 let stat_cols = [
2393   "dev", `Int;
2394   "ino", `Int;
2395   "mode", `Int;
2396   "nlink", `Int;
2397   "uid", `Int;
2398   "gid", `Int;
2399   "rdev", `Int;
2400   "size", `Int;
2401   "blksize", `Int;
2402   "blocks", `Int;
2403   "atime", `Int;
2404   "mtime", `Int;
2405   "ctime", `Int;
2406 ]
2407 let statvfs_cols = [
2408   "bsize", `Int;
2409   "frsize", `Int;
2410   "blocks", `Int;
2411   "bfree", `Int;
2412   "bavail", `Int;
2413   "files", `Int;
2414   "ffree", `Int;
2415   "favail", `Int;
2416   "fsid", `Int;
2417   "flag", `Int;
2418   "namemax", `Int;
2419 ]
2420
2421 (* Used for testing language bindings. *)
2422 type callt =
2423   | CallString of string
2424   | CallOptString of string option
2425   | CallStringList of string list
2426   | CallInt of int
2427   | CallBool of bool
2428
2429 (* Useful functions.
2430  * Note we don't want to use any external OCaml libraries which
2431  * makes this a bit harder than it should be.
2432  *)
2433 let failwithf fs = ksprintf failwith fs
2434
2435 let replace_char s c1 c2 =
2436   let s2 = String.copy s in
2437   let r = ref false in
2438   for i = 0 to String.length s2 - 1 do
2439     if String.unsafe_get s2 i = c1 then (
2440       String.unsafe_set s2 i c2;
2441       r := true
2442     )
2443   done;
2444   if not !r then s else s2
2445
2446 let isspace c =
2447   c = ' '
2448   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
2449
2450 let triml ?(test = isspace) str =
2451   let i = ref 0 in
2452   let n = ref (String.length str) in
2453   while !n > 0 && test str.[!i]; do
2454     decr n;
2455     incr i
2456   done;
2457   if !i = 0 then str
2458   else String.sub str !i !n
2459
2460 let trimr ?(test = isspace) str =
2461   let n = ref (String.length str) in
2462   while !n > 0 && test str.[!n-1]; do
2463     decr n
2464   done;
2465   if !n = String.length str then str
2466   else String.sub str 0 !n
2467
2468 let trim ?(test = isspace) str =
2469   trimr ~test (triml ~test str)
2470
2471 let rec find s sub =
2472   let len = String.length s in
2473   let sublen = String.length sub in
2474   let rec loop i =
2475     if i <= len-sublen then (
2476       let rec loop2 j =
2477         if j < sublen then (
2478           if s.[i+j] = sub.[j] then loop2 (j+1)
2479           else -1
2480         ) else
2481           i (* found *)
2482       in
2483       let r = loop2 0 in
2484       if r = -1 then loop (i+1) else r
2485     ) else
2486       -1 (* not found *)
2487   in
2488   loop 0
2489
2490 let rec replace_str s s1 s2 =
2491   let len = String.length s in
2492   let sublen = String.length s1 in
2493   let i = find s s1 in
2494   if i = -1 then s
2495   else (
2496     let s' = String.sub s 0 i in
2497     let s'' = String.sub s (i+sublen) (len-i-sublen) in
2498     s' ^ s2 ^ replace_str s'' s1 s2
2499   )
2500
2501 let rec string_split sep str =
2502   let len = String.length str in
2503   let seplen = String.length sep in
2504   let i = find str sep in
2505   if i = -1 then [str]
2506   else (
2507     let s' = String.sub str 0 i in
2508     let s'' = String.sub str (i+seplen) (len-i-seplen) in
2509     s' :: string_split sep s''
2510   )
2511
2512 let files_equal n1 n2 =
2513   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
2514   match Sys.command cmd with
2515   | 0 -> true
2516   | 1 -> false
2517   | i -> failwithf "%s: failed with error code %d" cmd i
2518
2519 let rec find_map f = function
2520   | [] -> raise Not_found
2521   | x :: xs ->
2522       match f x with
2523       | Some y -> y
2524       | None -> find_map f xs
2525
2526 let iteri f xs =
2527   let rec loop i = function
2528     | [] -> ()
2529     | x :: xs -> f i x; loop (i+1) xs
2530   in
2531   loop 0 xs
2532
2533 let mapi f xs =
2534   let rec loop i = function
2535     | [] -> []
2536     | x :: xs -> let r = f i x in r :: loop (i+1) xs
2537   in
2538   loop 0 xs
2539
2540 let name_of_argt = function
2541   | String n | OptString n | StringList n | Bool n | Int n
2542   | FileIn n | FileOut n -> n
2543
2544 let seq_of_test = function
2545   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
2546   | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
2547   | TestOutputLength (s, _) | TestOutputStruct (s, _)
2548   | TestLastFail s -> s
2549
2550 (* Check function names etc. for consistency. *)
2551 let check_functions () =
2552   let contains_uppercase str =
2553     let len = String.length str in
2554     let rec loop i =
2555       if i >= len then false
2556       else (
2557         let c = str.[i] in
2558         if c >= 'A' && c <= 'Z' then true
2559         else loop (i+1)
2560       )
2561     in
2562     loop 0
2563   in
2564
2565   (* Check function names. *)
2566   List.iter (
2567     fun (name, _, _, _, _, _, _) ->
2568       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
2569         failwithf "function name %s does not need 'guestfs' prefix" name;
2570       if name = "" then
2571         failwithf "function name is empty";
2572       if name.[0] < 'a' || name.[0] > 'z' then
2573         failwithf "function name %s must start with lowercase a-z" name;
2574       if String.contains name '-' then
2575         failwithf "function name %s should not contain '-', use '_' instead."
2576           name
2577   ) all_functions;
2578
2579   (* Check function parameter/return names. *)
2580   List.iter (
2581     fun (name, style, _, _, _, _, _) ->
2582       let check_arg_ret_name n =
2583         if contains_uppercase n then
2584           failwithf "%s param/ret %s should not contain uppercase chars"
2585             name n;
2586         if String.contains n '-' || String.contains n '_' then
2587           failwithf "%s param/ret %s should not contain '-' or '_'"
2588             name n;
2589         if n = "value" then
2590           failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
2591         if n = "int" || n = "char" || n = "short" || n = "long" then
2592           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
2593         if n = "i" then
2594           failwithf "%s has a param/ret called 'i', which will cause some conflicts in the generated code" name;
2595         if n = "argv" || n = "args" then
2596           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name
2597       in
2598
2599       (match fst style with
2600        | RErr -> ()
2601        | RInt n | RInt64 n | RBool n | RConstString n | RString n
2602        | RStringList n | RPVList n | RVGList n | RLVList n
2603        | RStat n | RStatVFS n
2604        | RHashtable n ->
2605            check_arg_ret_name n
2606        | RIntBool (n,m) ->
2607            check_arg_ret_name n;
2608            check_arg_ret_name m
2609       );
2610       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
2611   ) all_functions;
2612
2613   (* Check short descriptions. *)
2614   List.iter (
2615     fun (name, _, _, _, _, shortdesc, _) ->
2616       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
2617         failwithf "short description of %s should begin with lowercase." name;
2618       let c = shortdesc.[String.length shortdesc-1] in
2619       if c = '\n' || c = '.' then
2620         failwithf "short description of %s should not end with . or \\n." name
2621   ) all_functions;
2622
2623   (* Check long dscriptions. *)
2624   List.iter (
2625     fun (name, _, _, _, _, _, longdesc) ->
2626       if longdesc.[String.length longdesc-1] = '\n' then
2627         failwithf "long description of %s should not end with \\n." name
2628   ) all_functions;
2629
2630   (* Check proc_nrs. *)
2631   List.iter (
2632     fun (name, _, proc_nr, _, _, _, _) ->
2633       if proc_nr <= 0 then
2634         failwithf "daemon function %s should have proc_nr > 0" name
2635   ) daemon_functions;
2636
2637   List.iter (
2638     fun (name, _, proc_nr, _, _, _, _) ->
2639       if proc_nr <> -1 then
2640         failwithf "non-daemon function %s should have proc_nr -1" name
2641   ) non_daemon_functions;
2642
2643   let proc_nrs =
2644     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
2645       daemon_functions in
2646   let proc_nrs =
2647     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
2648   let rec loop = function
2649     | [] -> ()
2650     | [_] -> ()
2651     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
2652         loop rest
2653     | (name1,nr1) :: (name2,nr2) :: _ ->
2654         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
2655           name1 name2 nr1 nr2
2656   in
2657   loop proc_nrs;
2658
2659   (* Check tests. *)
2660   List.iter (
2661     function
2662       (* Ignore functions that have no tests.  We generate a
2663        * warning when the user does 'make check' instead.
2664        *)
2665     | name, _, _, _, [], _, _ -> ()
2666     | name, _, _, _, tests, _, _ ->
2667         let funcs =
2668           List.map (
2669             fun (_, _, test) ->
2670               match seq_of_test test with
2671               | [] ->
2672                   failwithf "%s has a test containing an empty sequence" name
2673               | cmds -> List.map List.hd cmds
2674           ) tests in
2675         let funcs = List.flatten funcs in
2676
2677         let tested = List.mem name funcs in
2678
2679         if not tested then
2680           failwithf "function %s has tests but does not test itself" name
2681   ) all_functions
2682
2683 (* 'pr' prints to the current output file. *)
2684 let chan = ref stdout
2685 let pr fs = ksprintf (output_string !chan) fs
2686
2687 (* Generate a header block in a number of standard styles. *)
2688 type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
2689 type license = GPLv2 | LGPLv2
2690
2691 let generate_header comment license =
2692   let c = match comment with
2693     | CStyle ->     pr "/* "; " *"
2694     | HashStyle ->  pr "# ";  "#"
2695     | OCamlStyle -> pr "(* "; " *"
2696     | HaskellStyle -> pr "{- "; "  " in
2697   pr "libguestfs generated file\n";
2698   pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
2699   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
2700   pr "%s\n" c;
2701   pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
2702   pr "%s\n" c;
2703   (match license with
2704    | GPLv2 ->
2705        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
2706        pr "%s it under the terms of the GNU General Public License as published by\n" c;
2707        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
2708        pr "%s (at your option) any later version.\n" c;
2709        pr "%s\n" c;
2710        pr "%s This program is distributed in the hope that it will be useful,\n" c;
2711        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2712        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
2713        pr "%s GNU General Public License for more details.\n" c;
2714        pr "%s\n" c;
2715        pr "%s You should have received a copy of the GNU General Public License along\n" c;
2716        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
2717        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
2718
2719    | LGPLv2 ->
2720        pr "%s This library is free software; you can redistribute it and/or\n" c;
2721        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
2722        pr "%s License as published by the Free Software Foundation; either\n" c;
2723        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
2724        pr "%s\n" c;
2725        pr "%s This library is distributed in the hope that it will be useful,\n" c;
2726        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
2727        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
2728        pr "%s Lesser General Public License for more details.\n" c;
2729        pr "%s\n" c;
2730        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
2731        pr "%s License along with this library; if not, write to the Free Software\n" c;
2732        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
2733   );
2734   (match comment with
2735    | CStyle -> pr " */\n"
2736    | HashStyle -> ()
2737    | OCamlStyle -> pr " *)\n"
2738    | HaskellStyle -> pr "-}\n"
2739   );
2740   pr "\n"
2741
2742 (* Start of main code generation functions below this line. *)
2743
2744 (* Generate the pod documentation for the C API. *)
2745 let rec generate_actions_pod () =
2746   List.iter (
2747     fun (shortname, style, _, flags, _, _, longdesc) ->
2748       if not (List.mem NotInDocs flags) then (
2749         let name = "guestfs_" ^ shortname in
2750         pr "=head2 %s\n\n" name;
2751         pr " ";
2752         generate_prototype ~extern:false ~handle:"handle" name style;
2753         pr "\n\n";
2754         pr "%s\n\n" longdesc;
2755         (match fst style with
2756          | RErr ->
2757              pr "This function returns 0 on success or -1 on error.\n\n"
2758          | RInt _ ->
2759              pr "On error this function returns -1.\n\n"
2760          | RInt64 _ ->
2761              pr "On error this function returns -1.\n\n"
2762          | RBool _ ->
2763              pr "This function returns a C truth value on success or -1 on error.\n\n"
2764          | RConstString _ ->
2765              pr "This function returns a string, or NULL on error.
2766 The string is owned by the guest handle and must I<not> be freed.\n\n"
2767          | RString _ ->
2768              pr "This function returns a string, or NULL on error.
2769 I<The caller must free the returned string after use>.\n\n"
2770          | RStringList _ ->
2771              pr "This function returns a NULL-terminated array of strings
2772 (like L<environ(3)>), or NULL if there was an error.
2773 I<The caller must free the strings and the array after use>.\n\n"
2774          | RIntBool _ ->
2775              pr "This function returns a C<struct guestfs_int_bool *>,
2776 or NULL if there was an error.
2777 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
2778          | RPVList _ ->
2779              pr "This function returns a C<struct guestfs_lvm_pv_list *>
2780 (see E<lt>guestfs-structs.hE<gt>),
2781 or NULL if there was an error.
2782 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
2783          | RVGList _ ->
2784              pr "This function returns a C<struct guestfs_lvm_vg_list *>
2785 (see E<lt>guestfs-structs.hE<gt>),
2786 or NULL if there was an error.
2787 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
2788          | RLVList _ ->
2789              pr "This function returns a C<struct guestfs_lvm_lv_list *>
2790 (see E<lt>guestfs-structs.hE<gt>),
2791 or NULL if there was an error.
2792 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
2793          | RStat _ ->
2794              pr "This function returns a C<struct guestfs_stat *>
2795 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
2796 or NULL if there was an error.
2797 I<The caller must call C<free> after use>.\n\n"
2798          | RStatVFS _ ->
2799              pr "This function returns a C<struct guestfs_statvfs *>
2800 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
2801 or NULL if there was an error.
2802 I<The caller must call C<free> after use>.\n\n"
2803          | RHashtable _ ->
2804              pr "This function returns a NULL-terminated array of
2805 strings, or NULL if there was an error.
2806 The array of strings will always have length C<2n+1>, where
2807 C<n> keys and values alternate, followed by the trailing NULL entry.
2808 I<The caller must free the strings and the array after use>.\n\n"
2809         );
2810         if List.mem ProtocolLimitWarning flags then
2811           pr "%s\n\n" protocol_limit_warning;
2812         if List.mem DangerWillRobinson flags then
2813           pr "%s\n\n" danger_will_robinson
2814       )
2815   ) all_functions_sorted
2816
2817 and generate_structs_pod () =
2818   (* LVM structs documentation. *)
2819   List.iter (
2820     fun (typ, cols) ->
2821       pr "=head2 guestfs_lvm_%s\n" typ;
2822       pr "\n";
2823       pr " struct guestfs_lvm_%s {\n" typ;
2824       List.iter (
2825         function
2826         | name, `String -> pr "  char *%s;\n" name
2827         | name, `UUID ->
2828             pr "  /* The next field is NOT nul-terminated, be careful when printing it: */\n";
2829             pr "  char %s[32];\n" name
2830         | name, `Bytes -> pr "  uint64_t %s;\n" name
2831         | name, `Int -> pr "  int64_t %s;\n" name
2832         | name, `OptPercent ->
2833             pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
2834             pr "  float %s;\n" name
2835       ) cols;
2836       pr " \n";
2837       pr " struct guestfs_lvm_%s_list {\n" typ;
2838       pr "   uint32_t len; /* Number of elements in list. */\n";
2839       pr "   struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
2840       pr " };\n";
2841       pr " \n";
2842       pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
2843         typ typ;
2844       pr "\n"
2845   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
2846
2847 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
2848  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
2849  *
2850  * We have to use an underscore instead of a dash because otherwise
2851  * rpcgen generates incorrect code.
2852  *
2853  * This header is NOT exported to clients, but see also generate_structs_h.
2854  *)
2855 and generate_xdr () =
2856   generate_header CStyle LGPLv2;
2857
2858   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
2859   pr "typedef string str<>;\n";
2860   pr "\n";
2861
2862   (* LVM internal structures. *)
2863   List.iter (
2864     function
2865     | typ, cols ->
2866         pr "struct guestfs_lvm_int_%s {\n" typ;
2867         List.iter (function
2868                    | name, `String -> pr "  string %s<>;\n" name
2869                    | name, `UUID -> pr "  opaque %s[32];\n" name
2870                    | name, `Bytes -> pr "  hyper %s;\n" name
2871                    | name, `Int -> pr "  hyper %s;\n" name
2872                    | name, `OptPercent -> pr "  float %s;\n" name
2873                   ) cols;
2874         pr "};\n";
2875         pr "\n";
2876         pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
2877         pr "\n";
2878   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
2879
2880   (* Stat internal structures. *)
2881   List.iter (
2882     function
2883     | typ, cols ->
2884         pr "struct guestfs_int_%s {\n" typ;
2885         List.iter (function
2886                    | name, `Int -> pr "  hyper %s;\n" name
2887                   ) cols;
2888         pr "};\n";
2889         pr "\n";
2890   ) ["stat", stat_cols; "statvfs", statvfs_cols];
2891
2892   List.iter (
2893     fun (shortname, style, _, _, _, _, _) ->
2894       let name = "guestfs_" ^ shortname in
2895
2896       (match snd style with
2897        | [] -> ()
2898        | args ->
2899            pr "struct %s_args {\n" name;
2900            List.iter (
2901              function
2902              | String n -> pr "  string %s<>;\n" n
2903              | OptString n -> pr "  str *%s;\n" n
2904              | StringList n -> pr "  str %s<>;\n" n
2905              | Bool n -> pr "  bool %s;\n" n
2906              | Int n -> pr "  int %s;\n" n
2907              | FileIn _ | FileOut _ -> ()
2908            ) args;
2909            pr "};\n\n"
2910       );
2911       (match fst style with
2912        | RErr -> ()
2913        | RInt n ->
2914            pr "struct %s_ret {\n" name;
2915            pr "  int %s;\n" n;
2916            pr "};\n\n"
2917        | RInt64 n ->
2918            pr "struct %s_ret {\n" name;
2919            pr "  hyper %s;\n" n;
2920            pr "};\n\n"
2921        | RBool n ->
2922            pr "struct %s_ret {\n" name;
2923            pr "  bool %s;\n" n;
2924            pr "};\n\n"
2925        | RConstString _ ->
2926            failwithf "RConstString cannot be returned from a daemon function"
2927        | RString n ->
2928            pr "struct %s_ret {\n" name;
2929            pr "  string %s<>;\n" n;
2930            pr "};\n\n"
2931        | RStringList n ->
2932            pr "struct %s_ret {\n" name;
2933            pr "  str %s<>;\n" n;
2934            pr "};\n\n"
2935        | RIntBool (n,m) ->
2936            pr "struct %s_ret {\n" name;
2937            pr "  int %s;\n" n;
2938            pr "  bool %s;\n" m;
2939            pr "};\n\n"
2940        | RPVList n ->
2941            pr "struct %s_ret {\n" name;
2942            pr "  guestfs_lvm_int_pv_list %s;\n" n;
2943            pr "};\n\n"
2944        | RVGList n ->
2945            pr "struct %s_ret {\n" name;
2946            pr "  guestfs_lvm_int_vg_list %s;\n" n;
2947            pr "};\n\n"
2948        | RLVList n ->
2949            pr "struct %s_ret {\n" name;
2950            pr "  guestfs_lvm_int_lv_list %s;\n" n;
2951            pr "};\n\n"
2952        | RStat n ->
2953            pr "struct %s_ret {\n" name;
2954            pr "  guestfs_int_stat %s;\n" n;
2955            pr "};\n\n"
2956        | RStatVFS n ->
2957            pr "struct %s_ret {\n" name;
2958            pr "  guestfs_int_statvfs %s;\n" n;
2959            pr "};\n\n"
2960        | RHashtable n ->
2961            pr "struct %s_ret {\n" name;
2962            pr "  str %s<>;\n" n;
2963            pr "};\n\n"
2964       );
2965   ) daemon_functions;
2966
2967   (* Table of procedure numbers. *)
2968   pr "enum guestfs_procedure {\n";
2969   List.iter (
2970     fun (shortname, _, proc_nr, _, _, _, _) ->
2971       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
2972   ) daemon_functions;
2973   pr "  GUESTFS_PROC_NR_PROCS\n";
2974   pr "};\n";
2975   pr "\n";
2976
2977   (* Having to choose a maximum message size is annoying for several
2978    * reasons (it limits what we can do in the API), but it (a) makes
2979    * the protocol a lot simpler, and (b) provides a bound on the size
2980    * of the daemon which operates in limited memory space.  For large
2981    * file transfers you should use FTP.
2982    *)
2983   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
2984   pr "\n";
2985
2986   (* Message header, etc. *)
2987   pr "\
2988 /* The communication protocol is now documented in the guestfs(3)
2989  * manpage.
2990  */
2991
2992 const GUESTFS_PROGRAM = 0x2000F5F5;
2993 const GUESTFS_PROTOCOL_VERSION = 1;
2994
2995 /* These constants must be larger than any possible message length. */
2996 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
2997 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
2998
2999 enum guestfs_message_direction {
3000   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
3001   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
3002 };
3003
3004 enum guestfs_message_status {
3005   GUESTFS_STATUS_OK = 0,
3006   GUESTFS_STATUS_ERROR = 1
3007 };
3008
3009 const GUESTFS_ERROR_LEN = 256;
3010
3011 struct guestfs_message_error {
3012   string error_message<GUESTFS_ERROR_LEN>;
3013 };
3014
3015 struct guestfs_message_header {
3016   unsigned prog;                     /* GUESTFS_PROGRAM */
3017   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
3018   guestfs_procedure proc;            /* GUESTFS_PROC_x */
3019   guestfs_message_direction direction;
3020   unsigned serial;                   /* message serial number */
3021   guestfs_message_status status;
3022 };
3023
3024 const GUESTFS_MAX_CHUNK_SIZE = 8192;
3025
3026 struct guestfs_chunk {
3027   int cancel;                        /* if non-zero, transfer is cancelled */
3028   /* data size is 0 bytes if the transfer has finished successfully */
3029   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
3030 };
3031 "
3032
3033 (* Generate the guestfs-structs.h file. *)
3034 and generate_structs_h () =
3035   generate_header CStyle LGPLv2;
3036
3037   (* This is a public exported header file containing various
3038    * structures.  The structures are carefully written to have
3039    * exactly the same in-memory format as the XDR structures that
3040    * we use on the wire to the daemon.  The reason for creating
3041    * copies of these structures here is just so we don't have to
3042    * export the whole of guestfs_protocol.h (which includes much
3043    * unrelated and XDR-dependent stuff that we don't want to be
3044    * public, or required by clients).
3045    *
3046    * To reiterate, we will pass these structures to and from the
3047    * client with a simple assignment or memcpy, so the format
3048    * must be identical to what rpcgen / the RFC defines.
3049    *)
3050
3051   (* guestfs_int_bool structure. *)
3052   pr "struct guestfs_int_bool {\n";
3053   pr "  int32_t i;\n";
3054   pr "  int32_t b;\n";
3055   pr "};\n";
3056   pr "\n";
3057
3058   (* LVM public structures. *)
3059   List.iter (
3060     function
3061     | typ, cols ->
3062         pr "struct guestfs_lvm_%s {\n" typ;
3063         List.iter (
3064           function
3065           | name, `String -> pr "  char *%s;\n" name
3066           | name, `UUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
3067           | name, `Bytes -> pr "  uint64_t %s;\n" name
3068           | name, `Int -> pr "  int64_t %s;\n" name
3069           | name, `OptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
3070         ) cols;
3071         pr "};\n";
3072         pr "\n";
3073         pr "struct guestfs_lvm_%s_list {\n" typ;
3074         pr "  uint32_t len;\n";
3075         pr "  struct guestfs_lvm_%s *val;\n" typ;
3076         pr "};\n";
3077         pr "\n"
3078   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
3079
3080   (* Stat structures. *)
3081   List.iter (
3082     function
3083     | typ, cols ->
3084         pr "struct guestfs_%s {\n" typ;
3085         List.iter (
3086           function
3087           | name, `Int -> pr "  int64_t %s;\n" name
3088         ) cols;
3089         pr "};\n";
3090         pr "\n"
3091   ) ["stat", stat_cols; "statvfs", statvfs_cols]
3092
3093 (* Generate the guestfs-actions.h file. *)
3094 and generate_actions_h () =
3095   generate_header CStyle LGPLv2;
3096   List.iter (
3097     fun (shortname, style, _, _, _, _, _) ->
3098       let name = "guestfs_" ^ shortname in
3099       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
3100         name style
3101   ) all_functions
3102
3103 (* Generate the client-side dispatch stubs. *)
3104 and generate_client_actions () =
3105   generate_header CStyle LGPLv2;
3106
3107   pr "\
3108 #include <stdio.h>
3109 #include <stdlib.h>
3110
3111 #include \"guestfs.h\"
3112 #include \"guestfs_protocol.h\"
3113
3114 #define error guestfs_error
3115 #define perrorf guestfs_perrorf
3116 #define safe_malloc guestfs_safe_malloc
3117 #define safe_realloc guestfs_safe_realloc
3118 #define safe_strdup guestfs_safe_strdup
3119 #define safe_memdup guestfs_safe_memdup
3120
3121 /* Check the return message from a call for validity. */
3122 static int
3123 check_reply_header (guestfs_h *g,
3124                     const struct guestfs_message_header *hdr,
3125                     int proc_nr, int serial)
3126 {
3127   if (hdr->prog != GUESTFS_PROGRAM) {
3128     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
3129     return -1;
3130   }
3131   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
3132     error (g, \"wrong protocol version (%%d/%%d)\",
3133            hdr->vers, GUESTFS_PROTOCOL_VERSION);
3134     return -1;
3135   }
3136   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
3137     error (g, \"unexpected message direction (%%d/%%d)\",
3138            hdr->direction, GUESTFS_DIRECTION_REPLY);
3139     return -1;
3140   }
3141   if (hdr->proc != proc_nr) {
3142     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
3143     return -1;
3144   }
3145   if (hdr->serial != serial) {
3146     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
3147     return -1;
3148   }
3149
3150   return 0;
3151 }
3152
3153 /* Check we are in the right state to run a high-level action. */
3154 static int
3155 check_state (guestfs_h *g, const char *caller)
3156 {
3157   if (!guestfs_is_ready (g)) {
3158     if (guestfs_is_config (g))
3159       error (g, \"%%s: call launch() before using this function\",
3160         caller);
3161     else if (guestfs_is_launching (g))
3162       error (g, \"%%s: call wait_ready() before using this function\",
3163         caller);
3164     else
3165       error (g, \"%%s called from the wrong state, %%d != READY\",
3166         caller, guestfs_get_state (g));
3167     return -1;
3168   }
3169   return 0;
3170 }
3171
3172 ";
3173
3174   (* Client-side stubs for each function. *)
3175   List.iter (
3176     fun (shortname, style, _, _, _, _, _) ->
3177       let name = "guestfs_" ^ shortname in
3178
3179       (* Generate the context struct which stores the high-level
3180        * state between callback functions.
3181        *)
3182       pr "struct %s_ctx {\n" shortname;
3183       pr "  /* This flag is set by the callbacks, so we know we've done\n";
3184       pr "   * the callbacks as expected, and in the right sequence.\n";
3185       pr "   * 0 = not called, 1 = reply_cb called.\n";
3186       pr "   */\n";
3187       pr "  int cb_sequence;\n";
3188       pr "  struct guestfs_message_header hdr;\n";
3189       pr "  struct guestfs_message_error err;\n";
3190       (match fst style with
3191        | RErr -> ()
3192        | RConstString _ ->
3193            failwithf "RConstString cannot be returned from a daemon function"
3194        | RInt _ | RInt64 _
3195        | RBool _ | RString _ | RStringList _
3196        | RIntBool _
3197        | RPVList _ | RVGList _ | RLVList _
3198        | RStat _ | RStatVFS _
3199        | RHashtable _ ->
3200            pr "  struct %s_ret ret;\n" name
3201       );
3202       pr "};\n";
3203       pr "\n";
3204
3205       (* Generate the reply callback function. *)
3206       pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
3207       pr "{\n";
3208       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
3209       pr "  struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
3210       pr "\n";
3211       pr "  /* This should definitely not happen. */\n";
3212       pr "  if (ctx->cb_sequence != 0) {\n";
3213       pr "    ctx->cb_sequence = 9999;\n";
3214       pr "    error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
3215       pr "    return;\n";
3216       pr "  }\n";
3217       pr "\n";
3218       pr "  ml->main_loop_quit (ml, g);\n";
3219       pr "\n";
3220       pr "  if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
3221       pr "    error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
3222       pr "    return;\n";
3223       pr "  }\n";
3224       pr "  if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
3225       pr "    if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
3226       pr "      error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
3227         name;
3228       pr "      return;\n";
3229       pr "    }\n";
3230       pr "    goto done;\n";
3231       pr "  }\n";
3232
3233       (match fst style with
3234        | RErr -> ()
3235        | RConstString _ ->
3236            failwithf "RConstString cannot be returned from a daemon function"
3237        | RInt _ | RInt64 _
3238        | RBool _ | RString _ | RStringList _
3239        | RIntBool _
3240        | RPVList _ | RVGList _ | RLVList _
3241        | RStat _ | RStatVFS _
3242        | RHashtable _ ->
3243             pr "  if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
3244             pr "    error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
3245             pr "    return;\n";
3246             pr "  }\n";
3247       );
3248
3249       pr " done:\n";
3250       pr "  ctx->cb_sequence = 1;\n";
3251       pr "}\n\n";
3252
3253       (* Generate the action stub. *)
3254       generate_prototype ~extern:false ~semicolon:false ~newline:true
3255         ~handle:"g" name style;
3256
3257       let error_code =
3258         match fst style with
3259         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
3260         | RConstString _ ->
3261             failwithf "RConstString cannot be returned from a daemon function"
3262         | RString _ | RStringList _ | RIntBool _
3263         | RPVList _ | RVGList _ | RLVList _
3264         | RStat _ | RStatVFS _
3265         | RHashtable _ ->
3266             "NULL" in
3267
3268       pr "{\n";
3269
3270       (match snd style with
3271        | [] -> ()
3272        | _ -> pr "  struct %s_args args;\n" name
3273       );
3274
3275       pr "  struct %s_ctx ctx;\n" shortname;
3276       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
3277       pr "  int serial;\n";
3278       pr "\n";
3279       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
3280       pr "  guestfs_set_busy (g);\n";
3281       pr "\n";
3282       pr "  memset (&ctx, 0, sizeof ctx);\n";
3283       pr "\n";
3284
3285       (* Send the main header and arguments. *)
3286       (match snd style with
3287        | [] ->
3288            pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
3289              (String.uppercase shortname)
3290        | args ->
3291            List.iter (
3292              function
3293              | String n ->
3294                  pr "  args.%s = (char *) %s;\n" n n
3295              | OptString n ->
3296                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
3297              | StringList n ->
3298                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
3299                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
3300              | Bool n ->
3301                  pr "  args.%s = %s;\n" n n
3302              | Int n ->
3303                  pr "  args.%s = %s;\n" n n
3304              | FileIn _ | FileOut _ -> ()
3305            ) args;
3306            pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
3307              (String.uppercase shortname);
3308            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
3309              name;
3310       );
3311       pr "  if (serial == -1) {\n";
3312       pr "    guestfs_end_busy (g);\n";
3313       pr "    return %s;\n" error_code;
3314       pr "  }\n";
3315       pr "\n";
3316
3317       (* Send any additional files (FileIn) requested. *)
3318       let need_read_reply_label = ref false in
3319       List.iter (
3320         function
3321         | FileIn n ->
3322             pr "  {\n";
3323             pr "    int r;\n";
3324             pr "\n";
3325             pr "    r = guestfs__send_file_sync (g, %s);\n" n;
3326             pr "    if (r == -1) {\n";
3327             pr "      guestfs_end_busy (g);\n";
3328             pr "      return %s;\n" error_code;
3329             pr "    }\n";
3330             pr "    if (r == -2) /* daemon cancelled */\n";
3331             pr "      goto read_reply;\n";
3332             need_read_reply_label := true;
3333             pr "  }\n";
3334             pr "\n";
3335         | _ -> ()
3336       ) (snd style);
3337
3338       (* Wait for the reply from the remote end. *)
3339       if !need_read_reply_label then pr " read_reply:\n";
3340       pr "  guestfs__switch_to_receiving (g);\n";
3341       pr "  ctx.cb_sequence = 0;\n";
3342       pr "  guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
3343       pr "  (void) ml->main_loop_run (ml, g);\n";
3344       pr "  guestfs_set_reply_callback (g, NULL, NULL);\n";
3345       pr "  if (ctx.cb_sequence != 1) {\n";
3346       pr "    error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
3347       pr "    guestfs_end_busy (g);\n";
3348       pr "    return %s;\n" error_code;
3349       pr "  }\n";
3350       pr "\n";
3351
3352       pr "  if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
3353         (String.uppercase shortname);
3354       pr "    guestfs_end_busy (g);\n";
3355       pr "    return %s;\n" error_code;
3356       pr "  }\n";
3357       pr "\n";
3358
3359       pr "  if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
3360       pr "    error (g, \"%%s\", ctx.err.error_message);\n";
3361       pr "    free (ctx.err.error_message);\n";
3362       pr "    guestfs_end_busy (g);\n";
3363       pr "    return %s;\n" error_code;
3364       pr "  }\n";
3365       pr "\n";
3366
3367       (* Expecting to receive further files (FileOut)? *)
3368       List.iter (
3369         function
3370         | FileOut n ->
3371             pr "  if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
3372             pr "    guestfs_end_busy (g);\n";
3373             pr "    return %s;\n" error_code;
3374             pr "  }\n";
3375             pr "\n";
3376         | _ -> ()
3377       ) (snd style);
3378
3379       pr "  guestfs_end_busy (g);\n";
3380
3381       (match fst style with
3382        | RErr -> pr "  return 0;\n"
3383        | RInt n | RInt64 n | RBool n ->
3384            pr "  return ctx.ret.%s;\n" n
3385        | RConstString _ ->
3386            failwithf "RConstString cannot be returned from a daemon function"
3387        | RString n ->
3388            pr "  return ctx.ret.%s; /* caller will free */\n" n
3389        | RStringList n | RHashtable n ->
3390            pr "  /* caller will free this, but we need to add a NULL entry */\n";
3391            pr "  ctx.ret.%s.%s_val =\n" n n;
3392            pr "    safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
3393            pr "                  sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
3394              n n;
3395            pr "  ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
3396            pr "  return ctx.ret.%s.%s_val;\n" n n
3397        | RIntBool _ ->
3398            pr "  /* caller with free this */\n";
3399            pr "  return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
3400        | RPVList n | RVGList n | RLVList n
3401        | RStat n | RStatVFS n ->
3402            pr "  /* caller will free this */\n";
3403            pr "  return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
3404       );
3405
3406       pr "}\n\n"
3407   ) daemon_functions
3408
3409 (* Generate daemon/actions.h. *)
3410 and generate_daemon_actions_h () =
3411   generate_header CStyle GPLv2;
3412
3413   pr "#include \"../src/guestfs_protocol.h\"\n";
3414   pr "\n";
3415
3416   List.iter (
3417     fun (name, style, _, _, _, _, _) ->
3418         generate_prototype
3419           ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
3420           name style;
3421   ) daemon_functions
3422
3423 (* Generate the server-side stubs. *)
3424 and generate_daemon_actions () =
3425   generate_header CStyle GPLv2;
3426
3427   pr "#include <config.h>\n";
3428   pr "\n";
3429   pr "#include <stdio.h>\n";
3430   pr "#include <stdlib.h>\n";
3431   pr "#include <string.h>\n";
3432   pr "#include <inttypes.h>\n";
3433   pr "#include <ctype.h>\n";
3434   pr "#include <rpc/types.h>\n";
3435   pr "#include <rpc/xdr.h>\n";
3436   pr "\n";
3437   pr "#include \"daemon.h\"\n";
3438   pr "#include \"../src/guestfs_protocol.h\"\n";
3439   pr "#include \"actions.h\"\n";
3440   pr "\n";
3441
3442   List.iter (
3443     fun (name, style, _, _, _, _, _) ->
3444       (* Generate server-side stubs. *)
3445       pr "static void %s_stub (XDR *xdr_in)\n" name;
3446       pr "{\n";
3447       let error_code =
3448         match fst style with
3449         | RErr | RInt _ -> pr "  int r;\n"; "-1"
3450         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
3451         | RBool _ -> pr "  int r;\n"; "-1"
3452         | RConstString _ ->
3453             failwithf "RConstString cannot be returned from a daemon function"
3454         | RString _ -> pr "  char *r;\n"; "NULL"
3455         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
3456         | RIntBool _ -> pr "  guestfs_%s_ret *r;\n" name; "NULL"
3457         | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"
3458         | RVGList _ -> pr "  guestfs_lvm_int_vg_list *r;\n"; "NULL"
3459         | RLVList _ -> pr "  guestfs_lvm_int_lv_list *r;\n"; "NULL"
3460         | RStat _ -> pr "  guestfs_int_stat *r;\n"; "NULL"
3461         | RStatVFS _ -> pr "  guestfs_int_statvfs *r;\n"; "NULL" in
3462
3463       (match snd style with
3464        | [] -> ()
3465        | args ->
3466            pr "  struct guestfs_%s_args args;\n" name;
3467            List.iter (
3468              function
3469              | String n
3470              | OptString n -> pr "  const char *%s;\n" n
3471              | StringList n -> pr "  char **%s;\n" n
3472              | Bool n -> pr "  int %s;\n" n
3473              | Int n -> pr "  int %s;\n" n
3474              | FileIn _ | FileOut _ -> ()
3475            ) args
3476       );
3477       pr "\n";
3478
3479       (match snd style with
3480        | [] -> ()
3481        | args ->
3482            pr "  memset (&args, 0, sizeof args);\n";
3483            pr "\n";
3484            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
3485            pr "    reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
3486            pr "    return;\n";
3487            pr "  }\n";
3488            List.iter (
3489              function
3490              | String n -> pr "  %s = args.%s;\n" n n
3491              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
3492              | StringList n ->
3493                  pr "  %s = realloc (args.%s.%s_val,\n" n n n;
3494                  pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
3495                  pr "  if (%s == NULL) {\n" n;
3496                  pr "    reply_with_perror (\"realloc\");\n";
3497                  pr "    goto done;\n";
3498                  pr "  }\n";
3499                  pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
3500                  pr "  args.%s.%s_val = %s;\n" n n n;
3501              | Bool n -> pr "  %s = args.%s;\n" n n
3502              | Int n -> pr "  %s = args.%s;\n" n n
3503              | FileIn _ | FileOut _ -> ()
3504            ) args;
3505            pr "\n"
3506       );
3507
3508       (* Don't want to call the impl with any FileIn or FileOut
3509        * parameters, since these go "outside" the RPC protocol.
3510        *)
3511       let argsnofile =
3512         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
3513           (snd style) in
3514       pr "  r = do_%s " name;
3515       generate_call_args argsnofile;
3516       pr ";\n";
3517
3518       pr "  if (r == %s)\n" error_code;
3519       pr "    /* do_%s has already called reply_with_error */\n" name;
3520       pr "    goto done;\n";
3521       pr "\n";
3522
3523       (* If there are any FileOut parameters, then the impl must
3524        * send its own reply.
3525        *)
3526       let no_reply =
3527         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
3528       if no_reply then
3529         pr "  /* do_%s has already sent a reply */\n" name
3530       else (
3531         match fst style with
3532         | RErr -> pr "  reply (NULL, NULL);\n"
3533         | RInt n | RInt64 n | RBool n ->
3534             pr "  struct guestfs_%s_ret ret;\n" name;
3535             pr "  ret.%s = r;\n" n;
3536             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3537               name
3538         | RConstString _ ->
3539             failwithf "RConstString cannot be returned from a daemon function"
3540         | RString n ->
3541             pr "  struct guestfs_%s_ret ret;\n" name;
3542             pr "  ret.%s = r;\n" n;
3543             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3544               name;
3545             pr "  free (r);\n"
3546         | RStringList n | RHashtable n ->
3547             pr "  struct guestfs_%s_ret ret;\n" name;
3548             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
3549             pr "  ret.%s.%s_val = r;\n" n n;
3550             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
3551               name;
3552             pr "  free_strings (r);\n"
3553         | RIntBool _ ->
3554             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
3555               name;
3556             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
3557         | RPVList n | RVGList n | RLVList n
3558         | RStat n | RStatVFS n ->
3559             pr "  struct guestfs_%s_ret ret;\n" name;
3560             pr "  ret.%s = *r;\n" n;
3561             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3562               name;
3563             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
3564               name
3565       );
3566
3567       (* Free the args. *)
3568       (match snd style with
3569        | [] ->
3570            pr "done: ;\n";
3571        | _ ->
3572            pr "done:\n";
3573            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
3574              name
3575       );
3576
3577       pr "}\n\n";
3578   ) daemon_functions;
3579
3580   (* Dispatch function. *)
3581   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
3582   pr "{\n";
3583   pr "  switch (proc_nr) {\n";
3584
3585   List.iter (
3586     fun (name, style, _, _, _, _, _) ->
3587         pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
3588         pr "      %s_stub (xdr_in);\n" name;
3589         pr "      break;\n"
3590   ) daemon_functions;
3591
3592   pr "    default:\n";
3593   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
3594   pr "  }\n";
3595   pr "}\n";
3596   pr "\n";
3597
3598   (* LVM columns and tokenization functions. *)
3599   (* XXX This generates crap code.  We should rethink how we
3600    * do this parsing.
3601    *)
3602   List.iter (
3603     function
3604     | typ, cols ->
3605         pr "static const char *lvm_%s_cols = \"%s\";\n"
3606           typ (String.concat "," (List.map fst cols));
3607         pr "\n";
3608
3609         pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
3610         pr "{\n";
3611         pr "  char *tok, *p, *next;\n";
3612         pr "  int i, j;\n";
3613         pr "\n";
3614         (*
3615         pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
3616         pr "\n";
3617         *)
3618         pr "  if (!str) {\n";
3619         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
3620         pr "    return -1;\n";
3621         pr "  }\n";
3622         pr "  if (!*str || isspace (*str)) {\n";
3623         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
3624         pr "    return -1;\n";
3625         pr "  }\n";
3626         pr "  tok = str;\n";
3627         List.iter (
3628           fun (name, coltype) ->
3629             pr "  if (!tok) {\n";
3630             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
3631             pr "    return -1;\n";
3632             pr "  }\n";
3633             pr "  p = strchrnul (tok, ',');\n";
3634             pr "  if (*p) next = p+1; else next = NULL;\n";
3635             pr "  *p = '\\0';\n";
3636             (match coltype with
3637              | `String ->
3638                  pr "  r->%s = strdup (tok);\n" name;
3639                  pr "  if (r->%s == NULL) {\n" name;
3640                  pr "    perror (\"strdup\");\n";
3641                  pr "    return -1;\n";
3642                  pr "  }\n"
3643              | `UUID ->
3644                  pr "  for (i = j = 0; i < 32; ++j) {\n";
3645                  pr "    if (tok[j] == '\\0') {\n";
3646                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
3647                  pr "      return -1;\n";
3648                  pr "    } else if (tok[j] != '-')\n";
3649                  pr "      r->%s[i++] = tok[j];\n" name;
3650                  pr "  }\n";
3651              | `Bytes ->
3652                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
3653                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3654                  pr "    return -1;\n";
3655                  pr "  }\n";
3656              | `Int ->
3657                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
3658                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3659                  pr "    return -1;\n";
3660                  pr "  }\n";
3661              | `OptPercent ->
3662                  pr "  if (tok[0] == '\\0')\n";
3663                  pr "    r->%s = -1;\n" name;
3664                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
3665                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
3666                  pr "    return -1;\n";
3667                  pr "  }\n";
3668             );
3669             pr "  tok = next;\n";
3670         ) cols;
3671
3672         pr "  if (tok != NULL) {\n";
3673         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
3674         pr "    return -1;\n";
3675         pr "  }\n";
3676         pr "  return 0;\n";
3677         pr "}\n";
3678         pr "\n";
3679
3680         pr "guestfs_lvm_int_%s_list *\n" typ;
3681         pr "parse_command_line_%ss (void)\n" typ;
3682         pr "{\n";
3683         pr "  char *out, *err;\n";
3684         pr "  char *p, *pend;\n";
3685         pr "  int r, i;\n";
3686         pr "  guestfs_lvm_int_%s_list *ret;\n" typ;
3687         pr "  void *newp;\n";
3688         pr "\n";
3689         pr "  ret = malloc (sizeof *ret);\n";
3690         pr "  if (!ret) {\n";
3691         pr "    reply_with_perror (\"malloc\");\n";
3692         pr "    return NULL;\n";
3693         pr "  }\n";
3694         pr "\n";
3695         pr "  ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
3696         pr "  ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
3697         pr "\n";
3698         pr "  r = command (&out, &err,\n";
3699         pr "           \"/sbin/lvm\", \"%ss\",\n" typ;
3700         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
3701         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
3702         pr "  if (r == -1) {\n";
3703         pr "    reply_with_error (\"%%s\", err);\n";
3704         pr "    free (out);\n";
3705         pr "    free (err);\n";
3706         pr "    free (ret);\n";
3707         pr "    return NULL;\n";
3708         pr "  }\n";
3709         pr "\n";
3710         pr "  free (err);\n";
3711         pr "\n";
3712         pr "  /* Tokenize each line of the output. */\n";
3713         pr "  p = out;\n";
3714         pr "  i = 0;\n";
3715         pr "  while (p) {\n";
3716         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
3717         pr "    if (pend) {\n";
3718         pr "      *pend = '\\0';\n";
3719         pr "      pend++;\n";
3720         pr "    }\n";
3721         pr "\n";
3722         pr "    while (*p && isspace (*p))      /* Skip any leading whitespace. */\n";
3723         pr "      p++;\n";
3724         pr "\n";
3725         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
3726         pr "      p = pend;\n";
3727         pr "      continue;\n";
3728         pr "    }\n";
3729         pr "\n";
3730         pr "    /* Allocate some space to store this next entry. */\n";
3731         pr "    newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
3732         pr "                sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
3733         pr "    if (newp == NULL) {\n";
3734         pr "      reply_with_perror (\"realloc\");\n";
3735         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3736         pr "      free (ret);\n";
3737         pr "      free (out);\n";
3738         pr "      return NULL;\n";
3739         pr "    }\n";
3740         pr "    ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
3741         pr "\n";
3742         pr "    /* Tokenize the next entry. */\n";
3743         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
3744         pr "    if (r == -1) {\n";
3745         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
3746         pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
3747         pr "      free (ret);\n";
3748         pr "      free (out);\n";
3749         pr "      return NULL;\n";
3750         pr "    }\n";
3751         pr "\n";
3752         pr "    ++i;\n";
3753         pr "    p = pend;\n";
3754         pr "  }\n";
3755         pr "\n";
3756         pr "  ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
3757         pr "\n";
3758         pr "  free (out);\n";
3759         pr "  return ret;\n";
3760         pr "}\n"
3761
3762   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
3763
3764 (* Generate the tests. *)
3765 and generate_tests () =
3766   generate_header CStyle GPLv2;
3767
3768   pr "\
3769 #include <stdio.h>
3770 #include <stdlib.h>
3771 #include <string.h>
3772 #include <unistd.h>
3773 #include <sys/types.h>
3774 #include <fcntl.h>
3775
3776 #include \"guestfs.h\"
3777
3778 static guestfs_h *g;
3779 static int suppress_error = 0;
3780
3781 /* This will be 's' or 'h' depending on whether the guest kernel
3782  * names IDE devices /dev/sd* or /dev/hd*.
3783  */
3784 static char devchar = 's';
3785
3786 static void print_error (guestfs_h *g, void *data, const char *msg)
3787 {
3788   if (!suppress_error)
3789     fprintf (stderr, \"%%s\\n\", msg);
3790 }
3791
3792 static void print_strings (char * const * const argv)
3793 {
3794   int argc;
3795
3796   for (argc = 0; argv[argc] != NULL; ++argc)
3797     printf (\"\\t%%s\\n\", argv[argc]);
3798 }
3799
3800 /*
3801 static void print_table (char * const * const argv)
3802 {
3803   int i;
3804
3805   for (i = 0; argv[i] != NULL; i += 2)
3806     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
3807 }
3808 */
3809
3810 static void no_test_warnings (void)
3811 {
3812 ";
3813
3814   List.iter (
3815     function
3816     | name, _, _, _, [], _, _ ->
3817         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
3818     | name, _, _, _, tests, _, _ -> ()
3819   ) all_functions;
3820
3821   pr "}\n";
3822   pr "\n";
3823
3824   (* Generate the actual tests.  Note that we generate the tests
3825    * in reverse order, deliberately, so that (in general) the
3826    * newest tests run first.  This makes it quicker and easier to
3827    * debug them.
3828    *)
3829   let test_names =
3830     List.map (
3831       fun (name, _, _, _, tests, _, _) ->
3832         mapi (generate_one_test name) tests
3833     ) (List.rev all_functions) in
3834   let test_names = List.concat test_names in
3835   let nr_tests = List.length test_names in
3836
3837   pr "\
3838 int main (int argc, char *argv[])
3839 {
3840   char c = 0;
3841   int failed = 0;
3842   const char *filename;
3843   int fd, i;
3844   int nr_tests, test_num = 0;
3845   char **devs;
3846
3847   no_test_warnings ();
3848
3849   g = guestfs_create ();
3850   if (g == NULL) {
3851     printf (\"guestfs_create FAILED\\n\");
3852     exit (1);
3853   }
3854
3855   guestfs_set_error_handler (g, print_error, NULL);
3856
3857   guestfs_set_path (g, \"../appliance\");
3858
3859   filename = \"test1.img\";
3860   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3861   if (fd == -1) {
3862     perror (filename);
3863     exit (1);
3864   }
3865   if (lseek (fd, %d, SEEK_SET) == -1) {
3866     perror (\"lseek\");
3867     close (fd);
3868     unlink (filename);
3869     exit (1);
3870   }
3871   if (write (fd, &c, 1) == -1) {
3872     perror (\"write\");
3873     close (fd);
3874     unlink (filename);
3875     exit (1);
3876   }
3877   if (close (fd) == -1) {
3878     perror (filename);
3879     unlink (filename);
3880     exit (1);
3881   }
3882   if (guestfs_add_drive (g, filename) == -1) {
3883     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3884     exit (1);
3885   }
3886
3887   filename = \"test2.img\";
3888   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3889   if (fd == -1) {
3890     perror (filename);
3891     exit (1);
3892   }
3893   if (lseek (fd, %d, SEEK_SET) == -1) {
3894     perror (\"lseek\");
3895     close (fd);
3896     unlink (filename);
3897     exit (1);
3898   }
3899   if (write (fd, &c, 1) == -1) {
3900     perror (\"write\");
3901     close (fd);
3902     unlink (filename);
3903     exit (1);
3904   }
3905   if (close (fd) == -1) {
3906     perror (filename);
3907     unlink (filename);
3908     exit (1);
3909   }
3910   if (guestfs_add_drive (g, filename) == -1) {
3911     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3912     exit (1);
3913   }
3914
3915   filename = \"test3.img\";
3916   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
3917   if (fd == -1) {
3918     perror (filename);
3919     exit (1);
3920   }
3921   if (lseek (fd, %d, SEEK_SET) == -1) {
3922     perror (\"lseek\");
3923     close (fd);
3924     unlink (filename);
3925     exit (1);
3926   }
3927   if (write (fd, &c, 1) == -1) {
3928     perror (\"write\");
3929     close (fd);
3930     unlink (filename);
3931     exit (1);
3932   }
3933   if (close (fd) == -1) {
3934     perror (filename);
3935     unlink (filename);
3936     exit (1);
3937   }
3938   if (guestfs_add_drive (g, filename) == -1) {
3939     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
3940     exit (1);
3941   }
3942
3943   if (guestfs_add_drive_ro (g, \"../images/test.sqsh\") == -1) {
3944     printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\");
3945     exit (1);
3946   }
3947
3948   if (guestfs_launch (g) == -1) {
3949     printf (\"guestfs_launch FAILED\\n\");
3950     exit (1);
3951   }
3952   if (guestfs_wait_ready (g) == -1) {
3953     printf (\"guestfs_wait_ready FAILED\\n\");
3954     exit (1);
3955   }
3956
3957   /* Detect if the appliance uses /dev/sd* or /dev/hd* in device
3958    * names.  This changed between RHEL 5 and RHEL 6 so we have to
3959    * support both.
3960    */
3961   devs = guestfs_list_devices (g);
3962   if (devs == NULL || devs[0] == NULL) {
3963     printf (\"guestfs_list_devices FAILED\\n\");
3964     exit (1);
3965   }
3966   if (strncmp (devs[0], \"/dev/sd\", 7) == 0)
3967     devchar = 's';
3968   else if (strncmp (devs[0], \"/dev/hd\", 7) == 0)
3969     devchar = 'h';
3970   else {
3971     printf (\"guestfs_list_devices returned unexpected string '%%s'\\n\",
3972             devs[0]);
3973     exit (1);
3974   }
3975   for (i = 0; devs[i] != NULL; ++i)
3976     free (devs[i]);
3977   free (devs);
3978
3979   nr_tests = %d;
3980
3981 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
3982
3983   iteri (
3984     fun i test_name ->
3985       pr "  test_num++;\n";
3986       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
3987       pr "  if (%s () == -1) {\n" test_name;
3988       pr "    printf (\"%s FAILED\\n\");\n" test_name;
3989       pr "    failed++;\n";
3990       pr "  }\n";
3991   ) test_names;
3992   pr "\n";
3993
3994   pr "  guestfs_close (g);\n";
3995   pr "  unlink (\"test1.img\");\n";
3996   pr "  unlink (\"test2.img\");\n";
3997   pr "  unlink (\"test3.img\");\n";
3998   pr "\n";
3999
4000   pr "  if (failed > 0) {\n";
4001   pr "    printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
4002   pr "    exit (1);\n";
4003   pr "  }\n";
4004   pr "\n";
4005
4006   pr "  exit (0);\n";
4007   pr "}\n"
4008
4009 and generate_one_test name i (init, prereq, test) =
4010   let test_name = sprintf "test_%s_%d" name i in
4011
4012   pr "\
4013 static int %s_skip (void)
4014 {
4015   const char *str;
4016
4017   str = getenv (\"SKIP_%s\");
4018   if (str && strcmp (str, \"1\") == 0) return 1;
4019   str = getenv (\"SKIP_TEST_%s\");
4020   if (str && strcmp (str, \"1\") == 0) return 1;
4021   return 0;
4022 }
4023
4024 " test_name (String.uppercase test_name) (String.uppercase name);
4025
4026   (match prereq with
4027    | Disabled | Always -> ()
4028    | If code | Unless code ->
4029        pr "static int %s_prereq (void)\n" test_name;
4030        pr "{\n";
4031        pr "  %s\n" code;
4032        pr "}\n";
4033        pr "\n";
4034   );
4035
4036   pr "\
4037 static int %s (void)
4038 {
4039   if (%s_skip ()) {
4040     printf (\"%%s skipped (reason: SKIP_TEST_* variable set)\\n\", \"%s\");
4041     return 0;
4042   }
4043
4044 " test_name test_name test_name;
4045
4046   (match prereq with
4047    | Disabled ->
4048        pr "  printf (\"%%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
4049    | If _ ->
4050        pr "  if (! %s_prereq ()) {\n" test_name;
4051        pr "    printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
4052        pr "    return 0;\n";
4053        pr "  }\n";
4054        pr "\n";
4055        generate_one_test_body name i test_name init test;
4056    | Unless _ ->
4057        pr "  if (%s_prereq ()) {\n" test_name;
4058        pr "    printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
4059        pr "    return 0;\n";
4060        pr "  }\n";
4061        pr "\n";
4062        generate_one_test_body name i test_name init test;
4063    | Always ->
4064        generate_one_test_body name i test_name init test
4065   );
4066
4067   pr "  return 0;\n";
4068   pr "}\n";
4069   pr "\n";
4070   test_name
4071
4072 and generate_one_test_body name i test_name init test =
4073   (match init with
4074    | InitNone
4075    | InitEmpty ->
4076        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
4077        List.iter (generate_test_command_call test_name)
4078          [["blockdev_setrw"; "/dev/sda"];
4079           ["umount_all"];
4080           ["lvm_remove_all"]]
4081    | InitBasicFS ->
4082        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
4083        List.iter (generate_test_command_call test_name)
4084          [["blockdev_setrw"; "/dev/sda"];
4085           ["umount_all"];
4086           ["lvm_remove_all"];
4087           ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
4088           ["mkfs"; "ext2"; "/dev/sda1"];
4089           ["mount"; "/dev/sda1"; "/"]]
4090    | InitBasicFSonLVM ->
4091        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
4092          test_name;
4093        List.iter (generate_test_command_call test_name)
4094          [["blockdev_setrw"; "/dev/sda"];
4095           ["umount_all"];
4096           ["lvm_remove_all"];
4097           ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
4098           ["pvcreate"; "/dev/sda1"];
4099           ["vgcreate"; "VG"; "/dev/sda1"];
4100           ["lvcreate"; "LV"; "VG"; "8"];
4101           ["mkfs"; "ext2"; "/dev/VG/LV"];
4102           ["mount"; "/dev/VG/LV"; "/"]]
4103   );
4104
4105   let get_seq_last = function
4106     | [] ->
4107         failwithf "%s: you cannot use [] (empty list) when expecting a command"
4108           test_name
4109     | seq ->
4110         let seq = List.rev seq in
4111         List.rev (List.tl seq), List.hd seq
4112   in
4113
4114   match test with
4115   | TestRun seq ->
4116       pr "  /* TestRun for %s (%d) */\n" name i;
4117       List.iter (generate_test_command_call test_name) seq
4118   | TestOutput (seq, expected) ->
4119       pr "  /* TestOutput for %s (%d) */\n" name i;
4120       pr "  char expected[] = \"%s\";\n" (c_quote expected);
4121       if String.length expected > 7 &&
4122         String.sub expected 0 7 = "/dev/sd" then
4123           pr "  expected[5] = devchar;\n";
4124       let seq, last = get_seq_last seq in
4125       let test () =
4126         pr "    if (strcmp (r, expected) != 0) {\n";
4127         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
4128         pr "      return -1;\n";
4129         pr "    }\n"
4130       in
4131       List.iter (generate_test_command_call test_name) seq;
4132       generate_test_command_call ~test test_name last
4133   | TestOutputList (seq, expected) ->
4134       pr "  /* TestOutputList for %s (%d) */\n" name i;
4135       let seq, last = get_seq_last seq in
4136       let test () =
4137         iteri (
4138           fun i str ->
4139             pr "    if (!r[%d]) {\n" i;
4140             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
4141             pr "      print_strings (r);\n";
4142             pr "      return -1;\n";
4143             pr "    }\n";
4144             pr "    {\n";
4145             pr "      char expected[] = \"%s\";\n" (c_quote str);
4146             if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
4147               pr "      expected[5] = devchar;\n";
4148             pr "      if (strcmp (r[%d], expected) != 0) {\n" i;
4149             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
4150             pr "        return -1;\n";
4151             pr "      }\n";
4152             pr "    }\n"
4153         ) expected;
4154         pr "    if (r[%d] != NULL) {\n" (List.length expected);
4155         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
4156           test_name;
4157         pr "      print_strings (r);\n";
4158         pr "      return -1;\n";
4159         pr "    }\n"
4160       in
4161       List.iter (generate_test_command_call test_name) seq;
4162       generate_test_command_call ~test test_name last
4163   | TestOutputInt (seq, expected) ->
4164       pr "  /* TestOutputInt for %s (%d) */\n" name i;
4165       let seq, last = get_seq_last seq in
4166       let test () =
4167         pr "    if (r != %d) {\n" expected;
4168         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
4169           test_name expected;
4170         pr "               (int) r);\n";
4171         pr "      return -1;\n";
4172         pr "    }\n"
4173       in
4174       List.iter (generate_test_command_call test_name) seq;
4175       generate_test_command_call ~test test_name last
4176   | TestOutputTrue seq ->
4177       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
4178       let seq, last = get_seq_last seq in
4179       let test () =
4180         pr "    if (!r) {\n";
4181         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
4182           test_name;
4183         pr "      return -1;\n";
4184         pr "    }\n"
4185       in
4186       List.iter (generate_test_command_call test_name) seq;
4187       generate_test_command_call ~test test_name last
4188   | TestOutputFalse seq ->
4189       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
4190       let seq, last = get_seq_last seq in
4191       let test () =
4192         pr "    if (r) {\n";
4193         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
4194           test_name;
4195         pr "      return -1;\n";
4196         pr "    }\n"
4197       in
4198       List.iter (generate_test_command_call test_name) seq;
4199       generate_test_command_call ~test test_name last
4200   | TestOutputLength (seq, expected) ->
4201       pr "  /* TestOutputLength for %s (%d) */\n" name i;
4202       let seq, last = get_seq_last seq in
4203       let test () =
4204         pr "    int j;\n";
4205         pr "    for (j = 0; j < %d; ++j)\n" expected;
4206         pr "      if (r[j] == NULL) {\n";
4207         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
4208           test_name;
4209         pr "        print_strings (r);\n";
4210         pr "        return -1;\n";
4211         pr "      }\n";
4212         pr "    if (r[j] != NULL) {\n";
4213         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
4214           test_name;
4215         pr "      print_strings (r);\n";
4216         pr "      return -1;\n";
4217         pr "    }\n"
4218       in
4219       List.iter (generate_test_command_call test_name) seq;
4220       generate_test_command_call ~test test_name last
4221   | TestOutputStruct (seq, checks) ->
4222       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
4223       let seq, last = get_seq_last seq in
4224       let test () =
4225         List.iter (
4226           function
4227           | CompareWithInt (field, expected) ->
4228               pr "    if (r->%s != %d) {\n" field expected;
4229               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
4230                 test_name field expected;
4231               pr "               (int) r->%s);\n" field;
4232               pr "      return -1;\n";
4233               pr "    }\n"
4234           | CompareWithString (field, expected) ->
4235               pr "    if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
4236               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
4237                 test_name field expected;
4238               pr "               r->%s);\n" field;
4239               pr "      return -1;\n";
4240               pr "    }\n"
4241           | CompareFieldsIntEq (field1, field2) ->
4242               pr "    if (r->%s != r->%s) {\n" field1 field2;
4243               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
4244                 test_name field1 field2;
4245               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
4246               pr "      return -1;\n";
4247               pr "    }\n"
4248           | CompareFieldsStrEq (field1, field2) ->
4249               pr "    if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
4250               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
4251                 test_name field1 field2;
4252               pr "               r->%s, r->%s);\n" field1 field2;
4253               pr "      return -1;\n";
4254               pr "    }\n"
4255         ) checks
4256       in
4257       List.iter (generate_test_command_call test_name) seq;
4258       generate_test_command_call ~test test_name last
4259   | TestLastFail seq ->
4260       pr "  /* TestLastFail for %s (%d) */\n" name i;
4261       let seq, last = get_seq_last seq in
4262       List.iter (generate_test_command_call test_name) seq;
4263       generate_test_command_call test_name ~expect_error:true last
4264
4265 (* Generate the code to run a command, leaving the result in 'r'.
4266  * If you expect to get an error then you should set expect_error:true.
4267  *)
4268 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
4269   match cmd with
4270   | [] -> assert false
4271   | name :: args ->
4272       (* Look up the command to find out what args/ret it has. *)
4273       let style =
4274         try
4275           let _, style, _, _, _, _, _ =
4276             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
4277           style
4278         with Not_found ->
4279           failwithf "%s: in test, command %s was not found" test_name name in
4280
4281       if List.length (snd style) <> List.length args then
4282         failwithf "%s: in test, wrong number of args given to %s"
4283           test_name name;
4284
4285       pr "  {\n";
4286
4287       List.iter (
4288         function
4289         | OptString n, "NULL" -> ()
4290         | String n, arg
4291         | OptString n, arg ->
4292             pr "    char %s[] = \"%s\";\n" n (c_quote arg);
4293             if String.length arg > 7 && String.sub arg 0 7 = "/dev/sd" then
4294               pr "    %s[5] = devchar;\n" n
4295         | Int _, _
4296         | Bool _, _
4297         | FileIn _, _ | FileOut _, _ -> ()
4298         | StringList n, arg ->
4299             let strs = string_split " " arg in
4300             iteri (
4301               fun i str ->
4302                 pr "    char %s_%d[] = \"%s\";\n" n i (c_quote str);
4303                 if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
4304                   pr "    %s_%d[5] = devchar;\n" n i
4305             ) strs;
4306             pr "    char *%s[] = {\n" n;
4307             iteri (
4308               fun i _ -> pr "      %s_%d,\n" n i
4309             ) strs;
4310             pr "      NULL\n";
4311             pr "    };\n";
4312       ) (List.combine (snd style) args);
4313
4314       let error_code =
4315         match fst style with
4316         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
4317         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
4318         | RConstString _ -> pr "    const char *r;\n"; "NULL"
4319         | RString _ -> pr "    char *r;\n"; "NULL"
4320         | RStringList _ | RHashtable _ ->
4321             pr "    char **r;\n";
4322             pr "    int i;\n";
4323             "NULL"
4324         | RIntBool _ ->
4325             pr "    struct guestfs_int_bool *r;\n"; "NULL"
4326         | RPVList _ ->
4327             pr "    struct guestfs_lvm_pv_list *r;\n"; "NULL"
4328         | RVGList _ ->
4329             pr "    struct guestfs_lvm_vg_list *r;\n"; "NULL"
4330         | RLVList _ ->
4331             pr "    struct guestfs_lvm_lv_list *r;\n"; "NULL"
4332         | RStat _ ->
4333             pr "    struct guestfs_stat *r;\n"; "NULL"
4334         | RStatVFS _ ->
4335             pr "    struct guestfs_statvfs *r;\n"; "NULL" in
4336
4337       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
4338       pr "    r = guestfs_%s (g" name;
4339
4340       (* Generate the parameters. *)
4341       List.iter (
4342         function
4343         | OptString _, "NULL" -> pr ", NULL"
4344         | String n, _
4345         | OptString n, _ ->
4346             pr ", %s" n
4347         | FileIn _, arg | FileOut _, arg ->
4348             pr ", \"%s\"" (c_quote arg)
4349         | StringList n, _ ->
4350             pr ", %s" n
4351         | Int _, arg ->
4352             let i =
4353               try int_of_string arg
4354               with Failure "int_of_string" ->
4355                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
4356             pr ", %d" i
4357         | Bool _, arg ->
4358             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
4359       ) (List.combine (snd style) args);
4360
4361       pr ");\n";
4362       if not expect_error then
4363         pr "    if (r == %s)\n" error_code
4364       else
4365         pr "    if (r != %s)\n" error_code;
4366       pr "      return -1;\n";
4367
4368       (* Insert the test code. *)
4369       (match test with
4370        | None -> ()
4371        | Some f -> f ()
4372       );
4373
4374       (match fst style with
4375        | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
4376        | RString _ -> pr "    free (r);\n"
4377        | RStringList _ | RHashtable _ ->
4378            pr "    for (i = 0; r[i] != NULL; ++i)\n";
4379            pr "      free (r[i]);\n";
4380            pr "    free (r);\n"
4381        | RIntBool _ ->
4382            pr "    guestfs_free_int_bool (r);\n"
4383        | RPVList _ ->
4384            pr "    guestfs_free_lvm_pv_list (r);\n"
4385        | RVGList _ ->
4386            pr "    guestfs_free_lvm_vg_list (r);\n"
4387        | RLVList _ ->
4388            pr "    guestfs_free_lvm_lv_list (r);\n"
4389        | RStat _ | RStatVFS _ ->
4390            pr "    free (r);\n"
4391       );
4392
4393       pr "  }\n"
4394
4395 and c_quote str =
4396   let str = replace_str str "\r" "\\r" in
4397   let str = replace_str str "\n" "\\n" in
4398   let str = replace_str str "\t" "\\t" in
4399   let str = replace_str str "\000" "\\0" in
4400   str
4401
4402 (* Generate a lot of different functions for guestfish. *)
4403 and generate_fish_cmds () =
4404   generate_header CStyle GPLv2;
4405
4406   let all_functions =
4407     List.filter (
4408       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4409     ) all_functions in
4410   let all_functions_sorted =
4411     List.filter (
4412       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4413     ) all_functions_sorted in
4414
4415   pr "#include <stdio.h>\n";
4416   pr "#include <stdlib.h>\n";
4417   pr "#include <string.h>\n";
4418   pr "#include <inttypes.h>\n";
4419   pr "\n";
4420   pr "#include <guestfs.h>\n";
4421   pr "#include \"fish.h\"\n";
4422   pr "\n";
4423
4424   (* list_commands function, which implements guestfish -h *)
4425   pr "void list_commands (void)\n";
4426   pr "{\n";
4427   pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
4428   pr "  list_builtin_commands ();\n";
4429   List.iter (
4430     fun (name, _, _, flags, _, shortdesc, _) ->
4431       let name = replace_char name '_' '-' in
4432       pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
4433         name shortdesc
4434   ) all_functions_sorted;
4435   pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
4436   pr "}\n";
4437   pr "\n";
4438
4439   (* display_command function, which implements guestfish -h cmd *)
4440   pr "void display_command (const char *cmd)\n";
4441   pr "{\n";
4442   List.iter (
4443     fun (name, style, _, flags, _, shortdesc, longdesc) ->
4444       let name2 = replace_char name '_' '-' in
4445       let alias =
4446         try find_map (function FishAlias n -> Some n | _ -> None) flags
4447         with Not_found -> name in
4448       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
4449       let synopsis =
4450         match snd style with
4451         | [] -> name2
4452         | args ->
4453             sprintf "%s <%s>"
4454               name2 (String.concat "> <" (List.map name_of_argt args)) in
4455
4456       let warnings =
4457         if List.mem ProtocolLimitWarning flags then
4458           ("\n\n" ^ protocol_limit_warning)
4459         else "" in
4460
4461       (* For DangerWillRobinson commands, we should probably have
4462        * guestfish prompt before allowing you to use them (especially
4463        * in interactive mode). XXX
4464        *)
4465       let warnings =
4466         warnings ^
4467           if List.mem DangerWillRobinson flags then
4468             ("\n\n" ^ danger_will_robinson)
4469           else "" in
4470
4471       let describe_alias =
4472         if name <> alias then
4473           sprintf "\n\nYou can use '%s' as an alias for this command." alias
4474         else "" in
4475
4476       pr "  if (";
4477       pr "strcasecmp (cmd, \"%s\") == 0" name;
4478       if name <> name2 then
4479         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4480       if name <> alias then
4481         pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4482       pr ")\n";
4483       pr "    pod2text (\"%s - %s\", %S);\n"
4484         name2 shortdesc
4485         (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
4486       pr "  else\n"
4487   ) all_functions;
4488   pr "    display_builtin_command (cmd);\n";
4489   pr "}\n";
4490   pr "\n";
4491
4492   (* print_{pv,vg,lv}_list functions *)
4493   List.iter (
4494     function
4495     | typ, cols ->
4496         pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
4497         pr "{\n";
4498         pr "  int i;\n";
4499         pr "\n";
4500         List.iter (
4501           function
4502           | name, `String ->
4503               pr "  printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
4504           | name, `UUID ->
4505               pr "  printf (\"%s: \");\n" name;
4506               pr "  for (i = 0; i < 32; ++i)\n";
4507               pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
4508               pr "  printf (\"\\n\");\n"
4509           | name, `Bytes ->
4510               pr "  printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
4511           | name, `Int ->
4512               pr "  printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
4513           | name, `OptPercent ->
4514               pr "  if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
4515                 typ name name typ name;
4516               pr "  else printf (\"%s: \\n\");\n" name
4517         ) cols;
4518         pr "}\n";
4519         pr "\n";
4520         pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
4521           typ typ typ;
4522         pr "{\n";
4523         pr "  int i;\n";
4524         pr "\n";
4525         pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
4526         pr "    print_%s (&%ss->val[i]);\n" typ typ;
4527         pr "}\n";
4528         pr "\n";
4529   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
4530
4531   (* print_{stat,statvfs} functions *)
4532   List.iter (
4533     function
4534     | typ, cols ->
4535         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
4536         pr "{\n";
4537         List.iter (
4538           function
4539           | name, `Int ->
4540               pr "  printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
4541         ) cols;
4542         pr "}\n";
4543         pr "\n";
4544   ) ["stat", stat_cols; "statvfs", statvfs_cols];
4545
4546   (* run_<action> actions *)
4547   List.iter (
4548     fun (name, style, _, flags, _, _, _) ->
4549       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
4550       pr "{\n";
4551       (match fst style with
4552        | RErr
4553        | RInt _
4554        | RBool _ -> pr "  int r;\n"
4555        | RInt64 _ -> pr "  int64_t r;\n"
4556        | RConstString _ -> pr "  const char *r;\n"
4557        | RString _ -> pr "  char *r;\n"
4558        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
4559        | RIntBool _ -> pr "  struct guestfs_int_bool *r;\n"
4560        | RPVList _ -> pr "  struct guestfs_lvm_pv_list *r;\n"
4561        | RVGList _ -> pr "  struct guestfs_lvm_vg_list *r;\n"
4562        | RLVList _ -> pr "  struct guestfs_lvm_lv_list *r;\n"
4563        | RStat _ -> pr "  struct guestfs_stat *r;\n"
4564        | RStatVFS _ -> pr "  struct guestfs_statvfs *r;\n"
4565       );
4566       List.iter (
4567         function
4568         | String n
4569         | OptString n
4570         | FileIn n
4571         | FileOut n -> pr "  const char *%s;\n" n
4572         | StringList n -> pr "  char **%s;\n" n
4573         | Bool n -> pr "  int %s;\n" n
4574         | Int n -> pr "  int %s;\n" n
4575       ) (snd style);
4576
4577       (* Check and convert parameters. *)
4578       let argc_expected = List.length (snd style) in
4579       pr "  if (argc != %d) {\n" argc_expected;
4580       pr "    fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
4581         argc_expected;
4582       pr "    fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
4583       pr "    return -1;\n";
4584       pr "  }\n";
4585       iteri (
4586         fun i ->
4587           function
4588           | String name -> pr "  %s = argv[%d];\n" name i
4589           | OptString name ->
4590               pr "  %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
4591                 name i i
4592           | FileIn name ->
4593               pr "  %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
4594                 name i i
4595           | FileOut name ->
4596               pr "  %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
4597                 name i i
4598           | StringList name ->
4599               pr "  %s = parse_string_list (argv[%d]);\n" name i
4600           | Bool name ->
4601               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
4602           | Int name ->
4603               pr "  %s = atoi (argv[%d]);\n" name i
4604       ) (snd style);
4605
4606       (* Call C API function. *)
4607       let fn =
4608         try find_map (function FishAction n -> Some n | _ -> None) flags
4609         with Not_found -> sprintf "guestfs_%s" name in
4610       pr "  r = %s " fn;
4611       generate_call_args ~handle:"g" (snd style);
4612       pr ";\n";
4613
4614       (* Check return value for errors and display command results. *)
4615       (match fst style with
4616        | RErr -> pr "  return r;\n"
4617        | RInt _ ->
4618            pr "  if (r == -1) return -1;\n";
4619            pr "  printf (\"%%d\\n\", r);\n";
4620            pr "  return 0;\n"
4621        | RInt64 _ ->
4622            pr "  if (r == -1) return -1;\n";
4623            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
4624            pr "  return 0;\n"
4625        | RBool _ ->
4626            pr "  if (r == -1) return -1;\n";
4627            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
4628            pr "  return 0;\n"
4629        | RConstString _ ->
4630            pr "  if (r == NULL) return -1;\n";
4631            pr "  printf (\"%%s\\n\", r);\n";
4632            pr "  return 0;\n"
4633        | RString _ ->
4634            pr "  if (r == NULL) return -1;\n";
4635            pr "  printf (\"%%s\\n\", r);\n";
4636            pr "  free (r);\n";
4637            pr "  return 0;\n"
4638        | RStringList _ ->
4639            pr "  if (r == NULL) return -1;\n";
4640            pr "  print_strings (r);\n";
4641            pr "  free_strings (r);\n";
4642            pr "  return 0;\n"
4643        | RIntBool _ ->
4644            pr "  if (r == NULL) return -1;\n";
4645            pr "  printf (\"%%d, %%s\\n\", r->i,\n";
4646            pr "    r->b ? \"true\" : \"false\");\n";
4647            pr "  guestfs_free_int_bool (r);\n";
4648            pr "  return 0;\n"
4649        | RPVList _ ->
4650            pr "  if (r == NULL) return -1;\n";
4651            pr "  print_pv_list (r);\n";
4652            pr "  guestfs_free_lvm_pv_list (r);\n";
4653            pr "  return 0;\n"
4654        | RVGList _ ->
4655            pr "  if (r == NULL) return -1;\n";
4656            pr "  print_vg_list (r);\n";
4657            pr "  guestfs_free_lvm_vg_list (r);\n";
4658            pr "  return 0;\n"
4659        | RLVList _ ->
4660            pr "  if (r == NULL) return -1;\n";
4661            pr "  print_lv_list (r);\n";
4662            pr "  guestfs_free_lvm_lv_list (r);\n";
4663            pr "  return 0;\n"
4664        | RStat _ ->
4665            pr "  if (r == NULL) return -1;\n";
4666            pr "  print_stat (r);\n";
4667            pr "  free (r);\n";
4668            pr "  return 0;\n"
4669        | RStatVFS _ ->
4670            pr "  if (r == NULL) return -1;\n";
4671            pr "  print_statvfs (r);\n";
4672            pr "  free (r);\n";
4673            pr "  return 0;\n"
4674        | RHashtable _ ->
4675            pr "  if (r == NULL) return -1;\n";
4676            pr "  print_table (r);\n";
4677            pr "  free_strings (r);\n";
4678            pr "  return 0;\n"
4679       );
4680       pr "}\n";
4681       pr "\n"
4682   ) all_functions;
4683
4684   (* run_action function *)
4685   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
4686   pr "{\n";
4687   List.iter (
4688     fun (name, _, _, flags, _, _, _) ->
4689       let name2 = replace_char name '_' '-' in
4690       let alias =
4691         try find_map (function FishAlias n -> Some n | _ -> None) flags
4692         with Not_found -> name in
4693       pr "  if (";
4694       pr "strcasecmp (cmd, \"%s\") == 0" name;
4695       if name <> name2 then
4696         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
4697       if name <> alias then
4698         pr " || strcasecmp (cmd, \"%s\") == 0" alias;
4699       pr ")\n";
4700       pr "    return run_%s (cmd, argc, argv);\n" name;
4701       pr "  else\n";
4702   ) all_functions;
4703   pr "    {\n";
4704   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
4705   pr "      return -1;\n";
4706   pr "    }\n";
4707   pr "  return 0;\n";
4708   pr "}\n";
4709   pr "\n"
4710
4711 (* Readline completion for guestfish. *)
4712 and generate_fish_completion () =
4713   generate_header CStyle GPLv2;
4714
4715   let all_functions =
4716     List.filter (
4717       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
4718     ) all_functions in
4719
4720   pr "\
4721 #include <config.h>
4722
4723 #include <stdio.h>
4724 #include <stdlib.h>
4725 #include <string.h>
4726
4727 #ifdef HAVE_LIBREADLINE
4728 #include <readline/readline.h>
4729 #endif
4730
4731 #include \"fish.h\"
4732
4733 #ifdef HAVE_LIBREADLINE
4734
4735 static const char *const commands[] = {
4736   BUILTIN_COMMANDS_FOR_COMPLETION,
4737 ";
4738
4739   (* Get the commands, including the aliases.  They don't need to be
4740    * sorted - the generator() function just does a dumb linear search.
4741    *)
4742   let commands =
4743     List.map (
4744       fun (name, _, _, flags, _, _, _) ->
4745         let name2 = replace_char name '_' '-' in
4746         let alias =
4747           try find_map (function FishAlias n -> Some n | _ -> None) flags
4748           with Not_found -> name in
4749
4750         if name <> alias then [name2; alias] else [name2]
4751     ) all_functions in
4752   let commands = List.flatten commands in
4753
4754   List.iter (pr "  \"%s\",\n") commands;
4755
4756   pr "  NULL
4757 };
4758
4759 static char *
4760 generator (const char *text, int state)
4761 {
4762   static int index, len;
4763   const char *name;
4764
4765   if (!state) {
4766     index = 0;
4767     len = strlen (text);
4768   }
4769
4770   while ((name = commands[index]) != NULL) {
4771     index++;
4772     if (strncasecmp (name, text, len) == 0)
4773       return strdup (name);
4774   }
4775
4776   return NULL;
4777 }
4778
4779 #endif /* HAVE_LIBREADLINE */
4780
4781 char **do_completion (const char *text, int start, int end)
4782 {
4783   char **matches = NULL;
4784
4785 #ifdef HAVE_LIBREADLINE
4786   if (start == 0)
4787     matches = rl_completion_matches (text, generator);
4788 #endif
4789
4790   return matches;
4791 }
4792 ";
4793
4794 (* Generate the POD documentation for guestfish. *)
4795 and generate_fish_actions_pod () =
4796   let all_functions_sorted =
4797     List.filter (
4798       fun (_, _, _, flags, _, _, _) ->
4799         not (List.mem NotInFish flags || List.mem NotInDocs flags)
4800     ) all_functions_sorted in
4801
4802   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
4803
4804   List.iter (
4805     fun (name, style, _, flags, _, _, longdesc) ->
4806       let longdesc =
4807         Str.global_substitute rex (
4808           fun s ->
4809             let sub =
4810               try Str.matched_group 1 s
4811               with Not_found ->
4812                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
4813             "C<" ^ replace_char sub '_' '-' ^ ">"
4814         ) longdesc in
4815       let name = replace_char name '_' '-' in
4816       let alias =
4817         try find_map (function FishAlias n -> Some n | _ -> None) flags
4818         with Not_found -> name in
4819
4820       pr "=head2 %s" name;
4821       if name <> alias then
4822         pr " | %s" alias;
4823       pr "\n";
4824       pr "\n";
4825       pr " %s" name;
4826       List.iter (
4827         function
4828         | String n -> pr " %s" n
4829         | OptString n -> pr " %s" n
4830         | StringList n -> pr " '%s ...'" n
4831         | Bool _ -> pr " true|false"
4832         | Int n -> pr " %s" n
4833         | FileIn n | FileOut n -> pr " (%s|-)" n
4834       ) (snd style);
4835       pr "\n";
4836       pr "\n";
4837       pr "%s\n\n" longdesc;
4838
4839       if List.exists (function FileIn _ | FileOut _ -> true
4840                       | _ -> false) (snd style) then
4841         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
4842
4843       if List.mem ProtocolLimitWarning flags then
4844         pr "%s\n\n" protocol_limit_warning;
4845
4846       if List.mem DangerWillRobinson flags then
4847         pr "%s\n\n" danger_will_robinson
4848   ) all_functions_sorted
4849
4850 (* Generate a C function prototype. *)
4851 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
4852     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
4853     ?(prefix = "")
4854     ?handle name style =
4855   if extern then pr "extern ";
4856   if static then pr "static ";
4857   (match fst style with
4858    | RErr -> pr "int "
4859    | RInt _ -> pr "int "
4860    | RInt64 _ -> pr "int64_t "
4861    | RBool _ -> pr "int "
4862    | RConstString _ -> pr "const char *"
4863    | RString _ -> pr "char *"
4864    | RStringList _ | RHashtable _ -> pr "char **"
4865    | RIntBool _ ->
4866        if not in_daemon then pr "struct guestfs_int_bool *"
4867        else pr "guestfs_%s_ret *" name
4868    | RPVList _ ->
4869        if not in_daemon then pr "struct guestfs_lvm_pv_list *"
4870        else pr "guestfs_lvm_int_pv_list *"
4871    | RVGList _ ->
4872        if not in_daemon then pr "struct guestfs_lvm_vg_list *"
4873        else pr "guestfs_lvm_int_vg_list *"
4874    | RLVList _ ->
4875        if not in_daemon then pr "struct guestfs_lvm_lv_list *"
4876        else pr "guestfs_lvm_int_lv_list *"
4877    | RStat _ ->
4878        if not in_daemon then pr "struct guestfs_stat *"
4879        else pr "guestfs_int_stat *"
4880    | RStatVFS _ ->
4881        if not in_daemon then pr "struct guestfs_statvfs *"
4882        else pr "guestfs_int_statvfs *"
4883   );
4884   pr "%s%s (" prefix name;
4885   if handle = None && List.length (snd style) = 0 then
4886     pr "void"
4887   else (
4888     let comma = ref false in
4889     (match handle with
4890      | None -> ()
4891      | Some handle -> pr "guestfs_h *%s" handle; comma := true
4892     );
4893     let next () =
4894       if !comma then (
4895         if single_line then pr ", " else pr ",\n\t\t"
4896       );
4897       comma := true
4898     in
4899     List.iter (
4900       function
4901       | String n
4902       | OptString n -> next (); pr "const char *%s" n
4903       | StringList n -> next (); pr "char * const* const %s" n
4904       | Bool n -> next (); pr "int %s" n
4905       | Int n -> next (); pr "int %s" n
4906       | FileIn n
4907       | FileOut n ->
4908           if not in_daemon then (next (); pr "const char *%s" n)
4909     ) (snd style);
4910   );
4911   pr ")";
4912   if semicolon then pr ";";
4913   if newline then pr "\n"
4914
4915 (* Generate C call arguments, eg "(handle, foo, bar)" *)
4916 and generate_call_args ?handle args =
4917   pr "(";
4918   let comma = ref false in
4919   (match handle with
4920    | None -> ()
4921    | Some handle -> pr "%s" handle; comma := true
4922   );
4923   List.iter (
4924     fun arg ->
4925       if !comma then pr ", ";
4926       comma := true;
4927       pr "%s" (name_of_argt arg)
4928   ) args;
4929   pr ")"
4930
4931 (* Generate the OCaml bindings interface. *)
4932 and generate_ocaml_mli () =
4933   generate_header OCamlStyle LGPLv2;
4934
4935   pr "\
4936 (** For API documentation you should refer to the C API
4937     in the guestfs(3) manual page.  The OCaml API uses almost
4938     exactly the same calls. *)
4939
4940 type t
4941 (** A [guestfs_h] handle. *)
4942
4943 exception Error of string
4944 (** This exception is raised when there is an error. *)
4945
4946 val create : unit -> t
4947
4948 val close : t -> unit
4949 (** Handles are closed by the garbage collector when they become
4950     unreferenced, but callers can also call this in order to
4951     provide predictable cleanup. *)
4952
4953 ";
4954   generate_ocaml_lvm_structure_decls ();
4955
4956   generate_ocaml_stat_structure_decls ();
4957
4958   (* The actions. *)
4959   List.iter (
4960     fun (name, style, _, _, _, shortdesc, _) ->
4961       generate_ocaml_prototype name style;
4962       pr "(** %s *)\n" shortdesc;
4963       pr "\n"
4964   ) all_functions
4965
4966 (* Generate the OCaml bindings implementation. *)
4967 and generate_ocaml_ml () =
4968   generate_header OCamlStyle LGPLv2;
4969
4970   pr "\
4971 type t
4972 exception Error of string
4973 external create : unit -> t = \"ocaml_guestfs_create\"
4974 external close : t -> unit = \"ocaml_guestfs_close\"
4975
4976 let () =
4977   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
4978
4979 ";
4980
4981   generate_ocaml_lvm_structure_decls ();
4982
4983   generate_ocaml_stat_structure_decls ();
4984
4985   (* The actions. *)
4986   List.iter (
4987     fun (name, style, _, _, _, shortdesc, _) ->
4988       generate_ocaml_prototype ~is_external:true name style;
4989   ) all_functions
4990
4991 (* Generate the OCaml bindings C implementation. *)
4992 and generate_ocaml_c () =
4993   generate_header CStyle LGPLv2;
4994
4995   pr "\
4996 #include <stdio.h>
4997 #include <stdlib.h>
4998 #include <string.h>
4999
5000 #include <caml/config.h>
5001 #include <caml/alloc.h>
5002 #include <caml/callback.h>
5003 #include <caml/fail.h>
5004 #include <caml/memory.h>
5005 #include <caml/mlvalues.h>
5006 #include <caml/signals.h>
5007
5008 #include <guestfs.h>
5009
5010 #include \"guestfs_c.h\"
5011
5012 /* Copy a hashtable of string pairs into an assoc-list.  We return
5013  * the list in reverse order, but hashtables aren't supposed to be
5014  * ordered anyway.
5015  */
5016 static CAMLprim value
5017 copy_table (char * const * argv)
5018 {
5019   CAMLparam0 ();
5020   CAMLlocal5 (rv, pairv, kv, vv, cons);
5021   int i;
5022
5023   rv = Val_int (0);
5024   for (i = 0; argv[i] != NULL; i += 2) {
5025     kv = caml_copy_string (argv[i]);
5026     vv = caml_copy_string (argv[i+1]);
5027     pairv = caml_alloc (2, 0);
5028     Store_field (pairv, 0, kv);
5029     Store_field (pairv, 1, vv);
5030     cons = caml_alloc (2, 0);
5031     Store_field (cons, 1, rv);
5032     rv = cons;
5033     Store_field (cons, 0, pairv);
5034   }
5035
5036   CAMLreturn (rv);
5037 }
5038
5039 ";
5040
5041   (* LVM struct copy functions. *)
5042   List.iter (
5043     fun (typ, cols) ->
5044       let has_optpercent_col =
5045         List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
5046
5047       pr "static CAMLprim value\n";
5048       pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
5049       pr "{\n";
5050       pr "  CAMLparam0 ();\n";
5051       if has_optpercent_col then
5052         pr "  CAMLlocal3 (rv, v, v2);\n"
5053       else
5054         pr "  CAMLlocal2 (rv, v);\n";
5055       pr "\n";
5056       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
5057       iteri (
5058         fun i col ->
5059           (match col with
5060            | name, `String ->
5061                pr "  v = caml_copy_string (%s->%s);\n" typ name
5062            | name, `UUID ->
5063                pr "  v = caml_alloc_string (32);\n";
5064                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
5065            | name, `Bytes
5066            | name, `Int ->
5067                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
5068            | name, `OptPercent ->
5069                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
5070                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
5071                pr "    v = caml_alloc (1, 0);\n";
5072                pr "    Store_field (v, 0, v2);\n";
5073                pr "  } else /* None */\n";
5074                pr "    v = Val_int (0);\n";
5075           );
5076           pr "  Store_field (rv, %d, v);\n" i
5077       ) cols;
5078       pr "  CAMLreturn (rv);\n";
5079       pr "}\n";
5080       pr "\n";
5081
5082       pr "static CAMLprim value\n";
5083       pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
5084         typ typ typ;
5085       pr "{\n";
5086       pr "  CAMLparam0 ();\n";
5087       pr "  CAMLlocal2 (rv, v);\n";
5088       pr "  int i;\n";
5089       pr "\n";
5090       pr "  if (%ss->len == 0)\n" typ;
5091       pr "    CAMLreturn (Atom (0));\n";
5092       pr "  else {\n";
5093       pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
5094       pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
5095       pr "      v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
5096       pr "      caml_modify (&Field (rv, i), v);\n";
5097       pr "    }\n";
5098       pr "    CAMLreturn (rv);\n";
5099       pr "  }\n";
5100       pr "}\n";
5101       pr "\n";
5102   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
5103
5104   (* Stat copy functions. *)
5105   List.iter (
5106     fun (typ, cols) ->
5107       pr "static CAMLprim value\n";
5108       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
5109       pr "{\n";
5110       pr "  CAMLparam0 ();\n";
5111       pr "  CAMLlocal2 (rv, v);\n";
5112       pr "\n";
5113       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
5114       iteri (
5115         fun i col ->
5116           (match col with
5117            | name, `Int ->
5118                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
5119           );
5120           pr "  Store_field (rv, %d, v);\n" i
5121       ) cols;
5122       pr "  CAMLreturn (rv);\n";
5123       pr "}\n";
5124       pr "\n";
5125   ) ["stat", stat_cols; "statvfs", statvfs_cols];
5126
5127   (* The wrappers. *)
5128   List.iter (
5129     fun (name, style, _, _, _, _, _) ->
5130       let params =
5131         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
5132
5133       pr "CAMLprim value\n";
5134       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
5135       List.iter (pr ", value %s") (List.tl params);
5136       pr ")\n";
5137       pr "{\n";
5138
5139       (match params with
5140        | [p1; p2; p3; p4; p5] ->
5141            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
5142        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
5143            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
5144            pr "  CAMLxparam%d (%s);\n"
5145              (List.length rest) (String.concat ", " rest)
5146        | ps ->
5147            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
5148       );
5149       pr "  CAMLlocal1 (rv);\n";
5150       pr "\n";
5151
5152       pr "  guestfs_h *g = Guestfs_val (gv);\n";
5153       pr "  if (g == NULL)\n";
5154       pr "    caml_failwith (\"%s: used handle after closing it\");\n" name;
5155       pr "\n";
5156
5157       List.iter (
5158         function
5159         | String n
5160         | FileIn n
5161         | FileOut n ->
5162             pr "  const char *%s = String_val (%sv);\n" n n
5163         | OptString n ->
5164             pr "  const char *%s =\n" n;
5165             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
5166               n n
5167         | StringList n ->
5168             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
5169         | Bool n ->
5170             pr "  int %s = Bool_val (%sv);\n" n n
5171         | Int n ->
5172             pr "  int %s = Int_val (%sv);\n" n n
5173       ) (snd style);
5174       let error_code =
5175         match fst style with
5176         | RErr -> pr "  int r;\n"; "-1"
5177         | RInt _ -> pr "  int r;\n"; "-1"
5178         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
5179         | RBool _ -> pr "  int r;\n"; "-1"
5180         | RConstString _ -> pr "  const char *r;\n"; "NULL"
5181         | RString _ -> pr "  char *r;\n"; "NULL"
5182         | RStringList _ ->
5183             pr "  int i;\n";
5184             pr "  char **r;\n";
5185             "NULL"
5186         | RIntBool _ ->
5187             pr "  struct guestfs_int_bool *r;\n"; "NULL"
5188         | RPVList _ ->
5189             pr "  struct guestfs_lvm_pv_list *r;\n"; "NULL"
5190         | RVGList _ ->
5191             pr "  struct guestfs_lvm_vg_list *r;\n"; "NULL"
5192         | RLVList _ ->
5193             pr "  struct guestfs_lvm_lv_list *r;\n"; "NULL"
5194         | RStat _ ->
5195             pr "  struct guestfs_stat *r;\n"; "NULL"
5196         | RStatVFS _ ->
5197             pr "  struct guestfs_statvfs *r;\n"; "NULL"
5198         | RHashtable _ ->
5199             pr "  int i;\n";
5200             pr "  char **r;\n";
5201             "NULL" in
5202       pr "\n";
5203
5204       pr "  caml_enter_blocking_section ();\n";
5205       pr "  r = guestfs_%s " name;
5206       generate_call_args ~handle:"g" (snd style);
5207       pr ";\n";
5208       pr "  caml_leave_blocking_section ();\n";
5209
5210       List.iter (
5211         function
5212         | StringList n ->
5213             pr "  ocaml_guestfs_free_strings (%s);\n" n;
5214         | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
5215       ) (snd style);
5216
5217       pr "  if (r == %s)\n" error_code;
5218       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
5219       pr "\n";
5220
5221       (match fst style with
5222        | RErr -> pr "  rv = Val_unit;\n"
5223        | RInt _ -> pr "  rv = Val_int (r);\n"
5224        | RInt64 _ ->
5225            pr "  rv = caml_copy_int64 (r);\n"
5226        | RBool _ -> pr "  rv = Val_bool (r);\n"
5227        | RConstString _ -> pr "  rv = caml_copy_string (r);\n"
5228        | RString _ ->
5229            pr "  rv = caml_copy_string (r);\n";
5230            pr "  free (r);\n"
5231        | RStringList _ ->
5232            pr "  rv = caml_copy_string_array ((const char **) r);\n";
5233            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
5234            pr "  free (r);\n"
5235        | RIntBool _ ->
5236            pr "  rv = caml_alloc (2, 0);\n";
5237            pr "  Store_field (rv, 0, Val_int (r->i));\n";
5238            pr "  Store_field (rv, 1, Val_bool (r->b));\n";
5239            pr "  guestfs_free_int_bool (r);\n";
5240        | RPVList _ ->
5241            pr "  rv = copy_lvm_pv_list (r);\n";
5242            pr "  guestfs_free_lvm_pv_list (r);\n";
5243        | RVGList _ ->
5244            pr "  rv = copy_lvm_vg_list (r);\n";
5245            pr "  guestfs_free_lvm_vg_list (r);\n";
5246        | RLVList _ ->
5247            pr "  rv = copy_lvm_lv_list (r);\n";
5248            pr "  guestfs_free_lvm_lv_list (r);\n";
5249        | RStat _ ->
5250            pr "  rv = copy_stat (r);\n";
5251            pr "  free (r);\n";
5252        | RStatVFS _ ->
5253            pr "  rv = copy_statvfs (r);\n";
5254            pr "  free (r);\n";
5255        | RHashtable _ ->
5256            pr "  rv = copy_table (r);\n";
5257            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
5258            pr "  free (r);\n";
5259       );
5260
5261       pr "  CAMLreturn (rv);\n";
5262       pr "}\n";
5263       pr "\n";
5264
5265       if List.length params > 5 then (
5266         pr "CAMLprim value\n";
5267         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
5268         pr "{\n";
5269         pr "  return ocaml_guestfs_%s (argv[0]" name;
5270         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
5271         pr ");\n";
5272         pr "}\n";
5273         pr "\n"
5274       )
5275   ) all_functions
5276
5277 and generate_ocaml_lvm_structure_decls () =
5278   List.iter (
5279     fun (typ, cols) ->
5280       pr "type lvm_%s = {\n" typ;
5281       List.iter (
5282         function
5283         | name, `String -> pr "  %s : string;\n" name
5284         | name, `UUID -> pr "  %s : string;\n" name
5285         | name, `Bytes -> pr "  %s : int64;\n" name
5286         | name, `Int -> pr "  %s : int64;\n" name
5287         | name, `OptPercent -> pr "  %s : float option;\n" name
5288       ) cols;
5289       pr "}\n";
5290       pr "\n"
5291   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
5292
5293 and generate_ocaml_stat_structure_decls () =
5294   List.iter (
5295     fun (typ, cols) ->
5296       pr "type %s = {\n" typ;
5297       List.iter (
5298         function
5299         | name, `Int -> pr "  %s : int64;\n" name
5300       ) cols;
5301       pr "}\n";
5302       pr "\n"
5303   ) ["stat", stat_cols; "statvfs", statvfs_cols]
5304
5305 and generate_ocaml_prototype ?(is_external = false) name style =
5306   if is_external then pr "external " else pr "val ";
5307   pr "%s : t -> " name;
5308   List.iter (
5309     function
5310     | String _ | FileIn _ | FileOut _ -> pr "string -> "
5311     | OptString _ -> pr "string option -> "
5312     | StringList _ -> pr "string array -> "
5313     | Bool _ -> pr "bool -> "
5314     | Int _ -> pr "int -> "
5315   ) (snd style);
5316   (match fst style with
5317    | RErr -> pr "unit" (* all errors are turned into exceptions *)
5318    | RInt _ -> pr "int"
5319    | RInt64 _ -> pr "int64"
5320    | RBool _ -> pr "bool"
5321    | RConstString _ -> pr "string"
5322    | RString _ -> pr "string"
5323    | RStringList _ -> pr "string array"
5324    | RIntBool _ -> pr "int * bool"
5325    | RPVList _ -> pr "lvm_pv array"
5326    | RVGList _ -> pr "lvm_vg array"
5327    | RLVList _ -> pr "lvm_lv array"
5328    | RStat _ -> pr "stat"
5329    | RStatVFS _ -> pr "statvfs"
5330    | RHashtable _ -> pr "(string * string) list"
5331   );
5332   if is_external then (
5333     pr " = ";
5334     if List.length (snd style) + 1 > 5 then
5335       pr "\"ocaml_guestfs_%s_byte\" " name;
5336     pr "\"ocaml_guestfs_%s\"" name
5337   );
5338   pr "\n"
5339
5340 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
5341 and generate_perl_xs () =
5342   generate_header CStyle LGPLv2;
5343
5344   pr "\
5345 #include \"EXTERN.h\"
5346 #include \"perl.h\"
5347 #include \"XSUB.h\"
5348
5349 #include <guestfs.h>
5350
5351 #ifndef PRId64
5352 #define PRId64 \"lld\"
5353 #endif
5354
5355 static SV *
5356 my_newSVll(long long val) {
5357 #ifdef USE_64_BIT_ALL
5358   return newSViv(val);
5359 #else
5360   char buf[100];
5361   int len;
5362   len = snprintf(buf, 100, \"%%\" PRId64, val);
5363   return newSVpv(buf, len);
5364 #endif
5365 }
5366
5367 #ifndef PRIu64
5368 #define PRIu64 \"llu\"
5369 #endif
5370
5371 static SV *
5372 my_newSVull(unsigned long long val) {
5373 #ifdef USE_64_BIT_ALL
5374   return newSVuv(val);
5375 #else
5376   char buf[100];
5377   int len;
5378   len = snprintf(buf, 100, \"%%\" PRIu64, val);
5379   return newSVpv(buf, len);
5380 #endif
5381 }
5382
5383 /* http://www.perlmonks.org/?node_id=680842 */
5384 static char **
5385 XS_unpack_charPtrPtr (SV *arg) {
5386   char **ret;
5387   AV *av;
5388   I32 i;
5389
5390   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
5391     croak (\"array reference expected\");
5392
5393   av = (AV *)SvRV (arg);
5394   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
5395   if (!ret)
5396     croak (\"malloc failed\");
5397
5398   for (i = 0; i <= av_len (av); i++) {
5399     SV **elem = av_fetch (av, i, 0);
5400
5401     if (!elem || !*elem)
5402       croak (\"missing element in list\");
5403
5404     ret[i] = SvPV_nolen (*elem);
5405   }
5406
5407   ret[i] = NULL;
5408
5409   return ret;
5410 }
5411
5412 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
5413
5414 PROTOTYPES: ENABLE
5415
5416 guestfs_h *
5417 _create ()
5418    CODE:
5419       RETVAL = guestfs_create ();
5420       if (!RETVAL)
5421         croak (\"could not create guestfs handle\");
5422       guestfs_set_error_handler (RETVAL, NULL, NULL);
5423  OUTPUT:
5424       RETVAL
5425
5426 void
5427 DESTROY (g)
5428       guestfs_h *g;
5429  PPCODE:
5430       guestfs_close (g);
5431
5432 ";
5433
5434   List.iter (
5435     fun (name, style, _, _, _, _, _) ->
5436       (match fst style with
5437        | RErr -> pr "void\n"
5438        | RInt _ -> pr "SV *\n"
5439        | RInt64 _ -> pr "SV *\n"
5440        | RBool _ -> pr "SV *\n"
5441        | RConstString _ -> pr "SV *\n"
5442        | RString _ -> pr "SV *\n"
5443        | RStringList _
5444        | RIntBool _
5445        | RPVList _ | RVGList _ | RLVList _
5446        | RStat _ | RStatVFS _
5447        | RHashtable _ ->
5448            pr "void\n" (* all lists returned implictly on the stack *)
5449       );
5450       (* Call and arguments. *)
5451       pr "%s " name;
5452       generate_call_args ~handle:"g" (snd style);
5453       pr "\n";
5454       pr "      guestfs_h *g;\n";
5455       iteri (
5456         fun i ->
5457           function
5458           | String n | FileIn n | FileOut n -> pr "      char *%s;\n" n
5459           | OptString n ->
5460               (* http://www.perlmonks.org/?node_id=554277
5461                * Note that the implicit handle argument means we have
5462                * to add 1 to the ST(x) operator.
5463                *)
5464               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
5465           | StringList n -> pr "      char **%s;\n" n
5466           | Bool n -> pr "      int %s;\n" n
5467           | Int n -> pr "      int %s;\n" n
5468       ) (snd style);
5469
5470       let do_cleanups () =
5471         List.iter (
5472           function
5473           | String _ | OptString _ | Bool _ | Int _
5474           | FileIn _ | FileOut _ -> ()
5475           | StringList n -> pr "      free (%s);\n" n
5476         ) (snd style)
5477       in
5478
5479       (* Code. *)
5480       (match fst style with
5481        | RErr ->
5482            pr "PREINIT:\n";
5483            pr "      int r;\n";
5484            pr " PPCODE:\n";
5485            pr "      r = guestfs_%s " name;
5486            generate_call_args ~handle:"g" (snd style);
5487            pr ";\n";
5488            do_cleanups ();
5489            pr "      if (r == -1)\n";
5490            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5491        | RInt n
5492        | RBool n ->
5493            pr "PREINIT:\n";
5494            pr "      int %s;\n" n;
5495            pr "   CODE:\n";
5496            pr "      %s = guestfs_%s " n name;
5497            generate_call_args ~handle:"g" (snd style);
5498            pr ";\n";
5499            do_cleanups ();
5500            pr "      if (%s == -1)\n" n;
5501            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5502            pr "      RETVAL = newSViv (%s);\n" n;
5503            pr " OUTPUT:\n";
5504            pr "      RETVAL\n"
5505        | RInt64 n ->
5506            pr "PREINIT:\n";
5507            pr "      int64_t %s;\n" n;
5508            pr "   CODE:\n";
5509            pr "      %s = guestfs_%s " n name;
5510            generate_call_args ~handle:"g" (snd style);
5511            pr ";\n";
5512            do_cleanups ();
5513            pr "      if (%s == -1)\n" n;
5514            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5515            pr "      RETVAL = my_newSVll (%s);\n" n;
5516            pr " OUTPUT:\n";
5517            pr "      RETVAL\n"
5518        | RConstString n ->
5519            pr "PREINIT:\n";
5520            pr "      const char *%s;\n" n;
5521            pr "   CODE:\n";
5522            pr "      %s = guestfs_%s " n name;
5523            generate_call_args ~handle:"g" (snd style);
5524            pr ";\n";
5525            do_cleanups ();
5526            pr "      if (%s == NULL)\n" n;
5527            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5528            pr "      RETVAL = newSVpv (%s, 0);\n" n;
5529            pr " OUTPUT:\n";
5530            pr "      RETVAL\n"
5531        | RString n ->
5532            pr "PREINIT:\n";
5533            pr "      char *%s;\n" n;
5534            pr "   CODE:\n";
5535            pr "      %s = guestfs_%s " n name;
5536            generate_call_args ~handle:"g" (snd style);
5537            pr ";\n";
5538            do_cleanups ();
5539            pr "      if (%s == NULL)\n" n;
5540            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5541            pr "      RETVAL = newSVpv (%s, 0);\n" n;
5542            pr "      free (%s);\n" n;
5543            pr " OUTPUT:\n";
5544            pr "      RETVAL\n"
5545        | RStringList n | RHashtable n ->
5546            pr "PREINIT:\n";
5547            pr "      char **%s;\n" n;
5548            pr "      int i, n;\n";
5549            pr " PPCODE:\n";
5550            pr "      %s = guestfs_%s " n name;
5551            generate_call_args ~handle:"g" (snd style);
5552            pr ";\n";
5553            do_cleanups ();
5554            pr "      if (%s == NULL)\n" n;
5555            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5556            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
5557            pr "      EXTEND (SP, n);\n";
5558            pr "      for (i = 0; i < n; ++i) {\n";
5559            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
5560            pr "        free (%s[i]);\n" n;
5561            pr "      }\n";
5562            pr "      free (%s);\n" n;
5563        | RIntBool _ ->
5564            pr "PREINIT:\n";
5565            pr "      struct guestfs_int_bool *r;\n";
5566            pr " PPCODE:\n";
5567            pr "      r = guestfs_%s " name;
5568            generate_call_args ~handle:"g" (snd style);
5569            pr ";\n";
5570            do_cleanups ();
5571            pr "      if (r == NULL)\n";
5572            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5573            pr "      EXTEND (SP, 2);\n";
5574            pr "      PUSHs (sv_2mortal (newSViv (r->i)));\n";
5575            pr "      PUSHs (sv_2mortal (newSViv (r->b)));\n";
5576            pr "      guestfs_free_int_bool (r);\n";
5577        | RPVList n ->
5578            generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
5579        | RVGList n ->
5580            generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
5581        | RLVList n ->
5582            generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
5583        | RStat n ->
5584            generate_perl_stat_code "stat" stat_cols name style n do_cleanups
5585        | RStatVFS n ->
5586            generate_perl_stat_code
5587              "statvfs" statvfs_cols name style n do_cleanups
5588       );
5589
5590       pr "\n"
5591   ) all_functions
5592
5593 and generate_perl_lvm_code typ cols name style n do_cleanups =
5594   pr "PREINIT:\n";
5595   pr "      struct guestfs_lvm_%s_list *%s;\n" typ n;
5596   pr "      int i;\n";
5597   pr "      HV *hv;\n";
5598   pr " PPCODE:\n";
5599   pr "      %s = guestfs_%s " n name;
5600   generate_call_args ~handle:"g" (snd style);
5601   pr ";\n";
5602   do_cleanups ();
5603   pr "      if (%s == NULL)\n" n;
5604   pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5605   pr "      EXTEND (SP, %s->len);\n" n;
5606   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
5607   pr "        hv = newHV ();\n";
5608   List.iter (
5609     function
5610     | name, `String ->
5611         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
5612           name (String.length name) n name
5613     | name, `UUID ->
5614         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
5615           name (String.length name) n name
5616     | name, `Bytes ->
5617         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
5618           name (String.length name) n name
5619     | name, `Int ->
5620         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
5621           name (String.length name) n name
5622     | name, `OptPercent ->
5623         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
5624           name (String.length name) n name
5625   ) cols;
5626   pr "        PUSHs (sv_2mortal ((SV *) hv));\n";
5627   pr "      }\n";
5628   pr "      guestfs_free_lvm_%s_list (%s);\n" typ n
5629
5630 and generate_perl_stat_code typ cols name style n do_cleanups =
5631   pr "PREINIT:\n";
5632   pr "      struct guestfs_%s *%s;\n" typ n;
5633   pr " PPCODE:\n";
5634   pr "      %s = guestfs_%s " n name;
5635   generate_call_args ~handle:"g" (snd style);
5636   pr ";\n";
5637   do_cleanups ();
5638   pr "      if (%s == NULL)\n" n;
5639   pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
5640   pr "      EXTEND (SP, %d);\n" (List.length cols);
5641   List.iter (
5642     function
5643     | name, `Int ->
5644         pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
5645   ) cols;
5646   pr "      free (%s);\n" n
5647
5648 (* Generate Sys/Guestfs.pm. *)
5649 and generate_perl_pm () =
5650   generate_header HashStyle LGPLv2;
5651
5652   pr "\
5653 =pod
5654
5655 =head1 NAME
5656
5657 Sys::Guestfs - Perl bindings for libguestfs
5658
5659 =head1 SYNOPSIS
5660
5661  use Sys::Guestfs;
5662
5663  my $h = Sys::Guestfs->new ();
5664  $h->add_drive ('guest.img');
5665  $h->launch ();
5666  $h->wait_ready ();
5667  $h->mount ('/dev/sda1', '/');
5668  $h->touch ('/hello');
5669  $h->sync ();
5670
5671 =head1 DESCRIPTION
5672
5673 The C<Sys::Guestfs> module provides a Perl XS binding to the
5674 libguestfs API for examining and modifying virtual machine
5675 disk images.
5676
5677 Amongst the things this is good for: making batch configuration
5678 changes to guests, getting disk used/free statistics (see also:
5679 virt-df), migrating between virtualization systems (see also:
5680 virt-p2v), performing partial backups, performing partial guest
5681 clones, cloning guests and changing registry/UUID/hostname info, and
5682 much else besides.
5683
5684 Libguestfs uses Linux kernel and qemu code, and can access any type of
5685 guest filesystem that Linux and qemu can, including but not limited
5686 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
5687 schemes, qcow, qcow2, vmdk.
5688
5689 Libguestfs provides ways to enumerate guest storage (eg. partitions,
5690 LVs, what filesystem is in each LV, etc.).  It can also run commands
5691 in the context of the guest.  Also you can access filesystems over FTP.
5692
5693 =head1 ERRORS
5694
5695 All errors turn into calls to C<croak> (see L<Carp(3)>).
5696
5697 =head1 METHODS
5698
5699 =over 4
5700
5701 =cut
5702
5703 package Sys::Guestfs;
5704
5705 use strict;
5706 use warnings;
5707
5708 require XSLoader;
5709 XSLoader::load ('Sys::Guestfs');
5710
5711 =item $h = Sys::Guestfs->new ();
5712
5713 Create a new guestfs handle.
5714
5715 =cut
5716
5717 sub new {
5718   my $proto = shift;
5719   my $class = ref ($proto) || $proto;
5720
5721   my $self = Sys::Guestfs::_create ();
5722   bless $self, $class;
5723   return $self;
5724 }
5725
5726 ";
5727
5728   (* Actions.  We only need to print documentation for these as
5729    * they are pulled in from the XS code automatically.
5730    *)
5731   List.iter (
5732     fun (name, style, _, flags, _, _, longdesc) ->
5733       if not (List.mem NotInDocs flags) then (
5734         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
5735         pr "=item ";
5736         generate_perl_prototype name style;
5737         pr "\n\n";
5738         pr "%s\n\n" longdesc;
5739         if List.mem ProtocolLimitWarning flags then
5740           pr "%s\n\n" protocol_limit_warning;
5741         if List.mem DangerWillRobinson flags then
5742           pr "%s\n\n" danger_will_robinson
5743       )
5744   ) all_functions_sorted;
5745
5746   (* End of file. *)
5747   pr "\
5748 =cut
5749
5750 1;
5751
5752 =back
5753
5754 =head1 COPYRIGHT
5755
5756 Copyright (C) 2009 Red Hat Inc.
5757
5758 =head1 LICENSE
5759
5760 Please see the file COPYING.LIB for the full license.
5761
5762 =head1 SEE ALSO
5763
5764 L<guestfs(3)>, L<guestfish(1)>.
5765
5766 =cut
5767 "
5768
5769 and generate_perl_prototype name style =
5770   (match fst style with
5771    | RErr -> ()
5772    | RBool n
5773    | RInt n
5774    | RInt64 n
5775    | RConstString n
5776    | RString n -> pr "$%s = " n
5777    | RIntBool (n, m) -> pr "($%s, $%s) = " n m
5778    | RStringList n
5779    | RPVList n
5780    | RVGList n
5781    | RLVList n -> pr "@%s = " n
5782    | RStat n
5783    | RStatVFS n
5784    | RHashtable n -> pr "%%%s = " n
5785   );
5786   pr "$h->%s (" name;
5787   let comma = ref false in
5788   List.iter (
5789     fun arg ->
5790       if !comma then pr ", ";
5791       comma := true;
5792       match arg with
5793       | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
5794           pr "$%s" n
5795       | StringList n ->
5796           pr "\\@%s" n
5797   ) (snd style);
5798   pr ");"
5799
5800 (* Generate Python C module. *)
5801 and generate_python_c () =
5802   generate_header CStyle LGPLv2;
5803
5804   pr "\
5805 #include <stdio.h>
5806 #include <stdlib.h>
5807 #include <assert.h>
5808
5809 #include <Python.h>
5810
5811 #include \"guestfs.h\"
5812
5813 typedef struct {
5814   PyObject_HEAD
5815   guestfs_h *g;
5816 } Pyguestfs_Object;
5817
5818 static guestfs_h *
5819 get_handle (PyObject *obj)
5820 {
5821   assert (obj);
5822   assert (obj != Py_None);
5823   return ((Pyguestfs_Object *) obj)->g;
5824 }
5825
5826 static PyObject *
5827 put_handle (guestfs_h *g)
5828 {
5829   assert (g);
5830   return
5831     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
5832 }
5833
5834 /* This list should be freed (but not the strings) after use. */
5835 static const char **
5836 get_string_list (PyObject *obj)
5837 {
5838   int i, len;
5839   const char **r;
5840
5841   assert (obj);
5842
5843   if (!PyList_Check (obj)) {
5844     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
5845     return NULL;
5846   }
5847
5848   len = PyList_Size (obj);
5849   r = malloc (sizeof (char *) * (len+1));
5850   if (r == NULL) {
5851     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
5852     return NULL;
5853   }
5854
5855   for (i = 0; i < len; ++i)
5856     r[i] = PyString_AsString (PyList_GetItem (obj, i));
5857   r[len] = NULL;
5858
5859   return r;
5860 }
5861
5862 static PyObject *
5863 put_string_list (char * const * const argv)
5864 {
5865   PyObject *list;
5866   int argc, i;
5867
5868   for (argc = 0; argv[argc] != NULL; ++argc)
5869     ;
5870
5871   list = PyList_New (argc);
5872   for (i = 0; i < argc; ++i)
5873     PyList_SetItem (list, i, PyString_FromString (argv[i]));
5874
5875   return list;
5876 }
5877
5878 static PyObject *
5879 put_table (char * const * const argv)
5880 {
5881   PyObject *list, *item;
5882   int argc, i;
5883
5884   for (argc = 0; argv[argc] != NULL; ++argc)
5885     ;
5886
5887   list = PyList_New (argc >> 1);
5888   for (i = 0; i < argc; i += 2) {
5889     item = PyTuple_New (2);
5890     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
5891     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
5892     PyList_SetItem (list, i >> 1, item);
5893   }
5894
5895   return list;
5896 }
5897
5898 static void
5899 free_strings (char **argv)
5900 {
5901   int argc;
5902
5903   for (argc = 0; argv[argc] != NULL; ++argc)
5904     free (argv[argc]);
5905   free (argv);
5906 }
5907
5908 static PyObject *
5909 py_guestfs_create (PyObject *self, PyObject *args)
5910 {
5911   guestfs_h *g;
5912
5913   g = guestfs_create ();
5914   if (g == NULL) {
5915     PyErr_SetString (PyExc_RuntimeError,
5916                      \"guestfs.create: failed to allocate handle\");
5917     return NULL;
5918   }
5919   guestfs_set_error_handler (g, NULL, NULL);
5920   return put_handle (g);
5921 }
5922
5923 static PyObject *
5924 py_guestfs_close (PyObject *self, PyObject *args)
5925 {
5926   PyObject *py_g;
5927   guestfs_h *g;
5928
5929   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
5930     return NULL;
5931   g = get_handle (py_g);
5932
5933   guestfs_close (g);
5934
5935   Py_INCREF (Py_None);
5936   return Py_None;
5937 }
5938
5939 ";
5940
5941   (* LVM structures, turned into Python dictionaries. *)
5942   List.iter (
5943     fun (typ, cols) ->
5944       pr "static PyObject *\n";
5945       pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
5946       pr "{\n";
5947       pr "  PyObject *dict;\n";
5948       pr "\n";
5949       pr "  dict = PyDict_New ();\n";
5950       List.iter (
5951         function
5952         | name, `String ->
5953             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
5954             pr "                        PyString_FromString (%s->%s));\n"
5955               typ name
5956         | name, `UUID ->
5957             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
5958             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
5959               typ name
5960         | name, `Bytes ->
5961             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
5962             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
5963               typ name
5964         | name, `Int ->
5965             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
5966             pr "                        PyLong_FromLongLong (%s->%s));\n"
5967               typ name
5968         | name, `OptPercent ->
5969             pr "  if (%s->%s >= 0)\n" typ name;
5970             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
5971             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
5972               typ name;
5973             pr "  else {\n";
5974             pr "    Py_INCREF (Py_None);\n";
5975             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);" name;
5976             pr "  }\n"
5977       ) cols;
5978       pr "  return dict;\n";
5979       pr "};\n";
5980       pr "\n";
5981
5982       pr "static PyObject *\n";
5983       pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
5984       pr "{\n";
5985       pr "  PyObject *list;\n";
5986       pr "  int i;\n";
5987       pr "\n";
5988       pr "  list = PyList_New (%ss->len);\n" typ;
5989       pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
5990       pr "    PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
5991       pr "  return list;\n";
5992       pr "};\n";
5993       pr "\n"
5994   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
5995
5996   (* Stat structures, turned into Python dictionaries. *)
5997   List.iter (
5998     fun (typ, cols) ->
5999       pr "static PyObject *\n";
6000       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
6001       pr "{\n";
6002       pr "  PyObject *dict;\n";
6003       pr "\n";
6004       pr "  dict = PyDict_New ();\n";
6005       List.iter (
6006         function
6007         | name, `Int ->
6008             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
6009             pr "                        PyLong_FromLongLong (%s->%s));\n"
6010               typ name
6011       ) cols;
6012       pr "  return dict;\n";
6013       pr "};\n";
6014       pr "\n";
6015   ) ["stat", stat_cols; "statvfs", statvfs_cols];
6016
6017   (* Python wrapper functions. *)
6018   List.iter (
6019     fun (name, style, _, _, _, _, _) ->
6020       pr "static PyObject *\n";
6021       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
6022       pr "{\n";
6023
6024       pr "  PyObject *py_g;\n";
6025       pr "  guestfs_h *g;\n";
6026       pr "  PyObject *py_r;\n";
6027
6028       let error_code =
6029         match fst style with
6030         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
6031         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6032         | RConstString _ -> pr "  const char *r;\n"; "NULL"
6033         | RString _ -> pr "  char *r;\n"; "NULL"
6034         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6035         | RIntBool _ -> pr "  struct guestfs_int_bool *r;\n"; "NULL"
6036         | RPVList n -> pr "  struct guestfs_lvm_pv_list *r;\n"; "NULL"
6037         | RVGList n -> pr "  struct guestfs_lvm_vg_list *r;\n"; "NULL"
6038         | RLVList n -> pr "  struct guestfs_lvm_lv_list *r;\n"; "NULL"
6039         | RStat n -> pr "  struct guestfs_stat *r;\n"; "NULL"
6040         | RStatVFS n -> pr "  struct guestfs_statvfs *r;\n"; "NULL" in
6041
6042       List.iter (
6043         function
6044         | String n | FileIn n | FileOut n -> pr "  const char *%s;\n" n
6045         | OptString n -> pr "  const char *%s;\n" n
6046         | StringList n ->
6047             pr "  PyObject *py_%s;\n" n;
6048             pr "  const char **%s;\n" n
6049         | Bool n -> pr "  int %s;\n" n
6050         | Int n -> pr "  int %s;\n" n
6051       ) (snd style);
6052
6053       pr "\n";
6054
6055       (* Convert the parameters. *)
6056       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
6057       List.iter (
6058         function
6059         | String _ | FileIn _ | FileOut _ -> pr "s"
6060         | OptString _ -> pr "z"
6061         | StringList _ -> pr "O"
6062         | Bool _ -> pr "i" (* XXX Python has booleans? *)
6063         | Int _ -> pr "i"
6064       ) (snd style);
6065       pr ":guestfs_%s\",\n" name;
6066       pr "                         &py_g";
6067       List.iter (
6068         function
6069         | String n | FileIn n | FileOut n -> pr ", &%s" n
6070         | OptString n -> pr ", &%s" n
6071         | StringList n -> pr ", &py_%s" n
6072         | Bool n -> pr ", &%s" n
6073         | Int n -> pr ", &%s" n
6074       ) (snd style);
6075
6076       pr "))\n";
6077       pr "    return NULL;\n";
6078
6079       pr "  g = get_handle (py_g);\n";
6080       List.iter (
6081         function
6082         | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
6083         | StringList n ->
6084             pr "  %s = get_string_list (py_%s);\n" n n;
6085             pr "  if (!%s) return NULL;\n" n
6086       ) (snd style);
6087
6088       pr "\n";
6089
6090       pr "  r = guestfs_%s " name;
6091       generate_call_args ~handle:"g" (snd style);
6092       pr ";\n";
6093
6094       List.iter (
6095         function
6096         | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
6097         | StringList n ->
6098             pr "  free (%s);\n" n
6099       ) (snd style);
6100
6101       pr "  if (r == %s) {\n" error_code;
6102       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
6103       pr "    return NULL;\n";
6104       pr "  }\n";
6105       pr "\n";
6106
6107       (match fst style with
6108        | RErr ->
6109            pr "  Py_INCREF (Py_None);\n";
6110            pr "  py_r = Py_None;\n"
6111        | RInt _
6112        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
6113        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
6114        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
6115        | RString _ ->
6116            pr "  py_r = PyString_FromString (r);\n";
6117            pr "  free (r);\n"
6118        | RStringList _ ->
6119            pr "  py_r = put_string_list (r);\n";
6120            pr "  free_strings (r);\n"
6121        | RIntBool _ ->
6122            pr "  py_r = PyTuple_New (2);\n";
6123            pr "  PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
6124            pr "  PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
6125            pr "  guestfs_free_int_bool (r);\n"
6126        | RPVList n ->
6127            pr "  py_r = put_lvm_pv_list (r);\n";
6128            pr "  guestfs_free_lvm_pv_list (r);\n"
6129        | RVGList n ->
6130            pr "  py_r = put_lvm_vg_list (r);\n";
6131            pr "  guestfs_free_lvm_vg_list (r);\n"
6132        | RLVList n ->
6133            pr "  py_r = put_lvm_lv_list (r);\n";
6134            pr "  guestfs_free_lvm_lv_list (r);\n"
6135        | RStat n ->
6136            pr "  py_r = put_stat (r);\n";
6137            pr "  free (r);\n"
6138        | RStatVFS n ->
6139            pr "  py_r = put_statvfs (r);\n";
6140            pr "  free (r);\n"
6141        | RHashtable n ->
6142            pr "  py_r = put_table (r);\n";
6143            pr "  free_strings (r);\n"
6144       );
6145
6146       pr "  return py_r;\n";
6147       pr "}\n";
6148       pr "\n"
6149   ) all_functions;
6150
6151   (* Table of functions. *)
6152   pr "static PyMethodDef methods[] = {\n";
6153   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
6154   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
6155   List.iter (
6156     fun (name, _, _, _, _, _, _) ->
6157       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
6158         name name
6159   ) all_functions;
6160   pr "  { NULL, NULL, 0, NULL }\n";
6161   pr "};\n";
6162   pr "\n";
6163
6164   (* Init function. *)
6165   pr "\
6166 void
6167 initlibguestfsmod (void)
6168 {
6169   static int initialized = 0;
6170
6171   if (initialized) return;
6172   Py_InitModule ((char *) \"libguestfsmod\", methods);
6173   initialized = 1;
6174 }
6175 "
6176
6177 (* Generate Python module. *)
6178 and generate_python_py () =
6179   generate_header HashStyle LGPLv2;
6180
6181   pr "\
6182 u\"\"\"Python bindings for libguestfs
6183
6184 import guestfs
6185 g = guestfs.GuestFS ()
6186 g.add_drive (\"guest.img\")
6187 g.launch ()
6188 g.wait_ready ()
6189 parts = g.list_partitions ()
6190
6191 The guestfs module provides a Python binding to the libguestfs API
6192 for examining and modifying virtual machine disk images.
6193
6194 Amongst the things this is good for: making batch configuration
6195 changes to guests, getting disk used/free statistics (see also:
6196 virt-df), migrating between virtualization systems (see also:
6197 virt-p2v), performing partial backups, performing partial guest
6198 clones, cloning guests and changing registry/UUID/hostname info, and
6199 much else besides.
6200
6201 Libguestfs uses Linux kernel and qemu code, and can access any type of
6202 guest filesystem that Linux and qemu can, including but not limited
6203 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
6204 schemes, qcow, qcow2, vmdk.
6205
6206 Libguestfs provides ways to enumerate guest storage (eg. partitions,
6207 LVs, what filesystem is in each LV, etc.).  It can also run commands
6208 in the context of the guest.  Also you can access filesystems over FTP.
6209
6210 Errors which happen while using the API are turned into Python
6211 RuntimeError exceptions.
6212
6213 To create a guestfs handle you usually have to perform the following
6214 sequence of calls:
6215
6216 # Create the handle, call add_drive at least once, and possibly
6217 # several times if the guest has multiple block devices:
6218 g = guestfs.GuestFS ()
6219 g.add_drive (\"guest.img\")
6220
6221 # Launch the qemu subprocess and wait for it to become ready:
6222 g.launch ()
6223 g.wait_ready ()
6224
6225 # Now you can issue commands, for example:
6226 logvols = g.lvs ()
6227
6228 \"\"\"
6229
6230 import libguestfsmod
6231
6232 class GuestFS:
6233     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
6234
6235     def __init__ (self):
6236         \"\"\"Create a new libguestfs handle.\"\"\"
6237         self._o = libguestfsmod.create ()
6238
6239     def __del__ (self):
6240         libguestfsmod.close (self._o)
6241
6242 ";
6243
6244   List.iter (
6245     fun (name, style, _, flags, _, _, longdesc) ->
6246       pr "    def %s " name;
6247       generate_call_args ~handle:"self" (snd style);
6248       pr ":\n";
6249
6250       if not (List.mem NotInDocs flags) then (
6251         let doc = replace_str longdesc "C<guestfs_" "C<g." in
6252         let doc =
6253           match fst style with
6254           | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
6255           | RString _ -> doc
6256           | RStringList _ ->
6257               doc ^ "\n\nThis function returns a list of strings."
6258           | RIntBool _ ->
6259               doc ^ "\n\nThis function returns a tuple (int, bool).\n"
6260           | RPVList _ ->
6261               doc ^ "\n\nThis function returns a list of PVs.  Each PV is represented as a dictionary."
6262           | RVGList _ ->
6263               doc ^ "\n\nThis function returns a list of VGs.  Each VG is represented as a dictionary."
6264           | RLVList _ ->
6265               doc ^ "\n\nThis function returns a list of LVs.  Each LV is represented as a dictionary."
6266           | RStat _ ->
6267               doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
6268           | RStatVFS _ ->
6269               doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
6270           | RHashtable _ ->
6271               doc ^ "\n\nThis function returns a dictionary." in
6272         let doc =
6273           if List.mem ProtocolLimitWarning flags then
6274             doc ^ "\n\n" ^ protocol_limit_warning
6275           else doc in
6276         let doc =
6277           if List.mem DangerWillRobinson flags then
6278             doc ^ "\n\n" ^ danger_will_robinson
6279           else doc in
6280         let doc = pod2text ~width:60 name doc in
6281         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
6282         let doc = String.concat "\n        " doc in
6283         pr "        u\"\"\"%s\"\"\"\n" doc;
6284       );
6285       pr "        return libguestfsmod.%s " name;
6286       generate_call_args ~handle:"self._o" (snd style);
6287       pr "\n";
6288       pr "\n";
6289   ) all_functions
6290
6291 (* Useful if you need the longdesc POD text as plain text.  Returns a
6292  * list of lines.
6293  *
6294  * This is the slowest thing about autogeneration.
6295  *)
6296 and pod2text ~width name longdesc =
6297   let filename, chan = Filename.open_temp_file "gen" ".tmp" in
6298   fprintf chan "=head1 %s\n\n%s\n" name longdesc;
6299   close_out chan;
6300   let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
6301   let chan = Unix.open_process_in cmd in
6302   let lines = ref [] in
6303   let rec loop i =
6304     let line = input_line chan in
6305     if i = 1 then               (* discard the first line of output *)
6306       loop (i+1)
6307     else (
6308       let line = triml line in
6309       lines := line :: !lines;
6310       loop (i+1)
6311     ) in
6312   let lines = try loop 1 with End_of_file -> List.rev !lines in
6313   Unix.unlink filename;
6314   match Unix.close_process_in chan with
6315   | Unix.WEXITED 0 -> lines
6316   | Unix.WEXITED i ->
6317       failwithf "pod2text: process exited with non-zero status (%d)" i
6318   | Unix.WSIGNALED i | Unix.WSTOPPED i ->
6319       failwithf "pod2text: process signalled or stopped by signal %d" i
6320
6321 (* Generate ruby bindings. *)
6322 and generate_ruby_c () =
6323   generate_header CStyle LGPLv2;
6324
6325   pr "\
6326 #include <stdio.h>
6327 #include <stdlib.h>
6328
6329 #include <ruby.h>
6330
6331 #include \"guestfs.h\"
6332
6333 #include \"extconf.h\"
6334
6335 /* For Ruby < 1.9 */
6336 #ifndef RARRAY_LEN
6337 #define RARRAY_LEN(r) (RARRAY((r))->len)
6338 #endif
6339
6340 static VALUE m_guestfs;                 /* guestfs module */
6341 static VALUE c_guestfs;                 /* guestfs_h handle */
6342 static VALUE e_Error;                   /* used for all errors */
6343
6344 static void ruby_guestfs_free (void *p)
6345 {
6346   if (!p) return;
6347   guestfs_close ((guestfs_h *) p);
6348 }
6349
6350 static VALUE ruby_guestfs_create (VALUE m)
6351 {
6352   guestfs_h *g;
6353
6354   g = guestfs_create ();
6355   if (!g)
6356     rb_raise (e_Error, \"failed to create guestfs handle\");
6357
6358   /* Don't print error messages to stderr by default. */
6359   guestfs_set_error_handler (g, NULL, NULL);
6360
6361   /* Wrap it, and make sure the close function is called when the
6362    * handle goes away.
6363    */
6364   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
6365 }
6366
6367 static VALUE ruby_guestfs_close (VALUE gv)
6368 {
6369   guestfs_h *g;
6370   Data_Get_Struct (gv, guestfs_h, g);
6371
6372   ruby_guestfs_free (g);
6373   DATA_PTR (gv) = NULL;
6374
6375   return Qnil;
6376 }
6377
6378 ";
6379
6380   List.iter (
6381     fun (name, style, _, _, _, _, _) ->
6382       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
6383       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
6384       pr ")\n";
6385       pr "{\n";
6386       pr "  guestfs_h *g;\n";
6387       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
6388       pr "  if (!g)\n";
6389       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
6390         name;
6391       pr "\n";
6392
6393       List.iter (
6394         function
6395         | String n | FileIn n | FileOut n ->
6396             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
6397             pr "  if (!%s)\n" n;
6398             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
6399             pr "              \"%s\", \"%s\");\n" n name
6400         | OptString n ->
6401             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
6402         | StringList n ->
6403             pr "  char **%s;" n;
6404             pr "  {\n";
6405             pr "    int i, len;\n";
6406             pr "    len = RARRAY_LEN (%sv);\n" n;
6407             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
6408               n;
6409             pr "    for (i = 0; i < len; ++i) {\n";
6410             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
6411             pr "      %s[i] = StringValueCStr (v);\n" n;
6412             pr "    }\n";
6413             pr "    %s[len] = NULL;\n" n;
6414             pr "  }\n";
6415         | Bool n ->
6416             pr "  int %s = RTEST (%sv);\n" n n
6417         | Int n ->
6418             pr "  int %s = NUM2INT (%sv);\n" n n
6419       ) (snd style);
6420       pr "\n";
6421
6422       let error_code =
6423         match fst style with
6424         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
6425         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6426         | RConstString _ -> pr "  const char *r;\n"; "NULL"
6427         | RString _ -> pr "  char *r;\n"; "NULL"
6428         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
6429         | RIntBool _ -> pr "  struct guestfs_int_bool *r;\n"; "NULL"
6430         | RPVList n -> pr "  struct guestfs_lvm_pv_list *r;\n"; "NULL"
6431         | RVGList n -> pr "  struct guestfs_lvm_vg_list *r;\n"; "NULL"
6432         | RLVList n -> pr "  struct guestfs_lvm_lv_list *r;\n"; "NULL"
6433         | RStat n -> pr "  struct guestfs_stat *r;\n"; "NULL"
6434         | RStatVFS n -> pr "  struct guestfs_statvfs *r;\n"; "NULL" in
6435       pr "\n";
6436
6437       pr "  r = guestfs_%s " name;
6438       generate_call_args ~handle:"g" (snd style);
6439       pr ";\n";
6440
6441       List.iter (
6442         function
6443         | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
6444         | StringList n ->
6445             pr "  free (%s);\n" n
6446       ) (snd style);
6447
6448       pr "  if (r == %s)\n" error_code;
6449       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
6450       pr "\n";
6451
6452       (match fst style with
6453        | RErr ->
6454            pr "  return Qnil;\n"
6455        | RInt _ | RBool _ ->
6456            pr "  return INT2NUM (r);\n"
6457        | RInt64 _ ->
6458            pr "  return ULL2NUM (r);\n"
6459        | RConstString _ ->
6460            pr "  return rb_str_new2 (r);\n";
6461        | RString _ ->
6462            pr "  VALUE rv = rb_str_new2 (r);\n";
6463            pr "  free (r);\n";
6464            pr "  return rv;\n";
6465        | RStringList _ ->
6466            pr "  int i, len = 0;\n";
6467            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
6468            pr "  VALUE rv = rb_ary_new2 (len);\n";
6469            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
6470            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
6471            pr "    free (r[i]);\n";
6472            pr "  }\n";
6473            pr "  free (r);\n";
6474            pr "  return rv;\n"
6475        | RIntBool _ ->
6476            pr "  VALUE rv = rb_ary_new2 (2);\n";
6477            pr "  rb_ary_push (rv, INT2NUM (r->i));\n";
6478            pr "  rb_ary_push (rv, INT2NUM (r->b));\n";
6479            pr "  guestfs_free_int_bool (r);\n";
6480            pr "  return rv;\n"
6481        | RPVList n ->
6482            generate_ruby_lvm_code "pv" pv_cols
6483        | RVGList n ->
6484            generate_ruby_lvm_code "vg" vg_cols
6485        | RLVList n ->
6486            generate_ruby_lvm_code "lv" lv_cols
6487        | RStat n ->
6488            pr "  VALUE rv = rb_hash_new ();\n";
6489            List.iter (
6490              function
6491              | name, `Int ->
6492                  pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
6493            ) stat_cols;
6494            pr "  free (r);\n";
6495            pr "  return rv;\n"
6496        | RStatVFS n ->
6497            pr "  VALUE rv = rb_hash_new ();\n";
6498            List.iter (
6499              function
6500              | name, `Int ->
6501                  pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
6502            ) statvfs_cols;
6503            pr "  free (r);\n";
6504            pr "  return rv;\n"
6505        | RHashtable _ ->
6506            pr "  VALUE rv = rb_hash_new ();\n";
6507            pr "  int i;\n";
6508            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
6509            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
6510            pr "    free (r[i]);\n";
6511            pr "    free (r[i+1]);\n";
6512            pr "  }\n";
6513            pr "  free (r);\n";
6514            pr "  return rv;\n"
6515       );
6516
6517       pr "}\n";
6518       pr "\n"
6519   ) all_functions;
6520
6521   pr "\
6522 /* Initialize the module. */
6523 void Init__guestfs ()
6524 {
6525   m_guestfs = rb_define_module (\"Guestfs\");
6526   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
6527   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
6528
6529   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
6530   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
6531
6532 ";
6533   (* Define the rest of the methods. *)
6534   List.iter (
6535     fun (name, style, _, _, _, _, _) ->
6536       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
6537       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
6538   ) all_functions;
6539
6540   pr "}\n"
6541
6542 (* Ruby code to return an LVM struct list. *)
6543 and generate_ruby_lvm_code typ cols =
6544   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
6545   pr "  int i;\n";
6546   pr "  for (i = 0; i < r->len; ++i) {\n";
6547   pr "    VALUE hv = rb_hash_new ();\n";
6548   List.iter (
6549     function
6550     | name, `String ->
6551         pr "    rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
6552     | name, `UUID ->
6553         pr "    rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
6554     | name, `Bytes
6555     | name, `Int ->
6556         pr "    rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
6557     | name, `OptPercent ->
6558         pr "    rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
6559   ) cols;
6560   pr "    rb_ary_push (rv, hv);\n";
6561   pr "  }\n";
6562   pr "  guestfs_free_lvm_%s_list (r);\n" typ;
6563   pr "  return rv;\n"
6564
6565 (* Generate Java bindings GuestFS.java file. *)
6566 and generate_java_java () =
6567   generate_header CStyle LGPLv2;
6568
6569   pr "\
6570 package com.redhat.et.libguestfs;
6571
6572 import java.util.HashMap;
6573 import com.redhat.et.libguestfs.LibGuestFSException;
6574 import com.redhat.et.libguestfs.PV;
6575 import com.redhat.et.libguestfs.VG;
6576 import com.redhat.et.libguestfs.LV;
6577 import com.redhat.et.libguestfs.Stat;
6578 import com.redhat.et.libguestfs.StatVFS;
6579 import com.redhat.et.libguestfs.IntBool;
6580
6581 /**
6582  * The GuestFS object is a libguestfs handle.
6583  *
6584  * @author rjones
6585  */
6586 public class GuestFS {
6587   // Load the native code.
6588   static {
6589     System.loadLibrary (\"guestfs_jni\");
6590   }
6591
6592   /**
6593    * The native guestfs_h pointer.
6594    */
6595   long g;
6596
6597   /**
6598    * Create a libguestfs handle.
6599    *
6600    * @throws LibGuestFSException
6601    */
6602   public GuestFS () throws LibGuestFSException
6603   {
6604     g = _create ();
6605   }
6606   private native long _create () throws LibGuestFSException;
6607
6608   /**
6609    * Close a libguestfs handle.
6610    *
6611    * You can also leave handles to be collected by the garbage
6612    * collector, but this method ensures that the resources used
6613    * by the handle are freed up immediately.  If you call any
6614    * other methods after closing the handle, you will get an
6615    * exception.
6616    *
6617    * @throws LibGuestFSException
6618    */
6619   public void close () throws LibGuestFSException
6620   {
6621     if (g != 0)
6622       _close (g);
6623     g = 0;
6624   }
6625   private native void _close (long g) throws LibGuestFSException;
6626
6627   public void finalize () throws LibGuestFSException
6628   {
6629     close ();
6630   }
6631
6632 ";
6633
6634   List.iter (
6635     fun (name, style, _, flags, _, shortdesc, longdesc) ->
6636       if not (List.mem NotInDocs flags); then (
6637         let doc = replace_str longdesc "C<guestfs_" "C<g." in
6638         let doc =
6639           if List.mem ProtocolLimitWarning flags then
6640             doc ^ "\n\n" ^ protocol_limit_warning
6641           else doc in
6642         let doc =
6643           if List.mem DangerWillRobinson flags then
6644             doc ^ "\n\n" ^ danger_will_robinson
6645           else doc in
6646         let doc = pod2text ~width:60 name doc in
6647         let doc = List.map (            (* RHBZ#501883 *)
6648           function
6649           | "" -> "<p>"
6650           | nonempty -> nonempty
6651         ) doc in
6652         let doc = String.concat "\n   * " doc in
6653
6654         pr "  /**\n";
6655         pr "   * %s\n" shortdesc;
6656         pr "   * <p>\n";
6657         pr "   * %s\n" doc;
6658         pr "   * @throws LibGuestFSException\n";
6659         pr "   */\n";
6660         pr "  ";
6661       );
6662       generate_java_prototype ~public:true ~semicolon:false name style;
6663       pr "\n";
6664       pr "  {\n";
6665       pr "    if (g == 0)\n";
6666       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
6667         name;
6668       pr "    ";
6669       if fst style <> RErr then pr "return ";
6670       pr "_%s " name;
6671       generate_call_args ~handle:"g" (snd style);
6672       pr ";\n";
6673       pr "  }\n";
6674       pr "  ";
6675       generate_java_prototype ~privat:true ~native:true name style;
6676       pr "\n";
6677       pr "\n";
6678   ) all_functions;
6679
6680   pr "}\n"
6681
6682 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
6683     ?(semicolon=true) name style =
6684   if privat then pr "private ";
6685   if public then pr "public ";
6686   if native then pr "native ";
6687
6688   (* return type *)
6689   (match fst style with
6690    | RErr -> pr "void ";
6691    | RInt _ -> pr "int ";
6692    | RInt64 _ -> pr "long ";
6693    | RBool _ -> pr "boolean ";
6694    | RConstString _ | RString _ -> pr "String ";
6695    | RStringList _ -> pr "String[] ";
6696    | RIntBool _ -> pr "IntBool ";
6697    | RPVList _ -> pr "PV[] ";
6698    | RVGList _ -> pr "VG[] ";
6699    | RLVList _ -> pr "LV[] ";
6700    | RStat _ -> pr "Stat ";
6701    | RStatVFS _ -> pr "StatVFS ";
6702    | RHashtable _ -> pr "HashMap<String,String> ";
6703   );
6704
6705   if native then pr "_%s " name else pr "%s " name;
6706   pr "(";
6707   let needs_comma = ref false in
6708   if native then (
6709     pr "long g";
6710     needs_comma := true
6711   );
6712
6713   (* args *)
6714   List.iter (
6715     fun arg ->
6716       if !needs_comma then pr ", ";
6717       needs_comma := true;
6718
6719       match arg with
6720       | String n
6721       | OptString n
6722       | FileIn n
6723       | FileOut n ->
6724           pr "String %s" n
6725       | StringList n ->
6726           pr "String[] %s" n
6727       | Bool n ->
6728           pr "boolean %s" n
6729       | Int n ->
6730           pr "int %s" n
6731   ) (snd style);
6732
6733   pr ")\n";
6734   pr "    throws LibGuestFSException";
6735   if semicolon then pr ";"
6736
6737 and generate_java_struct typ cols =
6738   generate_header CStyle LGPLv2;
6739
6740   pr "\
6741 package com.redhat.et.libguestfs;
6742
6743 /**
6744  * Libguestfs %s structure.
6745  *
6746  * @author rjones
6747  * @see GuestFS
6748  */
6749 public class %s {
6750 " typ typ;
6751
6752   List.iter (
6753     function
6754     | name, `String
6755     | name, `UUID -> pr "  public String %s;\n" name
6756     | name, `Bytes
6757     | name, `Int -> pr "  public long %s;\n" name
6758     | name, `OptPercent ->
6759         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
6760         pr "  public float %s;\n" name
6761   ) cols;
6762
6763   pr "}\n"
6764
6765 and generate_java_c () =
6766   generate_header CStyle LGPLv2;
6767
6768   pr "\
6769 #include <stdio.h>
6770 #include <stdlib.h>
6771 #include <string.h>
6772
6773 #include \"com_redhat_et_libguestfs_GuestFS.h\"
6774 #include \"guestfs.h\"
6775
6776 /* Note that this function returns.  The exception is not thrown
6777  * until after the wrapper function returns.
6778  */
6779 static void
6780 throw_exception (JNIEnv *env, const char *msg)
6781 {
6782   jclass cl;
6783   cl = (*env)->FindClass (env,
6784                           \"com/redhat/et/libguestfs/LibGuestFSException\");
6785   (*env)->ThrowNew (env, cl, msg);
6786 }
6787
6788 JNIEXPORT jlong JNICALL
6789 Java_com_redhat_et_libguestfs_GuestFS__1create
6790   (JNIEnv *env, jobject obj)
6791 {
6792   guestfs_h *g;
6793
6794   g = guestfs_create ();
6795   if (g == NULL) {
6796     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
6797     return 0;
6798   }
6799   guestfs_set_error_handler (g, NULL, NULL);
6800   return (jlong) (long) g;
6801 }
6802
6803 JNIEXPORT void JNICALL
6804 Java_com_redhat_et_libguestfs_GuestFS__1close
6805   (JNIEnv *env, jobject obj, jlong jg)
6806 {
6807   guestfs_h *g = (guestfs_h *) (long) jg;
6808   guestfs_close (g);
6809 }
6810
6811 ";
6812
6813   List.iter (
6814     fun (name, style, _, _, _, _, _) ->
6815       pr "JNIEXPORT ";
6816       (match fst style with
6817        | RErr -> pr "void ";
6818        | RInt _ -> pr "jint ";
6819        | RInt64 _ -> pr "jlong ";
6820        | RBool _ -> pr "jboolean ";
6821        | RConstString _ | RString _ -> pr "jstring ";
6822        | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ ->
6823            pr "jobject ";
6824        | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
6825            pr "jobjectArray ";
6826       );
6827       pr "JNICALL\n";
6828       pr "Java_com_redhat_et_libguestfs_GuestFS_";
6829       pr "%s" (replace_str ("_" ^ name) "_" "_1");
6830       pr "\n";
6831       pr "  (JNIEnv *env, jobject obj, jlong jg";
6832       List.iter (
6833         function
6834         | String n
6835         | OptString n
6836         | FileIn n
6837         | FileOut n ->
6838             pr ", jstring j%s" n
6839         | StringList n ->
6840             pr ", jobjectArray j%s" n
6841         | Bool n ->
6842             pr ", jboolean j%s" n
6843         | Int n ->
6844             pr ", jint j%s" n
6845       ) (snd style);
6846       pr ")\n";
6847       pr "{\n";
6848       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
6849       let error_code, no_ret =
6850         match fst style with
6851         | RErr -> pr "  int r;\n"; "-1", ""
6852         | RBool _
6853         | RInt _ -> pr "  int r;\n"; "-1", "0"
6854         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
6855         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
6856         | RString _ ->
6857             pr "  jstring jr;\n";
6858             pr "  char *r;\n"; "NULL", "NULL"
6859         | RStringList _ ->
6860             pr "  jobjectArray jr;\n";
6861             pr "  int r_len;\n";
6862             pr "  jclass cl;\n";
6863             pr "  jstring jstr;\n";
6864             pr "  char **r;\n"; "NULL", "NULL"
6865         | RIntBool _ ->
6866             pr "  jobject jr;\n";
6867             pr "  jclass cl;\n";
6868             pr "  jfieldID fl;\n";
6869             pr "  struct guestfs_int_bool *r;\n"; "NULL", "NULL"
6870         | RStat _ ->
6871             pr "  jobject jr;\n";
6872             pr "  jclass cl;\n";
6873             pr "  jfieldID fl;\n";
6874             pr "  struct guestfs_stat *r;\n"; "NULL", "NULL"
6875         | RStatVFS _ ->
6876             pr "  jobject jr;\n";
6877             pr "  jclass cl;\n";
6878             pr "  jfieldID fl;\n";
6879             pr "  struct guestfs_statvfs *r;\n"; "NULL", "NULL"
6880         | RPVList _ ->
6881             pr "  jobjectArray jr;\n";
6882             pr "  jclass cl;\n";
6883             pr "  jfieldID fl;\n";
6884             pr "  jobject jfl;\n";
6885             pr "  struct guestfs_lvm_pv_list *r;\n"; "NULL", "NULL"
6886         | RVGList _ ->
6887             pr "  jobjectArray jr;\n";
6888             pr "  jclass cl;\n";
6889             pr "  jfieldID fl;\n";
6890             pr "  jobject jfl;\n";
6891             pr "  struct guestfs_lvm_vg_list *r;\n"; "NULL", "NULL"
6892         | RLVList _ ->
6893             pr "  jobjectArray jr;\n";
6894             pr "  jclass cl;\n";
6895             pr "  jfieldID fl;\n";
6896             pr "  jobject jfl;\n";
6897             pr "  struct guestfs_lvm_lv_list *r;\n"; "NULL", "NULL"
6898         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL" in
6899       List.iter (
6900         function
6901         | String n
6902         | OptString n
6903         | FileIn n
6904         | FileOut n ->
6905             pr "  const char *%s;\n" n
6906         | StringList n ->
6907             pr "  int %s_len;\n" n;
6908             pr "  const char **%s;\n" n
6909         | Bool n
6910         | Int n ->
6911             pr "  int %s;\n" n
6912       ) (snd style);
6913
6914       let needs_i =
6915         (match fst style with
6916          | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true
6917          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
6918          | RString _ | RIntBool _ | RStat _ | RStatVFS _
6919          | RHashtable _ -> false) ||
6920         List.exists (function StringList _ -> true | _ -> false) (snd style) in
6921       if needs_i then
6922         pr "  int i;\n";
6923
6924       pr "\n";
6925
6926       (* Get the parameters. *)
6927       List.iter (
6928         function
6929         | String n
6930         | FileIn n
6931         | FileOut n ->
6932             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
6933         | OptString n ->
6934             (* This is completely undocumented, but Java null becomes
6935              * a NULL parameter.
6936              *)
6937             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
6938         | StringList n ->
6939             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
6940             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
6941             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
6942             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
6943               n;
6944             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
6945             pr "  }\n";
6946             pr "  %s[%s_len] = NULL;\n" n n;
6947         | Bool n
6948         | Int n ->
6949             pr "  %s = j%s;\n" n n
6950       ) (snd style);
6951
6952       (* Make the call. *)
6953       pr "  r = guestfs_%s " name;
6954       generate_call_args ~handle:"g" (snd style);
6955       pr ";\n";
6956
6957       (* Release the parameters. *)
6958       List.iter (
6959         function
6960         | String n
6961         | FileIn n
6962         | FileOut n ->
6963             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
6964         | OptString n ->
6965             pr "  if (j%s)\n" n;
6966             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
6967         | StringList n ->
6968             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
6969             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
6970               n;
6971             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
6972             pr "  }\n";
6973             pr "  free (%s);\n" n
6974         | Bool n
6975         | Int n -> ()
6976       ) (snd style);
6977
6978       (* Check for errors. *)
6979       pr "  if (r == %s) {\n" error_code;
6980       pr "    throw_exception (env, guestfs_last_error (g));\n";
6981       pr "    return %s;\n" no_ret;
6982       pr "  }\n";
6983
6984       (* Return value. *)
6985       (match fst style with
6986        | RErr -> ()
6987        | RInt _ -> pr "  return (jint) r;\n"
6988        | RBool _ -> pr "  return (jboolean) r;\n"
6989        | RInt64 _ -> pr "  return (jlong) r;\n"
6990        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
6991        | RString _ ->
6992            pr "  jr = (*env)->NewStringUTF (env, r);\n";
6993            pr "  free (r);\n";
6994            pr "  return jr;\n"
6995        | RStringList _ ->
6996            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
6997            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
6998            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
6999            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
7000            pr "  for (i = 0; i < r_len; ++i) {\n";
7001            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
7002            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
7003            pr "    free (r[i]);\n";
7004            pr "  }\n";
7005            pr "  free (r);\n";
7006            pr "  return jr;\n"
7007        | RIntBool _ ->
7008            pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/IntBool\");\n";
7009            pr "  jr = (*env)->AllocObject (env, cl);\n";
7010            pr "  fl = (*env)->GetFieldID (env, cl, \"i\", \"I\");\n";
7011            pr "  (*env)->SetIntField (env, jr, fl, r->i);\n";
7012            pr "  fl = (*env)->GetFieldID (env, cl, \"i\", \"Z\");\n";
7013            pr "  (*env)->SetBooleanField (env, jr, fl, r->b);\n";
7014            pr "  guestfs_free_int_bool (r);\n";
7015            pr "  return jr;\n"
7016        | RStat _ ->
7017            pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/Stat\");\n";
7018            pr "  jr = (*env)->AllocObject (env, cl);\n";
7019            List.iter (
7020              function
7021              | name, `Int ->
7022                  pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
7023                    name;
7024                  pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
7025            ) stat_cols;
7026            pr "  free (r);\n";
7027            pr "  return jr;\n"
7028        | RStatVFS _ ->
7029            pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/StatVFS\");\n";
7030            pr "  jr = (*env)->AllocObject (env, cl);\n";
7031            List.iter (
7032              function
7033              | name, `Int ->
7034                  pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
7035                    name;
7036                  pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
7037            ) statvfs_cols;
7038            pr "  free (r);\n";
7039            pr "  return jr;\n"
7040        | RPVList _ ->
7041            generate_java_lvm_return "pv" "PV" pv_cols
7042        | RVGList _ ->
7043            generate_java_lvm_return "vg" "VG" vg_cols
7044        | RLVList _ ->
7045            generate_java_lvm_return "lv" "LV" lv_cols
7046        | RHashtable _ ->
7047            (* XXX *)
7048            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
7049            pr "  return NULL;\n"
7050       );
7051
7052       pr "}\n";
7053       pr "\n"
7054   ) all_functions
7055
7056 and generate_java_lvm_return typ jtyp cols =
7057   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
7058   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
7059   pr "  for (i = 0; i < r->len; ++i) {\n";
7060   pr "    jfl = (*env)->AllocObject (env, cl);\n";
7061   List.iter (
7062     function
7063     | name, `String ->
7064         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
7065         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
7066     | name, `UUID ->
7067         pr "    {\n";
7068         pr "      char s[33];\n";
7069         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
7070         pr "      s[32] = 0;\n";
7071         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
7072         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
7073         pr "    }\n";
7074     | name, (`Bytes|`Int) ->
7075         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
7076         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
7077     | name, `OptPercent ->
7078         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
7079         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
7080   ) cols;
7081   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
7082   pr "  }\n";
7083   pr "  guestfs_free_lvm_%s_list (r);\n" typ;
7084   pr "  return jr;\n"
7085
7086 and generate_haskell_hs () =
7087   generate_header HaskellStyle LGPLv2;
7088
7089   (* XXX We only know how to generate partial FFI for Haskell
7090    * at the moment.  Please help out!
7091    *)
7092   let can_generate style =
7093     let check_no_bad_args =
7094       List.for_all (function Bool _ | Int _ -> false | _ -> true)
7095     in
7096     match style with
7097     | RErr, args -> check_no_bad_args args
7098     | RBool _, _
7099     | RInt _, _
7100     | RInt64 _, _
7101     | RConstString _, _
7102     | RString _, _
7103     | RStringList _, _
7104     | RIntBool _, _
7105     | RPVList _, _
7106     | RVGList _, _
7107     | RLVList _, _
7108     | RStat _, _
7109     | RStatVFS _, _
7110     | RHashtable _, _ -> false in
7111
7112   pr "\
7113 {-# INCLUDE <guestfs.h> #-}
7114 {-# LANGUAGE ForeignFunctionInterface #-}
7115
7116 module Guestfs (
7117   create";
7118
7119   (* List out the names of the actions we want to export. *)
7120   List.iter (
7121     fun (name, style, _, _, _, _, _) ->
7122       if can_generate style then pr ",\n  %s" name
7123   ) all_functions;
7124
7125   pr "
7126   ) where
7127 import Foreign
7128 import Foreign.C
7129 import IO
7130 import Control.Exception
7131 import Data.Typeable
7132
7133 data GuestfsS = GuestfsS            -- represents the opaque C struct
7134 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
7135 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
7136
7137 -- XXX define properly later XXX
7138 data PV = PV
7139 data VG = VG
7140 data LV = LV
7141 data IntBool = IntBool
7142 data Stat = Stat
7143 data StatVFS = StatVFS
7144 data Hashtable = Hashtable
7145
7146 foreign import ccall unsafe \"guestfs_create\" c_create
7147   :: IO GuestfsP
7148 foreign import ccall unsafe \"&guestfs_close\" c_close
7149   :: FunPtr (GuestfsP -> IO ())
7150 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
7151   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
7152
7153 create :: IO GuestfsH
7154 create = do
7155   p <- c_create
7156   c_set_error_handler p nullPtr nullPtr
7157   h <- newForeignPtr c_close p
7158   return h
7159
7160 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
7161   :: GuestfsP -> IO CString
7162
7163 -- last_error :: GuestfsH -> IO (Maybe String)
7164 -- last_error h = do
7165 --   str <- withForeignPtr h (\\p -> c_last_error p)
7166 --   maybePeek peekCString str
7167
7168 last_error :: GuestfsH -> IO (String)
7169 last_error h = do
7170   str <- withForeignPtr h (\\p -> c_last_error p)
7171   if (str == nullPtr)
7172     then return \"no error\"
7173     else peekCString str
7174
7175 ";
7176
7177   (* Generate wrappers for each foreign function. *)
7178   List.iter (
7179     fun (name, style, _, _, _, _, _) ->
7180       if can_generate style then (
7181         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
7182         pr "  :: ";
7183         generate_haskell_prototype ~handle:"GuestfsP" style;
7184         pr "\n";
7185         pr "\n";
7186         pr "%s :: " name;
7187         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
7188         pr "\n";
7189         pr "%s %s = do\n" name
7190           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
7191         pr "  r <- ";
7192         List.iter (
7193           function
7194           | FileIn n
7195           | FileOut n
7196           | String n -> pr "withCString %s $ \\%s -> " n n
7197           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
7198           | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
7199           | Bool n ->
7200               (* XXX this doesn't work *)
7201               pr "      let\n";
7202               pr "        %s = case %s of\n" n n;
7203               pr "          False -> 0\n";
7204               pr "          True -> 1\n";
7205               pr "      in fromIntegral %s $ \\%s ->\n" n n
7206           | Int n -> pr "fromIntegral %s $ \\%s -> " n n
7207         ) (snd style);
7208         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
7209           (String.concat " " ("p" :: List.map name_of_argt (snd style)));
7210         (match fst style with
7211          | RErr | RInt _ | RInt64 _ | RBool _ ->
7212              pr "  if (r == -1)\n";
7213              pr "    then do\n";
7214              pr "      err <- last_error h\n";
7215              pr "      fail err\n";
7216          | RConstString _ | RString _ | RStringList _ | RIntBool _
7217          | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
7218          | RHashtable _ ->
7219              pr "  if (r == nullPtr)\n";
7220              pr "    then do\n";
7221              pr "      err <- last_error h\n";
7222              pr "      fail err\n";
7223         );
7224         (match fst style with
7225          | RErr ->
7226              pr "    else return ()\n"
7227          | RInt _ ->
7228              pr "    else return (fromIntegral r)\n"
7229          | RInt64 _ ->
7230              pr "    else return (fromIntegral r)\n"
7231          | RBool _ ->
7232              pr "    else return (toBool r)\n"
7233          | RConstString _
7234          | RString _
7235          | RStringList _
7236          | RIntBool _
7237          | RPVList _
7238          | RVGList _
7239          | RLVList _
7240          | RStat _
7241          | RStatVFS _
7242          | RHashtable _ ->
7243              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
7244         );
7245         pr "\n";
7246       )
7247   ) all_functions
7248
7249 and generate_haskell_prototype ~handle ?(hs = false) style =
7250   pr "%s -> " handle;
7251   let string = if hs then "String" else "CString" in
7252   let int = if hs then "Int" else "CInt" in
7253   let bool = if hs then "Bool" else "CInt" in
7254   let int64 = if hs then "Integer" else "Int64" in
7255   List.iter (
7256     fun arg ->
7257       (match arg with
7258        | String _ -> pr "%s" string
7259        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
7260        | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
7261        | Bool _ -> pr "%s" bool
7262        | Int _ -> pr "%s" int
7263        | FileIn _ -> pr "%s" string
7264        | FileOut _ -> pr "%s" string
7265       );
7266       pr " -> ";
7267   ) (snd style);
7268   pr "IO (";
7269   (match fst style with
7270    | RErr -> if not hs then pr "CInt"
7271    | RInt _ -> pr "%s" int
7272    | RInt64 _ -> pr "%s" int64
7273    | RBool _ -> pr "%s" bool
7274    | RConstString _ -> pr "%s" string
7275    | RString _ -> pr "%s" string
7276    | RStringList _ -> pr "[%s]" string
7277    | RIntBool _ -> pr "IntBool"
7278    | RPVList _ -> pr "[PV]"
7279    | RVGList _ -> pr "[VG]"
7280    | RLVList _ -> pr "[LV]"
7281    | RStat _ -> pr "Stat"
7282    | RStatVFS _ -> pr "StatVFS"
7283    | RHashtable _ -> pr "Hashtable"
7284   );
7285   pr ")"
7286
7287 and generate_bindtests () =
7288   generate_header CStyle LGPLv2;
7289
7290   pr "\
7291 #include <stdio.h>
7292 #include <stdlib.h>
7293 #include <inttypes.h>
7294 #include <string.h>
7295
7296 #include \"guestfs.h\"
7297 #include \"guestfs_protocol.h\"
7298
7299 #define error guestfs_error
7300
7301 static void
7302 print_strings (char * const* const argv)
7303 {
7304   int argc;
7305
7306   printf (\"[\");
7307   for (argc = 0; argv[argc] != NULL; ++argc) {
7308     if (argc > 0) printf (\", \");
7309     printf (\"\\\"%%s\\\"\", argv[argc]);
7310   }
7311   printf (\"]\\n\");
7312 }
7313
7314 /* The test0 function prints its parameters to stdout. */
7315 ";
7316
7317   let test0, tests =
7318     match test_functions with
7319     | [] -> assert false
7320     | test0 :: tests -> test0, tests in
7321
7322   let () =
7323     let (name, style, _, _, _, _, _) = test0 in
7324     generate_prototype ~extern:false ~semicolon:false ~newline:true
7325       ~handle:"g" ~prefix:"guestfs_" name style;
7326     pr "{\n";
7327     List.iter (
7328       function
7329       | String n
7330       | FileIn n
7331       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
7332       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
7333       | StringList n -> pr "  print_strings (%s);\n" n
7334       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
7335       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
7336     ) (snd style);
7337     pr "  /* Java changes stdout line buffering so we need this: */\n";
7338     pr "  fflush (stdout);\n";
7339     pr "  return 0;\n";
7340     pr "}\n";
7341     pr "\n" in
7342
7343   List.iter (
7344     fun (name, style, _, _, _, _, _) ->
7345       if String.sub name (String.length name - 3) 3 <> "err" then (
7346         pr "/* Test normal return. */\n";
7347         generate_prototype ~extern:false ~semicolon:false ~newline:true
7348           ~handle:"g" ~prefix:"guestfs_" name style;
7349         pr "{\n";
7350         (match fst style with
7351          | RErr ->
7352              pr "  return 0;\n"
7353          | RInt _ ->
7354              pr "  int r;\n";
7355              pr "  sscanf (val, \"%%d\", &r);\n";
7356              pr "  return r;\n"
7357          | RInt64 _ ->
7358              pr "  int64_t r;\n";
7359              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
7360              pr "  return r;\n"
7361          | RBool _ ->
7362              pr "  return strcmp (val, \"true\") == 0;\n"
7363          | RConstString _ ->
7364              (* Can't return the input string here.  Return a static
7365               * string so we ensure we get a segfault if the caller
7366               * tries to free it.
7367               *)
7368              pr "  return \"static string\";\n"
7369          | RString _ ->
7370              pr "  return strdup (val);\n"
7371          | RStringList _ ->
7372              pr "  char **strs;\n";
7373              pr "  int n, i;\n";
7374              pr "  sscanf (val, \"%%d\", &n);\n";
7375              pr "  strs = malloc ((n+1) * sizeof (char *));\n";
7376              pr "  for (i = 0; i < n; ++i) {\n";
7377              pr "    strs[i] = malloc (16);\n";
7378              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
7379              pr "  }\n";
7380              pr "  strs[n] = NULL;\n";
7381              pr "  return strs;\n"
7382          | RIntBool _ ->
7383              pr "  struct guestfs_int_bool *r;\n";
7384              pr "  r = malloc (sizeof (struct guestfs_int_bool));\n";
7385              pr "  sscanf (val, \"%%\" SCNi32, &r->i);\n";
7386              pr "  r->b = 0;\n";
7387              pr "  return r;\n"
7388          | RPVList _ ->
7389              pr "  struct guestfs_lvm_pv_list *r;\n";
7390              pr "  int i;\n";
7391              pr "  r = malloc (sizeof (struct guestfs_lvm_pv_list));\n";
7392              pr "  sscanf (val, \"%%d\", &r->len);\n";
7393              pr "  r->val = calloc (r->len, sizeof (struct guestfs_lvm_pv));\n";
7394              pr "  for (i = 0; i < r->len; ++i) {\n";
7395              pr "    r->val[i].pv_name = malloc (16);\n";
7396              pr "    snprintf (r->val[i].pv_name, 16, \"%%d\", i);\n";
7397              pr "  }\n";
7398              pr "  return r;\n"
7399          | RVGList _ ->
7400              pr "  struct guestfs_lvm_vg_list *r;\n";
7401              pr "  int i;\n";
7402              pr "  r = malloc (sizeof (struct guestfs_lvm_vg_list));\n";
7403              pr "  sscanf (val, \"%%d\", &r->len);\n";
7404              pr "  r->val = calloc (r->len, sizeof (struct guestfs_lvm_vg));\n";
7405              pr "  for (i = 0; i < r->len; ++i) {\n";
7406              pr "    r->val[i].vg_name = malloc (16);\n";
7407              pr "    snprintf (r->val[i].vg_name, 16, \"%%d\", i);\n";
7408              pr "  }\n";
7409              pr "  return r;\n"
7410          | RLVList _ ->
7411              pr "  struct guestfs_lvm_lv_list *r;\n";
7412              pr "  int i;\n";
7413              pr "  r = malloc (sizeof (struct guestfs_lvm_lv_list));\n";
7414              pr "  sscanf (val, \"%%d\", &r->len);\n";
7415              pr "  r->val = calloc (r->len, sizeof (struct guestfs_lvm_lv));\n";
7416              pr "  for (i = 0; i < r->len; ++i) {\n";
7417              pr "    r->val[i].lv_name = malloc (16);\n";
7418              pr "    snprintf (r->val[i].lv_name, 16, \"%%d\", i);\n";
7419              pr "  }\n";
7420              pr "  return r;\n"
7421          | RStat _ ->
7422              pr "  struct guestfs_stat *r;\n";
7423              pr "  r = calloc (1, sizeof (*r));\n";
7424              pr "  sscanf (val, \"%%\" SCNi64, &r->dev);\n";
7425              pr "  return r;\n"
7426          | RStatVFS _ ->
7427              pr "  struct guestfs_statvfs *r;\n";
7428              pr "  r = calloc (1, sizeof (*r));\n";
7429              pr "  sscanf (val, \"%%\" SCNi64, &r->bsize);\n";
7430              pr "  return r;\n"
7431          | RHashtable _ ->
7432              pr "  char **strs;\n";
7433              pr "  int n, i;\n";
7434              pr "  sscanf (val, \"%%d\", &n);\n";
7435              pr "  strs = malloc ((n*2+1) * sizeof (char *));\n";
7436              pr "  for (i = 0; i < n; ++i) {\n";
7437              pr "    strs[i*2] = malloc (16);\n";
7438              pr "    strs[i*2+1] = malloc (16);\n";
7439              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
7440              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
7441              pr "  }\n";
7442              pr "  strs[n*2] = NULL;\n";
7443              pr "  return strs;\n"
7444         );
7445         pr "}\n";
7446         pr "\n"
7447       ) else (
7448         pr "/* Test error return. */\n";
7449         generate_prototype ~extern:false ~semicolon:false ~newline:true
7450           ~handle:"g" ~prefix:"guestfs_" name style;
7451         pr "{\n";
7452         pr "  error (g, \"error\");\n";
7453         (match fst style with
7454          | RErr | RInt _ | RInt64 _ | RBool _ ->
7455              pr "  return -1;\n"
7456          | RConstString _
7457          | RString _ | RStringList _ | RIntBool _
7458          | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
7459          | RHashtable _ ->
7460              pr "  return NULL;\n"
7461         );
7462         pr "}\n";
7463         pr "\n"
7464       )
7465   ) tests
7466
7467 and generate_ocaml_bindtests () =
7468   generate_header OCamlStyle GPLv2;
7469
7470   pr "\
7471 let () =
7472   let g = Guestfs.create () in
7473 ";
7474
7475   let mkargs args =
7476     String.concat " " (
7477       List.map (
7478         function
7479         | CallString s -> "\"" ^ s ^ "\""
7480         | CallOptString None -> "None"
7481         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
7482         | CallStringList xs ->
7483             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
7484         | CallInt i when i >= 0 -> string_of_int i
7485         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
7486         | CallBool b -> string_of_bool b
7487       ) args
7488     )
7489   in
7490
7491   generate_lang_bindtests (
7492     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
7493   );
7494
7495   pr "print_endline \"EOF\"\n"
7496
7497 and generate_perl_bindtests () =
7498   pr "#!/usr/bin/perl -w\n";
7499   generate_header HashStyle GPLv2;
7500
7501   pr "\
7502 use strict;
7503
7504 use Sys::Guestfs;
7505
7506 my $g = Sys::Guestfs->new ();
7507 ";
7508
7509   let mkargs args =
7510     String.concat ", " (
7511       List.map (
7512         function
7513         | CallString s -> "\"" ^ s ^ "\""
7514         | CallOptString None -> "undef"
7515         | CallOptString (Some s) -> sprintf "\"%s\"" s
7516         | CallStringList xs ->
7517             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
7518         | CallInt i -> string_of_int i
7519         | CallBool b -> if b then "1" else "0"
7520       ) args
7521     )
7522   in
7523
7524   generate_lang_bindtests (
7525     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
7526   );
7527
7528   pr "print \"EOF\\n\"\n"
7529
7530 and generate_python_bindtests () =
7531   generate_header HashStyle GPLv2;
7532
7533   pr "\
7534 import guestfs
7535
7536 g = guestfs.GuestFS ()
7537 ";
7538
7539   let mkargs args =
7540     String.concat ", " (
7541       List.map (
7542         function
7543         | CallString s -> "\"" ^ s ^ "\""
7544         | CallOptString None -> "None"
7545         | CallOptString (Some s) -> sprintf "\"%s\"" s
7546         | CallStringList xs ->
7547             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
7548         | CallInt i -> string_of_int i
7549         | CallBool b -> if b then "1" else "0"
7550       ) args
7551     )
7552   in
7553
7554   generate_lang_bindtests (
7555     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
7556   );
7557
7558   pr "print \"EOF\"\n"
7559
7560 and generate_ruby_bindtests () =
7561   generate_header HashStyle GPLv2;
7562
7563   pr "\
7564 require 'guestfs'
7565
7566 g = Guestfs::create()
7567 ";
7568
7569   let mkargs args =
7570     String.concat ", " (
7571       List.map (
7572         function
7573         | CallString s -> "\"" ^ s ^ "\""
7574         | CallOptString None -> "nil"
7575         | CallOptString (Some s) -> sprintf "\"%s\"" s
7576         | CallStringList xs ->
7577             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
7578         | CallInt i -> string_of_int i
7579         | CallBool b -> string_of_bool b
7580       ) args
7581     )
7582   in
7583
7584   generate_lang_bindtests (
7585     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
7586   );
7587
7588   pr "print \"EOF\\n\"\n"
7589
7590 and generate_java_bindtests () =
7591   generate_header CStyle GPLv2;
7592
7593   pr "\
7594 import com.redhat.et.libguestfs.*;
7595
7596 public class Bindtests {
7597     public static void main (String[] argv)
7598     {
7599         try {
7600             GuestFS g = new GuestFS ();
7601 ";
7602
7603   let mkargs args =
7604     String.concat ", " (
7605       List.map (
7606         function
7607         | CallString s -> "\"" ^ s ^ "\""
7608         | CallOptString None -> "null"
7609         | CallOptString (Some s) -> sprintf "\"%s\"" s
7610         | CallStringList xs ->
7611             "new String[]{" ^
7612               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
7613         | CallInt i -> string_of_int i
7614         | CallBool b -> string_of_bool b
7615       ) args
7616     )
7617   in
7618
7619   generate_lang_bindtests (
7620     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
7621   );
7622
7623   pr "
7624             System.out.println (\"EOF\");
7625         }
7626         catch (Exception exn) {
7627             System.err.println (exn);
7628             System.exit (1);
7629         }
7630     }
7631 }
7632 "
7633
7634 and generate_haskell_bindtests () =
7635   () (* XXX Haskell bindings need to be fleshed out. *)
7636
7637 (* Language-independent bindings tests - we do it this way to
7638  * ensure there is parity in testing bindings across all languages.
7639  *)
7640 and generate_lang_bindtests call =
7641   call "test0" [CallString "abc"; CallOptString (Some "def");
7642                 CallStringList []; CallBool false;
7643                 CallInt 0; CallString "123"; CallString "456"];
7644   call "test0" [CallString "abc"; CallOptString None;
7645                 CallStringList []; CallBool false;
7646                 CallInt 0; CallString "123"; CallString "456"];
7647   call "test0" [CallString ""; CallOptString (Some "def");
7648                 CallStringList []; CallBool false;
7649                 CallInt 0; CallString "123"; CallString "456"];
7650   call "test0" [CallString ""; CallOptString (Some "");
7651                 CallStringList []; CallBool false;
7652                 CallInt 0; CallString "123"; CallString "456"];
7653   call "test0" [CallString "abc"; CallOptString (Some "def");
7654                 CallStringList ["1"]; CallBool false;
7655                 CallInt 0; CallString "123"; CallString "456"];
7656   call "test0" [CallString "abc"; CallOptString (Some "def");
7657                 CallStringList ["1"; "2"]; CallBool false;
7658                 CallInt 0; CallString "123"; CallString "456"];
7659   call "test0" [CallString "abc"; CallOptString (Some "def");
7660                 CallStringList ["1"]; CallBool true;
7661                 CallInt 0; CallString "123"; CallString "456"];
7662   call "test0" [CallString "abc"; CallOptString (Some "def");
7663                 CallStringList ["1"]; CallBool false;
7664                 CallInt (-1); CallString "123"; CallString "456"];
7665   call "test0" [CallString "abc"; CallOptString (Some "def");
7666                 CallStringList ["1"]; CallBool false;
7667                 CallInt (-2); CallString "123"; CallString "456"];
7668   call "test0" [CallString "abc"; CallOptString (Some "def");
7669                 CallStringList ["1"]; CallBool false;
7670                 CallInt 1; CallString "123"; CallString "456"];
7671   call "test0" [CallString "abc"; CallOptString (Some "def");
7672                 CallStringList ["1"]; CallBool false;
7673                 CallInt 2; CallString "123"; CallString "456"];
7674   call "test0" [CallString "abc"; CallOptString (Some "def");
7675                 CallStringList ["1"]; CallBool false;
7676                 CallInt 4095; CallString "123"; CallString "456"];
7677   call "test0" [CallString "abc"; CallOptString (Some "def");
7678                 CallStringList ["1"]; CallBool false;
7679                 CallInt 0; CallString ""; CallString ""]
7680
7681   (* XXX Add here tests of the return and error functions. *)
7682
7683 let output_to filename =
7684   let filename_new = filename ^ ".new" in
7685   chan := open_out filename_new;
7686   let close () =
7687     close_out !chan;
7688     chan := stdout;
7689
7690     (* Is the new file different from the current file? *)
7691     if Sys.file_exists filename && files_equal filename filename_new then
7692       Unix.unlink filename_new          (* same, so skip it *)
7693     else (
7694       (* different, overwrite old one *)
7695       (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
7696       Unix.rename filename_new filename;
7697       Unix.chmod filename 0o444;
7698       printf "written %s\n%!" filename;
7699     )
7700   in
7701   close
7702
7703 (* Main program. *)
7704 let () =
7705   check_functions ();
7706
7707   if not (Sys.file_exists "configure.ac") then (
7708     eprintf "\
7709 You are probably running this from the wrong directory.
7710 Run it from the top source directory using the command
7711   src/generator.ml
7712 ";
7713     exit 1
7714   );
7715
7716   let close = output_to "src/guestfs_protocol.x" in
7717   generate_xdr ();
7718   close ();
7719
7720   let close = output_to "src/guestfs-structs.h" in
7721   generate_structs_h ();
7722   close ();
7723
7724   let close = output_to "src/guestfs-actions.h" in
7725   generate_actions_h ();
7726   close ();
7727
7728   let close = output_to "src/guestfs-actions.c" in
7729   generate_client_actions ();
7730   close ();
7731
7732   let close = output_to "daemon/actions.h" in
7733   generate_daemon_actions_h ();
7734   close ();
7735
7736   let close = output_to "daemon/stubs.c" in
7737   generate_daemon_actions ();
7738   close ();
7739
7740   let close = output_to "capitests/tests.c" in
7741   generate_tests ();
7742   close ();
7743
7744   let close = output_to "src/guestfs-bindtests.c" in
7745   generate_bindtests ();
7746   close ();
7747
7748   let close = output_to "fish/cmds.c" in
7749   generate_fish_cmds ();
7750   close ();
7751
7752   let close = output_to "fish/completion.c" in
7753   generate_fish_completion ();
7754   close ();
7755
7756   let close = output_to "guestfs-structs.pod" in
7757   generate_structs_pod ();
7758   close ();
7759
7760   let close = output_to "guestfs-actions.pod" in
7761   generate_actions_pod ();
7762   close ();
7763
7764   let close = output_to "guestfish-actions.pod" in
7765   generate_fish_actions_pod ();
7766   close ();
7767
7768   let close = output_to "ocaml/guestfs.mli" in
7769   generate_ocaml_mli ();
7770   close ();
7771
7772   let close = output_to "ocaml/guestfs.ml" in
7773   generate_ocaml_ml ();
7774   close ();
7775
7776   let close = output_to "ocaml/guestfs_c_actions.c" in
7777   generate_ocaml_c ();
7778   close ();
7779
7780   let close = output_to "ocaml/bindtests.ml" in
7781   generate_ocaml_bindtests ();
7782   close ();
7783
7784   let close = output_to "perl/Guestfs.xs" in
7785   generate_perl_xs ();
7786   close ();
7787
7788   let close = output_to "perl/lib/Sys/Guestfs.pm" in
7789   generate_perl_pm ();
7790   close ();
7791
7792   let close = output_to "perl/bindtests.pl" in
7793   generate_perl_bindtests ();
7794   close ();
7795
7796   let close = output_to "python/guestfs-py.c" in
7797   generate_python_c ();
7798   close ();
7799
7800   let close = output_to "python/guestfs.py" in
7801   generate_python_py ();
7802   close ();
7803
7804   let close = output_to "python/bindtests.py" in
7805   generate_python_bindtests ();
7806   close ();
7807
7808   let close = output_to "ruby/ext/guestfs/_guestfs.c" in
7809   generate_ruby_c ();
7810   close ();
7811
7812   let close = output_to "ruby/bindtests.rb" in
7813   generate_ruby_bindtests ();
7814   close ();
7815
7816   let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
7817   generate_java_java ();
7818   close ();
7819
7820   let close = output_to "java/com/redhat/et/libguestfs/PV.java" in
7821   generate_java_struct "PV" pv_cols;
7822   close ();
7823
7824   let close = output_to "java/com/redhat/et/libguestfs/VG.java" in
7825   generate_java_struct "VG" vg_cols;
7826   close ();
7827
7828   let close = output_to "java/com/redhat/et/libguestfs/LV.java" in
7829   generate_java_struct "LV" lv_cols;
7830   close ();
7831
7832   let close = output_to "java/com/redhat/et/libguestfs/Stat.java" in
7833   generate_java_struct "Stat" stat_cols;
7834   close ();
7835
7836   let close = output_to "java/com/redhat/et/libguestfs/StatVFS.java" in
7837   generate_java_struct "StatVFS" statvfs_cols;
7838   close ();
7839
7840   let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
7841   generate_java_c ();
7842   close ();
7843
7844   let close = output_to "java/Bindtests.java" in
7845   generate_java_bindtests ();
7846   close ();
7847
7848   let close = output_to "haskell/Guestfs.hs" in
7849   generate_haskell_hs ();
7850   close ();
7851
7852   let close = output_to "haskell/bindtests.hs" in
7853   generate_haskell_bindtests ();
7854   close ();