src/generator.ml

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