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