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