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