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