src/generator.ml

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