src/generator.ml

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