src/generator.ml

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