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   ("grep", (RStringList "lines", [String "regex"; String "path"]), 151, [ProtocolLimitWarning],
3050    [InitSquashFS, Always, TestOutputList (
3051       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3052     InitSquashFS, Always, TestOutputList (
3053       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3054    "return lines matching a pattern",
3055    "\
3056 This calls the external C<grep> program and returns the
3057 matching lines.");
3058
3059   ("egrep", (RStringList "lines", [String "regex"; String "path"]), 152, [ProtocolLimitWarning],
3060    [InitSquashFS, Always, TestOutputList (
3061       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3062    "return lines matching a pattern",
3063    "\
3064 This calls the external C<egrep> program and returns the
3065 matching lines.");
3066
3067   ("fgrep", (RStringList "lines", [String "pattern"; String "path"]), 153, [ProtocolLimitWarning],
3068    [InitSquashFS, Always, TestOutputList (
3069       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3070    "return lines matching a pattern",
3071    "\
3072 This calls the external C<fgrep> program and returns the
3073 matching lines.");
3074
3075   ("grepi", (RStringList "lines", [String "regex"; String "path"]), 154, [ProtocolLimitWarning],
3076    [InitSquashFS, Always, TestOutputList (
3077       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3078    "return lines matching a pattern",
3079    "\
3080 This calls the external C<grep -i> program and returns the
3081 matching lines.");
3082
3083   ("egrepi", (RStringList "lines", [String "regex"; String "path"]), 155, [ProtocolLimitWarning],
3084    [InitSquashFS, Always, TestOutputList (
3085       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3086    "return lines matching a pattern",
3087    "\
3088 This calls the external C<egrep -i> program and returns the
3089 matching lines.");
3090
3091   ("fgrepi", (RStringList "lines", [String "pattern"; String "path"]), 156, [ProtocolLimitWarning],
3092    [InitSquashFS, Always, TestOutputList (
3093       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3094    "return lines matching a pattern",
3095    "\
3096 This calls the external C<fgrep -i> program and returns the
3097 matching lines.");
3098
3099   ("zgrep", (RStringList "lines", [String "regex"; String "path"]), 157, [ProtocolLimitWarning],
3100    [InitSquashFS, Always, TestOutputList (
3101       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3102    "return lines matching a pattern",
3103    "\
3104 This calls the external C<zgrep> program and returns the
3105 matching lines.");
3106
3107   ("zegrep", (RStringList "lines", [String "regex"; String "path"]), 158, [ProtocolLimitWarning],
3108    [InitSquashFS, Always, TestOutputList (
3109       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3110    "return lines matching a pattern",
3111    "\
3112 This calls the external C<zegrep> program and returns the
3113 matching lines.");
3114
3115   ("zfgrep", (RStringList "lines", [String "pattern"; String "path"]), 159, [ProtocolLimitWarning],
3116    [InitSquashFS, Always, TestOutputList (
3117       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3118    "return lines matching a pattern",
3119    "\
3120 This calls the external C<zfgrep> program and returns the
3121 matching lines.");
3122
3123   ("zgrepi", (RStringList "lines", [String "regex"; String "path"]), 160, [ProtocolLimitWarning],
3124    [InitSquashFS, Always, TestOutputList (
3125       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3126    "return lines matching a pattern",
3127    "\
3128 This calls the external C<zgrep -i> program and returns the
3129 matching lines.");
3130
3131   ("zegrepi", (RStringList "lines", [String "regex"; String "path"]), 161, [ProtocolLimitWarning],
3132    [InitSquashFS, Always, TestOutputList (
3133       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3134    "return lines matching a pattern",
3135    "\
3136 This calls the external C<zegrep -i> program and returns the
3137 matching lines.");
3138
3139   ("zfgrepi", (RStringList "lines", [String "pattern"; String "path"]), 162, [ProtocolLimitWarning],
3140    [InitSquashFS, Always, TestOutputList (
3141       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3142    "return lines matching a pattern",
3143    "\
3144 This calls the external C<zfgrep -i> program and returns the
3145 matching lines.");
3146
3147 ]
3148
3149 let all_functions = non_daemon_functions @ daemon_functions
3150
3151 (* In some places we want the functions to be displayed sorted
3152  * alphabetically, so this is useful:
3153  *)
3154 let all_functions_sorted =
3155   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
3156                compare n1 n2) all_functions
3157
3158 (* Field types for structures. *)
3159 type field =
3160   | FChar                       (* C 'char' (really, a 7 bit byte). *)
3161   | FString                     (* nul-terminated ASCII string. *)
3162   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
3163   | FUInt32
3164   | FInt32
3165   | FUInt64
3166   | FInt64
3167   | FBytes                      (* Any int measure that counts bytes. *)
3168   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
3169   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
3170
3171 (* Because we generate extra parsing code for LVM command line tools,
3172  * we have to pull out the LVM columns separately here.
3173  *)
3174 let lvm_pv_cols = [
3175   "pv_name", FString;
3176   "pv_uuid", FUUID;
3177   "pv_fmt", FString;
3178   "pv_size", FBytes;
3179   "dev_size", FBytes;
3180   "pv_free", FBytes;
3181   "pv_used", FBytes;
3182   "pv_attr", FString (* XXX *);
3183   "pv_pe_count", FInt64;
3184   "pv_pe_alloc_count", FInt64;
3185   "pv_tags", FString;
3186   "pe_start", FBytes;
3187   "pv_mda_count", FInt64;
3188   "pv_mda_free", FBytes;
3189   (* Not in Fedora 10:
3190      "pv_mda_size", FBytes;
3191   *)
3192 ]
3193 let lvm_vg_cols = [
3194   "vg_name", FString;
3195   "vg_uuid", FUUID;
3196   "vg_fmt", FString;
3197   "vg_attr", FString (* XXX *);
3198   "vg_size", FBytes;
3199   "vg_free", FBytes;
3200   "vg_sysid", FString;
3201   "vg_extent_size", FBytes;
3202   "vg_extent_count", FInt64;
3203   "vg_free_count", FInt64;
3204   "max_lv", FInt64;
3205   "max_pv", FInt64;
3206   "pv_count", FInt64;
3207   "lv_count", FInt64;
3208   "snap_count", FInt64;
3209   "vg_seqno", FInt64;
3210   "vg_tags", FString;
3211   "vg_mda_count", FInt64;
3212   "vg_mda_free", FBytes;
3213   (* Not in Fedora 10:
3214      "vg_mda_size", FBytes;
3215   *)
3216 ]
3217 let lvm_lv_cols = [
3218   "lv_name", FString;
3219   "lv_uuid", FUUID;
3220   "lv_attr", FString (* XXX *);
3221   "lv_major", FInt64;
3222   "lv_minor", FInt64;
3223   "lv_kernel_major", FInt64;
3224   "lv_kernel_minor", FInt64;
3225   "lv_size", FBytes;
3226   "seg_count", FInt64;
3227   "origin", FString;
3228   "snap_percent", FOptPercent;
3229   "copy_percent", FOptPercent;
3230   "move_pv", FString;
3231   "lv_tags", FString;
3232   "mirror_log", FString;
3233   "modules", FString;
3234 ]
3235
3236 (* Names and fields in all structures (in RStruct and RStructList)
3237  * that we support.
3238  *)
3239 let structs = [
3240   (* The old RIntBool return type, only ever used for aug_defnode.  Do
3241    * not use this struct in any new code.
3242    *)
3243   "int_bool", [
3244     "i", FInt32;                (* for historical compatibility *)
3245     "b", FInt32;                (* for historical compatibility *)
3246   ];
3247
3248   (* LVM PVs, VGs, LVs. *)
3249   "lvm_pv", lvm_pv_cols;
3250   "lvm_vg", lvm_vg_cols;
3251   "lvm_lv", lvm_lv_cols;
3252
3253   (* Column names and types from stat structures.
3254    * NB. Can't use things like 'st_atime' because glibc header files
3255    * define some of these as macros.  Ugh.
3256    *)
3257   "stat", [
3258     "dev", FInt64;
3259     "ino", FInt64;
3260     "mode", FInt64;
3261     "nlink", FInt64;
3262     "uid", FInt64;
3263     "gid", FInt64;
3264     "rdev", FInt64;
3265     "size", FInt64;
3266     "blksize", FInt64;
3267     "blocks", FInt64;
3268     "atime", FInt64;
3269     "mtime", FInt64;
3270     "ctime", FInt64;
3271   ];
3272   "statvfs", [
3273     "bsize", FInt64;
3274     "frsize", FInt64;
3275     "blocks", FInt64;
3276     "bfree", FInt64;
3277     "bavail", FInt64;
3278     "files", FInt64;
3279     "ffree", FInt64;
3280     "favail", FInt64;
3281     "fsid", FInt64;
3282     "flag", FInt64;
3283     "namemax", FInt64;
3284   ];
3285
3286   (* Column names in dirent structure. *)
3287   "dirent", [
3288     "ino", FInt64;
3289     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
3290     "ftyp", FChar;
3291     "name", FString;
3292   ];
3293
3294   (* Version numbers. *)
3295   "version", [
3296     "major", FInt64;
3297     "minor", FInt64;
3298     "release", FInt64;
3299     "extra", FString;
3300   ];
3301
3302   (* Extended attribute. *)
3303   "xattr", [
3304     "attrname", FString;
3305     "attrval", FBuffer;
3306   ];
3307 ] (* end of structs *)
3308
3309 (* Ugh, Java has to be different ..
3310  * These names are also used by the Haskell bindings.
3311  *)
3312 let java_structs = [
3313   "int_bool", "IntBool";
3314   "lvm_pv", "PV";
3315   "lvm_vg", "VG";
3316   "lvm_lv", "LV";
3317   "stat", "Stat";
3318   "statvfs", "StatVFS";
3319   "dirent", "Dirent";
3320   "version", "Version";
3321   "xattr", "XAttr";
3322 ]
3323
3324 (* Used for testing language bindings. *)
3325 type callt =
3326   | CallString of string
3327   | CallOptString of string option
3328   | CallStringList of string list
3329   | CallInt of int
3330   | CallBool of bool
3331
3332 (* Used to memoize the result of pod2text. *)
3333 let pod2text_memo_filename = "src/.pod2text.data"
3334 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
3335   try
3336     let chan = open_in pod2text_memo_filename in
3337     let v = input_value chan in
3338     close_in chan;
3339     v
3340   with
3341     _ -> Hashtbl.create 13
3342
3343 (* Useful functions.
3344  * Note we don't want to use any external OCaml libraries which
3345  * makes this a bit harder than it should be.
3346  *)
3347 let failwithf fs = ksprintf failwith fs
3348
3349 let replace_char s c1 c2 =
3350   let s2 = String.copy s in
3351   let r = ref false in
3352   for i = 0 to String.length s2 - 1 do
3353     if String.unsafe_get s2 i = c1 then (
3354       String.unsafe_set s2 i c2;
3355       r := true
3356     )
3357   done;
3358   if not !r then s else s2
3359
3360 let isspace c =
3361   c = ' '
3362   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
3363
3364 let triml ?(test = isspace) str =
3365   let i = ref 0 in
3366   let n = ref (String.length str) in
3367   while !n > 0 && test str.[!i]; do
3368     decr n;
3369     incr i
3370   done;
3371   if !i = 0 then str
3372   else String.sub str !i !n
3373
3374 let trimr ?(test = isspace) str =
3375   let n = ref (String.length str) in
3376   while !n > 0 && test str.[!n-1]; do
3377     decr n
3378   done;
3379   if !n = String.length str then str
3380   else String.sub str 0 !n
3381
3382 let trim ?(test = isspace) str =
3383   trimr ~test (triml ~test str)
3384
3385 let rec find s sub =
3386   let len = String.length s in
3387   let sublen = String.length sub in
3388   let rec loop i =
3389     if i <= len-sublen then (
3390       let rec loop2 j =
3391         if j < sublen then (
3392           if s.[i+j] = sub.[j] then loop2 (j+1)
3393           else -1
3394         ) else
3395           i (* found *)
3396       in
3397       let r = loop2 0 in
3398       if r = -1 then loop (i+1) else r
3399     ) else
3400       -1 (* not found *)
3401   in
3402   loop 0
3403
3404 let rec replace_str s s1 s2 =
3405   let len = String.length s in
3406   let sublen = String.length s1 in
3407   let i = find s s1 in
3408   if i = -1 then s
3409   else (
3410     let s' = String.sub s 0 i in
3411     let s'' = String.sub s (i+sublen) (len-i-sublen) in
3412     s' ^ s2 ^ replace_str s'' s1 s2
3413   )
3414
3415 let rec string_split sep str =
3416   let len = String.length str in
3417   let seplen = String.length sep in
3418   let i = find str sep in
3419   if i = -1 then [str]
3420   else (
3421     let s' = String.sub str 0 i in
3422     let s'' = String.sub str (i+seplen) (len-i-seplen) in
3423     s' :: string_split sep s''
3424   )
3425
3426 let files_equal n1 n2 =
3427   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
3428   match Sys.command cmd with
3429   | 0 -> true
3430   | 1 -> false
3431   | i -> failwithf "%s: failed with error code %d" cmd i
3432
3433 let rec find_map f = function
3434   | [] -> raise Not_found
3435   | x :: xs ->
3436       match f x with
3437       | Some y -> y
3438       | None -> find_map f xs
3439
3440 let iteri f xs =
3441   let rec loop i = function
3442     | [] -> ()
3443     | x :: xs -> f i x; loop (i+1) xs
3444   in
3445   loop 0 xs
3446
3447 let mapi f xs =
3448   let rec loop i = function
3449     | [] -> []
3450     | x :: xs -> let r = f i x in r :: loop (i+1) xs
3451   in
3452   loop 0 xs
3453
3454 let name_of_argt = function
3455   | String n | OptString n | StringList n | Bool n | Int n
3456   | FileIn n | FileOut n -> n
3457
3458 let java_name_of_struct typ =
3459   try List.assoc typ java_structs
3460   with Not_found ->
3461     failwithf
3462       "java_name_of_struct: no java_structs entry corresponding to %s" typ
3463
3464 let cols_of_struct typ =
3465   try List.assoc typ structs
3466   with Not_found ->
3467     failwithf "cols_of_struct: unknown struct %s" typ
3468
3469 let seq_of_test = function
3470   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
3471   | TestOutputListOfDevices (s, _)
3472   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
3473   | TestOutputTrue s | TestOutputFalse s
3474   | TestOutputLength (s, _) | TestOutputStruct (s, _)
3475   | TestLastFail s -> s
3476
3477 (* Handling for function flags. *)
3478 let protocol_limit_warning =
3479   "Because of the message protocol, there is a transfer limit
3480 of somewhere between 2MB and 4MB.  To transfer large files you should use
3481 FTP."
3482
3483 let danger_will_robinson =
3484   "B<This command is dangerous.  Without careful use you
3485 can easily destroy all your data>."
3486
3487 let deprecation_notice flags =
3488   try
3489     let alt =
3490       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
3491     let txt =
3492       sprintf "This function is deprecated.
3493 In new code, use the C<%s> call instead.
3494
3495 Deprecated functions will not be removed from the API, but the
3496 fact that they are deprecated indicates that there are problems
3497 with correct use of these functions." alt in
3498     Some txt
3499   with
3500     Not_found -> None
3501
3502 (* Check function names etc. for consistency. *)
3503 let check_functions () =
3504   let contains_uppercase str =
3505     let len = String.length str in
3506     let rec loop i =
3507       if i >= len then false
3508       else (
3509         let c = str.[i] in
3510         if c >= 'A' && c <= 'Z' then true
3511         else loop (i+1)
3512       )
3513     in
3514     loop 0
3515   in
3516
3517   (* Check function names. *)
3518   List.iter (
3519     fun (name, _, _, _, _, _, _) ->
3520       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
3521         failwithf "function name %s does not need 'guestfs' prefix" name;
3522       if name = "" then
3523         failwithf "function name is empty";
3524       if name.[0] < 'a' || name.[0] > 'z' then
3525         failwithf "function name %s must start with lowercase a-z" name;
3526       if String.contains name '-' then
3527         failwithf "function name %s should not contain '-', use '_' instead."
3528           name
3529   ) all_functions;
3530
3531   (* Check function parameter/return names. *)
3532   List.iter (
3533     fun (name, style, _, _, _, _, _) ->
3534       let check_arg_ret_name n =
3535         if contains_uppercase n then
3536           failwithf "%s param/ret %s should not contain uppercase chars"
3537             name n;
3538         if String.contains n '-' || String.contains n '_' then
3539           failwithf "%s param/ret %s should not contain '-' or '_'"
3540             name n;
3541         if n = "value" then
3542           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;
3543         if n = "int" || n = "char" || n = "short" || n = "long" then
3544           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
3545         if n = "i" || n = "n" then
3546           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
3547         if n = "argv" || n = "args" then
3548           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name
3549       in
3550
3551       (match fst style with
3552        | RErr -> ()
3553        | RInt n | RInt64 n | RBool n
3554        | RConstString n | RConstOptString n | RString n
3555        | RStringList n | RStruct (n, _) | RStructList (n, _)
3556        | RHashtable n | RBufferOut n ->
3557            check_arg_ret_name n
3558       );
3559       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
3560   ) all_functions;
3561
3562   (* Check short descriptions. *)
3563   List.iter (
3564     fun (name, _, _, _, _, shortdesc, _) ->
3565       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
3566         failwithf "short description of %s should begin with lowercase." name;
3567       let c = shortdesc.[String.length shortdesc-1] in
3568       if c = '\n' || c = '.' then
3569         failwithf "short description of %s should not end with . or \\n." name
3570   ) all_functions;
3571
3572   (* Check long dscriptions. *)
3573   List.iter (
3574     fun (name, _, _, _, _, _, longdesc) ->
3575       if longdesc.[String.length longdesc-1] = '\n' then
3576         failwithf "long description of %s should not end with \\n." name
3577   ) all_functions;
3578
3579   (* Check proc_nrs. *)
3580   List.iter (
3581     fun (name, _, proc_nr, _, _, _, _) ->
3582       if proc_nr <= 0 then
3583         failwithf "daemon function %s should have proc_nr > 0" name
3584   ) daemon_functions;
3585
3586   List.iter (
3587     fun (name, _, proc_nr, _, _, _, _) ->
3588       if proc_nr <> -1 then
3589         failwithf "non-daemon function %s should have proc_nr -1" name
3590   ) non_daemon_functions;
3591
3592   let proc_nrs =
3593     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
3594       daemon_functions in
3595   let proc_nrs =
3596     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
3597   let rec loop = function
3598     | [] -> ()
3599     | [_] -> ()
3600     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
3601         loop rest
3602     | (name1,nr1) :: (name2,nr2) :: _ ->
3603         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
3604           name1 name2 nr1 nr2
3605   in
3606   loop proc_nrs;
3607
3608   (* Check tests. *)
3609   List.iter (
3610     function
3611       (* Ignore functions that have no tests.  We generate a
3612        * warning when the user does 'make check' instead.
3613        *)
3614     | name, _, _, _, [], _, _ -> ()
3615     | name, _, _, _, tests, _, _ ->
3616         let funcs =
3617           List.map (
3618             fun (_, _, test) ->
3619               match seq_of_test test with
3620               | [] ->
3621                   failwithf "%s has a test containing an empty sequence" name
3622               | cmds -> List.map List.hd cmds
3623           ) tests in
3624         let funcs = List.flatten funcs in
3625
3626         let tested = List.mem name funcs in
3627
3628         if not tested then
3629           failwithf "function %s has tests but does not test itself" name
3630   ) all_functions
3631
3632 (* 'pr' prints to the current output file. *)
3633 let chan = ref stdout
3634 let pr fs = ksprintf (output_string !chan) fs
3635
3636 (* Generate a header block in a number of standard styles. *)
3637 type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
3638 type license = GPLv2 | LGPLv2
3639
3640 let generate_header comment license =
3641   let c = match comment with
3642     | CStyle ->     pr "/* "; " *"
3643     | HashStyle ->  pr "# ";  "#"
3644     | OCamlStyle -> pr "(* "; " *"
3645     | HaskellStyle -> pr "{- "; "  " in
3646   pr "libguestfs generated file\n";
3647   pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
3648   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
3649   pr "%s\n" c;
3650   pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
3651   pr "%s\n" c;
3652   (match license with
3653    | GPLv2 ->
3654        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
3655        pr "%s it under the terms of the GNU General Public License as published by\n" c;
3656        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
3657        pr "%s (at your option) any later version.\n" c;
3658        pr "%s\n" c;
3659        pr "%s This program is distributed in the hope that it will be useful,\n" c;
3660        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
3661        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
3662        pr "%s GNU General Public License for more details.\n" c;
3663        pr "%s\n" c;
3664        pr "%s You should have received a copy of the GNU General Public License along\n" c;
3665        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
3666        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
3667
3668    | LGPLv2 ->
3669        pr "%s This library is free software; you can redistribute it and/or\n" c;
3670        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
3671        pr "%s License as published by the Free Software Foundation; either\n" c;
3672        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
3673        pr "%s\n" c;
3674        pr "%s This library is distributed in the hope that it will be useful,\n" c;
3675        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
3676        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
3677        pr "%s Lesser General Public License for more details.\n" c;
3678        pr "%s\n" c;
3679        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
3680        pr "%s License along with this library; if not, write to the Free Software\n" c;
3681        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
3682   );
3683   (match comment with
3684    | CStyle -> pr " */\n"
3685    | HashStyle -> ()
3686    | OCamlStyle -> pr " *)\n"
3687    | HaskellStyle -> pr "-}\n"
3688   );
3689   pr "\n"
3690
3691 (* Start of main code generation functions below this line. *)
3692
3693 (* Generate the pod documentation for the C API. *)
3694 let rec generate_actions_pod () =
3695   List.iter (
3696     fun (shortname, style, _, flags, _, _, longdesc) ->
3697       if not (List.mem NotInDocs flags) then (
3698         let name = "guestfs_" ^ shortname in
3699         pr "=head2 %s\n\n" name;
3700         pr " ";
3701         generate_prototype ~extern:false ~handle:"handle" name style;
3702         pr "\n\n";
3703         pr "%s\n\n" longdesc;
3704         (match fst style with
3705          | RErr ->
3706              pr "This function returns 0 on success or -1 on error.\n\n"
3707          | RInt _ ->
3708              pr "On error this function returns -1.\n\n"
3709          | RInt64 _ ->
3710              pr "On error this function returns -1.\n\n"
3711          | RBool _ ->
3712              pr "This function returns a C truth value on success or -1 on error.\n\n"
3713          | RConstString _ ->
3714              pr "This function returns a string, or NULL on error.
3715 The string is owned by the guest handle and must I<not> be freed.\n\n"
3716          | RConstOptString _ ->
3717              pr "This function returns a string which may be NULL.
3718 There is way to return an error from this function.
3719 The string is owned by the guest handle and must I<not> be freed.\n\n"
3720          | RString _ ->
3721              pr "This function returns a string, or NULL on error.
3722 I<The caller must free the returned string after use>.\n\n"
3723          | RStringList _ ->
3724              pr "This function returns a NULL-terminated array of strings
3725 (like L<environ(3)>), or NULL if there was an error.
3726 I<The caller must free the strings and the array after use>.\n\n"
3727          | RStruct (_, typ) ->
3728              pr "This function returns a C<struct guestfs_%s *>,
3729 or NULL if there was an error.
3730 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
3731          | RStructList (_, typ) ->
3732              pr "This function returns a C<struct guestfs_%s_list *>
3733 (see E<lt>guestfs-structs.hE<gt>),
3734 or NULL if there was an error.
3735 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
3736          | RHashtable _ ->
3737              pr "This function returns a NULL-terminated array of
3738 strings, or NULL if there was an error.
3739 The array of strings will always have length C<2n+1>, where
3740 C<n> keys and values alternate, followed by the trailing NULL entry.
3741 I<The caller must free the strings and the array after use>.\n\n"
3742          | RBufferOut _ ->
3743              pr "This function returns a buffer, or NULL on error.
3744 The size of the returned buffer is written to C<*size_r>.
3745 I<The caller must free the returned buffer after use>.\n\n"
3746         );
3747         if List.mem ProtocolLimitWarning flags then
3748           pr "%s\n\n" protocol_limit_warning;
3749         if List.mem DangerWillRobinson flags then
3750           pr "%s\n\n" danger_will_robinson;
3751         match deprecation_notice flags with
3752         | None -> ()
3753         | Some txt -> pr "%s\n\n" txt
3754       )
3755   ) all_functions_sorted
3756
3757 and generate_structs_pod () =
3758   (* Structs documentation. *)
3759   List.iter (
3760     fun (typ, cols) ->
3761       pr "=head2 guestfs_%s\n" typ;
3762       pr "\n";
3763       pr " struct guestfs_%s {\n" typ;
3764       List.iter (
3765         function
3766         | name, FChar -> pr "   char %s;\n" name
3767         | name, FUInt32 -> pr "   uint32_t %s;\n" name
3768         | name, FInt32 -> pr "   int32_t %s;\n" name
3769         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
3770         | name, FInt64 -> pr "   int64_t %s;\n" name
3771         | name, FString -> pr "   char *%s;\n" name
3772         | name, FBuffer ->
3773             pr "   /* The next two fields describe a byte array. */\n";
3774             pr "   uint32_t %s_len;\n" name;
3775             pr "   char *%s;\n" name
3776         | name, FUUID ->
3777             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
3778             pr "   char %s[32];\n" name
3779         | name, FOptPercent ->
3780             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
3781             pr "   float %s;\n" name
3782       ) cols;
3783       pr " };\n";
3784       pr " \n";
3785       pr " struct guestfs_%s_list {\n" typ;
3786       pr "   uint32_t len; /* Number of elements in list. */\n";
3787       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
3788       pr " };\n";
3789       pr " \n";
3790       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
3791       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
3792         typ typ;
3793       pr "\n"
3794   ) structs
3795
3796 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
3797  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
3798  *
3799  * We have to use an underscore instead of a dash because otherwise
3800  * rpcgen generates incorrect code.
3801  *
3802  * This header is NOT exported to clients, but see also generate_structs_h.
3803  *)
3804 and generate_xdr () =
3805   generate_header CStyle LGPLv2;
3806
3807   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
3808   pr "typedef string str<>;\n";
3809   pr "\n";
3810
3811   (* Internal structures. *)
3812   List.iter (
3813     function
3814     | typ, cols ->
3815         pr "struct guestfs_int_%s {\n" typ;
3816         List.iter (function
3817                    | name, FChar -> pr "  char %s;\n" name
3818                    | name, FString -> pr "  string %s<>;\n" name
3819                    | name, FBuffer -> pr "  opaque %s<>;\n" name
3820                    | name, FUUID -> pr "  opaque %s[32];\n" name
3821                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
3822                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
3823                    | name, FOptPercent -> pr "  float %s;\n" name
3824                   ) cols;
3825         pr "};\n";
3826         pr "\n";
3827         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
3828         pr "\n";
3829   ) structs;
3830
3831   List.iter (
3832     fun (shortname, style, _, _, _, _, _) ->
3833       let name = "guestfs_" ^ shortname in
3834
3835       (match snd style with
3836        | [] -> ()
3837        | args ->
3838            pr "struct %s_args {\n" name;
3839            List.iter (
3840              function
3841              | String n -> pr "  string %s<>;\n" n
3842              | OptString n -> pr "  str *%s;\n" n
3843              | StringList n -> pr "  str %s<>;\n" n
3844              | Bool n -> pr "  bool %s;\n" n
3845              | Int n -> pr "  int %s;\n" n
3846              | FileIn _ | FileOut _ -> ()
3847            ) args;
3848            pr "};\n\n"
3849       );
3850       (match fst style with
3851        | RErr -> ()
3852        | RInt n ->
3853            pr "struct %s_ret {\n" name;
3854            pr "  int %s;\n" n;
3855            pr "};\n\n"
3856        | RInt64 n ->
3857            pr "struct %s_ret {\n" name;
3858            pr "  hyper %s;\n" n;
3859            pr "};\n\n"
3860        | RBool n ->
3861            pr "struct %s_ret {\n" name;
3862            pr "  bool %s;\n" n;
3863            pr "};\n\n"
3864        | RConstString _ | RConstOptString _ ->
3865            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
3866        | RString n ->
3867            pr "struct %s_ret {\n" name;
3868            pr "  string %s<>;\n" n;
3869            pr "};\n\n"
3870        | RStringList n ->
3871            pr "struct %s_ret {\n" name;
3872            pr "  str %s<>;\n" n;
3873            pr "};\n\n"
3874        | RStruct (n, typ) ->
3875            pr "struct %s_ret {\n" name;
3876            pr "  guestfs_int_%s %s;\n" typ n;
3877            pr "};\n\n"
3878        | RStructList (n, typ) ->
3879            pr "struct %s_ret {\n" name;
3880            pr "  guestfs_int_%s_list %s;\n" typ n;
3881            pr "};\n\n"
3882        | RHashtable n ->
3883            pr "struct %s_ret {\n" name;
3884            pr "  str %s<>;\n" n;
3885            pr "};\n\n"
3886        | RBufferOut n ->
3887            pr "struct %s_ret {\n" name;
3888            pr "  opaque %s<>;\n" n;
3889            pr "};\n\n"
3890       );
3891   ) daemon_functions;
3892
3893   (* Table of procedure numbers. *)
3894   pr "enum guestfs_procedure {\n";
3895   List.iter (
3896     fun (shortname, _, proc_nr, _, _, _, _) ->
3897       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
3898   ) daemon_functions;
3899   pr "  GUESTFS_PROC_NR_PROCS\n";
3900   pr "};\n";
3901   pr "\n";
3902
3903   (* Having to choose a maximum message size is annoying for several
3904    * reasons (it limits what we can do in the API), but it (a) makes
3905    * the protocol a lot simpler, and (b) provides a bound on the size
3906    * of the daemon which operates in limited memory space.  For large
3907    * file transfers you should use FTP.
3908    *)
3909   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
3910   pr "\n";
3911
3912   (* Message header, etc. *)
3913   pr "\
3914 /* The communication protocol is now documented in the guestfs(3)
3915  * manpage.
3916  */
3917
3918 const GUESTFS_PROGRAM = 0x2000F5F5;
3919 const GUESTFS_PROTOCOL_VERSION = 1;
3920
3921 /* These constants must be larger than any possible message length. */
3922 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
3923 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
3924
3925 enum guestfs_message_direction {
3926   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
3927   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
3928 };
3929
3930 enum guestfs_message_status {
3931   GUESTFS_STATUS_OK = 0,
3932   GUESTFS_STATUS_ERROR = 1
3933 };
3934
3935 const GUESTFS_ERROR_LEN = 256;
3936
3937 struct guestfs_message_error {
3938   string error_message<GUESTFS_ERROR_LEN>;
3939 };
3940
3941 struct guestfs_message_header {
3942   unsigned prog;                     /* GUESTFS_PROGRAM */
3943   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
3944   guestfs_procedure proc;            /* GUESTFS_PROC_x */
3945   guestfs_message_direction direction;
3946   unsigned serial;                   /* message serial number */
3947   guestfs_message_status status;
3948 };
3949
3950 const GUESTFS_MAX_CHUNK_SIZE = 8192;
3951
3952 struct guestfs_chunk {
3953   int cancel;                        /* if non-zero, transfer is cancelled */
3954   /* data size is 0 bytes if the transfer has finished successfully */
3955   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
3956 };
3957 "
3958
3959 (* Generate the guestfs-structs.h file. *)
3960 and generate_structs_h () =
3961   generate_header CStyle LGPLv2;
3962
3963   (* This is a public exported header file containing various
3964    * structures.  The structures are carefully written to have
3965    * exactly the same in-memory format as the XDR structures that
3966    * we use on the wire to the daemon.  The reason for creating
3967    * copies of these structures here is just so we don't have to
3968    * export the whole of guestfs_protocol.h (which includes much
3969    * unrelated and XDR-dependent stuff that we don't want to be
3970    * public, or required by clients).
3971    *
3972    * To reiterate, we will pass these structures to and from the
3973    * client with a simple assignment or memcpy, so the format
3974    * must be identical to what rpcgen / the RFC defines.
3975    *)
3976
3977   (* Public structures. *)
3978   List.iter (
3979     fun (typ, cols) ->
3980       pr "struct guestfs_%s {\n" typ;
3981       List.iter (
3982         function
3983         | name, FChar -> pr "  char %s;\n" name
3984         | name, FString -> pr "  char *%s;\n" name
3985         | name, FBuffer ->
3986             pr "  uint32_t %s_len;\n" name;
3987             pr "  char *%s;\n" name
3988         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
3989         | name, FUInt32 -> pr "  uint32_t %s;\n" name
3990         | name, FInt32 -> pr "  int32_t %s;\n" name
3991         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
3992         | name, FInt64 -> pr "  int64_t %s;\n" name
3993         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
3994       ) cols;
3995       pr "};\n";
3996       pr "\n";
3997       pr "struct guestfs_%s_list {\n" typ;
3998       pr "  uint32_t len;\n";
3999       pr "  struct guestfs_%s *val;\n" typ;
4000       pr "};\n";
4001       pr "\n";
4002       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
4003       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
4004       pr "\n"
4005   ) structs
4006
4007 (* Generate the guestfs-actions.h file. *)
4008 and generate_actions_h () =
4009   generate_header CStyle LGPLv2;
4010   List.iter (
4011     fun (shortname, style, _, _, _, _, _) ->
4012       let name = "guestfs_" ^ shortname in
4013       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
4014         name style
4015   ) all_functions
4016
4017 (* Generate the client-side dispatch stubs. *)
4018 and generate_client_actions () =
4019   generate_header CStyle LGPLv2;
4020
4021   pr "\
4022 #include <stdio.h>
4023 #include <stdlib.h>
4024
4025 #include \"guestfs.h\"
4026 #include \"guestfs_protocol.h\"
4027
4028 #define error guestfs_error
4029 #define perrorf guestfs_perrorf
4030 #define safe_malloc guestfs_safe_malloc
4031 #define safe_realloc guestfs_safe_realloc
4032 #define safe_strdup guestfs_safe_strdup
4033 #define safe_memdup guestfs_safe_memdup
4034
4035 /* Check the return message from a call for validity. */
4036 static int
4037 check_reply_header (guestfs_h *g,
4038                     const struct guestfs_message_header *hdr,
4039                     int proc_nr, int serial)
4040 {
4041   if (hdr->prog != GUESTFS_PROGRAM) {
4042     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
4043     return -1;
4044   }
4045   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
4046     error (g, \"wrong protocol version (%%d/%%d)\",
4047            hdr->vers, GUESTFS_PROTOCOL_VERSION);
4048     return -1;
4049   }
4050   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
4051     error (g, \"unexpected message direction (%%d/%%d)\",
4052            hdr->direction, GUESTFS_DIRECTION_REPLY);
4053     return -1;
4054   }
4055   if (hdr->proc != proc_nr) {
4056     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
4057     return -1;
4058   }
4059   if (hdr->serial != serial) {
4060     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
4061     return -1;
4062   }
4063
4064   return 0;
4065 }
4066
4067 /* Check we are in the right state to run a high-level action. */
4068 static int
4069 check_state (guestfs_h *g, const char *caller)
4070 {
4071   if (!guestfs_is_ready (g)) {
4072     if (guestfs_is_config (g))
4073       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
4074         caller);
4075     else if (guestfs_is_launching (g))
4076       error (g, \"%%s: call wait_ready() before using this function\",
4077         caller);
4078     else
4079       error (g, \"%%s called from the wrong state, %%d != READY\",
4080         caller, guestfs_get_state (g));
4081     return -1;
4082   }
4083   return 0;
4084 }
4085
4086 ";
4087
4088   (* Client-side stubs for each function. *)
4089   List.iter (
4090     fun (shortname, style, _, _, _, _, _) ->
4091       let name = "guestfs_" ^ shortname in
4092
4093       (* Generate the context struct which stores the high-level
4094        * state between callback functions.
4095        *)
4096       pr "struct %s_ctx {\n" shortname;
4097       pr "  /* This flag is set by the callbacks, so we know we've done\n";
4098       pr "   * the callbacks as expected, and in the right sequence.\n";
4099       pr "   * 0 = not called, 1 = reply_cb called.\n";
4100       pr "   */\n";
4101       pr "  int cb_sequence;\n";
4102       pr "  struct guestfs_message_header hdr;\n";
4103       pr "  struct guestfs_message_error err;\n";
4104       (match fst style with
4105        | RErr -> ()
4106        | RConstString _ | RConstOptString _ ->
4107            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
4108        | RInt _ | RInt64 _
4109        | RBool _ | RString _ | RStringList _
4110        | RStruct _ | RStructList _
4111        | RHashtable _ | RBufferOut _ ->
4112            pr "  struct %s_ret ret;\n" name
4113       );
4114       pr "};\n";
4115       pr "\n";
4116
4117       (* Generate the reply callback function. *)
4118       pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
4119       pr "{\n";
4120       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
4121       pr "  struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
4122       pr "\n";
4123       pr "  /* This should definitely not happen. */\n";
4124       pr "  if (ctx->cb_sequence != 0) {\n";
4125       pr "    ctx->cb_sequence = 9999;\n";
4126       pr "    error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
4127       pr "    return;\n";
4128       pr "  }\n";
4129       pr "\n";
4130       pr "  ml->main_loop_quit (ml, g);\n";
4131       pr "\n";
4132       pr "  if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
4133       pr "    error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
4134       pr "    return;\n";
4135       pr "  }\n";
4136       pr "  if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
4137       pr "    if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
4138       pr "      error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
4139         name;
4140       pr "      return;\n";
4141       pr "    }\n";
4142       pr "    goto done;\n";
4143       pr "  }\n";
4144
4145       (match fst style with
4146        | RErr -> ()
4147        | RConstString _ | RConstOptString _ ->
4148            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
4149        | RInt _ | RInt64 _
4150        | RBool _ | RString _ | RStringList _
4151        | RStruct _ | RStructList _
4152        | RHashtable _ | RBufferOut _ ->
4153            pr "  if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
4154            pr "    error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
4155            pr "    return;\n";
4156            pr "  }\n";
4157       );
4158
4159       pr " done:\n";
4160       pr "  ctx->cb_sequence = 1;\n";
4161       pr "}\n\n";
4162
4163       (* Generate the action stub. *)
4164       generate_prototype ~extern:false ~semicolon:false ~newline:true
4165         ~handle:"g" name style;
4166
4167       let error_code =
4168         match fst style with
4169         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
4170         | RConstString _ | RConstOptString _ ->
4171             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
4172         | RString _ | RStringList _
4173         | RStruct _ | RStructList _
4174         | RHashtable _ | RBufferOut _ ->
4175             "NULL" in
4176
4177       pr "{\n";
4178
4179       (match snd style with
4180        | [] -> ()
4181        | _ -> pr "  struct %s_args args;\n" name
4182       );
4183
4184       pr "  struct %s_ctx ctx;\n" shortname;
4185       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
4186       pr "  int serial;\n";
4187       pr "\n";
4188       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
4189       pr "  guestfs_set_busy (g);\n";
4190       pr "\n";
4191       pr "  memset (&ctx, 0, sizeof ctx);\n";
4192       pr "\n";
4193
4194       (* Send the main header and arguments. *)
4195       (match snd style with
4196        | [] ->
4197            pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
4198              (String.uppercase shortname)
4199        | args ->
4200            List.iter (
4201              function
4202              | String n ->
4203                  pr "  args.%s = (char *) %s;\n" n n
4204              | OptString n ->
4205                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
4206              | StringList n ->
4207                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
4208                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
4209              | Bool n ->
4210                  pr "  args.%s = %s;\n" n n
4211              | Int n ->
4212                  pr "  args.%s = %s;\n" n n
4213              | FileIn _ | FileOut _ -> ()
4214            ) args;
4215            pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
4216              (String.uppercase shortname);
4217            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
4218              name;
4219       );
4220       pr "  if (serial == -1) {\n";
4221       pr "    guestfs_end_busy (g);\n";
4222       pr "    return %s;\n" error_code;
4223       pr "  }\n";
4224       pr "\n";
4225
4226       (* Send any additional files (FileIn) requested. *)
4227       let need_read_reply_label = ref false in
4228       List.iter (
4229         function
4230         | FileIn n ->
4231             pr "  {\n";
4232             pr "    int r;\n";
4233             pr "\n";
4234             pr "    r = guestfs__send_file_sync (g, %s);\n" n;
4235             pr "    if (r == -1) {\n";
4236             pr "      guestfs_end_busy (g);\n";
4237             pr "      return %s;\n" error_code;
4238             pr "    }\n";
4239             pr "    if (r == -2) /* daemon cancelled */\n";
4240             pr "      goto read_reply;\n";
4241             need_read_reply_label := true;
4242             pr "  }\n";
4243             pr "\n";
4244         | _ -> ()
4245       ) (snd style);
4246
4247       (* Wait for the reply from the remote end. *)
4248       if !need_read_reply_label then pr " read_reply:\n";
4249       pr "  guestfs__switch_to_receiving (g);\n";
4250       pr "  ctx.cb_sequence = 0;\n";
4251       pr "  guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
4252       pr "  (void) ml->main_loop_run (ml, g);\n";
4253       pr "  guestfs_set_reply_callback (g, NULL, NULL);\n";
4254       pr "  if (ctx.cb_sequence != 1) {\n";
4255       pr "    error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
4256       pr "    guestfs_end_busy (g);\n";
4257       pr "    return %s;\n" error_code;
4258       pr "  }\n";
4259       pr "\n";
4260
4261       pr "  if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
4262         (String.uppercase shortname);
4263       pr "    guestfs_end_busy (g);\n";
4264       pr "    return %s;\n" error_code;
4265       pr "  }\n";
4266       pr "\n";
4267
4268       pr "  if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
4269       pr "    error (g, \"%%s\", ctx.err.error_message);\n";
4270       pr "    free (ctx.err.error_message);\n";
4271       pr "    guestfs_end_busy (g);\n";
4272       pr "    return %s;\n" error_code;
4273       pr "  }\n";
4274       pr "\n";
4275
4276       (* Expecting to receive further files (FileOut)? *)
4277       List.iter (
4278         function
4279         | FileOut n ->
4280             pr "  if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
4281             pr "    guestfs_end_busy (g);\n";
4282             pr "    return %s;\n" error_code;
4283             pr "  }\n";
4284             pr "\n";
4285         | _ -> ()
4286       ) (snd style);
4287
4288       pr "  guestfs_end_busy (g);\n";
4289
4290       (match fst style with
4291        | RErr -> pr "  return 0;\n"
4292        | RInt n | RInt64 n | RBool n ->
4293            pr "  return ctx.ret.%s;\n" n
4294        | RConstString _ | RConstOptString _ ->
4295            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
4296        | RString n ->
4297            pr "  return ctx.ret.%s; /* caller will free */\n" n
4298        | RStringList n | RHashtable n ->
4299            pr "  /* caller will free this, but we need to add a NULL entry */\n";
4300            pr "  ctx.ret.%s.%s_val =\n" n n;
4301            pr "    safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
4302            pr "                  sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
4303              n n;
4304            pr "  ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
4305            pr "  return ctx.ret.%s.%s_val;\n" n n
4306        | RStruct (n, _) ->
4307            pr "  /* caller will free this */\n";
4308            pr "  return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
4309        | RStructList (n, _) ->
4310            pr "  /* caller will free this */\n";
4311            pr "  return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
4312        | RBufferOut n ->
4313            pr "  *size_r = ctx.ret.%s.%s_len;\n" n n;
4314            pr "  return ctx.ret.%s.%s_val; /* caller will free */\n" n n
4315       );
4316
4317       pr "}\n\n"
4318   ) daemon_functions;
4319
4320   (* Functions to free structures. *)
4321   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
4322   pr " * structure format is identical to the XDR format.  See note in\n";
4323   pr " * generator.ml.\n";
4324   pr " */\n";
4325   pr "\n";
4326
4327   List.iter (
4328     fun (typ, _) ->
4329       pr "void\n";
4330       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
4331       pr "{\n";
4332       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
4333       pr "  free (x);\n";
4334       pr "}\n";
4335       pr "\n";
4336
4337       pr "void\n";
4338       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
4339       pr "{\n";
4340       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
4341       pr "  free (x);\n";
4342       pr "}\n";
4343       pr "\n";
4344
4345   ) structs;
4346
4347 (* Generate daemon/actions.h. *)
4348 and generate_daemon_actions_h () =
4349   generate_header CStyle GPLv2;
4350
4351   pr "#include \"../src/guestfs_protocol.h\"\n";
4352   pr "\n";
4353
4354   List.iter (
4355     fun (name, style, _, _, _, _, _) ->
4356       generate_prototype
4357         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
4358         name style;
4359   ) daemon_functions
4360
4361 (* Generate the server-side stubs. *)
4362 and generate_daemon_actions () =
4363   generate_header CStyle GPLv2;
4364
4365   pr "#include <config.h>\n";
4366   pr "\n";
4367   pr "#include <stdio.h>\n";
4368   pr "#include <stdlib.h>\n";
4369   pr "#include <string.h>\n";
4370   pr "#include <inttypes.h>\n";
4371   pr "#include <ctype.h>\n";
4372   pr "#include <rpc/types.h>\n";
4373   pr "#include <rpc/xdr.h>\n";
4374   pr "\n";
4375   pr "#include \"daemon.h\"\n";
4376   pr "#include \"../src/guestfs_protocol.h\"\n";
4377   pr "#include \"actions.h\"\n";
4378   pr "\n";
4379
4380   List.iter (
4381     fun (name, style, _, _, _, _, _) ->
4382       (* Generate server-side stubs. *)
4383       pr "static void %s_stub (XDR *xdr_in)\n" name;
4384       pr "{\n";
4385       let error_code =
4386         match fst style with
4387         | RErr | RInt _ -> pr "  int r;\n"; "-1"
4388         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
4389         | RBool _ -> pr "  int r;\n"; "-1"
4390         | RConstString _ | RConstOptString _ ->
4391             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
4392         | RString _ -> pr "  char *r;\n"; "NULL"
4393         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
4394         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
4395         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
4396         | RBufferOut _ ->
4397             pr "  size_t size;\n";
4398             pr "  char *r;\n";
4399             "NULL" in
4400
4401       (match snd style with
4402        | [] -> ()
4403        | args ->
4404            pr "  struct guestfs_%s_args args;\n" name;
4405            List.iter (
4406              function
4407                (* Note we allow the string to be writable, in order to
4408                 * allow device name translation.  This is safe because
4409                 * we can modify the string (passed from RPC).
4410                 *)
4411              | String n
4412              | OptString n -> pr "  char *%s;\n" n
4413              | StringList n -> pr "  char **%s;\n" n
4414              | Bool n -> pr "  int %s;\n" n
4415              | Int n -> pr "  int %s;\n" n
4416              | FileIn _ | FileOut _ -> ()
4417            ) args
4418       );
4419       pr "\n";
4420
4421       (match snd style with
4422        | [] -> ()
4423        | args ->
4424            pr "  memset (&args, 0, sizeof args);\n";
4425            pr "\n";
4426            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
4427            pr "    reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
4428            pr "    return;\n";
4429            pr "  }\n";
4430            List.iter (
4431              function
4432              | String n -> pr "  %s = args.%s;\n" n n
4433              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
4434              | StringList n ->
4435                  pr "  %s = realloc (args.%s.%s_val,\n" n n n;
4436                  pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
4437                  pr "  if (%s == NULL) {\n" n;
4438                  pr "    reply_with_perror (\"realloc\");\n";
4439                  pr "    goto done;\n";
4440                  pr "  }\n";
4441                  pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
4442                  pr "  args.%s.%s_val = %s;\n" n n n;
4443              | Bool n -> pr "  %s = args.%s;\n" n n
4444              | Int n -> pr "  %s = args.%s;\n" n n
4445              | FileIn _ | FileOut _ -> ()
4446            ) args;
4447            pr "\n"
4448       );
4449
4450       (* Don't want to call the impl with any FileIn or FileOut
4451        * parameters, since these go "outside" the RPC protocol.
4452        *)
4453       let args' =
4454         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
4455           (snd style) in
4456       pr "  r = do_%s " name;
4457       generate_c_call_args (fst style, args');
4458       pr ";\n";
4459
4460       pr "  if (r == %s)\n" error_code;
4461       pr "    /* do_%s has already called reply_with_error */\n" name;
4462       pr "    goto done;\n";
4463       pr "\n";
4464
4465       (* If there are any FileOut parameters, then the impl must
4466        * send its own reply.
4467        *)
4468       let no_reply =
4469         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
4470       if no_reply then
4471         pr "  /* do_%s has already sent a reply */\n" name
4472       else (
4473         match fst style with
4474         | RErr -> pr "  reply (NULL, NULL);\n"
4475         | RInt n | RInt64 n | RBool n ->
4476             pr "  struct guestfs_%s_ret ret;\n" name;
4477             pr "  ret.%s = r;\n" n;
4478             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
4479               name
4480         | RConstString _ | RConstOptString _ ->
4481             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
4482         | RString n ->
4483             pr "  struct guestfs_%s_ret ret;\n" name;
4484             pr "  ret.%s = r;\n" n;
4485             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
4486               name;
4487             pr "  free (r);\n"
4488         | RStringList n | RHashtable n ->
4489             pr "  struct guestfs_%s_ret ret;\n" name;
4490             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
4491             pr "  ret.%s.%s_val = r;\n" n n;
4492             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
4493               name;
4494             pr "  free_strings (r);\n"
4495         | RStruct (n, _) ->
4496             pr "  struct guestfs_%s_ret ret;\n" name;
4497             pr "  ret.%s = *r;\n" n;
4498             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
4499               name;
4500             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
4501               name
4502         | RStructList (n, _) ->
4503             pr "  struct guestfs_%s_ret ret;\n" name;
4504             pr "  ret.%s = *r;\n" n;
4505             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
4506               name;
4507             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
4508               name
4509         | RBufferOut n ->
4510             pr "  struct guestfs_%s_ret ret;\n" name;
4511             pr "  ret.%s.%s_val = r;\n" n n;
4512             pr "  ret.%s.%s_len = size;\n" n n;
4513             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
4514               name;
4515             pr "  free (r);\n"
4516       );
4517
4518       (* Free the args. *)
4519       (match snd style with
4520        | [] ->
4521            pr "done: ;\n";
4522        | _ ->
4523            pr "done:\n";
4524            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
4525              name
4526       );
4527
4528       pr "}\n\n";
4529   ) daemon_functions;
4530
4531   (* Dispatch function. *)
4532   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
4533   pr "{\n";
4534   pr "  switch (proc_nr) {\n";
4535
4536   List.iter (
4537     fun (name, style, _, _, _, _, _) ->
4538       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
4539       pr "      %s_stub (xdr_in);\n" name;
4540       pr "      break;\n"
4541   ) daemon_functions;
4542
4543   pr "    default:\n";
4544   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";
4545   pr "  }\n";
4546   pr "}\n";
4547   pr "\n";
4548
4549   (* LVM columns and tokenization functions. *)
4550   (* XXX This generates crap code.  We should rethink how we
4551    * do this parsing.
4552    *)
4553   List.iter (
4554     function
4555     | typ, cols ->
4556         pr "static const char *lvm_%s_cols = \"%s\";\n"
4557           typ (String.concat "," (List.map fst cols));
4558         pr "\n";
4559
4560         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
4561         pr "{\n";
4562         pr "  char *tok, *p, *next;\n";
4563         pr "  int i, j;\n";
4564         pr "\n";
4565         (*
4566           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
4567           pr "\n";
4568         *)
4569         pr "  if (!str) {\n";
4570         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
4571         pr "    return -1;\n";
4572         pr "  }\n";
4573         pr "  if (!*str || isspace (*str)) {\n";
4574         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
4575         pr "    return -1;\n";
4576         pr "  }\n";
4577         pr "  tok = str;\n";
4578         List.iter (
4579           fun (name, coltype) ->
4580             pr "  if (!tok) {\n";
4581             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
4582             pr "    return -1;\n";
4583             pr "  }\n";
4584             pr "  p = strchrnul (tok, ',');\n";
4585             pr "  if (*p) next = p+1; else next = NULL;\n";
4586             pr "  *p = '\\0';\n";
4587             (match coltype with
4588              | FString ->
4589                  pr "  r->%s = strdup (tok);\n" name;
4590                  pr "  if (r->%s == NULL) {\n" name;
4591                  pr "    perror (\"strdup\");\n";
4592                  pr "    return -1;\n";
4593                  pr "  }\n"
4594              | FUUID ->
4595                  pr "  for (i = j = 0; i < 32; ++j) {\n";
4596                  pr "    if (tok[j] == '\\0') {\n";
4597                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
4598                  pr "      return -1;\n";
4599                  pr "    } else if (tok[j] != '-')\n";
4600                  pr "      r->%s[i++] = tok[j];\n" name;
4601                  pr "  }\n";
4602              | FBytes ->
4603                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
4604                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
4605                  pr "    return -1;\n";
4606                  pr "  }\n";
4607              | FInt64 ->
4608                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
4609                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
4610                  pr "    return -1;\n";
4611                  pr "  }\n";
4612              | FOptPercent ->
4613                  pr "  if (tok[0] == '\\0')\n";
4614                  pr "    r->%s = -1;\n" name;
4615                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
4616                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
4617                  pr "    return -1;\n";
4618                  pr "  }\n";
4619              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
4620                  assert false (* can never be an LVM column *)
4621             );
4622             pr "  tok = next;\n";
4623         ) cols;
4624
4625         pr "  if (tok != NULL) {\n";
4626         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
4627         pr "    return -1;\n";
4628         pr "  }\n";
4629         pr "  return 0;\n";
4630         pr "}\n";
4631         pr "\n";
4632
4633         pr "guestfs_int_lvm_%s_list *\n" typ;
4634         pr "parse_command_line_%ss (void)\n" typ;
4635         pr "{\n";
4636         pr "  char *out, *err;\n";
4637         pr "  char *p, *pend;\n";
4638         pr "  int r, i;\n";
4639         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
4640         pr "  void *newp;\n";
4641         pr "\n";
4642         pr "  ret = malloc (sizeof *ret);\n";
4643         pr "  if (!ret) {\n";
4644         pr "    reply_with_perror (\"malloc\");\n";
4645         pr "    return NULL;\n";
4646         pr "  }\n";
4647         pr "\n";
4648         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
4649         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
4650         pr "\n";
4651         pr "  r = command (&out, &err,\n";
4652         pr "           \"/sbin/lvm\", \"%ss\",\n" typ;
4653         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
4654         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
4655         pr "  if (r == -1) {\n";
4656         pr "    reply_with_error (\"%%s\", err);\n";
4657         pr "    free (out);\n";
4658         pr "    free (err);\n";
4659         pr "    free (ret);\n";
4660         pr "    return NULL;\n";
4661         pr "  }\n";
4662         pr "\n";
4663         pr "  free (err);\n";
4664         pr "\n";
4665         pr "  /* Tokenize each line of the output. */\n";
4666         pr "  p = out;\n";
4667         pr "  i = 0;\n";
4668         pr "  while (p) {\n";
4669         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
4670         pr "    if (pend) {\n";
4671         pr "      *pend = '\\0';\n";
4672         pr "      pend++;\n";
4673         pr "    }\n";
4674         pr "\n";
4675         pr "    while (*p && isspace (*p))      /* Skip any leading whitespace. */\n";
4676         pr "      p++;\n";
4677         pr "\n";
4678         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
4679         pr "      p = pend;\n";
4680         pr "      continue;\n";
4681         pr "    }\n";
4682         pr "\n";
4683         pr "    /* Allocate some space to store this next entry. */\n";
4684         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
4685         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
4686         pr "    if (newp == NULL) {\n";
4687         pr "      reply_with_perror (\"realloc\");\n";
4688         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
4689         pr "      free (ret);\n";
4690         pr "      free (out);\n";
4691         pr "      return NULL;\n";
4692         pr "    }\n";
4693         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
4694         pr "\n";
4695         pr "    /* Tokenize the next entry. */\n";
4696         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
4697         pr "    if (r == -1) {\n";
4698         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
4699         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
4700         pr "      free (ret);\n";
4701         pr "      free (out);\n";
4702         pr "      return NULL;\n";
4703         pr "    }\n";
4704         pr "\n";
4705         pr "    ++i;\n";
4706         pr "    p = pend;\n";
4707         pr "  }\n";
4708         pr "\n";
4709         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
4710         pr "\n";
4711         pr "  free (out);\n";
4712         pr "  return ret;\n";
4713         pr "}\n"
4714
4715   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
4716
4717 (* Generate a list of function names, for debugging in the daemon.. *)
4718 and generate_daemon_names () =
4719   generate_header CStyle GPLv2;
4720
4721   pr "#include <config.h>\n";
4722   pr "\n";
4723   pr "#include \"daemon.h\"\n";
4724   pr "\n";
4725
4726   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
4727   pr "const char *function_names[] = {\n";
4728   List.iter (
4729     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
4730   ) daemon_functions;
4731   pr "};\n";
4732
4733 (* Generate the tests. *)
4734 and generate_tests () =
4735   generate_header CStyle GPLv2;
4736
4737   pr "\
4738 #include <stdio.h>
4739 #include <stdlib.h>
4740 #include <string.h>
4741 #include <unistd.h>
4742 #include <sys/types.h>
4743 #include <fcntl.h>
4744
4745 #include \"guestfs.h\"
4746
4747 static guestfs_h *g;
4748 static int suppress_error = 0;
4749
4750 static void print_error (guestfs_h *g, void *data, const char *msg)
4751 {
4752   if (!suppress_error)
4753     fprintf (stderr, \"%%s\\n\", msg);
4754 }
4755
4756 static void print_strings (char * const * const argv)
4757 {
4758   int argc;
4759
4760   for (argc = 0; argv[argc] != NULL; ++argc)
4761     printf (\"\\t%%s\\n\", argv[argc]);
4762 }
4763
4764 /*
4765 static void print_table (char * const * const argv)
4766 {
4767   int i;
4768
4769   for (i = 0; argv[i] != NULL; i += 2)
4770     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
4771 }
4772 */
4773
4774 static void no_test_warnings (void)
4775 {
4776 ";
4777
4778   List.iter (
4779     function
4780     | name, _, _, _, [], _, _ ->
4781         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
4782     | name, _, _, _, tests, _, _ -> ()
4783   ) all_functions;
4784
4785   pr "}\n";
4786   pr "\n";
4787
4788   (* Generate the actual tests.  Note that we generate the tests
4789    * in reverse order, deliberately, so that (in general) the
4790    * newest tests run first.  This makes it quicker and easier to
4791    * debug them.
4792    *)
4793   let test_names =
4794     List.map (
4795       fun (name, _, _, _, tests, _, _) ->
4796         mapi (generate_one_test name) tests
4797     ) (List.rev all_functions) in
4798   let test_names = List.concat test_names in
4799   let nr_tests = List.length test_names in
4800
4801   pr "\
4802 int main (int argc, char *argv[])
4803 {
4804   char c = 0;
4805   int failed = 0;
4806   const char *filename;
4807   int fd;
4808   int nr_tests, test_num = 0;
4809
4810   setbuf (stdout, NULL);
4811
4812   no_test_warnings ();
4813
4814   g = guestfs_create ();
4815   if (g == NULL) {
4816     printf (\"guestfs_create FAILED\\n\");
4817     exit (1);
4818   }
4819
4820   guestfs_set_error_handler (g, print_error, NULL);
4821
4822   guestfs_set_path (g, \"../appliance\");
4823
4824   filename = \"test1.img\";
4825   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
4826   if (fd == -1) {
4827     perror (filename);
4828     exit (1);
4829   }
4830   if (lseek (fd, %d, SEEK_SET) == -1) {
4831     perror (\"lseek\");
4832     close (fd);
4833     unlink (filename);
4834     exit (1);
4835   }
4836   if (write (fd, &c, 1) == -1) {
4837     perror (\"write\");
4838     close (fd);
4839     unlink (filename);
4840     exit (1);
4841   }
4842   if (close (fd) == -1) {
4843     perror (filename);
4844     unlink (filename);
4845     exit (1);
4846   }
4847   if (guestfs_add_drive (g, filename) == -1) {
4848     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
4849     exit (1);
4850   }
4851
4852   filename = \"test2.img\";
4853   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
4854   if (fd == -1) {
4855     perror (filename);
4856     exit (1);
4857   }
4858   if (lseek (fd, %d, SEEK_SET) == -1) {
4859     perror (\"lseek\");
4860     close (fd);
4861     unlink (filename);
4862     exit (1);
4863   }
4864   if (write (fd, &c, 1) == -1) {
4865     perror (\"write\");
4866     close (fd);
4867     unlink (filename);
4868     exit (1);
4869   }
4870   if (close (fd) == -1) {
4871     perror (filename);
4872     unlink (filename);
4873     exit (1);
4874   }
4875   if (guestfs_add_drive (g, filename) == -1) {
4876     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
4877     exit (1);
4878   }
4879
4880   filename = \"test3.img\";
4881   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
4882   if (fd == -1) {
4883     perror (filename);
4884     exit (1);
4885   }
4886   if (lseek (fd, %d, SEEK_SET) == -1) {
4887     perror (\"lseek\");
4888     close (fd);
4889     unlink (filename);
4890     exit (1);
4891   }
4892   if (write (fd, &c, 1) == -1) {
4893     perror (\"write\");
4894     close (fd);
4895     unlink (filename);
4896     exit (1);
4897   }
4898   if (close (fd) == -1) {
4899     perror (filename);
4900     unlink (filename);
4901     exit (1);
4902   }
4903   if (guestfs_add_drive (g, filename) == -1) {
4904     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
4905     exit (1);
4906   }
4907
4908   if (guestfs_add_drive_ro (g, \"../images/test.sqsh\") == -1) {
4909     printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\");
4910     exit (1);
4911   }
4912
4913   if (guestfs_launch (g) == -1) {
4914     printf (\"guestfs_launch FAILED\\n\");
4915     exit (1);
4916   }
4917
4918   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
4919   alarm (600);
4920
4921   if (guestfs_wait_ready (g) == -1) {
4922     printf (\"guestfs_wait_ready FAILED\\n\");
4923     exit (1);
4924   }
4925
4926   /* Cancel previous alarm. */
4927   alarm (0);
4928
4929   nr_tests = %d;
4930
4931 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
4932
4933   iteri (
4934     fun i test_name ->
4935       pr "  test_num++;\n";
4936       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
4937       pr "  if (%s () == -1) {\n" test_name;
4938       pr "    printf (\"%s FAILED\\n\");\n" test_name;
4939       pr "    failed++;\n";
4940       pr "  }\n";
4941   ) test_names;
4942   pr "\n";
4943
4944   pr "  guestfs_close (g);\n";
4945   pr "  unlink (\"test1.img\");\n";
4946   pr "  unlink (\"test2.img\");\n";
4947   pr "  unlink (\"test3.img\");\n";
4948   pr "\n";
4949
4950   pr "  if (failed > 0) {\n";
4951   pr "    printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
4952   pr "    exit (1);\n";
4953   pr "  }\n";
4954   pr "\n";
4955
4956   pr "  exit (0);\n";
4957   pr "}\n"
4958
4959 and generate_one_test name i (init, prereq, test) =
4960   let test_name = sprintf "test_%s_%d" name i in
4961
4962   pr "\
4963 static int %s_skip (void)
4964 {
4965   const char *str;
4966
4967   str = getenv (\"TEST_ONLY\");
4968   if (str)
4969     return strstr (str, \"%s\") == NULL;
4970   str = getenv (\"SKIP_%s\");
4971   if (str && strcmp (str, \"1\") == 0) return 1;
4972   str = getenv (\"SKIP_TEST_%s\");
4973   if (str && strcmp (str, \"1\") == 0) return 1;
4974   return 0;
4975 }
4976
4977 " test_name name (String.uppercase test_name) (String.uppercase name);
4978
4979   (match prereq with
4980    | Disabled | Always -> ()
4981    | If code | Unless code ->
4982        pr "static int %s_prereq (void)\n" test_name;
4983        pr "{\n";
4984        pr "  %s\n" code;
4985        pr "}\n";
4986        pr "\n";
4987   );
4988
4989   pr "\
4990 static int %s (void)
4991 {
4992   if (%s_skip ()) {
4993     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
4994     return 0;
4995   }
4996
4997 " test_name test_name test_name;
4998
4999   (match prereq with
5000    | Disabled ->
5001        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
5002    | If _ ->
5003        pr "  if (! %s_prereq ()) {\n" test_name;
5004        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
5005        pr "    return 0;\n";
5006        pr "  }\n";
5007        pr "\n";
5008        generate_one_test_body name i test_name init test;
5009    | Unless _ ->
5010        pr "  if (%s_prereq ()) {\n" test_name;
5011        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
5012        pr "    return 0;\n";
5013        pr "  }\n";
5014        pr "\n";
5015        generate_one_test_body name i test_name init test;
5016    | Always ->
5017        generate_one_test_body name i test_name init test
5018   );
5019
5020   pr "  return 0;\n";
5021   pr "}\n";
5022   pr "\n";
5023   test_name
5024
5025 and generate_one_test_body name i test_name init test =
5026   (match init with
5027    | InitNone (* XXX at some point, InitNone and InitEmpty became
5028                * folded together as the same thing.  Really we should
5029                * make InitNone do nothing at all, but the tests may
5030                * need to be checked to make sure this is OK.
5031                *)
5032    | InitEmpty ->
5033        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
5034        List.iter (generate_test_command_call test_name)
5035          [["blockdev_setrw"; "/dev/sda"];
5036           ["umount_all"];
5037           ["lvm_remove_all"]]
5038    | InitBasicFS ->
5039        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
5040        List.iter (generate_test_command_call test_name)
5041          [["blockdev_setrw"; "/dev/sda"];
5042           ["umount_all"];
5043           ["lvm_remove_all"];
5044           ["sfdiskM"; "/dev/sda"; ","];
5045           ["mkfs"; "ext2"; "/dev/sda1"];
5046           ["mount"; "/dev/sda1"; "/"]]
5047    | InitBasicFSonLVM ->
5048        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
5049          test_name;
5050        List.iter (generate_test_command_call test_name)
5051          [["blockdev_setrw"; "/dev/sda"];
5052           ["umount_all"];
5053           ["lvm_remove_all"];
5054           ["sfdiskM"; "/dev/sda"; ","];
5055           ["pvcreate"; "/dev/sda1"];
5056           ["vgcreate"; "VG"; "/dev/sda1"];
5057           ["lvcreate"; "LV"; "VG"; "8"];
5058           ["mkfs"; "ext2"; "/dev/VG/LV"];
5059           ["mount"; "/dev/VG/LV"; "/"]]
5060    | InitSquashFS ->
5061        pr "  /* InitSquashFS for %s */\n" test_name;
5062        List.iter (generate_test_command_call test_name)
5063          [["blockdev_setrw"; "/dev/sda"];
5064           ["umount_all"];
5065           ["lvm_remove_all"];
5066           ["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"]]
5067   );
5068
5069   let get_seq_last = function
5070     | [] ->
5071         failwithf "%s: you cannot use [] (empty list) when expecting a command"
5072           test_name
5073     | seq ->
5074         let seq = List.rev seq in
5075         List.rev (List.tl seq), List.hd seq
5076   in
5077
5078   match test with
5079   | TestRun seq ->
5080       pr "  /* TestRun for %s (%d) */\n" name i;
5081       List.iter (generate_test_command_call test_name) seq
5082   | TestOutput (seq, expected) ->
5083       pr "  /* TestOutput for %s (%d) */\n" name i;
5084       pr "  const char *expected = \"%s\";\n" (c_quote expected);
5085       let seq, last = get_seq_last seq in
5086       let test () =
5087         pr "    if (strcmp (r, expected) != 0) {\n";
5088         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
5089         pr "      return -1;\n";
5090         pr "    }\n"
5091       in
5092       List.iter (generate_test_command_call test_name) seq;
5093       generate_test_command_call ~test test_name last
5094   | TestOutputList (seq, expected) ->
5095       pr "  /* TestOutputList for %s (%d) */\n" name i;
5096       let seq, last = get_seq_last seq in
5097       let test () =
5098         iteri (
5099           fun i str ->
5100             pr "    if (!r[%d]) {\n" i;
5101             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
5102             pr "      print_strings (r);\n";
5103             pr "      return -1;\n";
5104             pr "    }\n";
5105             pr "    {\n";
5106             pr "      const char *expected = \"%s\";\n" (c_quote str);
5107             pr "      if (strcmp (r[%d], expected) != 0) {\n" i;
5108             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
5109             pr "        return -1;\n";
5110             pr "      }\n";
5111             pr "    }\n"
5112         ) expected;
5113         pr "    if (r[%d] != NULL) {\n" (List.length expected);
5114         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
5115           test_name;
5116         pr "      print_strings (r);\n";
5117         pr "      return -1;\n";
5118         pr "    }\n"
5119       in
5120       List.iter (generate_test_command_call test_name) seq;
5121       generate_test_command_call ~test test_name last
5122   | TestOutputListOfDevices (seq, expected) ->
5123       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
5124       let seq, last = get_seq_last seq in
5125       let test () =
5126         iteri (
5127           fun i str ->
5128             pr "    if (!r[%d]) {\n" i;
5129             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
5130             pr "      print_strings (r);\n";
5131             pr "      return -1;\n";
5132             pr "    }\n";
5133             pr "    {\n";
5134             pr "      const char *expected = \"%s\";\n" (c_quote str);
5135             pr "      r[%d][5] = 's';\n" i;
5136             pr "      if (strcmp (r[%d], expected) != 0) {\n" i;
5137             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
5138             pr "        return -1;\n";
5139             pr "      }\n";
5140             pr "    }\n"
5141         ) expected;
5142         pr "    if (r[%d] != NULL) {\n" (List.length expected);
5143         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
5144           test_name;
5145         pr "      print_strings (r);\n";
5146         pr "      return -1;\n";
5147         pr "    }\n"
5148       in
5149       List.iter (generate_test_command_call test_name) seq;
5150       generate_test_command_call ~test test_name last
5151   | TestOutputInt (seq, expected) ->
5152       pr "  /* TestOutputInt for %s (%d) */\n" name i;
5153       let seq, last = get_seq_last seq in
5154       let test () =
5155         pr "    if (r != %d) {\n" expected;
5156         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
5157           test_name expected;
5158         pr "               (int) r);\n";
5159         pr "      return -1;\n";
5160         pr "    }\n"
5161       in
5162       List.iter (generate_test_command_call test_name) seq;
5163       generate_test_command_call ~test test_name last
5164   | TestOutputIntOp (seq, op, expected) ->
5165       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
5166       let seq, last = get_seq_last seq in
5167       let test () =
5168         pr "    if (! (r %s %d)) {\n" op expected;
5169         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
5170           test_name op expected;
5171         pr "               (int) r);\n";
5172         pr "      return -1;\n";
5173         pr "    }\n"
5174       in
5175       List.iter (generate_test_command_call test_name) seq;
5176       generate_test_command_call ~test test_name last
5177   | TestOutputTrue seq ->
5178       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
5179       let seq, last = get_seq_last seq in
5180       let test () =
5181         pr "    if (!r) {\n";
5182         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
5183           test_name;
5184         pr "      return -1;\n";
5185         pr "    }\n"
5186       in
5187       List.iter (generate_test_command_call test_name) seq;
5188       generate_test_command_call ~test test_name last
5189   | TestOutputFalse seq ->
5190       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
5191       let seq, last = get_seq_last seq in
5192       let test () =
5193         pr "    if (r) {\n";
5194         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
5195           test_name;
5196         pr "      return -1;\n";
5197         pr "    }\n"
5198       in
5199       List.iter (generate_test_command_call test_name) seq;
5200       generate_test_command_call ~test test_name last
5201   | TestOutputLength (seq, expected) ->
5202       pr "  /* TestOutputLength for %s (%d) */\n" name i;
5203       let seq, last = get_seq_last seq in
5204       let test () =
5205         pr "    int j;\n";
5206         pr "    for (j = 0; j < %d; ++j)\n" expected;
5207         pr "      if (r[j] == NULL) {\n";
5208         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
5209           test_name;
5210         pr "        print_strings (r);\n";
5211         pr "        return -1;\n";
5212         pr "      }\n";
5213         pr "    if (r[j] != NULL) {\n";
5214         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
5215           test_name;
5216         pr "      print_strings (r);\n";
5217         pr "      return -1;\n";
5218         pr "    }\n"
5219       in
5220       List.iter (generate_test_command_call test_name) seq;
5221       generate_test_command_call ~test test_name last
5222   | TestOutputStruct (seq, checks) ->
5223       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
5224       let seq, last = get_seq_last seq in
5225       let test () =
5226         List.iter (
5227           function
5228           | CompareWithInt (field, expected) ->
5229               pr "    if (r->%s != %d) {\n" field expected;
5230               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
5231                 test_name field expected;
5232               pr "               (int) r->%s);\n" field;
5233               pr "      return -1;\n";
5234               pr "    }\n"
5235           | CompareWithIntOp (field, op, expected) ->
5236               pr "    if (!(r->%s %s %d)) {\n" field op expected;
5237               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
5238                 test_name field op expected;
5239               pr "               (int) r->%s);\n" field;
5240               pr "      return -1;\n";
5241               pr "    }\n"
5242           | CompareWithString (field, expected) ->
5243               pr "    if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
5244               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
5245                 test_name field expected;
5246               pr "               r->%s);\n" field;
5247               pr "      return -1;\n";
5248               pr "    }\n"
5249           | CompareFieldsIntEq (field1, field2) ->
5250               pr "    if (r->%s != r->%s) {\n" field1 field2;
5251               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
5252                 test_name field1 field2;
5253               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
5254               pr "      return -1;\n";
5255               pr "    }\n"
5256           | CompareFieldsStrEq (field1, field2) ->
5257               pr "    if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
5258               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
5259                 test_name field1 field2;
5260               pr "               r->%s, r->%s);\n" field1 field2;
5261               pr "      return -1;\n";
5262               pr "    }\n"
5263         ) checks
5264       in
5265       List.iter (generate_test_command_call test_name) seq;
5266       generate_test_command_call ~test test_name last
5267   | TestLastFail seq ->
5268       pr "  /* TestLastFail for %s (%d) */\n" name i;
5269       let seq, last = get_seq_last seq in
5270       List.iter (generate_test_command_call test_name) seq;
5271       generate_test_command_call test_name ~expect_error:true last
5272
5273 (* Generate the code to run a command, leaving the result in 'r'.
5274  * If you expect to get an error then you should set expect_error:true.
5275  *)
5276 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
5277   match cmd with
5278   | [] -> assert false
5279   | name :: args ->
5280       (* Look up the command to find out what args/ret it has. *)
5281       let style =
5282         try
5283           let _, style, _, _, _, _, _ =
5284             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
5285           style
5286         with Not_found ->
5287           failwithf "%s: in test, command %s was not found" test_name name in
5288
5289       if List.length (snd style) <> List.length args then
5290         failwithf "%s: in test, wrong number of args given to %s"
5291           test_name name;
5292
5293       pr "  {\n";
5294
5295       List.iter (
5296         function
5297         | OptString n, "NULL" -> ()
5298         | String n, arg
5299         | OptString n, arg ->
5300             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
5301         | Int _, _
5302         | Bool _, _
5303         | FileIn _, _ | FileOut _, _ -> ()
5304         | StringList n, arg ->
5305             let strs = string_split " " arg in
5306             iteri (
5307               fun i str ->
5308                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
5309             ) strs;
5310             pr "    const char *%s[] = {\n" n;
5311             iteri (
5312               fun i _ -> pr "      %s_%d,\n" n i
5313             ) strs;
5314             pr "      NULL\n";
5315             pr "    };\n";
5316       ) (List.combine (snd style) args);
5317
5318       let error_code =
5319         match fst style with
5320         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
5321         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
5322         | RConstString _ | RConstOptString _ ->
5323             pr "    const char *r;\n"; "NULL"
5324         | RString _ -> pr "    char *r;\n"; "NULL"
5325         | RStringList _ | RHashtable _ ->
5326             pr "    char **r;\n";
5327             pr "    int i;\n";
5328             "NULL"
5329         | RStruct (_, typ) ->
5330             pr "    struct guestfs_%s *r;\n" typ; "NULL"
5331         | RStructList (_, typ) ->
5332             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
5333         | RBufferOut _ ->
5334             pr "    char *r;\n";
5335             pr "    size_t size;\n";
5336             "NULL" in
5337
5338       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
5339       pr "    r = guestfs_%s (g" name;
5340
5341       (* Generate the parameters. *)
5342       List.iter (
5343         function
5344         | OptString _, "NULL" -> pr ", NULL"
5345         | String n, _
5346         | OptString n, _ ->
5347             pr ", %s" n
5348         | FileIn _, arg | FileOut _, arg ->
5349             pr ", \"%s\"" (c_quote arg)
5350         | StringList n, _ ->
5351             pr ", %s" n
5352         | Int _, arg ->
5353             let i =
5354               try int_of_string arg
5355               with Failure "int_of_string" ->
5356                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
5357             pr ", %d" i
5358         | Bool _, arg ->
5359             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
5360       ) (List.combine (snd style) args);
5361
5362       (match fst style with
5363        | RBufferOut _ -> pr ", &size"
5364        | _ -> ()
5365       );
5366
5367       pr ");\n";
5368
5369       if not expect_error then
5370         pr "    if (r == %s)\n" error_code
5371       else
5372         pr "    if (r != %s)\n" error_code;
5373       pr "      return -1;\n";
5374
5375       (* Insert the test code. *)
5376       (match test with
5377        | None -> ()
5378        | Some f -> f ()
5379       );
5380
5381       (match fst style with
5382        | RErr | RInt _ | RInt64 _ | RBool _
5383        | RConstString _ | RConstOptString _ -> ()
5384        | RString _ | RBufferOut _ -> pr "    free (r);\n"
5385        | RStringList _ | RHashtable _ ->
5386            pr "    for (i = 0; r[i] != NULL; ++i)\n";
5387            pr "      free (r[i]);\n";
5388            pr "    free (r);\n"
5389        | RStruct (_, typ) ->
5390            pr "    guestfs_free_%s (r);\n" typ
5391        | RStructList (_, typ) ->
5392            pr "    guestfs_free_%s_list (r);\n" typ
5393       );
5394
5395       pr "  }\n"
5396
5397 and c_quote str =
5398   let str = replace_str str "\r" "\\r" in
5399   let str = replace_str str "\n" "\\n" in
5400   let str = replace_str str "\t" "\\t" in
5401   let str = replace_str str "\000" "\\0" in
5402   str
5403
5404 (* Generate a lot of different functions for guestfish. *)
5405 and generate_fish_cmds () =
5406   generate_header CStyle GPLv2;
5407
5408   let all_functions =
5409     List.filter (
5410       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
5411     ) all_functions in
5412   let all_functions_sorted =
5413     List.filter (
5414       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
5415     ) all_functions_sorted in
5416
5417   pr "#include <stdio.h>\n";
5418   pr "#include <stdlib.h>\n";
5419   pr "#include <string.h>\n";
5420   pr "#include <inttypes.h>\n";
5421   pr "#include <ctype.h>\n";
5422   pr "\n";
5423   pr "#include <guestfs.h>\n";
5424   pr "#include \"fish.h\"\n";
5425   pr "\n";
5426
5427   (* list_commands function, which implements guestfish -h *)
5428   pr "void list_commands (void)\n";
5429   pr "{\n";
5430   pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
5431   pr "  list_builtin_commands ();\n";
5432   List.iter (
5433     fun (name, _, _, flags, _, shortdesc, _) ->
5434       let name = replace_char name '_' '-' in
5435       pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
5436         name shortdesc
5437   ) all_functions_sorted;
5438   pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
5439   pr "}\n";
5440   pr "\n";
5441
5442   (* display_command function, which implements guestfish -h cmd *)
5443   pr "void display_command (const char *cmd)\n";
5444   pr "{\n";
5445   List.iter (
5446     fun (name, style, _, flags, _, shortdesc, longdesc) ->
5447       let name2 = replace_char name '_' '-' in
5448       let alias =
5449         try find_map (function FishAlias n -> Some n | _ -> None) flags
5450         with Not_found -> name in
5451       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
5452       let synopsis =
5453         match snd style with
5454         | [] -> name2
5455         | args ->
5456             sprintf "%s <%s>"
5457               name2 (String.concat "> <" (List.map name_of_argt args)) in
5458
5459       let warnings =
5460         if List.mem ProtocolLimitWarning flags then
5461           ("\n\n" ^ protocol_limit_warning)
5462         else "" in
5463
5464       (* For DangerWillRobinson commands, we should probably have
5465        * guestfish prompt before allowing you to use them (especially
5466        * in interactive mode). XXX
5467        *)
5468       let warnings =
5469         warnings ^
5470           if List.mem DangerWillRobinson flags then
5471             ("\n\n" ^ danger_will_robinson)
5472           else "" in
5473
5474       let warnings =
5475         warnings ^
5476           match deprecation_notice flags with
5477           | None -> ""
5478           | Some txt -> "\n\n" ^ txt in
5479
5480       let describe_alias =
5481         if name <> alias then
5482           sprintf "\n\nYou can use '%s' as an alias for this command." alias
5483         else "" in
5484
5485       pr "  if (";
5486       pr "strcasecmp (cmd, \"%s\") == 0" name;
5487       if name <> name2 then
5488         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
5489       if name <> alias then
5490         pr " || strcasecmp (cmd, \"%s\") == 0" alias;
5491       pr ")\n";
5492       pr "    pod2text (\"%s - %s\", %S);\n"
5493         name2 shortdesc
5494         (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
5495       pr "  else\n"
5496   ) all_functions;
5497   pr "    display_builtin_command (cmd);\n";
5498   pr "}\n";
5499   pr "\n";
5500
5501   (* print_* functions *)
5502   List.iter (
5503     fun (typ, cols) ->
5504       let needs_i =
5505         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
5506
5507       pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
5508       pr "{\n";
5509       if needs_i then (
5510         pr "  int i;\n";
5511         pr "\n"
5512       );
5513       List.iter (
5514         function
5515         | name, FString ->
5516             pr "  printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
5517         | name, FUUID ->
5518             pr "  printf (\"%s: \");\n" name;
5519             pr "  for (i = 0; i < 32; ++i)\n";
5520             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
5521             pr "  printf (\"\\n\");\n"
5522         | name, FBuffer ->
5523             pr "  printf (\"%s: \");\n" name;
5524             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
5525             pr "    if (isprint (%s->%s[i]))\n" typ name;
5526             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
5527             pr "    else\n";
5528             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
5529             pr "  printf (\"\\n\");\n"
5530         | name, (FUInt64|FBytes) ->
5531             pr "  printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
5532         | name, FInt64 ->
5533             pr "  printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
5534         | name, FUInt32 ->
5535             pr "  printf (\"%s: %%\" PRIu32 \"\\n\", %s->%s);\n" name typ name
5536         | name, FInt32 ->
5537             pr "  printf (\"%s: %%\" PRIi32 \"\\n\", %s->%s);\n" name typ name
5538         | name, FChar ->
5539             pr "  printf (\"%s: %%c\\n\", %s->%s);\n" name typ name
5540         | name, FOptPercent ->
5541             pr "  if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
5542               typ name name typ name;
5543             pr "  else printf (\"%s: \\n\");\n" name
5544       ) cols;
5545       pr "}\n";
5546       pr "\n";
5547       pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
5548         typ typ typ;
5549       pr "{\n";
5550       pr "  int i;\n";
5551       pr "\n";
5552       pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
5553       pr "    print_%s (&%ss->val[i]);\n" typ typ;
5554       pr "}\n";
5555       pr "\n";
5556   ) structs;
5557
5558   (* run_<action> actions *)
5559   List.iter (
5560     fun (name, style, _, flags, _, _, _) ->
5561       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
5562       pr "{\n";
5563       (match fst style with
5564        | RErr
5565        | RInt _
5566        | RBool _ -> pr "  int r;\n"
5567        | RInt64 _ -> pr "  int64_t r;\n"
5568        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
5569        | RString _ -> pr "  char *r;\n"
5570        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
5571        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
5572        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
5573        | RBufferOut _ ->
5574            pr "  char *r;\n";
5575            pr "  size_t size;\n";
5576       );
5577       List.iter (
5578         function
5579         | String n
5580         | OptString n
5581         | FileIn n
5582         | FileOut n -> pr "  const char *%s;\n" n
5583         | StringList n -> pr "  char **%s;\n" n
5584         | Bool n -> pr "  int %s;\n" n
5585         | Int n -> pr "  int %s;\n" n
5586       ) (snd style);
5587
5588       (* Check and convert parameters. *)
5589       let argc_expected = List.length (snd style) in
5590       pr "  if (argc != %d) {\n" argc_expected;
5591       pr "    fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
5592         argc_expected;
5593       pr "    fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
5594       pr "    return -1;\n";
5595       pr "  }\n";
5596       iteri (
5597         fun i ->
5598           function
5599           | String name -> pr "  %s = argv[%d];\n" name i
5600           | OptString name ->
5601               pr "  %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
5602                 name i i
5603           | FileIn name ->
5604               pr "  %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
5605                 name i i
5606           | FileOut name ->
5607               pr "  %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
5608                 name i i
5609           | StringList name ->
5610               pr "  %s = parse_string_list (argv[%d]);\n" name i
5611           | Bool name ->
5612               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
5613           | Int name ->
5614               pr "  %s = atoi (argv[%d]);\n" name i
5615       ) (snd style);
5616
5617       (* Call C API function. *)
5618       let fn =
5619         try find_map (function FishAction n -> Some n | _ -> None) flags
5620         with Not_found -> sprintf "guestfs_%s" name in
5621       pr "  r = %s " fn;
5622       generate_c_call_args ~handle:"g" style;
5623       pr ";\n";
5624
5625       (* Check return value for errors and display command results. *)
5626       (match fst style with
5627        | RErr -> pr "  return r;\n"
5628        | RInt _ ->
5629            pr "  if (r == -1) return -1;\n";
5630            pr "  printf (\"%%d\\n\", r);\n";
5631            pr "  return 0;\n"
5632        | RInt64 _ ->
5633            pr "  if (r == -1) return -1;\n";
5634            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
5635            pr "  return 0;\n"
5636        | RBool _ ->
5637            pr "  if (r == -1) return -1;\n";
5638            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
5639            pr "  return 0;\n"
5640        | RConstString _ ->
5641            pr "  if (r == NULL) return -1;\n";
5642            pr "  printf (\"%%s\\n\", r);\n";
5643            pr "  return 0;\n"
5644        | RConstOptString _ ->
5645            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
5646            pr "  return 0;\n"
5647        | RString _ ->
5648            pr "  if (r == NULL) return -1;\n";
5649            pr "  printf (\"%%s\\n\", r);\n";
5650            pr "  free (r);\n";
5651            pr "  return 0;\n"
5652        | RStringList _ ->
5653            pr "  if (r == NULL) return -1;\n";
5654            pr "  print_strings (r);\n";
5655            pr "  free_strings (r);\n";
5656            pr "  return 0;\n"
5657        | RStruct (_, typ) ->
5658            pr "  if (r == NULL) return -1;\n";
5659            pr "  print_%s (r);\n" typ;
5660            pr "  guestfs_free_%s (r);\n" typ;
5661            pr "  return 0;\n"
5662        | RStructList (_, typ) ->
5663            pr "  if (r == NULL) return -1;\n";
5664            pr "  print_%s_list (r);\n" typ;
5665            pr "  guestfs_free_%s_list (r);\n" typ;
5666            pr "  return 0;\n"
5667        | RHashtable _ ->
5668            pr "  if (r == NULL) return -1;\n";
5669            pr "  print_table (r);\n";
5670            pr "  free_strings (r);\n";
5671            pr "  return 0;\n"
5672        | RBufferOut _ ->
5673            pr "  if (r == NULL) return -1;\n";
5674            pr "  fwrite (r, size, 1, stdout);\n";
5675            pr "  free (r);\n";
5676            pr "  return 0;\n"
5677       );
5678       pr "}\n";
5679       pr "\n"
5680   ) all_functions;
5681
5682   (* run_action function *)
5683   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
5684   pr "{\n";
5685   List.iter (
5686     fun (name, _, _, flags, _, _, _) ->
5687       let name2 = replace_char name '_' '-' in
5688       let alias =
5689         try find_map (function FishAlias n -> Some n | _ -> None) flags
5690         with Not_found -> name in
5691       pr "  if (";
5692       pr "strcasecmp (cmd, \"%s\") == 0" name;
5693       if name <> name2 then
5694         pr " || strcasecmp (cmd, \"%s\") == 0" name2;
5695       if name <> alias then
5696         pr " || strcasecmp (cmd, \"%s\") == 0" alias;
5697       pr ")\n";
5698       pr "    return run_%s (cmd, argc, argv);\n" name;
5699       pr "  else\n";
5700   ) all_functions;
5701   pr "    {\n";
5702   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
5703   pr "      return -1;\n";
5704   pr "    }\n";
5705   pr "  return 0;\n";
5706   pr "}\n";
5707   pr "\n"
5708
5709 (* Readline completion for guestfish. *)
5710 and generate_fish_completion () =
5711   generate_header CStyle GPLv2;
5712
5713   let all_functions =
5714     List.filter (
5715       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
5716     ) all_functions in
5717
5718   pr "\
5719 #include <config.h>
5720
5721 #include <stdio.h>
5722 #include <stdlib.h>
5723 #include <string.h>
5724
5725 #ifdef HAVE_LIBREADLINE
5726 #include <readline/readline.h>
5727 #endif
5728
5729 #include \"fish.h\"
5730
5731 #ifdef HAVE_LIBREADLINE
5732
5733 static const char *const commands[] = {
5734   BUILTIN_COMMANDS_FOR_COMPLETION,
5735 ";
5736
5737   (* Get the commands, including the aliases.  They don't need to be
5738    * sorted - the generator() function just does a dumb linear search.
5739    *)
5740   let commands =
5741     List.map (
5742       fun (name, _, _, flags, _, _, _) ->
5743         let name2 = replace_char name '_' '-' in
5744         let alias =
5745           try find_map (function FishAlias n -> Some n | _ -> None) flags
5746           with Not_found -> name in
5747
5748         if name <> alias then [name2; alias] else [name2]
5749     ) all_functions in
5750   let commands = List.flatten commands in
5751
5752   List.iter (pr "  \"%s\",\n") commands;
5753
5754   pr "  NULL
5755 };
5756
5757 static char *
5758 generator (const char *text, int state)
5759 {
5760   static int index, len;
5761   const char *name;
5762
5763   if (!state) {
5764     index = 0;
5765     len = strlen (text);
5766   }
5767
5768   rl_attempted_completion_over = 1;
5769
5770   while ((name = commands[index]) != NULL) {
5771     index++;
5772     if (strncasecmp (name, text, len) == 0)
5773       return strdup (name);
5774   }
5775
5776   return NULL;
5777 }
5778
5779 #endif /* HAVE_LIBREADLINE */
5780
5781 char **do_completion (const char *text, int start, int end)
5782 {
5783   char **matches = NULL;
5784
5785 #ifdef HAVE_LIBREADLINE
5786   rl_completion_append_character = ' ';
5787
5788   if (start == 0)
5789     matches = rl_completion_matches (text, generator);
5790   else if (complete_dest_paths)
5791     matches = rl_completion_matches (text, complete_dest_paths_generator);
5792 #endif
5793
5794   return matches;
5795 }
5796 ";
5797
5798 (* Generate the POD documentation for guestfish. *)
5799 and generate_fish_actions_pod () =
5800   let all_functions_sorted =
5801     List.filter (
5802       fun (_, _, _, flags, _, _, _) ->
5803         not (List.mem NotInFish flags || List.mem NotInDocs flags)
5804     ) all_functions_sorted in
5805
5806   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
5807
5808   List.iter (
5809     fun (name, style, _, flags, _, _, longdesc) ->
5810       let longdesc =
5811         Str.global_substitute rex (
5812           fun s ->
5813             let sub =
5814               try Str.matched_group 1 s
5815               with Not_found ->
5816                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
5817             "C<" ^ replace_char sub '_' '-' ^ ">"
5818         ) longdesc in
5819       let name = replace_char name '_' '-' in
5820       let alias =
5821         try find_map (function FishAlias n -> Some n | _ -> None) flags
5822         with Not_found -> name in
5823
5824       pr "=head2 %s" name;
5825       if name <> alias then
5826         pr " | %s" alias;
5827       pr "\n";
5828       pr "\n";
5829       pr " %s" name;
5830       List.iter (
5831         function
5832         | String n -> pr " %s" n
5833         | OptString n -> pr " %s" n
5834         | StringList n -> pr " '%s ...'" n
5835         | Bool _ -> pr " true|false"
5836         | Int n -> pr " %s" n
5837         | FileIn n | FileOut n -> pr " (%s|-)" n
5838       ) (snd style);
5839       pr "\n";
5840       pr "\n";
5841       pr "%s\n\n" longdesc;
5842
5843       if List.exists (function FileIn _ | FileOut _ -> true
5844                       | _ -> false) (snd style) then
5845         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
5846
5847       if List.mem ProtocolLimitWarning flags then
5848         pr "%s\n\n" protocol_limit_warning;
5849
5850       if List.mem DangerWillRobinson flags then
5851         pr "%s\n\n" danger_will_robinson;
5852
5853       match deprecation_notice flags with
5854       | None -> ()
5855       | Some txt -> pr "%s\n\n" txt
5856   ) all_functions_sorted
5857
5858 (* Generate a C function prototype. *)
5859 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
5860     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
5861     ?(prefix = "")
5862     ?handle name style =
5863   if extern then pr "extern ";
5864   if static then pr "static ";
5865   (match fst style with
5866    | RErr -> pr "int "
5867    | RInt _ -> pr "int "
5868    | RInt64 _ -> pr "int64_t "
5869    | RBool _ -> pr "int "
5870    | RConstString _ | RConstOptString _ -> pr "const char *"
5871    | RString _ | RBufferOut _ -> pr "char *"
5872    | RStringList _ | RHashtable _ -> pr "char **"
5873    | RStruct (_, typ) ->
5874        if not in_daemon then pr "struct guestfs_%s *" typ
5875        else pr "guestfs_int_%s *" typ
5876    | RStructList (_, typ) ->
5877        if not in_daemon then pr "struct guestfs_%s_list *" typ
5878        else pr "guestfs_int_%s_list *" typ
5879   );
5880   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
5881   pr "%s%s (" prefix name;
5882   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
5883     pr "void"
5884   else (
5885     let comma = ref false in
5886     (match handle with
5887      | None -> ()
5888      | Some handle -> pr "guestfs_h *%s" handle; comma := true
5889     );
5890     let next () =
5891       if !comma then (
5892         if single_line then pr ", " else pr ",\n\t\t"
5893       );
5894       comma := true
5895     in
5896     List.iter (
5897       function
5898       | String n
5899       | OptString n ->
5900           next ();
5901           if not in_daemon then pr "const char *%s" n
5902           else pr "char *%s" n
5903       | StringList n ->
5904           next ();
5905           if not in_daemon then pr "char * const* const %s" n
5906           else pr "char **%s" n
5907       | Bool n -> next (); pr "int %s" n
5908       | Int n -> next (); pr "int %s" n
5909       | FileIn n
5910       | FileOut n ->
5911           if not in_daemon then (next (); pr "const char *%s" n)
5912     ) (snd style);
5913     if is_RBufferOut then (next (); pr "size_t *size_r");
5914   );
5915   pr ")";
5916   if semicolon then pr ";";
5917   if newline then pr "\n"
5918
5919 (* Generate C call arguments, eg "(handle, foo, bar)" *)
5920 and generate_c_call_args ?handle ?(decl = false) style =
5921   pr "(";
5922   let comma = ref false in
5923   let next () =
5924     if !comma then pr ", ";
5925     comma := true
5926   in
5927   (match handle with
5928    | None -> ()
5929    | Some handle -> pr "%s" handle; comma := true
5930   );
5931   List.iter (
5932     fun arg ->
5933       next ();
5934       pr "%s" (name_of_argt arg)
5935   ) (snd style);
5936   (* For RBufferOut calls, add implicit &size parameter. *)
5937   if not decl then (
5938     match fst style with
5939     | RBufferOut _ ->
5940         next ();
5941         pr "&size"
5942     | _ -> ()
5943   );
5944   pr ")"
5945
5946 (* Generate the OCaml bindings interface. *)
5947 and generate_ocaml_mli () =
5948   generate_header OCamlStyle LGPLv2;
5949
5950   pr "\
5951 (** For API documentation you should refer to the C API
5952     in the guestfs(3) manual page.  The OCaml API uses almost
5953     exactly the same calls. *)
5954
5955 type t
5956 (** A [guestfs_h] handle. *)
5957
5958 exception Error of string
5959 (** This exception is raised when there is an error. *)
5960
5961 val create : unit -> t
5962
5963 val close : t -> unit
5964 (** Handles are closed by the garbage collector when they become
5965     unreferenced, but callers can also call this in order to
5966     provide predictable cleanup. *)
5967
5968 ";
5969   generate_ocaml_structure_decls ();
5970
5971   (* The actions. *)
5972   List.iter (
5973     fun (name, style, _, _, _, shortdesc, _) ->
5974       generate_ocaml_prototype name style;
5975       pr "(** %s *)\n" shortdesc;
5976       pr "\n"
5977   ) all_functions
5978
5979 (* Generate the OCaml bindings implementation. *)
5980 and generate_ocaml_ml () =
5981   generate_header OCamlStyle LGPLv2;
5982
5983   pr "\
5984 type t
5985 exception Error of string
5986 external create : unit -> t = \"ocaml_guestfs_create\"
5987 external close : t -> unit = \"ocaml_guestfs_close\"
5988
5989 let () =
5990   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
5991
5992 ";
5993
5994   generate_ocaml_structure_decls ();
5995
5996   (* The actions. *)
5997   List.iter (
5998     fun (name, style, _, _, _, shortdesc, _) ->
5999       generate_ocaml_prototype ~is_external:true name style;
6000   ) all_functions
6001
6002 (* Generate the OCaml bindings C implementation. *)
6003 and generate_ocaml_c () =
6004   generate_header CStyle LGPLv2;
6005
6006   pr "\
6007 #include <stdio.h>
6008 #include <stdlib.h>
6009 #include <string.h>
6010
6011 #include <caml/config.h>
6012 #include <caml/alloc.h>
6013 #include <caml/callback.h>
6014 #include <caml/fail.h>
6015 #include <caml/memory.h>
6016 #include <caml/mlvalues.h>
6017 #include <caml/signals.h>
6018
6019 #include <guestfs.h>
6020
6021 #include \"guestfs_c.h\"
6022
6023 /* Copy a hashtable of string pairs into an assoc-list.  We return
6024  * the list in reverse order, but hashtables aren't supposed to be
6025  * ordered anyway.
6026  */
6027 static CAMLprim value
6028 copy_table (char * const * argv)
6029 {
6030   CAMLparam0 ();
6031   CAMLlocal5 (rv, pairv, kv, vv, cons);
6032   int i;
6033
6034   rv = Val_int (0);
6035   for (i = 0; argv[i] != NULL; i += 2) {
6036     kv = caml_copy_string (argv[i]);
6037     vv = caml_copy_string (argv[i+1]);
6038     pairv = caml_alloc (2, 0);
6039     Store_field (pairv, 0, kv);
6040     Store_field (pairv, 1, vv);
6041     cons = caml_alloc (2, 0);
6042     Store_field (cons, 1, rv);
6043     rv = cons;
6044     Store_field (cons, 0, pairv);
6045   }
6046
6047   CAMLreturn (rv);
6048 }
6049
6050 ";
6051
6052   (* Struct copy functions. *)
6053   List.iter (
6054     fun (typ, cols) ->
6055       let has_optpercent_col =
6056         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
6057
6058       pr "static CAMLprim value\n";
6059       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
6060       pr "{\n";
6061       pr "  CAMLparam0 ();\n";
6062       if has_optpercent_col then
6063         pr "  CAMLlocal3 (rv, v, v2);\n"
6064       else
6065         pr "  CAMLlocal2 (rv, v);\n";
6066       pr "\n";
6067       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
6068       iteri (
6069         fun i col ->
6070           (match col with
6071            | name, FString ->
6072                pr "  v = caml_copy_string (%s->%s);\n" typ name
6073            | name, FBuffer ->
6074                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
6075                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
6076                  typ name typ name
6077            | name, FUUID ->
6078                pr "  v = caml_alloc_string (32);\n";
6079                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
6080            | name, (FBytes|FInt64|FUInt64) ->
6081                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
6082            | name, (FInt32|FUInt32) ->
6083                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
6084            | name, FOptPercent ->
6085                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
6086                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
6087                pr "    v = caml_alloc (1, 0);\n";
6088                pr "    Store_field (v, 0, v2);\n";
6089                pr "  } else /* None */\n";
6090                pr "    v = Val_int (0);\n";
6091            | name, FChar ->
6092                pr "  v = Val_int (%s->%s);\n" typ name
6093           );
6094           pr "  Store_field (rv, %d, v);\n" i
6095       ) cols;
6096       pr "  CAMLreturn (rv);\n";
6097       pr "}\n";
6098       pr "\n";
6099
6100       pr "static CAMLprim value\n";
6101       pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n"
6102         typ typ typ;
6103       pr "{\n";
6104       pr "  CAMLparam0 ();\n";
6105       pr "  CAMLlocal2 (rv, v);\n";
6106       pr "  int i;\n";
6107       pr "\n";
6108       pr "  if (%ss->len == 0)\n" typ;
6109       pr "    CAMLreturn (Atom (0));\n";
6110       pr "  else {\n";
6111       pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
6112       pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
6113       pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
6114       pr "      caml_modify (&Field (rv, i), v);\n";
6115       pr "    }\n";
6116       pr "    CAMLreturn (rv);\n";
6117       pr "  }\n";
6118       pr "}\n";
6119       pr "\n";
6120   ) structs;
6121
6122   (* The wrappers. *)
6123   List.iter (
6124     fun (name, style, _, _, _, _, _) ->
6125       let params =
6126         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
6127
6128       let needs_extra_vs =
6129         match fst style with RConstOptString _ -> true | _ -> false in
6130
6131       pr "CAMLprim value\n";
6132       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
6133       List.iter (pr ", value %s") (List.tl params);
6134       pr ")\n";
6135       pr "{\n";
6136
6137       (match params with
6138        | [p1; p2; p3; p4; p5] ->
6139            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
6140        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
6141            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
6142            pr "  CAMLxparam%d (%s);\n"
6143              (List.length rest) (String.concat ", " rest)
6144        | ps ->
6145            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
6146       );
6147       if not needs_extra_vs then
6148         pr "  CAMLlocal1 (rv);\n"
6149       else
6150         pr "  CAMLlocal3 (rv, v, v2);\n";
6151       pr "\n";
6152
6153       pr "  guestfs_h *g = Guestfs_val (gv);\n";
6154       pr "  if (g == NULL)\n";
6155       pr "    caml_failwith (\"%s: used handle after closing it\");\n" name;
6156       pr "\n";
6157
6158       List.iter (
6159         function
6160         | String n
6161         | FileIn n
6162         | FileOut n ->
6163             pr "  const char *%s = String_val (%sv);\n" n n
6164         | OptString n ->
6165             pr "  const char *%s =\n" n;
6166             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
6167               n n
6168         | StringList n ->
6169             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
6170         | Bool n ->
6171             pr "  int %s = Bool_val (%sv);\n" n n
6172         | Int n ->
6173             pr "  int %s = Int_val (%sv);\n" n n
6174       ) (snd style);
6175       let error_code =
6176         match fst style with
6177         | RErr -> pr "  int r;\n"; "-1"
6178         | RInt _ -> pr "  int r;\n"; "-1"
6179         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
6180         | RBool _ -> pr "  int r;\n"; "-1"
6181         | RConstString _ | RConstOptString _ ->
6182             pr "  const char *r;\n"; "NULL"
6183         | RString _ -> pr "  char *r;\n"; "NULL"
6184         | RStringList _ ->
6185             pr "  int i;\n";
6186             pr "  char **r;\n";
6187             "NULL"
6188         | RStruct (_, typ) ->
6189             pr "  struct guestfs_%s *r;\n" typ; "NULL"
6190         | RStructList (_, typ) ->
6191             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
6192         | RHashtable _ ->
6193             pr "  int i;\n";
6194             pr "  char **r;\n";
6195             "NULL"
6196         | RBufferOut _ ->
6197             pr "  char *r;\n";
6198             pr "  size_t size;\n";
6199             "NULL" in
6200       pr "\n";
6201
6202       pr "  caml_enter_blocking_section ();\n";
6203       pr "  r = guestfs_%s " name;
6204       generate_c_call_args ~handle:"g" style;
6205       pr ";\n";
6206       pr "  caml_leave_blocking_section ();\n";
6207
6208       List.iter (
6209         function
6210         | StringList n ->
6211             pr "  ocaml_guestfs_free_strings (%s);\n" n;
6212         | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
6213       ) (snd style);
6214
6215       pr "  if (r == %s)\n" error_code;
6216       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
6217       pr "\n";
6218
6219       (match fst style with
6220        | RErr -> pr "  rv = Val_unit;\n"
6221        | RInt _ -> pr "  rv = Val_int (r);\n"
6222        | RInt64 _ ->
6223            pr "  rv = caml_copy_int64 (r);\n"
6224        | RBool _ -> pr "  rv = Val_bool (r);\n"
6225        | RConstString _ ->
6226            pr "  rv = caml_copy_string (r);\n"
6227        | RConstOptString _ ->
6228            pr "  if (r) { /* Some string */\n";
6229            pr "    v = caml_alloc (1, 0);\n";
6230            pr "    v2 = caml_copy_string (r);\n";
6231            pr "    Store_field (v, 0, v2);\n";
6232            pr "  } else /* None */\n";
6233            pr "    v = Val_int (0);\n";
6234        | RString _ ->
6235            pr "  rv = caml_copy_string (r);\n";
6236            pr "  free (r);\n"
6237        | RStringList _ ->
6238            pr "  rv = caml_copy_string_array ((const char **) r);\n";
6239            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
6240            pr "  free (r);\n"
6241        | RStruct (_, typ) ->
6242            pr "  rv = copy_%s (r);\n" typ;
6243            pr "  guestfs_free_%s (r);\n" typ;
6244        | RStructList (_, typ) ->
6245            pr "  rv = copy_%s_list (r);\n" typ;
6246            pr "  guestfs_free_%s_list (r);\n" typ;
6247        | RHashtable _ ->
6248            pr "  rv = copy_table (r);\n";
6249            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
6250            pr "  free (r);\n";
6251        | RBufferOut _ ->
6252            pr "  rv = caml_alloc_string (size);\n";
6253            pr "  memcpy (String_val (rv), r, size);\n";
6254       );
6255
6256       pr "  CAMLreturn (rv);\n";
6257       pr "}\n";
6258       pr "\n";
6259
6260       if List.length params > 5 then (
6261         pr "CAMLprim value\n";
6262         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
6263         pr "{\n";
6264         pr "  return ocaml_guestfs_%s (argv[0]" name;
6265         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
6266         pr ");\n";
6267         pr "}\n";
6268         pr "\n"
6269       )
6270   ) all_functions
6271
6272 and generate_ocaml_structure_decls () =
6273   List.iter (
6274     fun (typ, cols) ->
6275       pr "type %s = {\n" typ;
6276       List.iter (
6277         function
6278         | name, FString -> pr "  %s : string;\n" name
6279         | name, FBuffer -> pr "  %s : string;\n" name
6280         | name, FUUID -> pr "  %s : string;\n" name
6281         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
6282         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
6283         | name, FChar -> pr "  %s : char;\n" name
6284         | name, FOptPercent -> pr "  %s : float option;\n" name
6285       ) cols;
6286       pr "}\n";
6287       pr "\n"
6288   ) structs
6289
6290 and generate_ocaml_prototype ?(is_external = false) name style =
6291   if is_external then pr "external " else pr "val ";
6292   pr "%s : t -> " name;
6293   List.iter (
6294     function
6295     | String _ | FileIn _ | FileOut _ -> pr "string -> "
6296     | OptString _ -> pr "string option -> "
6297     | StringList _ -> pr "string array -> "
6298     | Bool _ -> pr "bool -> "
6299     | Int _ -> pr "int -> "
6300   ) (snd style);
6301   (match fst style with
6302    | RErr -> pr "unit" (* all errors are turned into exceptions *)
6303    | RInt _ -> pr "int"
6304    | RInt64 _ -> pr "int64"
6305    | RBool _ -> pr "bool"
6306    | RConstString _ -> pr "string"
6307    | RConstOptString _ -> pr "string option"
6308    | RString _ | RBufferOut _ -> pr "string"
6309    | RStringList _ -> pr "string array"
6310    | RStruct (_, typ) -> pr "%s" typ
6311    | RStructList (_, typ) -> pr "%s array" typ
6312    | RHashtable _ -> pr "(string * string) list"
6313   );
6314   if is_external then (
6315     pr " = ";
6316     if List.length (snd style) + 1 > 5 then
6317       pr "\"ocaml_guestfs_%s_byte\" " name;
6318     pr "\"ocaml_guestfs_%s\"" name
6319   );
6320   pr "\n"
6321
6322 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
6323 and generate_perl_xs () =
6324   generate_header CStyle LGPLv2;
6325
6326   pr "\
6327 #include \"EXTERN.h\"
6328 #include \"perl.h\"
6329 #include \"XSUB.h\"
6330
6331 #include <guestfs.h>
6332
6333 #ifndef PRId64
6334 #define PRId64 \"lld\"
6335 #endif
6336
6337 static SV *
6338 my_newSVll(long long val) {
6339 #ifdef USE_64_BIT_ALL
6340   return newSViv(val);
6341 #else
6342   char buf[100];
6343   int len;
6344   len = snprintf(buf, 100, \"%%\" PRId64, val);
6345   return newSVpv(buf, len);
6346 #endif
6347 }
6348
6349 #ifndef PRIu64
6350 #define PRIu64 \"llu\"
6351 #endif
6352
6353 static SV *
6354 my_newSVull(unsigned long long val) {
6355 #ifdef USE_64_BIT_ALL
6356   return newSVuv(val);
6357 #else
6358   char buf[100];
6359   int len;
6360   len = snprintf(buf, 100, \"%%\" PRIu64, val);
6361   return newSVpv(buf, len);
6362 #endif
6363 }
6364
6365 /* http://www.perlmonks.org/?node_id=680842 */
6366 static char **
6367 XS_unpack_charPtrPtr (SV *arg) {
6368   char **ret;
6369   AV *av;
6370   I32 i;
6371
6372   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
6373     croak (\"array reference expected\");
6374
6375   av = (AV *)SvRV (arg);
6376   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
6377   if (!ret)
6378     croak (\"malloc failed\");
6379
6380   for (i = 0; i <= av_len (av); i++) {
6381     SV **elem = av_fetch (av, i, 0);
6382
6383     if (!elem || !*elem)
6384       croak (\"missing element in list\");
6385
6386     ret[i] = SvPV_nolen (*elem);
6387   }
6388
6389   ret[i] = NULL;
6390
6391   return ret;
6392 }
6393
6394 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
6395
6396 PROTOTYPES: ENABLE
6397
6398 guestfs_h *
6399 _create ()
6400    CODE:
6401       RETVAL = guestfs_create ();
6402       if (!RETVAL)
6403         croak (\"could not create guestfs handle\");
6404       guestfs_set_error_handler (RETVAL, NULL, NULL);
6405  OUTPUT:
6406       RETVAL
6407
6408 void
6409 DESTROY (g)
6410       guestfs_h *g;
6411  PPCODE:
6412       guestfs_close (g);
6413
6414 ";
6415
6416   List.iter (
6417     fun (name, style, _, _, _, _, _) ->
6418       (match fst style with
6419        | RErr -> pr "void\n"
6420        | RInt _ -> pr "SV *\n"
6421        | RInt64 _ -> pr "SV *\n"
6422        | RBool _ -> pr "SV *\n"
6423        | RConstString _ -> pr "SV *\n"
6424        | RConstOptString _ -> pr "SV *\n"
6425        | RString _ -> pr "SV *\n"
6426        | RBufferOut _ -> pr "SV *\n"
6427        | RStringList _
6428        | RStruct _ | RStructList _
6429        | RHashtable _ ->
6430            pr "void\n" (* all lists returned implictly on the stack *)
6431       );
6432       (* Call and arguments. *)
6433       pr "%s " name;
6434       generate_c_call_args ~handle:"g" ~decl:true style;
6435       pr "\n";
6436       pr "      guestfs_h *g;\n";
6437       iteri (
6438         fun i ->
6439           function
6440           | String n | FileIn n | FileOut n -> pr "      char *%s;\n" n
6441           | OptString n ->
6442               (* http://www.perlmonks.org/?node_id=554277
6443                * Note that the implicit handle argument means we have
6444                * to add 1 to the ST(x) operator.
6445                *)
6446               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
6447           | StringList n -> pr "      char **%s;\n" n
6448           | Bool n -> pr "      int %s;\n" n
6449           | Int n -> pr "      int %s;\n" n
6450       ) (snd style);
6451
6452       let do_cleanups () =
6453         List.iter (
6454           function
6455           | String _ | OptString _ | Bool _ | Int _
6456           | FileIn _ | FileOut _ -> ()
6457           | StringList n -> pr "      free (%s);\n" n
6458         ) (snd style)
6459       in
6460
6461       (* Code. *)
6462       (match fst style with
6463        | RErr ->
6464            pr "PREINIT:\n";
6465            pr "      int r;\n";
6466            pr " PPCODE:\n";
6467            pr "      r = guestfs_%s " name;
6468            generate_c_call_args ~handle:"g" style;
6469            pr ";\n";
6470            do_cleanups ();
6471            pr "      if (r == -1)\n";
6472            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6473        | RInt n
6474        | RBool n ->
6475            pr "PREINIT:\n";
6476            pr "      int %s;\n" n;
6477            pr "   CODE:\n";
6478            pr "      %s = guestfs_%s " n name;
6479            generate_c_call_args ~handle:"g" style;
6480            pr ";\n";
6481            do_cleanups ();
6482            pr "      if (%s == -1)\n" n;
6483            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6484            pr "      RETVAL = newSViv (%s);\n" n;
6485            pr " OUTPUT:\n";
6486            pr "      RETVAL\n"
6487        | RInt64 n ->
6488            pr "PREINIT:\n";
6489            pr "      int64_t %s;\n" n;
6490            pr "   CODE:\n";
6491            pr "      %s = guestfs_%s " n name;
6492            generate_c_call_args ~handle:"g" style;
6493            pr ";\n";
6494            do_cleanups ();
6495            pr "      if (%s == -1)\n" n;
6496            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6497            pr "      RETVAL = my_newSVll (%s);\n" n;
6498            pr " OUTPUT:\n";
6499            pr "      RETVAL\n"
6500        | RConstString n ->
6501            pr "PREINIT:\n";
6502            pr "      const char *%s;\n" n;
6503            pr "   CODE:\n";
6504            pr "      %s = guestfs_%s " n name;
6505            generate_c_call_args ~handle:"g" style;
6506            pr ";\n";
6507            do_cleanups ();
6508            pr "      if (%s == NULL)\n" n;
6509            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6510            pr "      RETVAL = newSVpv (%s, 0);\n" n;
6511            pr " OUTPUT:\n";
6512            pr "      RETVAL\n"
6513        | RConstOptString n ->
6514            pr "PREINIT:\n";
6515            pr "      const char *%s;\n" n;
6516            pr "   CODE:\n";
6517            pr "      %s = guestfs_%s " n name;
6518            generate_c_call_args ~handle:"g" style;
6519            pr ";\n";
6520            do_cleanups ();
6521            pr "      if (%s == NULL)\n" n;
6522            pr "        RETVAL = &PL_sv_undef;\n";
6523            pr "      else\n";
6524            pr "        RETVAL = newSVpv (%s, 0);\n" n;
6525            pr " OUTPUT:\n";
6526            pr "      RETVAL\n"
6527        | RString n ->
6528            pr "PREINIT:\n";
6529            pr "      char *%s;\n" n;
6530            pr "   CODE:\n";
6531            pr "      %s = guestfs_%s " n name;
6532            generate_c_call_args ~handle:"g" style;
6533            pr ";\n";
6534            do_cleanups ();
6535            pr "      if (%s == NULL)\n" n;
6536            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6537            pr "      RETVAL = newSVpv (%s, 0);\n" n;
6538            pr "      free (%s);\n" n;
6539            pr " OUTPUT:\n";
6540            pr "      RETVAL\n"
6541        | RStringList n | RHashtable n ->
6542            pr "PREINIT:\n";
6543            pr "      char **%s;\n" n;
6544            pr "      int i, n;\n";
6545            pr " PPCODE:\n";
6546            pr "      %s = guestfs_%s " n name;
6547            generate_c_call_args ~handle:"g" style;
6548            pr ";\n";
6549            do_cleanups ();
6550            pr "      if (%s == NULL)\n" n;
6551            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6552            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
6553            pr "      EXTEND (SP, n);\n";
6554            pr "      for (i = 0; i < n; ++i) {\n";
6555            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
6556            pr "        free (%s[i]);\n" n;
6557            pr "      }\n";
6558            pr "      free (%s);\n" n;
6559        | RStruct (n, typ) ->
6560            let cols = cols_of_struct typ in
6561            generate_perl_struct_code typ cols name style n do_cleanups
6562        | RStructList (n, typ) ->
6563            let cols = cols_of_struct typ in
6564            generate_perl_struct_list_code typ cols name style n do_cleanups
6565        | RBufferOut n ->
6566            pr "PREINIT:\n";
6567            pr "      char *%s;\n" n;
6568            pr "      size_t size;\n";
6569            pr "   CODE:\n";
6570            pr "      %s = guestfs_%s " n name;
6571            generate_c_call_args ~handle:"g" style;
6572            pr ";\n";
6573            do_cleanups ();
6574            pr "      if (%s == NULL)\n" n;
6575            pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6576            pr "      RETVAL = newSVpv (%s, size);\n" n;
6577            pr "      free (%s);\n" n;
6578            pr " OUTPUT:\n";
6579            pr "      RETVAL\n"
6580       );
6581
6582       pr "\n"
6583   ) all_functions
6584
6585 and generate_perl_struct_list_code typ cols name style n do_cleanups =
6586   pr "PREINIT:\n";
6587   pr "      struct guestfs_%s_list *%s;\n" typ n;
6588   pr "      int i;\n";
6589   pr "      HV *hv;\n";
6590   pr " PPCODE:\n";
6591   pr "      %s = guestfs_%s " n name;
6592   generate_c_call_args ~handle:"g" style;
6593   pr ";\n";
6594   do_cleanups ();
6595   pr "      if (%s == NULL)\n" n;
6596   pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6597   pr "      EXTEND (SP, %s->len);\n" n;
6598   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
6599   pr "        hv = newHV ();\n";
6600   List.iter (
6601     function
6602     | name, FString ->
6603         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
6604           name (String.length name) n name
6605     | name, FUUID ->
6606         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
6607           name (String.length name) n name
6608     | name, FBuffer ->
6609         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
6610           name (String.length name) n name n name
6611     | name, (FBytes|FUInt64) ->
6612         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
6613           name (String.length name) n name
6614     | name, FInt64 ->
6615         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
6616           name (String.length name) n name
6617     | name, (FInt32|FUInt32) ->
6618         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
6619           name (String.length name) n name
6620     | name, FChar ->
6621         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
6622           name (String.length name) n name
6623     | name, FOptPercent ->
6624         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
6625           name (String.length name) n name
6626   ) cols;
6627   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
6628   pr "      }\n";
6629   pr "      guestfs_free_%s_list (%s);\n" typ n
6630
6631 and generate_perl_struct_code typ cols name style n do_cleanups =
6632   pr "PREINIT:\n";
6633   pr "      struct guestfs_%s *%s;\n" typ n;
6634   pr " PPCODE:\n";
6635   pr "      %s = guestfs_%s " n name;
6636   generate_c_call_args ~handle:"g" style;
6637   pr ";\n";
6638   do_cleanups ();
6639   pr "      if (%s == NULL)\n" n;
6640   pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
6641   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
6642   List.iter (
6643     fun ((name, _) as col) ->
6644       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
6645
6646       match col with
6647       | name, FString ->
6648           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
6649             n name
6650       | name, FBuffer ->
6651           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, %s->%s_len)));\n"
6652             n name n name
6653       | name, FUUID ->
6654           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
6655             n name
6656       | name, (FBytes|FUInt64) ->
6657           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
6658             n name
6659       | name, FInt64 ->
6660           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
6661             n name
6662       | name, (FInt32|FUInt32) ->
6663           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
6664             n name
6665       | name, FChar ->
6666           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
6667             n name
6668       | name, FOptPercent ->
6669           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
6670             n name
6671   ) cols;
6672   pr "      free (%s);\n" n
6673
6674 (* Generate Sys/Guestfs.pm. *)
6675 and generate_perl_pm () =
6676   generate_header HashStyle LGPLv2;
6677
6678   pr "\
6679 =pod
6680
6681 =head1 NAME
6682
6683 Sys::Guestfs - Perl bindings for libguestfs
6684
6685 =head1 SYNOPSIS
6686
6687  use Sys::Guestfs;
6688
6689  my $h = Sys::Guestfs->new ();
6690  $h->add_drive ('guest.img');
6691  $h->launch ();
6692  $h->wait_ready ();
6693  $h->mount ('/dev/sda1', '/');
6694  $h->touch ('/hello');
6695  $h->sync ();
6696
6697 =head1 DESCRIPTION
6698
6699 The C<Sys::Guestfs> module provides a Perl XS binding to the
6700 libguestfs API for examining and modifying virtual machine
6701 disk images.
6702
6703 Amongst the things this is good for: making batch configuration
6704 changes to guests, getting disk used/free statistics (see also:
6705 virt-df), migrating between virtualization systems (see also:
6706 virt-p2v), performing partial backups, performing partial guest
6707 clones, cloning guests and changing registry/UUID/hostname info, and
6708 much else besides.
6709
6710 Libguestfs uses Linux kernel and qemu code, and can access any type of
6711 guest filesystem that Linux and qemu can, including but not limited
6712 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
6713 schemes, qcow, qcow2, vmdk.
6714
6715 Libguestfs provides ways to enumerate guest storage (eg. partitions,
6716 LVs, what filesystem is in each LV, etc.).  It can also run commands
6717 in the context of the guest.  Also you can access filesystems over FTP.
6718
6719 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
6720 functions for using libguestfs from Perl, including integration
6721 with libvirt.
6722
6723 =head1 ERRORS
6724
6725 All errors turn into calls to C<croak> (see L<Carp(3)>).
6726
6727 =head1 METHODS
6728
6729 =over 4
6730
6731 =cut
6732
6733 package Sys::Guestfs;
6734
6735 use strict;
6736 use warnings;
6737
6738 require XSLoader;
6739 XSLoader::load ('Sys::Guestfs');
6740
6741 =item $h = Sys::Guestfs->new ();
6742
6743 Create a new guestfs handle.
6744
6745 =cut
6746
6747 sub new {
6748   my $proto = shift;
6749   my $class = ref ($proto) || $proto;
6750
6751   my $self = Sys::Guestfs::_create ();
6752   bless $self, $class;
6753   return $self;
6754 }
6755
6756 ";
6757
6758   (* Actions.  We only need to print documentation for these as
6759    * they are pulled in from the XS code automatically.
6760    *)
6761   List.iter (
6762     fun (name, style, _, flags, _, _, longdesc) ->
6763       if not (List.mem NotInDocs flags) then (
6764         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
6765         pr "=item ";
6766         generate_perl_prototype name style;
6767         pr "\n\n";
6768         pr "%s\n\n" longdesc;
6769         if List.mem ProtocolLimitWarning flags then
6770           pr "%s\n\n" protocol_limit_warning;
6771         if List.mem DangerWillRobinson flags then
6772           pr "%s\n\n" danger_will_robinson;
6773         match deprecation_notice flags with
6774         | None -> ()
6775         | Some txt -> pr "%s\n\n" txt
6776       )
6777   ) all_functions_sorted;
6778
6779   (* End of file. *)
6780   pr "\
6781 =cut
6782
6783 1;
6784
6785 =back
6786
6787 =head1 COPYRIGHT
6788
6789 Copyright (C) 2009 Red Hat Inc.
6790
6791 =head1 LICENSE
6792
6793 Please see the file COPYING.LIB for the full license.
6794
6795 =head1 SEE ALSO
6796
6797 L<guestfs(3)>,
6798 L<guestfish(1)>,
6799 L<http://libguestfs.org>,
6800 L<Sys::Guestfs::Lib(3)>.
6801
6802 =cut
6803 "
6804
6805 and generate_perl_prototype name style =
6806   (match fst style with
6807    | RErr -> ()
6808    | RBool n
6809    | RInt n
6810    | RInt64 n
6811    | RConstString n
6812    | RConstOptString n
6813    | RString n
6814    | RBufferOut n -> pr "$%s = " n
6815    | RStruct (n,_)
6816    | RHashtable n -> pr "%%%s = " n
6817    | RStringList n
6818    | RStructList (n,_) -> pr "@%s = " n
6819   );
6820   pr "$h->%s (" name;
6821   let comma = ref false in
6822   List.iter (
6823     fun arg ->
6824       if !comma then pr ", ";
6825       comma := true;
6826       match arg with
6827       | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
6828           pr "$%s" n
6829       | StringList n ->
6830           pr "\\@%s" n
6831   ) (snd style);
6832   pr ");"
6833
6834 (* Generate Python C module. *)
6835 and generate_python_c () =
6836   generate_header CStyle LGPLv2;
6837
6838   pr "\
6839 #include <stdio.h>
6840 #include <stdlib.h>
6841 #include <assert.h>
6842
6843 #include <Python.h>
6844
6845 #include \"guestfs.h\"
6846
6847 typedef struct {
6848   PyObject_HEAD
6849   guestfs_h *g;
6850 } Pyguestfs_Object;
6851
6852 static guestfs_h *
6853 get_handle (PyObject *obj)
6854 {
6855   assert (obj);
6856   assert (obj != Py_None);
6857   return ((Pyguestfs_Object *) obj)->g;
6858 }
6859
6860 static PyObject *
6861 put_handle (guestfs_h *g)
6862 {
6863   assert (g);
6864   return
6865     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
6866 }
6867
6868 /* This list should be freed (but not the strings) after use. */
6869 static const char **
6870 get_string_list (PyObject *obj)
6871 {
6872   int i, len;
6873   const char **r;
6874
6875   assert (obj);
6876
6877   if (!PyList_Check (obj)) {
6878     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
6879     return NULL;
6880   }
6881
6882   len = PyList_Size (obj);
6883   r = malloc (sizeof (char *) * (len+1));
6884   if (r == NULL) {
6885     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
6886     return NULL;
6887   }
6888
6889   for (i = 0; i < len; ++i)
6890     r[i] = PyString_AsString (PyList_GetItem (obj, i));
6891   r[len] = NULL;
6892
6893   return r;
6894 }
6895
6896 static PyObject *
6897 put_string_list (char * const * const argv)
6898 {
6899   PyObject *list;
6900   int argc, i;
6901
6902   for (argc = 0; argv[argc] != NULL; ++argc)
6903     ;
6904
6905   list = PyList_New (argc);
6906   for (i = 0; i < argc; ++i)
6907     PyList_SetItem (list, i, PyString_FromString (argv[i]));
6908
6909   return list;
6910 }
6911
6912 static PyObject *
6913 put_table (char * const * const argv)
6914 {
6915   PyObject *list, *item;
6916   int argc, i;
6917
6918   for (argc = 0; argv[argc] != NULL; ++argc)
6919     ;
6920
6921   list = PyList_New (argc >> 1);
6922   for (i = 0; i < argc; i += 2) {
6923     item = PyTuple_New (2);
6924     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
6925     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
6926     PyList_SetItem (list, i >> 1, item);
6927   }
6928
6929   return list;
6930 }
6931
6932 static void
6933 free_strings (char **argv)
6934 {
6935   int argc;
6936
6937   for (argc = 0; argv[argc] != NULL; ++argc)
6938     free (argv[argc]);
6939   free (argv);
6940 }
6941
6942 static PyObject *
6943 py_guestfs_create (PyObject *self, PyObject *args)
6944 {
6945   guestfs_h *g;
6946
6947   g = guestfs_create ();
6948   if (g == NULL) {
6949     PyErr_SetString (PyExc_RuntimeError,
6950                      \"guestfs.create: failed to allocate handle\");
6951     return NULL;
6952   }
6953   guestfs_set_error_handler (g, NULL, NULL);
6954   return put_handle (g);
6955 }
6956
6957 static PyObject *
6958 py_guestfs_close (PyObject *self, PyObject *args)
6959 {
6960   PyObject *py_g;
6961   guestfs_h *g;
6962
6963   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
6964     return NULL;
6965   g = get_handle (py_g);
6966
6967   guestfs_close (g);
6968
6969   Py_INCREF (Py_None);
6970   return Py_None;
6971 }
6972
6973 ";
6974
6975   (* Structures, turned into Python dictionaries. *)
6976   List.iter (
6977     fun (typ, cols) ->
6978       pr "static PyObject *\n";
6979       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
6980       pr "{\n";
6981       pr "  PyObject *dict;\n";
6982       pr "\n";
6983       pr "  dict = PyDict_New ();\n";
6984       List.iter (
6985         function
6986         | name, FString ->
6987             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
6988             pr "                        PyString_FromString (%s->%s));\n"
6989               typ name
6990         | name, FBuffer ->
6991             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
6992             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
6993               typ name typ name
6994         | name, FUUID ->
6995             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
6996             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
6997               typ name
6998         | name, (FBytes|FUInt64) ->
6999             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
7000             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
7001               typ name
7002         | name, FInt64 ->
7003             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
7004             pr "                        PyLong_FromLongLong (%s->%s));\n"
7005               typ name
7006         | name, FUInt32 ->
7007             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
7008             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
7009               typ name
7010         | name, FInt32 ->
7011             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
7012             pr "                        PyLong_FromLong (%s->%s));\n"
7013               typ name
7014         | name, FOptPercent ->
7015             pr "  if (%s->%s >= 0)\n" typ name;
7016             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
7017             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
7018               typ name;
7019             pr "  else {\n";
7020             pr "    Py_INCREF (Py_None);\n";
7021             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);" name;
7022             pr "  }\n"
7023         | name, FChar ->
7024             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
7025             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
7026       ) cols;
7027       pr "  return dict;\n";
7028       pr "};\n";
7029       pr "\n";
7030
7031       pr "static PyObject *\n";
7032       pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
7033       pr "{\n";
7034       pr "  PyObject *list;\n";
7035       pr "  int i;\n";
7036       pr "\n";
7037       pr "  list = PyList_New (%ss->len);\n" typ;
7038       pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
7039       pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
7040       pr "  return list;\n";
7041       pr "};\n";
7042       pr "\n"
7043   ) structs;
7044
7045   (* Python wrapper functions. *)
7046   List.iter (
7047     fun (name, style, _, _, _, _, _) ->
7048       pr "static PyObject *\n";
7049       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
7050       pr "{\n";
7051
7052       pr "  PyObject *py_g;\n";
7053       pr "  guestfs_h *g;\n";
7054       pr "  PyObject *py_r;\n";
7055
7056       let error_code =
7057         match fst style with
7058         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
7059         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
7060         | RConstString _ | RConstOptString _ ->
7061             pr "  const char *r;\n"; "NULL"
7062         | RString _ -> pr "  char *r;\n"; "NULL"
7063         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
7064         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
7065         | RStructList (_, typ) ->
7066             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
7067         | RBufferOut _ ->
7068             pr "  char *r;\n";
7069             pr "  size_t size;\n";
7070             "NULL" in
7071
7072       List.iter (
7073         function
7074         | String n | FileIn n | FileOut n -> pr "  const char *%s;\n" n
7075         | OptString n -> pr "  const char *%s;\n" n
7076         | StringList n ->
7077             pr "  PyObject *py_%s;\n" n;
7078             pr "  const char **%s;\n" n
7079         | Bool n -> pr "  int %s;\n" n
7080         | Int n -> pr "  int %s;\n" n
7081       ) (snd style);
7082
7083       pr "\n";
7084
7085       (* Convert the parameters. *)
7086       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
7087       List.iter (
7088         function
7089         | String _ | FileIn _ | FileOut _ -> pr "s"
7090         | OptString _ -> pr "z"
7091         | StringList _ -> pr "O"
7092         | Bool _ -> pr "i" (* XXX Python has booleans? *)
7093         | Int _ -> pr "i"
7094       ) (snd style);
7095       pr ":guestfs_%s\",\n" name;
7096       pr "                         &py_g";
7097       List.iter (
7098         function
7099         | String n | FileIn n | FileOut n -> pr ", &%s" n
7100         | OptString n -> pr ", &%s" n
7101         | StringList n -> pr ", &py_%s" n
7102         | Bool n -> pr ", &%s" n
7103         | Int n -> pr ", &%s" n
7104       ) (snd style);
7105
7106       pr "))\n";
7107       pr "    return NULL;\n";
7108
7109       pr "  g = get_handle (py_g);\n";
7110       List.iter (
7111         function
7112         | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
7113         | StringList n ->
7114             pr "  %s = get_string_list (py_%s);\n" n n;
7115             pr "  if (!%s) return NULL;\n" n
7116       ) (snd style);
7117
7118       pr "\n";
7119
7120       pr "  r = guestfs_%s " name;
7121       generate_c_call_args ~handle:"g" style;
7122       pr ";\n";
7123
7124       List.iter (
7125         function
7126         | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
7127         | StringList n ->
7128             pr "  free (%s);\n" n
7129       ) (snd style);
7130
7131       pr "  if (r == %s) {\n" error_code;
7132       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
7133       pr "    return NULL;\n";
7134       pr "  }\n";
7135       pr "\n";
7136
7137       (match fst style with
7138        | RErr ->
7139            pr "  Py_INCREF (Py_None);\n";
7140            pr "  py_r = Py_None;\n"
7141        | RInt _
7142        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
7143        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
7144        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
7145        | RConstOptString _ ->
7146            pr "  if (r)\n";
7147            pr "    py_r = PyString_FromString (r);\n";
7148            pr "  else {\n";
7149            pr "    Py_INCREF (Py_None);\n";
7150            pr "    py_r = Py_None;\n";
7151            pr "  }\n"
7152        | RString _ ->
7153            pr "  py_r = PyString_FromString (r);\n";
7154            pr "  free (r);\n"
7155        | RStringList _ ->
7156            pr "  py_r = put_string_list (r);\n";
7157            pr "  free_strings (r);\n"
7158        | RStruct (_, typ) ->
7159            pr "  py_r = put_%s (r);\n" typ;
7160            pr "  guestfs_free_%s (r);\n" typ
7161        | RStructList (_, typ) ->
7162            pr "  py_r = put_%s_list (r);\n" typ;
7163            pr "  guestfs_free_%s_list (r);\n" typ
7164        | RHashtable n ->
7165            pr "  py_r = put_table (r);\n";
7166            pr "  free_strings (r);\n"
7167        | RBufferOut _ ->
7168            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
7169            pr "  free (r);\n"
7170       );
7171
7172       pr "  return py_r;\n";
7173       pr "}\n";
7174       pr "\n"
7175   ) all_functions;
7176
7177   (* Table of functions. *)
7178   pr "static PyMethodDef methods[] = {\n";
7179   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
7180   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
7181   List.iter (
7182     fun (name, _, _, _, _, _, _) ->
7183       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
7184         name name
7185   ) all_functions;
7186   pr "  { NULL, NULL, 0, NULL }\n";
7187   pr "};\n";
7188   pr "\n";
7189
7190   (* Init function. *)
7191   pr "\
7192 void
7193 initlibguestfsmod (void)
7194 {
7195   static int initialized = 0;
7196
7197   if (initialized) return;
7198   Py_InitModule ((char *) \"libguestfsmod\", methods);
7199   initialized = 1;
7200 }
7201 "
7202
7203 (* Generate Python module. *)
7204 and generate_python_py () =
7205   generate_header HashStyle LGPLv2;
7206
7207   pr "\
7208 u\"\"\"Python bindings for libguestfs
7209
7210 import guestfs
7211 g = guestfs.GuestFS ()
7212 g.add_drive (\"guest.img\")
7213 g.launch ()
7214 g.wait_ready ()
7215 parts = g.list_partitions ()
7216
7217 The guestfs module provides a Python binding to the libguestfs API
7218 for examining and modifying virtual machine disk images.
7219
7220 Amongst the things this is good for: making batch configuration
7221 changes to guests, getting disk used/free statistics (see also:
7222 virt-df), migrating between virtualization systems (see also:
7223 virt-p2v), performing partial backups, performing partial guest
7224 clones, cloning guests and changing registry/UUID/hostname info, and
7225 much else besides.
7226
7227 Libguestfs uses Linux kernel and qemu code, and can access any type of
7228 guest filesystem that Linux and qemu can, including but not limited
7229 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
7230 schemes, qcow, qcow2, vmdk.
7231
7232 Libguestfs provides ways to enumerate guest storage (eg. partitions,
7233 LVs, what filesystem is in each LV, etc.).  It can also run commands
7234 in the context of the guest.  Also you can access filesystems over FTP.
7235
7236 Errors which happen while using the API are turned into Python
7237 RuntimeError exceptions.
7238
7239 To create a guestfs handle you usually have to perform the following
7240 sequence of calls:
7241
7242 # Create the handle, call add_drive at least once, and possibly
7243 # several times if the guest has multiple block devices:
7244 g = guestfs.GuestFS ()
7245 g.add_drive (\"guest.img\")
7246
7247 # Launch the qemu subprocess and wait for it to become ready:
7248 g.launch ()
7249 g.wait_ready ()
7250
7251 # Now you can issue commands, for example:
7252 logvols = g.lvs ()
7253
7254 \"\"\"
7255
7256 import libguestfsmod
7257
7258 class GuestFS:
7259     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
7260
7261     def __init__ (self):
7262         \"\"\"Create a new libguestfs handle.\"\"\"
7263         self._o = libguestfsmod.create ()
7264
7265     def __del__ (self):
7266         libguestfsmod.close (self._o)
7267
7268 ";
7269
7270   List.iter (
7271     fun (name, style, _, flags, _, _, longdesc) ->
7272       pr "    def %s " name;
7273       generate_py_call_args ~handle:"self" (snd style);
7274       pr ":\n";
7275
7276       if not (List.mem NotInDocs flags) then (
7277         let doc = replace_str longdesc "C<guestfs_" "C<g." in
7278         let doc =
7279           match fst style with
7280           | RErr | RInt _ | RInt64 _ | RBool _
7281           | RConstOptString _ | RConstString _
7282           | RString _ | RBufferOut _ -> doc
7283           | RStringList _ ->
7284               doc ^ "\n\nThis function returns a list of strings."
7285           | RStruct (_, typ) ->
7286               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
7287           | RStructList (_, typ) ->
7288               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
7289           | RHashtable _ ->
7290               doc ^ "\n\nThis function returns a dictionary." in
7291         let doc =
7292           if List.mem ProtocolLimitWarning flags then
7293             doc ^ "\n\n" ^ protocol_limit_warning
7294           else doc in
7295         let doc =
7296           if List.mem DangerWillRobinson flags then
7297             doc ^ "\n\n" ^ danger_will_robinson
7298           else doc in
7299         let doc =
7300           match deprecation_notice flags with
7301           | None -> doc
7302           | Some txt -> doc ^ "\n\n" ^ txt in
7303         let doc = pod2text ~width:60 name doc in
7304         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
7305         let doc = String.concat "\n        " doc in
7306         pr "        u\"\"\"%s\"\"\"\n" doc;
7307       );
7308       pr "        return libguestfsmod.%s " name;
7309       generate_py_call_args ~handle:"self._o" (snd style);
7310       pr "\n";
7311       pr "\n";
7312   ) all_functions
7313
7314 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
7315 and generate_py_call_args ~handle args =
7316   pr "(%s" handle;
7317   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
7318   pr ")"
7319
7320 (* Useful if you need the longdesc POD text as plain text.  Returns a
7321  * list of lines.
7322  *
7323  * Because this is very slow (the slowest part of autogeneration),
7324  * we memoize the results.
7325  *)
7326 and pod2text ~width name longdesc =
7327   let key = width, name, longdesc in
7328   try Hashtbl.find pod2text_memo key
7329   with Not_found ->
7330     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
7331     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
7332     close_out chan;
7333     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
7334     let chan = Unix.open_process_in cmd in
7335     let lines = ref [] in
7336     let rec loop i =
7337       let line = input_line chan in
7338       if i = 1 then             (* discard the first line of output *)
7339         loop (i+1)
7340       else (
7341         let line = triml line in
7342         lines := line :: !lines;
7343         loop (i+1)
7344       ) in
7345     let lines = try loop 1 with End_of_file -> List.rev !lines in
7346     Unix.unlink filename;
7347     (match Unix.close_process_in chan with
7348      | Unix.WEXITED 0 -> ()
7349      | Unix.WEXITED i ->
7350          failwithf "pod2text: process exited with non-zero status (%d)" i
7351      | Unix.WSIGNALED i | Unix.WSTOPPED i ->
7352          failwithf "pod2text: process signalled or stopped by signal %d" i
7353     );
7354     Hashtbl.add pod2text_memo key lines;
7355     let chan = open_out pod2text_memo_filename in
7356     output_value chan pod2text_memo;
7357     close_out chan;
7358     lines
7359
7360 (* Generate ruby bindings. *)
7361 and generate_ruby_c () =
7362   generate_header CStyle LGPLv2;
7363
7364   pr "\
7365 #include <stdio.h>
7366 #include <stdlib.h>
7367
7368 #include <ruby.h>
7369
7370 #include \"guestfs.h\"
7371
7372 #include \"extconf.h\"
7373
7374 /* For Ruby < 1.9 */
7375 #ifndef RARRAY_LEN
7376 #define RARRAY_LEN(r) (RARRAY((r))->len)
7377 #endif
7378
7379 static VALUE m_guestfs;                 /* guestfs module */
7380 static VALUE c_guestfs;                 /* guestfs_h handle */
7381 static VALUE e_Error;                   /* used for all errors */
7382
7383 static void ruby_guestfs_free (void *p)
7384 {
7385   if (!p) return;
7386   guestfs_close ((guestfs_h *) p);
7387 }
7388
7389 static VALUE ruby_guestfs_create (VALUE m)
7390 {
7391   guestfs_h *g;
7392
7393   g = guestfs_create ();
7394   if (!g)
7395     rb_raise (e_Error, \"failed to create guestfs handle\");
7396
7397   /* Don't print error messages to stderr by default. */
7398   guestfs_set_error_handler (g, NULL, NULL);
7399
7400   /* Wrap it, and make sure the close function is called when the
7401    * handle goes away.
7402    */
7403   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
7404 }
7405
7406 static VALUE ruby_guestfs_close (VALUE gv)
7407 {
7408   guestfs_h *g;
7409   Data_Get_Struct (gv, guestfs_h, g);
7410
7411   ruby_guestfs_free (g);
7412   DATA_PTR (gv) = NULL;
7413
7414   return Qnil;
7415 }
7416
7417 ";
7418
7419   List.iter (
7420     fun (name, style, _, _, _, _, _) ->
7421       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
7422       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
7423       pr ")\n";
7424       pr "{\n";
7425       pr "  guestfs_h *g;\n";
7426       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
7427       pr "  if (!g)\n";
7428       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
7429         name;
7430       pr "\n";
7431
7432       List.iter (
7433         function
7434         | String n | FileIn n | FileOut n ->
7435             pr "  Check_Type (%sv, T_STRING);\n" n;
7436             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
7437             pr "  if (!%s)\n" n;
7438             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
7439             pr "              \"%s\", \"%s\");\n" n name
7440         | OptString n ->
7441             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
7442         | StringList n ->
7443             pr "  char **%s;\n" n;
7444             pr "  Check_Type (%sv, T_ARRAY);\n" n;
7445             pr "  {\n";
7446             pr "    int i, len;\n";
7447             pr "    len = RARRAY_LEN (%sv);\n" n;
7448             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
7449               n;
7450             pr "    for (i = 0; i < len; ++i) {\n";
7451             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
7452             pr "      %s[i] = StringValueCStr (v);\n" n;
7453             pr "    }\n";
7454             pr "    %s[len] = NULL;\n" n;
7455             pr "  }\n";
7456         | Bool n ->
7457             pr "  int %s = RTEST (%sv);\n" n n
7458         | Int n ->
7459             pr "  int %s = NUM2INT (%sv);\n" n n
7460       ) (snd style);
7461       pr "\n";
7462
7463       let error_code =
7464         match fst style with
7465         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
7466         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
7467         | RConstString _ | RConstOptString _ ->
7468             pr "  const char *r;\n"; "NULL"
7469         | RString _ -> pr "  char *r;\n"; "NULL"
7470         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
7471         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
7472         | RStructList (_, typ) ->
7473             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
7474         | RBufferOut _ ->
7475             pr "  char *r;\n";
7476             pr "  size_t size;\n";
7477             "NULL" in
7478       pr "\n";
7479
7480       pr "  r = guestfs_%s " name;
7481       generate_c_call_args ~handle:"g" style;
7482       pr ";\n";
7483
7484       List.iter (
7485         function
7486         | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
7487         | StringList n ->
7488             pr "  free (%s);\n" n
7489       ) (snd style);
7490
7491       pr "  if (r == %s)\n" error_code;
7492       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
7493       pr "\n";
7494
7495       (match fst style with
7496        | RErr ->
7497            pr "  return Qnil;\n"
7498        | RInt _ | RBool _ ->
7499            pr "  return INT2NUM (r);\n"
7500        | RInt64 _ ->
7501            pr "  return ULL2NUM (r);\n"
7502        | RConstString _ ->
7503            pr "  return rb_str_new2 (r);\n";
7504        | RConstOptString _ ->
7505            pr "  if (r)\n";
7506            pr "    return rb_str_new2 (r);\n";
7507            pr "  else\n";
7508            pr "    return Qnil;\n";
7509        | RString _ ->
7510            pr "  VALUE rv = rb_str_new2 (r);\n";
7511            pr "  free (r);\n";
7512            pr "  return rv;\n";
7513        | RStringList _ ->
7514            pr "  int i, len = 0;\n";
7515            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
7516            pr "  VALUE rv = rb_ary_new2 (len);\n";
7517            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
7518            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
7519            pr "    free (r[i]);\n";
7520            pr "  }\n";
7521            pr "  free (r);\n";
7522            pr "  return rv;\n"
7523        | RStruct (_, typ) ->
7524            let cols = cols_of_struct typ in
7525            generate_ruby_struct_code typ cols
7526        | RStructList (_, typ) ->
7527            let cols = cols_of_struct typ in
7528            generate_ruby_struct_list_code typ cols
7529        | RHashtable _ ->
7530            pr "  VALUE rv = rb_hash_new ();\n";
7531            pr "  int i;\n";
7532            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
7533            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
7534            pr "    free (r[i]);\n";
7535            pr "    free (r[i+1]);\n";
7536            pr "  }\n";
7537            pr "  free (r);\n";
7538            pr "  return rv;\n"
7539        | RBufferOut _ ->
7540            pr "  VALUE rv = rb_str_new (r, size);\n";
7541            pr "  free (r);\n";
7542            pr "  return rv;\n";
7543       );
7544
7545       pr "}\n";
7546       pr "\n"
7547   ) all_functions;
7548
7549   pr "\
7550 /* Initialize the module. */
7551 void Init__guestfs ()
7552 {
7553   m_guestfs = rb_define_module (\"Guestfs\");
7554   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
7555   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
7556
7557   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
7558   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
7559
7560 ";
7561   (* Define the rest of the methods. *)
7562   List.iter (
7563     fun (name, style, _, _, _, _, _) ->
7564       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
7565       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
7566   ) all_functions;
7567
7568   pr "}\n"
7569
7570 (* Ruby code to return a struct. *)
7571 and generate_ruby_struct_code typ cols =
7572   pr "  VALUE rv = rb_hash_new ();\n";
7573   List.iter (
7574     function
7575     | name, FString ->
7576         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
7577     | name, FBuffer ->
7578         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
7579     | name, FUUID ->
7580         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
7581     | name, (FBytes|FUInt64) ->
7582         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
7583     | name, FInt64 ->
7584         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
7585     | name, FUInt32 ->
7586         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
7587     | name, FInt32 ->
7588         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
7589     | name, FOptPercent ->
7590         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
7591     | name, FChar -> (* XXX wrong? *)
7592         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
7593   ) cols;
7594   pr "  guestfs_free_%s (r);\n" typ;
7595   pr "  return rv;\n"
7596
7597 (* Ruby code to return a struct list. *)
7598 and generate_ruby_struct_list_code typ cols =
7599   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
7600   pr "  int i;\n";
7601   pr "  for (i = 0; i < r->len; ++i) {\n";
7602   pr "    VALUE hv = rb_hash_new ();\n";
7603   List.iter (
7604     function
7605     | name, FString ->
7606         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
7607     | name, FBuffer ->
7608         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
7609     | name, FUUID ->
7610         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
7611     | name, (FBytes|FUInt64) ->
7612         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
7613     | name, FInt64 ->
7614         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
7615     | name, FUInt32 ->
7616         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
7617     | name, FInt32 ->
7618         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
7619     | name, FOptPercent ->
7620         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
7621     | name, FChar -> (* XXX wrong? *)
7622         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
7623   ) cols;
7624   pr "    rb_ary_push (rv, hv);\n";
7625   pr "  }\n";
7626   pr "  guestfs_free_%s_list (r);\n" typ;
7627   pr "  return rv;\n"
7628
7629 (* Generate Java bindings GuestFS.java file. *)
7630 and generate_java_java () =
7631   generate_header CStyle LGPLv2;
7632
7633   pr "\
7634 package com.redhat.et.libguestfs;
7635
7636 import java.util.HashMap;
7637 import com.redhat.et.libguestfs.LibGuestFSException;
7638 import com.redhat.et.libguestfs.PV;
7639 import com.redhat.et.libguestfs.VG;
7640 import com.redhat.et.libguestfs.LV;
7641 import com.redhat.et.libguestfs.Stat;
7642 import com.redhat.et.libguestfs.StatVFS;
7643 import com.redhat.et.libguestfs.IntBool;
7644 import com.redhat.et.libguestfs.Dirent;
7645
7646 /**
7647  * The GuestFS object is a libguestfs handle.
7648  *
7649  * @author rjones
7650  */
7651 public class GuestFS {
7652   // Load the native code.
7653   static {
7654     System.loadLibrary (\"guestfs_jni\");
7655   }
7656
7657   /**
7658    * The native guestfs_h pointer.
7659    */
7660   long g;
7661
7662   /**
7663    * Create a libguestfs handle.
7664    *
7665    * @throws LibGuestFSException
7666    */
7667   public GuestFS () throws LibGuestFSException
7668   {
7669     g = _create ();
7670   }
7671   private native long _create () throws LibGuestFSException;
7672
7673   /**
7674    * Close a libguestfs handle.
7675    *
7676    * You can also leave handles to be collected by the garbage
7677    * collector, but this method ensures that the resources used
7678    * by the handle are freed up immediately.  If you call any
7679    * other methods after closing the handle, you will get an
7680    * exception.
7681    *
7682    * @throws LibGuestFSException
7683    */
7684   public void close () throws LibGuestFSException
7685   {
7686     if (g != 0)
7687       _close (g);
7688     g = 0;
7689   }
7690   private native void _close (long g) throws LibGuestFSException;
7691
7692   public void finalize () throws LibGuestFSException
7693   {
7694     close ();
7695   }
7696
7697 ";
7698
7699   List.iter (
7700     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7701       if not (List.mem NotInDocs flags); then (
7702         let doc = replace_str longdesc "C<guestfs_" "C<g." in
7703         let doc =
7704           if List.mem ProtocolLimitWarning flags then
7705             doc ^ "\n\n" ^ protocol_limit_warning
7706           else doc in
7707         let doc =
7708           if List.mem DangerWillRobinson flags then
7709             doc ^ "\n\n" ^ danger_will_robinson
7710           else doc in
7711         let doc =
7712           match deprecation_notice flags with
7713           | None -> doc
7714           | Some txt -> doc ^ "\n\n" ^ txt in
7715         let doc = pod2text ~width:60 name doc in
7716         let doc = List.map (            (* RHBZ#501883 *)
7717           function
7718           | "" -> "<p>"
7719           | nonempty -> nonempty
7720         ) doc in
7721         let doc = String.concat "\n   * " doc in
7722
7723         pr "  /**\n";
7724         pr "   * %s\n" shortdesc;
7725         pr "   * <p>\n";
7726         pr "   * %s\n" doc;
7727         pr "   * @throws LibGuestFSException\n";
7728         pr "   */\n";
7729         pr "  ";
7730       );
7731       generate_java_prototype ~public:true ~semicolon:false name style;
7732       pr "\n";
7733       pr "  {\n";
7734       pr "    if (g == 0)\n";
7735       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
7736         name;
7737       pr "    ";
7738       if fst style <> RErr then pr "return ";
7739       pr "_%s " name;
7740       generate_java_call_args ~handle:"g" (snd style);
7741       pr ";\n";
7742       pr "  }\n";
7743       pr "  ";
7744       generate_java_prototype ~privat:true ~native:true name style;
7745       pr "\n";
7746       pr "\n";
7747   ) all_functions;
7748
7749   pr "}\n"
7750
7751 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
7752 and generate_java_call_args ~handle args =
7753   pr "(%s" handle;
7754   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
7755   pr ")"
7756
7757 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
7758     ?(semicolon=true) name style =
7759   if privat then pr "private ";
7760   if public then pr "public ";
7761   if native then pr "native ";
7762
7763   (* return type *)
7764   (match fst style with
7765    | RErr -> pr "void ";
7766    | RInt _ -> pr "int ";
7767    | RInt64 _ -> pr "long ";
7768    | RBool _ -> pr "boolean ";
7769    | RConstString _ | RConstOptString _ | RString _
7770    | RBufferOut _ -> pr "String ";
7771    | RStringList _ -> pr "String[] ";
7772    | RStruct (_, typ) ->
7773        let name = java_name_of_struct typ in
7774        pr "%s " name;
7775    | RStructList (_, typ) ->
7776        let name = java_name_of_struct typ in
7777        pr "%s[] " name;
7778    | RHashtable _ -> pr "HashMap<String,String> ";
7779   );
7780
7781   if native then pr "_%s " name else pr "%s " name;
7782   pr "(";
7783   let needs_comma = ref false in
7784   if native then (
7785     pr "long g";
7786     needs_comma := true
7787   );
7788
7789   (* args *)
7790   List.iter (
7791     fun arg ->
7792       if !needs_comma then pr ", ";
7793       needs_comma := true;
7794
7795       match arg with
7796       | String n
7797       | OptString n
7798       | FileIn n
7799       | FileOut n ->
7800           pr "String %s" n
7801       | StringList n ->
7802           pr "String[] %s" n
7803       | Bool n ->
7804           pr "boolean %s" n
7805       | Int n ->
7806           pr "int %s" n
7807   ) (snd style);
7808
7809   pr ")\n";
7810   pr "    throws LibGuestFSException";
7811   if semicolon then pr ";"
7812
7813 and generate_java_struct jtyp cols =
7814   generate_header CStyle LGPLv2;
7815
7816   pr "\
7817 package com.redhat.et.libguestfs;
7818
7819 /**
7820  * Libguestfs %s structure.
7821  *
7822  * @author rjones
7823  * @see GuestFS
7824  */
7825 public class %s {
7826 " jtyp jtyp;
7827
7828   List.iter (
7829     function
7830     | name, FString
7831     | name, FUUID
7832     | name, FBuffer -> pr "  public String %s;\n" name
7833     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
7834     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
7835     | name, FChar -> pr "  public char %s;\n" name
7836     | name, FOptPercent ->
7837         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
7838         pr "  public float %s;\n" name
7839   ) cols;
7840
7841   pr "}\n"
7842
7843 and generate_java_c () =
7844   generate_header CStyle LGPLv2;
7845
7846   pr "\
7847 #include <stdio.h>
7848 #include <stdlib.h>
7849 #include <string.h>
7850
7851 #include \"com_redhat_et_libguestfs_GuestFS.h\"
7852 #include \"guestfs.h\"
7853
7854 /* Note that this function returns.  The exception is not thrown
7855  * until after the wrapper function returns.
7856  */
7857 static void
7858 throw_exception (JNIEnv *env, const char *msg)
7859 {
7860   jclass cl;
7861   cl = (*env)->FindClass (env,
7862                           \"com/redhat/et/libguestfs/LibGuestFSException\");
7863   (*env)->ThrowNew (env, cl, msg);
7864 }
7865
7866 JNIEXPORT jlong JNICALL
7867 Java_com_redhat_et_libguestfs_GuestFS__1create
7868   (JNIEnv *env, jobject obj)
7869 {
7870   guestfs_h *g;
7871
7872   g = guestfs_create ();
7873   if (g == NULL) {
7874     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
7875     return 0;
7876   }
7877   guestfs_set_error_handler (g, NULL, NULL);
7878   return (jlong) (long) g;
7879 }
7880
7881 JNIEXPORT void JNICALL
7882 Java_com_redhat_et_libguestfs_GuestFS__1close
7883   (JNIEnv *env, jobject obj, jlong jg)
7884 {
7885   guestfs_h *g = (guestfs_h *) (long) jg;
7886   guestfs_close (g);
7887 }
7888
7889 ";
7890
7891   List.iter (
7892     fun (name, style, _, _, _, _, _) ->
7893       pr "JNIEXPORT ";
7894       (match fst style with
7895        | RErr -> pr "void ";
7896        | RInt _ -> pr "jint ";
7897        | RInt64 _ -> pr "jlong ";
7898        | RBool _ -> pr "jboolean ";
7899        | RConstString _ | RConstOptString _ | RString _
7900        | RBufferOut _ -> pr "jstring ";
7901        | RStruct _ | RHashtable _ ->
7902            pr "jobject ";
7903        | RStringList _ | RStructList _ ->
7904            pr "jobjectArray ";
7905       );
7906       pr "JNICALL\n";
7907       pr "Java_com_redhat_et_libguestfs_GuestFS_";
7908       pr "%s" (replace_str ("_" ^ name) "_" "_1");
7909       pr "\n";
7910       pr "  (JNIEnv *env, jobject obj, jlong jg";
7911       List.iter (
7912         function
7913         | String n
7914         | OptString n
7915         | FileIn n
7916         | FileOut n ->
7917             pr ", jstring j%s" n
7918         | StringList n ->
7919             pr ", jobjectArray j%s" n
7920         | Bool n ->
7921             pr ", jboolean j%s" n
7922         | Int n ->
7923             pr ", jint j%s" n
7924       ) (snd style);
7925       pr ")\n";
7926       pr "{\n";
7927       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
7928       let error_code, no_ret =
7929         match fst style with
7930         | RErr -> pr "  int r;\n"; "-1", ""
7931         | RBool _
7932         | RInt _ -> pr "  int r;\n"; "-1", "0"
7933         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
7934         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
7935         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
7936         | RString _ ->
7937             pr "  jstring jr;\n";
7938             pr "  char *r;\n"; "NULL", "NULL"
7939         | RStringList _ ->
7940             pr "  jobjectArray jr;\n";
7941             pr "  int r_len;\n";
7942             pr "  jclass cl;\n";
7943             pr "  jstring jstr;\n";
7944             pr "  char **r;\n"; "NULL", "NULL"
7945         | RStruct (_, typ) ->
7946             pr "  jobject jr;\n";
7947             pr "  jclass cl;\n";
7948             pr "  jfieldID fl;\n";
7949             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
7950         | RStructList (_, typ) ->
7951             pr "  jobjectArray jr;\n";
7952             pr "  jclass cl;\n";
7953             pr "  jfieldID fl;\n";
7954             pr "  jobject jfl;\n";
7955             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
7956         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
7957         | RBufferOut _ ->
7958             pr "  jstring jr;\n";
7959             pr "  char *r;\n";
7960             pr "  size_t size;\n";
7961             "NULL", "NULL" in
7962       List.iter (
7963         function
7964         | String n
7965         | OptString n
7966         | FileIn n
7967         | FileOut n ->
7968             pr "  const char *%s;\n" n
7969         | StringList n ->
7970             pr "  int %s_len;\n" n;
7971             pr "  const char **%s;\n" n
7972         | Bool n
7973         | Int n ->
7974             pr "  int %s;\n" n
7975       ) (snd style);
7976
7977       let needs_i =
7978         (match fst style with
7979          | RStringList _ | RStructList _ -> true
7980          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
7981          | RConstOptString _
7982          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
7983           List.exists (function StringList _ -> true | _ -> false) (snd style) in
7984       if needs_i then
7985         pr "  int i;\n";
7986
7987       pr "\n";
7988
7989       (* Get the parameters. *)
7990       List.iter (
7991         function
7992         | String n
7993         | FileIn n
7994         | FileOut n ->
7995             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
7996         | OptString n ->
7997             (* This is completely undocumented, but Java null becomes
7998              * a NULL parameter.
7999              *)
8000             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
8001         | StringList n ->
8002             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
8003             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
8004             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
8005             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
8006               n;
8007             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
8008             pr "  }\n";
8009             pr "  %s[%s_len] = NULL;\n" n n;
8010         | Bool n
8011         | Int n ->
8012             pr "  %s = j%s;\n" n n
8013       ) (snd style);
8014
8015       (* Make the call. *)
8016       pr "  r = guestfs_%s " name;
8017       generate_c_call_args ~handle:"g" style;
8018       pr ";\n";
8019
8020       (* Release the parameters. *)
8021       List.iter (
8022         function
8023         | String n
8024         | FileIn n
8025         | FileOut n ->
8026             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
8027         | OptString n ->
8028             pr "  if (j%s)\n" n;
8029             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
8030         | StringList n ->
8031             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
8032             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
8033               n;
8034             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
8035             pr "  }\n";
8036             pr "  free (%s);\n" n
8037         | Bool n
8038         | Int n -> ()
8039       ) (snd style);
8040
8041       (* Check for errors. *)
8042       pr "  if (r == %s) {\n" error_code;
8043       pr "    throw_exception (env, guestfs_last_error (g));\n";
8044       pr "    return %s;\n" no_ret;
8045       pr "  }\n";
8046
8047       (* Return value. *)
8048       (match fst style with
8049        | RErr -> ()
8050        | RInt _ -> pr "  return (jint) r;\n"
8051        | RBool _ -> pr "  return (jboolean) r;\n"
8052        | RInt64 _ -> pr "  return (jlong) r;\n"
8053        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
8054        | RConstOptString _ ->
8055            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
8056        | RString _ ->
8057            pr "  jr = (*env)->NewStringUTF (env, r);\n";
8058            pr "  free (r);\n";
8059            pr "  return jr;\n"
8060        | RStringList _ ->
8061            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
8062            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
8063            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
8064            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
8065            pr "  for (i = 0; i < r_len; ++i) {\n";
8066            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
8067            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
8068            pr "    free (r[i]);\n";
8069            pr "  }\n";
8070            pr "  free (r);\n";
8071            pr "  return jr;\n"
8072        | RStruct (_, typ) ->
8073            let jtyp = java_name_of_struct typ in
8074            let cols = cols_of_struct typ in
8075            generate_java_struct_return typ jtyp cols
8076        | RStructList (_, typ) ->
8077            let jtyp = java_name_of_struct typ in
8078            let cols = cols_of_struct typ in
8079            generate_java_struct_list_return typ jtyp cols
8080        | RHashtable _ ->
8081            (* XXX *)
8082            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
8083            pr "  return NULL;\n"
8084        | RBufferOut _ ->
8085            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
8086            pr "  free (r);\n";
8087            pr "  return jr;\n"
8088       );
8089
8090       pr "}\n";
8091       pr "\n"
8092   ) all_functions
8093
8094 and generate_java_struct_return typ jtyp cols =
8095   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
8096   pr "  jr = (*env)->AllocObject (env, cl);\n";
8097   List.iter (
8098     function
8099     | name, FString ->
8100         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
8101         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
8102     | name, FUUID ->
8103         pr "  {\n";
8104         pr "    char s[33];\n";
8105         pr "    memcpy (s, r->%s, 32);\n" name;
8106         pr "    s[32] = 0;\n";
8107         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
8108         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
8109         pr "  }\n";
8110     | name, FBuffer ->
8111         pr "  {\n";
8112         pr "    int len = r->%s_len;\n" name;
8113         pr "    char s[len+1];\n";
8114         pr "    memcpy (s, r->%s, len);\n" name;
8115         pr "    s[len] = 0;\n";
8116         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
8117         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
8118         pr "  }\n";
8119     | name, (FBytes|FUInt64|FInt64) ->
8120         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
8121         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
8122     | name, (FUInt32|FInt32) ->
8123         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
8124         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
8125     | name, FOptPercent ->
8126         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
8127         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
8128     | name, FChar ->
8129         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
8130         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
8131   ) cols;
8132   pr "  free (r);\n";
8133   pr "  return jr;\n"
8134
8135 and generate_java_struct_list_return typ jtyp cols =
8136   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
8137   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
8138   pr "  for (i = 0; i < r->len; ++i) {\n";
8139   pr "    jfl = (*env)->AllocObject (env, cl);\n";
8140   List.iter (
8141     function
8142     | name, FString ->
8143         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
8144         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
8145     | name, FUUID ->
8146         pr "    {\n";
8147         pr "      char s[33];\n";
8148         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
8149         pr "      s[32] = 0;\n";
8150         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
8151         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
8152         pr "    }\n";
8153     | name, FBuffer ->
8154         pr "    {\n";
8155         pr "      int len = r->val[i].%s_len;\n" name;
8156         pr "      char s[len+1];\n";
8157         pr "      memcpy (s, r->val[i].%s, len);\n" name;
8158         pr "      s[len] = 0;\n";
8159         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
8160         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
8161         pr "    }\n";
8162     | name, (FBytes|FUInt64|FInt64) ->
8163         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
8164         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
8165     | name, (FUInt32|FInt32) ->
8166         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
8167         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
8168     | name, FOptPercent ->
8169         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
8170         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
8171     | name, FChar ->
8172         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
8173         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
8174   ) cols;
8175   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
8176   pr "  }\n";
8177   pr "  guestfs_free_%s_list (r);\n" typ;
8178   pr "  return jr;\n"
8179
8180 and generate_haskell_hs () =
8181   generate_header HaskellStyle LGPLv2;
8182
8183   (* XXX We only know how to generate partial FFI for Haskell
8184    * at the moment.  Please help out!
8185    *)
8186   let can_generate style =
8187     match style with
8188     | RErr, _
8189     | RInt _, _
8190     | RInt64 _, _ -> true
8191     | RBool _, _
8192     | RConstString _, _
8193     | RConstOptString _, _
8194     | RString _, _
8195     | RStringList _, _
8196     | RStruct _, _
8197     | RStructList _, _
8198     | RHashtable _, _
8199     | RBufferOut _, _ -> false in
8200
8201   pr "\
8202 {-# INCLUDE <guestfs.h> #-}
8203 {-# LANGUAGE ForeignFunctionInterface #-}
8204
8205 module Guestfs (
8206   create";
8207
8208   (* List out the names of the actions we want to export. *)
8209   List.iter (
8210     fun (name, style, _, _, _, _, _) ->
8211       if can_generate style then pr ",\n  %s" name
8212   ) all_functions;
8213
8214   pr "
8215   ) where
8216 import Foreign
8217 import Foreign.C
8218 import Foreign.C.Types
8219 import IO
8220 import Control.Exception
8221 import Data.Typeable
8222
8223 data GuestfsS = GuestfsS            -- represents the opaque C struct
8224 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
8225 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
8226
8227 -- XXX define properly later XXX
8228 data PV = PV
8229 data VG = VG
8230 data LV = LV
8231 data IntBool = IntBool
8232 data Stat = Stat
8233 data StatVFS = StatVFS
8234 data Hashtable = Hashtable
8235
8236 foreign import ccall unsafe \"guestfs_create\" c_create
8237   :: IO GuestfsP
8238 foreign import ccall unsafe \"&guestfs_close\" c_close
8239   :: FunPtr (GuestfsP -> IO ())
8240 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
8241   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
8242
8243 create :: IO GuestfsH
8244 create = do
8245   p <- c_create
8246   c_set_error_handler p nullPtr nullPtr
8247   h <- newForeignPtr c_close p
8248   return h
8249
8250 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
8251   :: GuestfsP -> IO CString
8252
8253 -- last_error :: GuestfsH -> IO (Maybe String)
8254 -- last_error h = do
8255 --   str <- withForeignPtr h (\\p -> c_last_error p)
8256 --   maybePeek peekCString str
8257
8258 last_error :: GuestfsH -> IO (String)
8259 last_error h = do
8260   str <- withForeignPtr h (\\p -> c_last_error p)
8261   if (str == nullPtr)
8262     then return \"no error\"
8263     else peekCString str
8264
8265 ";
8266
8267   (* Generate wrappers for each foreign function. *)
8268   List.iter (
8269     fun (name, style, _, _, _, _, _) ->
8270       if can_generate style then (
8271         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
8272         pr "  :: ";
8273         generate_haskell_prototype ~handle:"GuestfsP" style;
8274         pr "\n";
8275         pr "\n";
8276         pr "%s :: " name;
8277         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
8278         pr "\n";
8279         pr "%s %s = do\n" name
8280           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
8281         pr "  r <- ";
8282         (* Convert pointer arguments using with* functions. *)
8283         List.iter (
8284           function
8285           | FileIn n
8286           | FileOut n
8287           | String n -> pr "withCString %s $ \\%s -> " n n
8288           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
8289           | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
8290           | Bool _ | Int _ -> ()
8291         ) (snd style);
8292         (* Convert integer arguments. *)
8293         let args =
8294           List.map (
8295             function
8296             | Bool n -> sprintf "(fromBool %s)" n
8297             | Int n -> sprintf "(fromIntegral %s)" n
8298             | FileIn n | FileOut n | String n | OptString n | StringList n -> n
8299           ) (snd style) in
8300         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
8301           (String.concat " " ("p" :: args));
8302         (match fst style with
8303          | RErr | RInt _ | RInt64 _ | RBool _ ->
8304              pr "  if (r == -1)\n";
8305              pr "    then do\n";
8306              pr "      err <- last_error h\n";
8307              pr "      fail err\n";
8308          | RConstString _ | RConstOptString _ | RString _
8309          | RStringList _ | RStruct _
8310          | RStructList _ | RHashtable _ | RBufferOut _ ->
8311              pr "  if (r == nullPtr)\n";
8312              pr "    then do\n";
8313              pr "      err <- last_error h\n";
8314              pr "      fail err\n";
8315         );
8316         (match fst style with
8317          | RErr ->
8318              pr "    else return ()\n"
8319          | RInt _ ->
8320              pr "    else return (fromIntegral r)\n"
8321          | RInt64 _ ->
8322              pr "    else return (fromIntegral r)\n"
8323          | RBool _ ->
8324              pr "    else return (toBool r)\n"
8325          | RConstString _
8326          | RConstOptString _
8327          | RString _
8328          | RStringList _
8329          | RStruct _
8330          | RStructList _
8331          | RHashtable _
8332          | RBufferOut _ ->
8333              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
8334         );
8335         pr "\n";
8336       )
8337   ) all_functions
8338
8339 and generate_haskell_prototype ~handle ?(hs = false) style =
8340   pr "%s -> " handle;
8341   let string = if hs then "String" else "CString" in
8342   let int = if hs then "Int" else "CInt" in
8343   let bool = if hs then "Bool" else "CInt" in
8344   let int64 = if hs then "Integer" else "Int64" in
8345   List.iter (
8346     fun arg ->
8347       (match arg with
8348        | String _ -> pr "%s" string
8349        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
8350        | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
8351        | Bool _ -> pr "%s" bool
8352        | Int _ -> pr "%s" int
8353        | FileIn _ -> pr "%s" string
8354        | FileOut _ -> pr "%s" string
8355       );
8356       pr " -> ";
8357   ) (snd style);
8358   pr "IO (";
8359   (match fst style with
8360    | RErr -> if not hs then pr "CInt"
8361    | RInt _ -> pr "%s" int
8362    | RInt64 _ -> pr "%s" int64
8363    | RBool _ -> pr "%s" bool
8364    | RConstString _ -> pr "%s" string
8365    | RConstOptString _ -> pr "Maybe %s" string
8366    | RString _ -> pr "%s" string
8367    | RStringList _ -> pr "[%s]" string
8368    | RStruct (_, typ) ->
8369        let name = java_name_of_struct typ in
8370        pr "%s" name
8371    | RStructList (_, typ) ->
8372        let name = java_name_of_struct typ in
8373        pr "[%s]" name
8374    | RHashtable _ -> pr "Hashtable"
8375    | RBufferOut _ -> pr "%s" string
8376   );
8377   pr ")"
8378
8379 and generate_bindtests () =
8380   generate_header CStyle LGPLv2;
8381
8382   pr "\
8383 #include <stdio.h>
8384 #include <stdlib.h>
8385 #include <inttypes.h>
8386 #include <string.h>
8387
8388 #include \"guestfs.h\"
8389 #include \"guestfs_protocol.h\"
8390
8391 #define error guestfs_error
8392 #define safe_calloc guestfs_safe_calloc
8393 #define safe_malloc guestfs_safe_malloc
8394
8395 static void
8396 print_strings (char * const* const argv)
8397 {
8398   int argc;
8399
8400   printf (\"[\");
8401   for (argc = 0; argv[argc] != NULL; ++argc) {
8402     if (argc > 0) printf (\", \");
8403     printf (\"\\\"%%s\\\"\", argv[argc]);
8404   }
8405   printf (\"]\\n\");
8406 }
8407
8408 /* The test0 function prints its parameters to stdout. */
8409 ";
8410
8411   let test0, tests =
8412     match test_functions with
8413     | [] -> assert false
8414     | test0 :: tests -> test0, tests in
8415
8416   let () =
8417     let (name, style, _, _, _, _, _) = test0 in
8418     generate_prototype ~extern:false ~semicolon:false ~newline:true
8419       ~handle:"g" ~prefix:"guestfs_" name style;
8420     pr "{\n";
8421     List.iter (
8422       function
8423       | String n
8424       | FileIn n
8425       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
8426       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
8427       | StringList n -> pr "  print_strings (%s);\n" n
8428       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
8429       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
8430     ) (snd style);
8431     pr "  /* Java changes stdout line buffering so we need this: */\n";
8432     pr "  fflush (stdout);\n";
8433     pr "  return 0;\n";
8434     pr "}\n";
8435     pr "\n" in
8436
8437   List.iter (
8438     fun (name, style, _, _, _, _, _) ->
8439       if String.sub name (String.length name - 3) 3 <> "err" then (
8440         pr "/* Test normal return. */\n";
8441         generate_prototype ~extern:false ~semicolon:false ~newline:true
8442           ~handle:"g" ~prefix:"guestfs_" name style;
8443         pr "{\n";
8444         (match fst style with
8445          | RErr ->
8446              pr "  return 0;\n"
8447          | RInt _ ->
8448              pr "  int r;\n";
8449              pr "  sscanf (val, \"%%d\", &r);\n";
8450              pr "  return r;\n"
8451          | RInt64 _ ->
8452              pr "  int64_t r;\n";
8453              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
8454              pr "  return r;\n"
8455          | RBool _ ->
8456              pr "  return strcmp (val, \"true\") == 0;\n"
8457          | RConstString _
8458          | RConstOptString _ ->
8459              (* Can't return the input string here.  Return a static
8460               * string so we ensure we get a segfault if the caller
8461               * tries to free it.
8462               *)
8463              pr "  return \"static string\";\n"
8464          | RString _ ->
8465              pr "  return strdup (val);\n"
8466          | RStringList _ ->
8467              pr "  char **strs;\n";
8468              pr "  int n, i;\n";
8469              pr "  sscanf (val, \"%%d\", &n);\n";
8470              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
8471              pr "  for (i = 0; i < n; ++i) {\n";
8472              pr "    strs[i] = safe_malloc (g, 16);\n";
8473              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
8474              pr "  }\n";
8475              pr "  strs[n] = NULL;\n";
8476              pr "  return strs;\n"
8477          | RStruct (_, typ) ->
8478              pr "  struct guestfs_%s *r;\n" typ;
8479              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
8480              pr "  return r;\n"
8481          | RStructList (_, typ) ->
8482              pr "  struct guestfs_%s_list *r;\n" typ;
8483              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
8484              pr "  sscanf (val, \"%%d\", &r->len);\n";
8485              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
8486              pr "  return r;\n"
8487          | RHashtable _ ->
8488              pr "  char **strs;\n";
8489              pr "  int n, i;\n";
8490              pr "  sscanf (val, \"%%d\", &n);\n";
8491              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
8492              pr "  for (i = 0; i < n; ++i) {\n";
8493              pr "    strs[i*2] = safe_malloc (g, 16);\n";
8494              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
8495              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
8496              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
8497              pr "  }\n";
8498              pr "  strs[n*2] = NULL;\n";
8499              pr "  return strs;\n"
8500          | RBufferOut _ ->
8501              pr "  return strdup (val);\n"
8502         );
8503         pr "}\n";
8504         pr "\n"
8505       ) else (
8506         pr "/* Test error return. */\n";
8507         generate_prototype ~extern:false ~semicolon:false ~newline:true
8508           ~handle:"g" ~prefix:"guestfs_" name style;
8509         pr "{\n";
8510         pr "  error (g, \"error\");\n";
8511         (match fst style with
8512          | RErr | RInt _ | RInt64 _ | RBool _ ->
8513              pr "  return -1;\n"
8514          | RConstString _ | RConstOptString _
8515          | RString _ | RStringList _ | RStruct _
8516          | RStructList _
8517          | RHashtable _
8518          | RBufferOut _ ->
8519              pr "  return NULL;\n"
8520         );
8521         pr "}\n";
8522         pr "\n"
8523       )
8524   ) tests
8525
8526 and generate_ocaml_bindtests () =
8527   generate_header OCamlStyle GPLv2;
8528
8529   pr "\
8530 let () =
8531   let g = Guestfs.create () in
8532 ";
8533
8534   let mkargs args =
8535     String.concat " " (
8536       List.map (
8537         function
8538         | CallString s -> "\"" ^ s ^ "\""
8539         | CallOptString None -> "None"
8540         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
8541         | CallStringList xs ->
8542             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
8543         | CallInt i when i >= 0 -> string_of_int i
8544         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
8545         | CallBool b -> string_of_bool b
8546       ) args
8547     )
8548   in
8549
8550   generate_lang_bindtests (
8551     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
8552   );
8553
8554   pr "print_endline \"EOF\"\n"
8555
8556 and generate_perl_bindtests () =
8557   pr "#!/usr/bin/perl -w\n";
8558   generate_header HashStyle GPLv2;
8559
8560   pr "\
8561 use strict;
8562
8563 use Sys::Guestfs;
8564
8565 my $g = Sys::Guestfs->new ();
8566 ";
8567
8568   let mkargs args =
8569     String.concat ", " (
8570       List.map (
8571         function
8572         | CallString s -> "\"" ^ s ^ "\""
8573         | CallOptString None -> "undef"
8574         | CallOptString (Some s) -> sprintf "\"%s\"" s
8575         | CallStringList xs ->
8576             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
8577         | CallInt i -> string_of_int i
8578         | CallBool b -> if b then "1" else "0"
8579       ) args
8580     )
8581   in
8582
8583   generate_lang_bindtests (
8584     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
8585   );
8586
8587   pr "print \"EOF\\n\"\n"
8588
8589 and generate_python_bindtests () =
8590   generate_header HashStyle GPLv2;
8591
8592   pr "\
8593 import guestfs
8594
8595 g = guestfs.GuestFS ()
8596 ";
8597
8598   let mkargs args =
8599     String.concat ", " (
8600       List.map (
8601         function
8602         | CallString s -> "\"" ^ s ^ "\""
8603         | CallOptString None -> "None"
8604         | CallOptString (Some s) -> sprintf "\"%s\"" s
8605         | CallStringList xs ->
8606             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
8607         | CallInt i -> string_of_int i
8608         | CallBool b -> if b then "1" else "0"
8609       ) args
8610     )
8611   in
8612
8613   generate_lang_bindtests (
8614     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
8615   );
8616
8617   pr "print \"EOF\"\n"
8618
8619 and generate_ruby_bindtests () =
8620   generate_header HashStyle GPLv2;
8621
8622   pr "\
8623 require 'guestfs'
8624
8625 g = Guestfs::create()
8626 ";
8627
8628   let mkargs args =
8629     String.concat ", " (
8630       List.map (
8631         function
8632         | CallString s -> "\"" ^ s ^ "\""
8633         | CallOptString None -> "nil"
8634         | CallOptString (Some s) -> sprintf "\"%s\"" s
8635         | CallStringList xs ->
8636             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
8637         | CallInt i -> string_of_int i
8638         | CallBool b -> string_of_bool b
8639       ) args
8640     )
8641   in
8642
8643   generate_lang_bindtests (
8644     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
8645   );
8646
8647   pr "print \"EOF\\n\"\n"
8648
8649 and generate_java_bindtests () =
8650   generate_header CStyle GPLv2;
8651
8652   pr "\
8653 import com.redhat.et.libguestfs.*;
8654
8655 public class Bindtests {
8656     public static void main (String[] argv)
8657     {
8658         try {
8659             GuestFS g = new GuestFS ();
8660 ";
8661
8662   let mkargs args =
8663     String.concat ", " (
8664       List.map (
8665         function
8666         | CallString s -> "\"" ^ s ^ "\""
8667         | CallOptString None -> "null"
8668         | CallOptString (Some s) -> sprintf "\"%s\"" s
8669         | CallStringList xs ->
8670             "new String[]{" ^
8671               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
8672         | CallInt i -> string_of_int i
8673         | CallBool b -> string_of_bool b
8674       ) args
8675     )
8676   in
8677
8678   generate_lang_bindtests (
8679     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
8680   );
8681
8682   pr "
8683             System.out.println (\"EOF\");
8684         }
8685         catch (Exception exn) {
8686             System.err.println (exn);
8687             System.exit (1);
8688         }
8689     }
8690 }
8691 "
8692
8693 and generate_haskell_bindtests () =
8694   generate_header HaskellStyle GPLv2;
8695
8696   pr "\
8697 module Bindtests where
8698 import qualified Guestfs
8699
8700 main = do
8701   g <- Guestfs.create
8702 ";
8703
8704   let mkargs args =
8705     String.concat " " (
8706       List.map (
8707         function
8708         | CallString s -> "\"" ^ s ^ "\""
8709         | CallOptString None -> "Nothing"
8710         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
8711         | CallStringList xs ->
8712             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
8713         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
8714         | CallInt i -> string_of_int i
8715         | CallBool true -> "True"
8716         | CallBool false -> "False"
8717       ) args
8718     )
8719   in
8720
8721   generate_lang_bindtests (
8722     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
8723   );
8724
8725   pr "  putStrLn \"EOF\"\n"
8726
8727 (* Language-independent bindings tests - we do it this way to
8728  * ensure there is parity in testing bindings across all languages.
8729  *)
8730 and generate_lang_bindtests call =
8731   call "test0" [CallString "abc"; CallOptString (Some "def");
8732                 CallStringList []; CallBool false;
8733                 CallInt 0; CallString "123"; CallString "456"];
8734   call "test0" [CallString "abc"; CallOptString None;
8735                 CallStringList []; CallBool false;
8736                 CallInt 0; CallString "123"; CallString "456"];
8737   call "test0" [CallString ""; CallOptString (Some "def");
8738                 CallStringList []; CallBool false;
8739                 CallInt 0; CallString "123"; CallString "456"];
8740   call "test0" [CallString ""; CallOptString (Some "");
8741                 CallStringList []; CallBool false;
8742                 CallInt 0; CallString "123"; CallString "456"];
8743   call "test0" [CallString "abc"; CallOptString (Some "def");
8744                 CallStringList ["1"]; CallBool false;
8745                 CallInt 0; CallString "123"; CallString "456"];
8746   call "test0" [CallString "abc"; CallOptString (Some "def");
8747                 CallStringList ["1"; "2"]; CallBool false;
8748                 CallInt 0; CallString "123"; CallString "456"];
8749   call "test0" [CallString "abc"; CallOptString (Some "def");
8750                 CallStringList ["1"]; CallBool true;
8751                 CallInt 0; CallString "123"; CallString "456"];
8752   call "test0" [CallString "abc"; CallOptString (Some "def");
8753                 CallStringList ["1"]; CallBool false;
8754                 CallInt (-1); CallString "123"; CallString "456"];
8755   call "test0" [CallString "abc"; CallOptString (Some "def");
8756                 CallStringList ["1"]; CallBool false;
8757                 CallInt (-2); CallString "123"; CallString "456"];
8758   call "test0" [CallString "abc"; CallOptString (Some "def");
8759                 CallStringList ["1"]; CallBool false;
8760                 CallInt 1; CallString "123"; CallString "456"];
8761   call "test0" [CallString "abc"; CallOptString (Some "def");
8762                 CallStringList ["1"]; CallBool false;
8763                 CallInt 2; CallString "123"; CallString "456"];
8764   call "test0" [CallString "abc"; CallOptString (Some "def");
8765                 CallStringList ["1"]; CallBool false;
8766                 CallInt 4095; CallString "123"; CallString "456"];
8767   call "test0" [CallString "abc"; CallOptString (Some "def");
8768                 CallStringList ["1"]; CallBool false;
8769                 CallInt 0; CallString ""; CallString ""]
8770
8771 (* XXX Add here tests of the return and error functions. *)
8772
8773 (* This is used to generate the src/MAX_PROC_NR file which
8774  * contains the maximum procedure number, a surrogate for the
8775  * ABI version number.  See src/Makefile.am for the details.
8776  *)
8777 and generate_max_proc_nr () =
8778   let proc_nrs = List.map (
8779     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
8780   ) daemon_functions in
8781
8782   let max_proc_nr = List.fold_left max 0 proc_nrs in
8783
8784   pr "%d\n" max_proc_nr
8785
8786 let output_to filename =
8787   let filename_new = filename ^ ".new" in
8788   chan := open_out filename_new;
8789   let close () =
8790     close_out !chan;
8791     chan := stdout;
8792
8793     (* Is the new file different from the current file? *)
8794     if Sys.file_exists filename && files_equal filename filename_new then
8795       Unix.unlink filename_new          (* same, so skip it *)
8796     else (
8797       (* different, overwrite old one *)
8798       (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
8799       Unix.rename filename_new filename;
8800       Unix.chmod filename 0o444;
8801       printf "written %s\n%!" filename;
8802     )
8803   in
8804   close
8805
8806 (* Main program. *)
8807 let () =
8808   check_functions ();
8809
8810   if not (Sys.file_exists "HACKING") then (
8811     eprintf "\
8812 You are probably running this from the wrong directory.
8813 Run it from the top source directory using the command
8814   src/generator.ml
8815 ";
8816     exit 1
8817   );
8818
8819   let close = output_to "src/guestfs_protocol.x" in
8820   generate_xdr ();
8821   close ();
8822
8823   let close = output_to "src/guestfs-structs.h" in
8824   generate_structs_h ();
8825   close ();
8826
8827   let close = output_to "src/guestfs-actions.h" in
8828   generate_actions_h ();
8829   close ();
8830
8831   let close = output_to "src/guestfs-actions.c" in
8832   generate_client_actions ();
8833   close ();
8834
8835   let close = output_to "daemon/actions.h" in
8836   generate_daemon_actions_h ();
8837   close ();
8838
8839   let close = output_to "daemon/stubs.c" in
8840   generate_daemon_actions ();
8841   close ();
8842
8843   let close = output_to "daemon/names.c" in
8844   generate_daemon_names ();
8845   close ();
8846
8847   let close = output_to "capitests/tests.c" in
8848   generate_tests ();
8849   close ();
8850
8851   let close = output_to "src/guestfs-bindtests.c" in
8852   generate_bindtests ();
8853   close ();
8854
8855   let close = output_to "fish/cmds.c" in
8856   generate_fish_cmds ();
8857   close ();
8858
8859   let close = output_to "fish/completion.c" in
8860   generate_fish_completion ();
8861   close ();
8862
8863   let close = output_to "guestfs-structs.pod" in
8864   generate_structs_pod ();
8865   close ();
8866
8867   let close = output_to "guestfs-actions.pod" in
8868   generate_actions_pod ();
8869   close ();
8870
8871   let close = output_to "guestfish-actions.pod" in
8872   generate_fish_actions_pod ();
8873   close ();
8874
8875   let close = output_to "ocaml/guestfs.mli" in
8876   generate_ocaml_mli ();
8877   close ();
8878
8879   let close = output_to "ocaml/guestfs.ml" in
8880   generate_ocaml_ml ();
8881   close ();
8882
8883   let close = output_to "ocaml/guestfs_c_actions.c" in
8884   generate_ocaml_c ();
8885   close ();
8886
8887   let close = output_to "ocaml/bindtests.ml" in
8888   generate_ocaml_bindtests ();
8889   close ();
8890
8891   let close = output_to "perl/Guestfs.xs" in
8892   generate_perl_xs ();
8893   close ();
8894
8895   let close = output_to "perl/lib/Sys/Guestfs.pm" in
8896   generate_perl_pm ();
8897   close ();
8898
8899   let close = output_to "perl/bindtests.pl" in
8900   generate_perl_bindtests ();
8901   close ();
8902
8903   let close = output_to "python/guestfs-py.c" in
8904   generate_python_c ();
8905   close ();
8906
8907   let close = output_to "python/guestfs.py" in
8908   generate_python_py ();
8909   close ();
8910
8911   let close = output_to "python/bindtests.py" in
8912   generate_python_bindtests ();
8913   close ();
8914
8915   let close = output_to "ruby/ext/guestfs/_guestfs.c" in
8916   generate_ruby_c ();
8917   close ();
8918
8919   let close = output_to "ruby/bindtests.rb" in
8920   generate_ruby_bindtests ();
8921   close ();
8922
8923   let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
8924   generate_java_java ();
8925   close ();
8926
8927   List.iter (
8928     fun (typ, jtyp) ->
8929       let cols = cols_of_struct typ in
8930       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
8931       let close = output_to filename in
8932       generate_java_struct jtyp cols;
8933       close ();
8934   ) java_structs;
8935
8936   let close = output_to "java/Makefile.inc" in
8937   pr "java_built_sources =";
8938   List.iter (
8939     fun (typ, jtyp) ->
8940         pr " com/redhat/et/libguestfs/%s.java" jtyp;
8941   ) java_structs;
8942   pr " com/redhat/et/libguestfs/GuestFS.java\n";
8943   close ();
8944
8945   let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
8946   generate_java_c ();
8947   close ();
8948
8949   let close = output_to "java/Bindtests.java" in
8950   generate_java_bindtests ();
8951   close ();
8952
8953   let close = output_to "haskell/Guestfs.hs" in
8954   generate_haskell_hs ();
8955   close ();
8956
8957   let close = output_to "haskell/Bindtests.hs" in
8958   generate_haskell_bindtests ();
8959   close ();
8960
8961   let close = output_to "src/MAX_PROC_NR" in
8962   generate_max_proc_nr ();
8963   close ();
8964
8965   (* Always generate this file last, and unconditionally.  It's used
8966    * by the Makefile to know when we must re-run the generator.
8967    *)
8968   let chan = open_out "src/stamp-generator" in
8969   fprintf chan "1\n";
8970   close_out chan