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