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