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