68b25e03652ba0107b5e670837166e58a822ad96
[libguestfs.git] / generator.ml
1 #!/usr/bin/env ocaml
2 (* libguestfs
3  * Copyright (C) 2009-2010 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 of
25  * 'daemon_functions' below), and daemon/<somefile>.c to write the
26  * implementation.
27  *
28  * After editing this file, run it (./src/generator.ml) to regenerate
29  * all the output files.  'make' will rerun this automatically when
30  * necessary.  Note that if you are using a separate build directory
31  * you must run generator.ml from the _source_ directory.
32  *
33  * IMPORTANT: This script should NOT print any warnings.  If it prints
34  * warnings, you should treat them as errors.
35  *
36  * OCaml tips:
37  * (1) In emacs, install tuareg-mode to display and format OCaml code
38  * correctly.  'vim' comes with a good OCaml editing mode by default.
39  * (2) Read the resources at http://ocaml-tutorial.org/
40  *)
41
42 #load "unix.cma";;
43 #load "str.cma";;
44 #directory "+xml-light";;
45 #directory "+../pkg-lib/xml-light";; (* for GODI users *)
46 #load "xml-light.cma";;
47
48 open Unix
49 open Printf
50
51 type style = ret * args
52 and ret =
53     (* "RErr" as a return value means an int used as a simple error
54      * indication, ie. 0 or -1.
55      *)
56   | RErr
57
58     (* "RInt" as a return value means an int which is -1 for error
59      * or any value >= 0 on success.  Only use this for smallish
60      * positive ints (0 <= i < 2^30).
61      *)
62   | RInt of string
63
64     (* "RInt64" is the same as RInt, but is guaranteed to be able
65      * to return a full 64 bit value, _except_ that -1 means error
66      * (so -1 cannot be a valid, non-error return value).
67      *)
68   | RInt64 of string
69
70     (* "RBool" is a bool return value which can be true/false or
71      * -1 for error.
72      *)
73   | RBool of string
74
75     (* "RConstString" is a string that refers to a constant value.
76      * The return value must NOT be NULL (since NULL indicates
77      * an error).
78      *
79      * Try to avoid using this.  In particular you cannot use this
80      * for values returned from the daemon, because there is no
81      * thread-safe way to return them in the C API.
82      *)
83   | RConstString of string
84
85     (* "RConstOptString" is an even more broken version of
86      * "RConstString".  The returned string may be NULL and there
87      * is no way to return an error indication.  Avoid using this!
88      *)
89   | RConstOptString of string
90
91     (* "RString" is a returned string.  It must NOT be NULL, since
92      * a NULL return indicates an error.  The caller frees this.
93      *)
94   | RString of string
95
96     (* "RStringList" is a list of strings.  No string in the list
97      * can be NULL.  The caller frees the strings and the array.
98      *)
99   | RStringList of string
100
101     (* "RStruct" is a function which returns a single named structure
102      * or an error indication (in C, a struct, and in other languages
103      * with varying representations, but usually very efficient).  See
104      * after the function list below for the structures.
105      *)
106   | RStruct of string * string          (* name of retval, name of struct *)
107
108     (* "RStructList" is a function which returns either a list/array
109      * of structures (could be zero-length), or an error indication.
110      *)
111   | RStructList of string * string      (* name of retval, name of struct *)
112
113     (* Key-value pairs of untyped strings.  Turns into a hashtable or
114      * dictionary in languages which support it.  DON'T use this as a
115      * general "bucket" for results.  Prefer a stronger typed return
116      * value if one is available, or write a custom struct.  Don't use
117      * this if the list could potentially be very long, since it is
118      * inefficient.  Keys should be unique.  NULLs are not permitted.
119      *)
120   | RHashtable of string
121
122     (* "RBufferOut" is handled almost exactly like RString, but
123      * it allows the string to contain arbitrary 8 bit data including
124      * ASCII NUL.  In the C API this causes an implicit extra parameter
125      * to be added of type <size_t *size_r>.  The extra parameter
126      * returns the actual size of the return buffer in bytes.
127      *
128      * Other programming languages support strings with arbitrary 8 bit
129      * data.
130      *
131      * At the RPC layer we have to use the opaque<> type instead of
132      * string<>.  Returned data is still limited to the max message
133      * size (ie. ~ 2 MB).
134      *)
135   | RBufferOut of string
136
137 and args = argt list    (* Function parameters, guestfs handle is implicit. *)
138
139     (* Note in future we should allow a "variable args" parameter as
140      * the final parameter, to allow commands like
141      *   chmod mode file [file(s)...]
142      * This is not implemented yet, but many commands (such as chmod)
143      * are currently defined with the argument order keeping this future
144      * possibility in mind.
145      *)
146 and argt =
147   | String of string    (* const char *name, cannot be NULL *)
148   | Device of string    (* /dev device name, cannot be NULL *)
149   | Pathname of string  (* file name, cannot be NULL *)
150   | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
151   | OptString of string (* const char *name, may be NULL *)
152   | StringList of string(* list of strings (each string cannot be NULL) *)
153   | DeviceList of string(* list of Device names (each cannot be NULL) *)
154   | Bool of string      (* boolean *)
155   | Int of string       (* int (smallish ints, signed, <= 31 bits) *)
156   | Int64 of string     (* any 64 bit int *)
157     (* These are treated as filenames (simple string parameters) in
158      * the C API and bindings.  But in the RPC protocol, we transfer
159      * the actual file content up to or down from the daemon.
160      * FileIn: local machine -> daemon (in request)
161      * FileOut: daemon -> local machine (in reply)
162      * In guestfish (only), the special name "-" means read from
163      * stdin or write to stdout.
164      *)
165   | FileIn of string
166   | FileOut of string
167 (* Not implemented:
168     (* Opaque buffer which can contain arbitrary 8 bit data.
169      * In the C API, this is expressed as <char *, int> pair.
170      * Most other languages have a string type which can contain
171      * ASCII NUL.  We use whatever type is appropriate for each
172      * language.
173      * Buffers are limited by the total message size.  To transfer
174      * large blocks of data, use FileIn/FileOut parameters instead.
175      * To return an arbitrary buffer, use RBufferOut.
176      *)
177   | BufferIn of string
178 *)
179
180 type flags =
181   | ProtocolLimitWarning  (* display warning about protocol size limits *)
182   | DangerWillRobinson    (* flags particularly dangerous commands *)
183   | FishAlias of string   (* provide an alias for this cmd in guestfish *)
184   | FishAction of string  (* call this function in guestfish *)
185   | NotInFish             (* do not export via guestfish *)
186   | NotInDocs             (* do not add this function to documentation *)
187   | DeprecatedBy of string (* function is deprecated, use .. instead *)
188   | Optional of string    (* function is part of an optional group *)
189
190 (* You can supply zero or as many tests as you want per API call.
191  *
192  * Note that the test environment has 3 block devices, of size 500MB,
193  * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
194  * a fourth ISO block device with some known files on it (/dev/sdd).
195  *
196  * Note for partitioning purposes, the 500MB device has 1015 cylinders.
197  * Number of cylinders was 63 for IDE emulated disks with precisely
198  * the same size.  How exactly this is calculated is a mystery.
199  *
200  * The ISO block device (/dev/sdd) comes from images/test.iso.
201  *
202  * To be able to run the tests in a reasonable amount of time,
203  * the virtual machine and block devices are reused between tests.
204  * So don't try testing kill_subprocess :-x
205  *
206  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
207  *
208  * Don't assume anything about the previous contents of the block
209  * devices.  Use 'Init*' to create some initial scenarios.
210  *
211  * You can add a prerequisite clause to any individual test.  This
212  * is a run-time check, which, if it fails, causes the test to be
213  * skipped.  Useful if testing a command which might not work on
214  * all variations of libguestfs builds.  A test that has prerequisite
215  * of 'Always' is run unconditionally.
216  *
217  * In addition, packagers can skip individual tests by setting the
218  * environment variables:     eg:
219  *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
220  *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)
221  *)
222 type tests = (test_init * test_prereq * test) list
223 and test =
224     (* Run the command sequence and just expect nothing to fail. *)
225   | TestRun of seq
226
227     (* Run the command sequence and expect the output of the final
228      * command to be the string.
229      *)
230   | TestOutput of seq * string
231
232     (* Run the command sequence and expect the output of the final
233      * command to be the list of strings.
234      *)
235   | TestOutputList of seq * string list
236
237     (* Run the command sequence and expect the output of the final
238      * command to be the list of block devices (could be either
239      * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
240      * character of each string).
241      *)
242   | TestOutputListOfDevices of seq * string list
243
244     (* Run the command sequence and expect the output of the final
245      * command to be the integer.
246      *)
247   | TestOutputInt of seq * int
248
249     (* Run the command sequence and expect the output of the final
250      * command to be <op> <int>, eg. ">=", "1".
251      *)
252   | TestOutputIntOp of seq * string * int
253
254     (* Run the command sequence and expect the output of the final
255      * command to be a true value (!= 0 or != NULL).
256      *)
257   | TestOutputTrue of seq
258
259     (* Run the command sequence and expect the output of the final
260      * command to be a false value (== 0 or == NULL, but not an error).
261      *)
262   | TestOutputFalse of seq
263
264     (* Run the command sequence and expect the output of the final
265      * command to be a list of the given length (but don't care about
266      * content).
267      *)
268   | TestOutputLength of seq * int
269
270     (* Run the command sequence and expect the output of the final
271      * command to be a buffer (RBufferOut), ie. string + size.
272      *)
273   | TestOutputBuffer of seq * string
274
275     (* Run the command sequence and expect the output of the final
276      * command to be a structure.
277      *)
278   | TestOutputStruct of seq * test_field_compare list
279
280     (* Run the command sequence and expect the final command (only)
281      * to fail.
282      *)
283   | TestLastFail of seq
284
285 and test_field_compare =
286   | CompareWithInt of string * int
287   | CompareWithIntOp of string * string * int
288   | CompareWithString of string * string
289   | CompareFieldsIntEq of string * string
290   | CompareFieldsStrEq of string * string
291
292 (* Test prerequisites. *)
293 and test_prereq =
294     (* Test always runs. *)
295   | Always
296
297     (* Test is currently disabled - eg. it fails, or it tests some
298      * unimplemented feature.
299      *)
300   | Disabled
301
302     (* 'string' is some C code (a function body) that should return
303      * true or false.  The test will run if the code returns true.
304      *)
305   | If of string
306
307     (* As for 'If' but the test runs _unless_ the code returns true. *)
308   | Unless of string
309
310 (* Some initial scenarios for testing. *)
311 and test_init =
312     (* Do nothing, block devices could contain random stuff including
313      * LVM PVs, and some filesystems might be mounted.  This is usually
314      * a bad idea.
315      *)
316   | InitNone
317
318     (* Block devices are empty and no filesystems are mounted. *)
319   | InitEmpty
320
321     (* /dev/sda contains a single partition /dev/sda1, with random
322      * content.  /dev/sdb and /dev/sdc may have random content.
323      * No LVM.
324      *)
325   | InitPartition
326
327     (* /dev/sda contains a single partition /dev/sda1, which is formatted
328      * as ext2, empty [except for lost+found] and mounted on /.
329      * /dev/sdb and /dev/sdc may have random content.
330      * No LVM.
331      *)
332   | InitBasicFS
333
334     (* /dev/sda:
335      *   /dev/sda1 (is a PV):
336      *     /dev/VG/LV (size 8MB):
337      *       formatted as ext2, empty [except for lost+found], mounted on /
338      * /dev/sdb and /dev/sdc may have random content.
339      *)
340   | InitBasicFSonLVM
341
342     (* /dev/sdd (the ISO, see images/ directory in source)
343      * is mounted on /
344      *)
345   | InitISOFS
346
347 (* Sequence of commands for testing. *)
348 and seq = cmd list
349 and cmd = string list
350
351 (* Note about long descriptions: When referring to another
352  * action, use the format C<guestfs_other> (ie. the full name of
353  * the C function).  This will be replaced as appropriate in other
354  * language bindings.
355  *
356  * Apart from that, long descriptions are just perldoc paragraphs.
357  *)
358
359 (* Generate a random UUID (used in tests). *)
360 let uuidgen () =
361   let chan = open_process_in "uuidgen" in
362   let uuid = input_line chan in
363   (match close_process_in chan with
364    | WEXITED 0 -> ()
365    | WEXITED _ ->
366        failwith "uuidgen: process exited with non-zero status"
367    | WSIGNALED _ | WSTOPPED _ ->
368        failwith "uuidgen: process signalled or stopped by signal"
369   );
370   uuid
371
372 (* These test functions are used in the language binding tests. *)
373
374 let test_all_args = [
375   String "str";
376   OptString "optstr";
377   StringList "strlist";
378   Bool "b";
379   Int "integer";
380   Int64 "integer64";
381   FileIn "filein";
382   FileOut "fileout";
383 ]
384
385 let test_all_rets = [
386   (* except for RErr, which is tested thoroughly elsewhere *)
387   "test0rint",         RInt "valout";
388   "test0rint64",       RInt64 "valout";
389   "test0rbool",        RBool "valout";
390   "test0rconststring", RConstString "valout";
391   "test0rconstoptstring", RConstOptString "valout";
392   "test0rstring",      RString "valout";
393   "test0rstringlist",  RStringList "valout";
394   "test0rstruct",      RStruct ("valout", "lvm_pv");
395   "test0rstructlist",  RStructList ("valout", "lvm_pv");
396   "test0rhashtable",   RHashtable "valout";
397 ]
398
399 let test_functions = [
400   ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
401    [],
402    "internal test function - do not use",
403    "\
404 This is an internal test function which is used to test whether
405 the automatically generated bindings can handle every possible
406 parameter type correctly.
407
408 It echos the contents of each parameter to stdout.
409
410 You probably don't want to call this function.");
411 ] @ List.flatten (
412   List.map (
413     fun (name, ret) ->
414       [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
415         [],
416         "internal test function - do not use",
417         "\
418 This is an internal test function which is used to test whether
419 the automatically generated bindings can handle every possible
420 return type correctly.
421
422 It converts string C<val> to the return type.
423
424 You probably don't want to call this function.");
425        (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
426         [],
427         "internal test function - do not use",
428         "\
429 This is an internal test function which is used to test whether
430 the automatically generated bindings can handle every possible
431 return type correctly.
432
433 This function always returns an error.
434
435 You probably don't want to call this function.")]
436   ) test_all_rets
437 )
438
439 (* non_daemon_functions are any functions which don't get processed
440  * in the daemon, eg. functions for setting and getting local
441  * configuration values.
442  *)
443
444 let non_daemon_functions = test_functions @ [
445   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
446    [],
447    "launch the qemu subprocess",
448    "\
449 Internally libguestfs is implemented by running a virtual machine
450 using L<qemu(1)>.
451
452 You should call this after configuring the handle
453 (eg. adding drives) but before performing any actions.");
454
455   ("wait_ready", (RErr, []), -1, [NotInFish],
456    [],
457    "wait until the qemu subprocess launches (no op)",
458    "\
459 This function is a no op.
460
461 In versions of the API E<lt> 1.0.71 you had to call this function
462 just after calling C<guestfs_launch> to wait for the launch
463 to complete.  However this is no longer necessary because
464 C<guestfs_launch> now does the waiting.
465
466 If you see any calls to this function in code then you can just
467 remove them, unless you want to retain compatibility with older
468 versions of the API.");
469
470   ("kill_subprocess", (RErr, []), -1, [],
471    [],
472    "kill the qemu subprocess",
473    "\
474 This kills the qemu subprocess.  You should never need to call this.");
475
476   ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
477    [],
478    "add an image to examine or modify",
479    "\
480 This function adds a virtual machine disk image C<filename> to the
481 guest.  The first time you call this function, the disk appears as IDE
482 disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
483 so on.
484
485 You don't necessarily need to be root when using libguestfs.  However
486 you obviously do need sufficient permissions to access the filename
487 for whatever operations you want to perform (ie. read access if you
488 just want to read the image or write access if you want to modify the
489 image).
490
491 This is equivalent to the qemu parameter
492 C<-drive file=filename,cache=off,if=...>.
493
494 C<cache=off> is omitted in cases where it is not supported by
495 the underlying filesystem.
496
497 C<if=...> is set at compile time by the configuration option
498 C<./configure --with-drive-if=...>.  In the rare case where you
499 might need to change this at run time, use C<guestfs_add_drive_with_if>
500 or C<guestfs_add_drive_ro_with_if>.
501
502 Note that this call checks for the existence of C<filename>.  This
503 stops you from specifying other types of drive which are supported
504 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
505 the general C<guestfs_config> call instead.");
506
507   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
508    [],
509    "add a CD-ROM disk image to examine",
510    "\
511 This function adds a virtual CD-ROM disk image to the guest.
512
513 This is equivalent to the qemu parameter C<-cdrom filename>.
514
515 Notes:
516
517 =over 4
518
519 =item *
520
521 This call checks for the existence of C<filename>.  This
522 stops you from specifying other types of drive which are supported
523 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
524 the general C<guestfs_config> call instead.
525
526 =item *
527
528 If you just want to add an ISO file (often you use this as an
529 efficient way to transfer large files into the guest), then you
530 should probably use C<guestfs_add_drive_ro> instead.
531
532 =back");
533
534   ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
535    [],
536    "add a drive in snapshot mode (read-only)",
537    "\
538 This adds a drive in snapshot mode, making it effectively
539 read-only.
540
541 Note that writes to the device are allowed, and will be seen for
542 the duration of the guestfs handle, but they are written
543 to a temporary file which is discarded as soon as the guestfs
544 handle is closed.  We don't currently have any method to enable
545 changes to be committed, although qemu can support this.
546
547 This is equivalent to the qemu parameter
548 C<-drive file=filename,snapshot=on,readonly=on,if=...>.
549
550 C<if=...> is set at compile time by the configuration option
551 C<./configure --with-drive-if=...>.  In the rare case where you
552 might need to change this at run time, use C<guestfs_add_drive_with_if>
553 or C<guestfs_add_drive_ro_with_if>.
554
555 C<readonly=on> is only added where qemu supports this option.
556
557 Note that this call checks for the existence of C<filename>.  This
558 stops you from specifying other types of drive which are supported
559 by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
560 the general C<guestfs_config> call instead.");
561
562   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
563    [],
564    "add qemu parameters",
565    "\
566 This can be used to add arbitrary qemu command line parameters
567 of the form C<-param value>.  Actually it's not quite arbitrary - we
568 prevent you from setting some parameters which would interfere with
569 parameters that we use.
570
571 The first character of C<param> string must be a C<-> (dash).
572
573 C<value> can be NULL.");
574
575   ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
576    [],
577    "set the qemu binary",
578    "\
579 Set the qemu binary that we will use.
580
581 The default is chosen when the library was compiled by the
582 configure script.
583
584 You can also override this by setting the C<LIBGUESTFS_QEMU>
585 environment variable.
586
587 Setting C<qemu> to C<NULL> restores the default qemu binary.
588
589 Note that you should call this function as early as possible
590 after creating the handle.  This is because some pre-launch
591 operations depend on testing qemu features (by running C<qemu -help>).
592 If the qemu binary changes, we don't retest features, and
593 so you might see inconsistent results.  Using the environment
594 variable C<LIBGUESTFS_QEMU> is safest of all since that picks
595 the qemu binary at the same time as the handle is created.");
596
597   ("get_qemu", (RConstString "qemu", []), -1, [],
598    [InitNone, Always, TestRun (
599       [["get_qemu"]])],
600    "get the qemu binary",
601    "\
602 Return the current qemu binary.
603
604 This is always non-NULL.  If it wasn't set already, then this will
605 return the default qemu binary name.");
606
607   ("set_path", (RErr, [String "searchpath"]), -1, [FishAlias "path"],
608    [],
609    "set the search path",
610    "\
611 Set the path that libguestfs searches for kernel and initrd.img.
612
613 The default is C<$libdir/guestfs> unless overridden by setting
614 C<LIBGUESTFS_PATH> environment variable.
615
616 Setting C<path> to C<NULL> restores the default path.");
617
618   ("get_path", (RConstString "path", []), -1, [],
619    [InitNone, Always, TestRun (
620       [["get_path"]])],
621    "get the search path",
622    "\
623 Return the current search path.
624
625 This is always non-NULL.  If it wasn't set already, then this will
626 return the default path.");
627
628   ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
629    [],
630    "add options to kernel command line",
631    "\
632 This function is used to add additional options to the
633 guest kernel command line.
634
635 The default is C<NULL> unless overridden by setting
636 C<LIBGUESTFS_APPEND> environment variable.
637
638 Setting C<append> to C<NULL> means I<no> additional options
639 are passed (libguestfs always adds a few of its own).");
640
641   ("get_append", (RConstOptString "append", []), -1, [],
642    (* This cannot be tested with the current framework.  The
643     * function can return NULL in normal operations, which the
644     * test framework interprets as an error.
645     *)
646    [],
647    "get the additional kernel options",
648    "\
649 Return the additional kernel options which are added to the
650 guest kernel command line.
651
652 If C<NULL> then no options are added.");
653
654   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
655    [],
656    "set autosync mode",
657    "\
658 If C<autosync> is true, this enables autosync.  Libguestfs will make a
659 best effort attempt to run C<guestfs_umount_all> followed by
660 C<guestfs_sync> when the handle is closed
661 (also if the program exits without closing handles).
662
663 This is disabled by default (except in guestfish where it is
664 enabled by default).");
665
666   ("get_autosync", (RBool "autosync", []), -1, [],
667    [InitNone, Always, TestRun (
668       [["get_autosync"]])],
669    "get autosync mode",
670    "\
671 Get the autosync flag.");
672
673   ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
674    [],
675    "set verbose mode",
676    "\
677 If C<verbose> is true, this turns on verbose messages (to C<stderr>).
678
679 Verbose messages are disabled unless the environment variable
680 C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
681
682   ("get_verbose", (RBool "verbose", []), -1, [],
683    [],
684    "get verbose mode",
685    "\
686 This returns the verbose messages flag.");
687
688   ("is_ready", (RBool "ready", []), -1, [],
689    [InitNone, Always, TestOutputTrue (
690       [["is_ready"]])],
691    "is ready to accept commands",
692    "\
693 This returns true iff this handle is ready to accept commands
694 (in the C<READY> state).
695
696 For more information on states, see L<guestfs(3)>.");
697
698   ("is_config", (RBool "config", []), -1, [],
699    [InitNone, Always, TestOutputFalse (
700       [["is_config"]])],
701    "is in configuration state",
702    "\
703 This returns true iff this handle is being configured
704 (in the C<CONFIG> state).
705
706 For more information on states, see L<guestfs(3)>.");
707
708   ("is_launching", (RBool "launching", []), -1, [],
709    [InitNone, Always, TestOutputFalse (
710       [["is_launching"]])],
711    "is launching subprocess",
712    "\
713 This returns true iff this handle is launching the subprocess
714 (in the C<LAUNCHING> state).
715
716 For more information on states, see L<guestfs(3)>.");
717
718   ("is_busy", (RBool "busy", []), -1, [],
719    [InitNone, Always, TestOutputFalse (
720       [["is_busy"]])],
721    "is busy processing a command",
722    "\
723 This returns true iff this handle is busy processing a command
724 (in the C<BUSY> state).
725
726 For more information on states, see L<guestfs(3)>.");
727
728   ("get_state", (RInt "state", []), -1, [],
729    [],
730    "get the current state",
731    "\
732 This returns the current state as an opaque integer.  This is
733 only useful for printing debug and internal error messages.
734
735 For more information on states, see L<guestfs(3)>.");
736
737   ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
738    [InitNone, Always, TestOutputInt (
739       [["set_memsize"; "500"];
740        ["get_memsize"]], 500)],
741    "set memory allocated to the qemu subprocess",
742    "\
743 This sets the memory size in megabytes allocated to the
744 qemu subprocess.  This only has any effect if called before
745 C<guestfs_launch>.
746
747 You can also change this by setting the environment
748 variable C<LIBGUESTFS_MEMSIZE> before the handle is
749 created.
750
751 For more information on the architecture of libguestfs,
752 see L<guestfs(3)>.");
753
754   ("get_memsize", (RInt "memsize", []), -1, [],
755    [InitNone, Always, TestOutputIntOp (
756       [["get_memsize"]], ">=", 256)],
757    "get memory allocated to the qemu subprocess",
758    "\
759 This gets the memory size in megabytes allocated to the
760 qemu subprocess.
761
762 If C<guestfs_set_memsize> was not called
763 on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
764 then this returns the compiled-in default value for memsize.
765
766 For more information on the architecture of libguestfs,
767 see L<guestfs(3)>.");
768
769   ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
770    [InitNone, Always, TestOutputIntOp (
771       [["get_pid"]], ">=", 1)],
772    "get PID of qemu subprocess",
773    "\
774 Return the process ID of the qemu subprocess.  If there is no
775 qemu subprocess, then this will return an error.
776
777 This is an internal call used for debugging and testing.");
778
779   ("version", (RStruct ("version", "version"), []), -1, [],
780    [InitNone, Always, TestOutputStruct (
781       [["version"]], [CompareWithInt ("major", 1)])],
782    "get the library version number",
783    "\
784 Return the libguestfs version number that the program is linked
785 against.
786
787 Note that because of dynamic linking this is not necessarily
788 the version of libguestfs that you compiled against.  You can
789 compile the program, and then at runtime dynamically link
790 against a completely different C<libguestfs.so> library.
791
792 This call was added in version C<1.0.58>.  In previous
793 versions of libguestfs there was no way to get the version
794 number.  From C code you can use ELF weak linking tricks to find out if
795 this symbol exists (if it doesn't, then it's an earlier version).
796
797 The call returns a structure with four elements.  The first
798 three (C<major>, C<minor> and C<release>) are numbers and
799 correspond to the usual version triplet.  The fourth element
800 (C<extra>) is a string and is normally empty, but may be
801 used for distro-specific information.
802
803 To construct the original version string:
804 C<$major.$minor.$release$extra>
805
806 I<Note:> Don't use this call to test for availability
807 of features.  Distro backports makes this unreliable.  Use
808 C<guestfs_available> instead.");
809
810   ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
811    [InitNone, Always, TestOutputTrue (
812       [["set_selinux"; "true"];
813        ["get_selinux"]])],
814    "set SELinux enabled or disabled at appliance boot",
815    "\
816 This sets the selinux flag that is passed to the appliance
817 at boot time.  The default is C<selinux=0> (disabled).
818
819 Note that if SELinux is enabled, it is always in
820 Permissive mode (C<enforcing=0>).
821
822 For more information on the architecture of libguestfs,
823 see L<guestfs(3)>.");
824
825   ("get_selinux", (RBool "selinux", []), -1, [],
826    [],
827    "get SELinux enabled flag",
828    "\
829 This returns the current setting of the selinux flag which
830 is passed to the appliance at boot time.  See C<guestfs_set_selinux>.
831
832 For more information on the architecture of libguestfs,
833 see L<guestfs(3)>.");
834
835   ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
836    [InitNone, Always, TestOutputFalse (
837       [["set_trace"; "false"];
838        ["get_trace"]])],
839    "enable or disable command traces",
840    "\
841 If the command trace flag is set to 1, then commands are
842 printed on stdout before they are executed in a format
843 which is very similar to the one used by guestfish.  In
844 other words, you can run a program with this enabled, and
845 you will get out a script which you can feed to guestfish
846 to perform the same set of actions.
847
848 If you want to trace C API calls into libguestfs (and
849 other libraries) then possibly a better way is to use
850 the external ltrace(1) command.
851
852 Command traces are disabled unless the environment variable
853 C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
854
855   ("get_trace", (RBool "trace", []), -1, [],
856    [],
857    "get command trace enabled flag",
858    "\
859 Return the command trace flag.");
860
861   ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
862    [InitNone, Always, TestOutputFalse (
863       [["set_direct"; "false"];
864        ["get_direct"]])],
865    "enable or disable direct appliance mode",
866    "\
867 If the direct appliance mode flag is enabled, then stdin and
868 stdout are passed directly through to the appliance once it
869 is launched.
870
871 One consequence of this is that log messages aren't caught
872 by the library and handled by C<guestfs_set_log_message_callback>,
873 but go straight to stdout.
874
875 You probably don't want to use this unless you know what you
876 are doing.
877
878 The default is disabled.");
879
880   ("get_direct", (RBool "direct", []), -1, [],
881    [],
882    "get direct appliance mode flag",
883    "\
884 Return the direct appliance mode flag.");
885
886   ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
887    [InitNone, Always, TestOutputTrue (
888       [["set_recovery_proc"; "true"];
889        ["get_recovery_proc"]])],
890    "enable or disable the recovery process",
891    "\
892 If this is called with the parameter C<false> then
893 C<guestfs_launch> does not create a recovery process.  The
894 purpose of the recovery process is to stop runaway qemu
895 processes in the case where the main program aborts abruptly.
896
897 This only has any effect if called before C<guestfs_launch>,
898 and the default is true.
899
900 About the only time when you would want to disable this is
901 if the main process will fork itself into the background
902 (\"daemonize\" itself).  In this case the recovery process
903 thinks that the main program has disappeared and so kills
904 qemu, which is not very helpful.");
905
906   ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
907    [],
908    "get recovery process enabled flag",
909    "\
910 Return the recovery process enabled flag.");
911
912   ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
913    [],
914    "add a drive specifying the QEMU block emulation to use",
915    "\
916 This is the same as C<guestfs_add_drive> but it allows you
917 to specify the QEMU interface emulation to use at run time.");
918
919   ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
920    [],
921    "add a drive read-only specifying the QEMU block emulation to use",
922    "\
923 This is the same as C<guestfs_add_drive_ro> but it allows you
924 to specify the QEMU interface emulation to use at run time.");
925
926 ]
927
928 (* daemon_functions are any functions which cause some action
929  * to take place in the daemon.
930  *)
931
932 let daemon_functions = [
933   ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
934    [InitEmpty, Always, TestOutput (
935       [["part_disk"; "/dev/sda"; "mbr"];
936        ["mkfs"; "ext2"; "/dev/sda1"];
937        ["mount"; "/dev/sda1"; "/"];
938        ["write_file"; "/new"; "new file contents"; "0"];
939        ["cat"; "/new"]], "new file contents")],
940    "mount a guest disk at a position in the filesystem",
941    "\
942 Mount a guest disk at a position in the filesystem.  Block devices
943 are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
944 the guest.  If those block devices contain partitions, they will have
945 the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
946 names can be used.
947
948 The rules are the same as for L<mount(2)>:  A filesystem must
949 first be mounted on C</> before others can be mounted.  Other
950 filesystems can only be mounted on directories which already
951 exist.
952
953 The mounted filesystem is writable, if we have sufficient permissions
954 on the underlying device.
955
956 B<Important note:>
957 When you use this call, the filesystem options C<sync> and C<noatime>
958 are set implicitly.  This was originally done because we thought it
959 would improve reliability, but it turns out that I<-o sync> has a
960 very large negative performance impact and negligible effect on
961 reliability.  Therefore we recommend that you avoid using
962 C<guestfs_mount> in any code that needs performance, and instead
963 use C<guestfs_mount_options> (use an empty string for the first
964 parameter if you don't want any options).");
965
966   ("sync", (RErr, []), 2, [],
967    [ InitEmpty, Always, TestRun [["sync"]]],
968    "sync disks, writes are flushed through to the disk image",
969    "\
970 This syncs the disk, so that any writes are flushed through to the
971 underlying disk image.
972
973 You should always call this if you have modified a disk image, before
974 closing the handle.");
975
976   ("touch", (RErr, [Pathname "path"]), 3, [],
977    [InitBasicFS, Always, TestOutputTrue (
978       [["touch"; "/new"];
979        ["exists"; "/new"]])],
980    "update file timestamps or create a new file",
981    "\
982 Touch acts like the L<touch(1)> command.  It can be used to
983 update the timestamps on a file, or, if the file does not exist,
984 to create a new zero-length file.");
985
986   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
987    [InitISOFS, Always, TestOutput (
988       [["cat"; "/known-2"]], "abcdef\n")],
989    "list the contents of a file",
990    "\
991 Return the contents of the file named C<path>.
992
993 Note that this function cannot correctly handle binary files
994 (specifically, files containing C<\\0> character which is treated
995 as end of string).  For those you need to use the C<guestfs_read_file>
996 or C<guestfs_download> functions which have a more complex interface.");
997
998   ("ll", (RString "listing", [Pathname "directory"]), 5, [],
999    [], (* XXX Tricky to test because it depends on the exact format
1000         * of the 'ls -l' command, which changes between F10 and F11.
1001         *)
1002    "list the files in a directory (long format)",
1003    "\
1004 List the files in C<directory> (relative to the root directory,
1005 there is no cwd) in the format of 'ls -la'.
1006
1007 This command is mostly useful for interactive sessions.  It
1008 is I<not> intended that you try to parse the output string.");
1009
1010   ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
1011    [InitBasicFS, Always, TestOutputList (
1012       [["touch"; "/new"];
1013        ["touch"; "/newer"];
1014        ["touch"; "/newest"];
1015        ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
1016    "list the files in a directory",
1017    "\
1018 List the files in C<directory> (relative to the root directory,
1019 there is no cwd).  The '.' and '..' entries are not returned, but
1020 hidden files are shown.
1021
1022 This command is mostly useful for interactive sessions.  Programs
1023 should probably use C<guestfs_readdir> instead.");
1024
1025   ("list_devices", (RStringList "devices", []), 7, [],
1026    [InitEmpty, Always, TestOutputListOfDevices (
1027       [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
1028    "list the block devices",
1029    "\
1030 List all the block devices.
1031
1032 The full block device names are returned, eg. C</dev/sda>");
1033
1034   ("list_partitions", (RStringList "partitions", []), 8, [],
1035    [InitBasicFS, Always, TestOutputListOfDevices (
1036       [["list_partitions"]], ["/dev/sda1"]);
1037     InitEmpty, Always, TestOutputListOfDevices (
1038       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1039        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1040    "list the partitions",
1041    "\
1042 List all the partitions detected on all block devices.
1043
1044 The full partition device names are returned, eg. C</dev/sda1>
1045
1046 This does not return logical volumes.  For that you will need to
1047 call C<guestfs_lvs>.");
1048
1049   ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
1050    [InitBasicFSonLVM, Always, TestOutputListOfDevices (
1051       [["pvs"]], ["/dev/sda1"]);
1052     InitEmpty, Always, TestOutputListOfDevices (
1053       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1054        ["pvcreate"; "/dev/sda1"];
1055        ["pvcreate"; "/dev/sda2"];
1056        ["pvcreate"; "/dev/sda3"];
1057        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1058    "list the LVM physical volumes (PVs)",
1059    "\
1060 List all the physical volumes detected.  This is the equivalent
1061 of the L<pvs(8)> command.
1062
1063 This returns a list of just the device names that contain
1064 PVs (eg. C</dev/sda2>).
1065
1066 See also C<guestfs_pvs_full>.");
1067
1068   ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
1069    [InitBasicFSonLVM, Always, TestOutputList (
1070       [["vgs"]], ["VG"]);
1071     InitEmpty, Always, TestOutputList (
1072       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1073        ["pvcreate"; "/dev/sda1"];
1074        ["pvcreate"; "/dev/sda2"];
1075        ["pvcreate"; "/dev/sda3"];
1076        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1077        ["vgcreate"; "VG2"; "/dev/sda3"];
1078        ["vgs"]], ["VG1"; "VG2"])],
1079    "list the LVM volume groups (VGs)",
1080    "\
1081 List all the volumes groups detected.  This is the equivalent
1082 of the L<vgs(8)> command.
1083
1084 This returns a list of just the volume group names that were
1085 detected (eg. C<VolGroup00>).
1086
1087 See also C<guestfs_vgs_full>.");
1088
1089   ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
1090    [InitBasicFSonLVM, Always, TestOutputList (
1091       [["lvs"]], ["/dev/VG/LV"]);
1092     InitEmpty, Always, TestOutputList (
1093       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1094        ["pvcreate"; "/dev/sda1"];
1095        ["pvcreate"; "/dev/sda2"];
1096        ["pvcreate"; "/dev/sda3"];
1097        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1098        ["vgcreate"; "VG2"; "/dev/sda3"];
1099        ["lvcreate"; "LV1"; "VG1"; "50"];
1100        ["lvcreate"; "LV2"; "VG1"; "50"];
1101        ["lvcreate"; "LV3"; "VG2"; "50"];
1102        ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
1103    "list the LVM logical volumes (LVs)",
1104    "\
1105 List all the logical volumes detected.  This is the equivalent
1106 of the L<lvs(8)> command.
1107
1108 This returns a list of the logical volume device names
1109 (eg. C</dev/VolGroup00/LogVol00>).
1110
1111 See also C<guestfs_lvs_full>.");
1112
1113   ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
1114    [], (* XXX how to test? *)
1115    "list the LVM physical volumes (PVs)",
1116    "\
1117 List all the physical volumes detected.  This is the equivalent
1118 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
1119
1120   ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
1121    [], (* XXX how to test? *)
1122    "list the LVM volume groups (VGs)",
1123    "\
1124 List all the volumes groups detected.  This is the equivalent
1125 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
1126
1127   ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
1128    [], (* XXX how to test? *)
1129    "list the LVM logical volumes (LVs)",
1130    "\
1131 List all the logical volumes detected.  This is the equivalent
1132 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
1133
1134   ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
1135    [InitISOFS, Always, TestOutputList (
1136       [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
1137     InitISOFS, Always, TestOutputList (
1138       [["read_lines"; "/empty"]], [])],
1139    "read file as lines",
1140    "\
1141 Return the contents of the file named C<path>.
1142
1143 The file contents are returned as a list of lines.  Trailing
1144 C<LF> and C<CRLF> character sequences are I<not> returned.
1145
1146 Note that this function cannot correctly handle binary files
1147 (specifically, files containing C<\\0> character which is treated
1148 as end of line).  For those you need to use the C<guestfs_read_file>
1149 function which has a more complex interface.");
1150
1151   ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
1152    [], (* XXX Augeas code needs tests. *)
1153    "create a new Augeas handle",
1154    "\
1155 Create a new Augeas handle for editing configuration files.
1156 If there was any previous Augeas handle associated with this
1157 guestfs session, then it is closed.
1158
1159 You must call this before using any other C<guestfs_aug_*>
1160 commands.
1161
1162 C<root> is the filesystem root.  C<root> must not be NULL,
1163 use C</> instead.
1164
1165 The flags are the same as the flags defined in
1166 E<lt>augeas.hE<gt>, the logical I<or> of the following
1167 integers:
1168
1169 =over 4
1170
1171 =item C<AUG_SAVE_BACKUP> = 1
1172
1173 Keep the original file with a C<.augsave> extension.
1174
1175 =item C<AUG_SAVE_NEWFILE> = 2
1176
1177 Save changes into a file with extension C<.augnew>, and
1178 do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
1179
1180 =item C<AUG_TYPE_CHECK> = 4
1181
1182 Typecheck lenses (can be expensive).
1183
1184 =item C<AUG_NO_STDINC> = 8
1185
1186 Do not use standard load path for modules.
1187
1188 =item C<AUG_SAVE_NOOP> = 16
1189
1190 Make save a no-op, just record what would have been changed.
1191
1192 =item C<AUG_NO_LOAD> = 32
1193
1194 Do not load the tree in C<guestfs_aug_init>.
1195
1196 =back
1197
1198 To close the handle, you can call C<guestfs_aug_close>.
1199
1200 To find out more about Augeas, see L<http://augeas.net/>.");
1201
1202   ("aug_close", (RErr, []), 26, [Optional "augeas"],
1203    [], (* XXX Augeas code needs tests. *)
1204    "close the current Augeas handle",
1205    "\
1206 Close the current Augeas handle and free up any resources
1207 used by it.  After calling this, you have to call
1208 C<guestfs_aug_init> again before you can use any other
1209 Augeas functions.");
1210
1211   ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
1212    [], (* XXX Augeas code needs tests. *)
1213    "define an Augeas variable",
1214    "\
1215 Defines an Augeas variable C<name> whose value is the result
1216 of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
1217 undefined.
1218
1219 On success this returns the number of nodes in C<expr>, or
1220 C<0> if C<expr> evaluates to something which is not a nodeset.");
1221
1222   ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
1223    [], (* XXX Augeas code needs tests. *)
1224    "define an Augeas node",
1225    "\
1226 Defines a variable C<name> whose value is the result of
1227 evaluating C<expr>.
1228
1229 If C<expr> evaluates to an empty nodeset, a node is created,
1230 equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
1231 C<name> will be the nodeset containing that single node.
1232
1233 On success this returns a pair containing the
1234 number of nodes in the nodeset, and a boolean flag
1235 if a node was created.");
1236
1237   ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
1238    [], (* XXX Augeas code needs tests. *)
1239    "look up the value of an Augeas path",
1240    "\
1241 Look up the value associated with C<path>.  If C<path>
1242 matches exactly one node, the C<value> is returned.");
1243
1244   ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
1245    [], (* XXX Augeas code needs tests. *)
1246    "set Augeas path to value",
1247    "\
1248 Set the value associated with C<path> to C<value>.");
1249
1250   ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
1251    [], (* XXX Augeas code needs tests. *)
1252    "insert a sibling Augeas node",
1253    "\
1254 Create a new sibling C<label> for C<path>, inserting it into
1255 the tree before or after C<path> (depending on the boolean
1256 flag C<before>).
1257
1258 C<path> must match exactly one existing node in the tree, and
1259 C<label> must be a label, ie. not contain C</>, C<*> or end
1260 with a bracketed index C<[N]>.");
1261
1262   ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
1263    [], (* XXX Augeas code needs tests. *)
1264    "remove an Augeas path",
1265    "\
1266 Remove C<path> and all of its children.
1267
1268 On success this returns the number of entries which were removed.");
1269
1270   ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
1271    [], (* XXX Augeas code needs tests. *)
1272    "move Augeas node",
1273    "\
1274 Move the node C<src> to C<dest>.  C<src> must match exactly
1275 one node.  C<dest> is overwritten if it exists.");
1276
1277   ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
1278    [], (* XXX Augeas code needs tests. *)
1279    "return Augeas nodes which match augpath",
1280    "\
1281 Returns a list of paths which match the path expression C<path>.
1282 The returned paths are sufficiently qualified so that they match
1283 exactly one node in the current tree.");
1284
1285   ("aug_save", (RErr, []), 25, [Optional "augeas"],
1286    [], (* XXX Augeas code needs tests. *)
1287    "write all pending Augeas changes to disk",
1288    "\
1289 This writes all pending changes to disk.
1290
1291 The flags which were passed to C<guestfs_aug_init> affect exactly
1292 how files are saved.");
1293
1294   ("aug_load", (RErr, []), 27, [Optional "augeas"],
1295    [], (* XXX Augeas code needs tests. *)
1296    "load files into the tree",
1297    "\
1298 Load files into the tree.
1299
1300 See C<aug_load> in the Augeas documentation for the full gory
1301 details.");
1302
1303   ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
1304    [], (* XXX Augeas code needs tests. *)
1305    "list Augeas nodes under augpath",
1306    "\
1307 This is just a shortcut for listing C<guestfs_aug_match>
1308 C<path/*> and sorting the resulting nodes into alphabetical order.");
1309
1310   ("rm", (RErr, [Pathname "path"]), 29, [],
1311    [InitBasicFS, Always, TestRun
1312       [["touch"; "/new"];
1313        ["rm"; "/new"]];
1314     InitBasicFS, Always, TestLastFail
1315       [["rm"; "/new"]];
1316     InitBasicFS, Always, TestLastFail
1317       [["mkdir"; "/new"];
1318        ["rm"; "/new"]]],
1319    "remove a file",
1320    "\
1321 Remove the single file C<path>.");
1322
1323   ("rmdir", (RErr, [Pathname "path"]), 30, [],
1324    [InitBasicFS, Always, TestRun
1325       [["mkdir"; "/new"];
1326        ["rmdir"; "/new"]];
1327     InitBasicFS, Always, TestLastFail
1328       [["rmdir"; "/new"]];
1329     InitBasicFS, Always, TestLastFail
1330       [["touch"; "/new"];
1331        ["rmdir"; "/new"]]],
1332    "remove a directory",
1333    "\
1334 Remove the single directory C<path>.");
1335
1336   ("rm_rf", (RErr, [Pathname "path"]), 31, [],
1337    [InitBasicFS, Always, TestOutputFalse
1338       [["mkdir"; "/new"];
1339        ["mkdir"; "/new/foo"];
1340        ["touch"; "/new/foo/bar"];
1341        ["rm_rf"; "/new"];
1342        ["exists"; "/new"]]],
1343    "remove a file or directory recursively",
1344    "\
1345 Remove the file or directory C<path>, recursively removing the
1346 contents if its a directory.  This is like the C<rm -rf> shell
1347 command.");
1348
1349   ("mkdir", (RErr, [Pathname "path"]), 32, [],
1350    [InitBasicFS, Always, TestOutputTrue
1351       [["mkdir"; "/new"];
1352        ["is_dir"; "/new"]];
1353     InitBasicFS, Always, TestLastFail
1354       [["mkdir"; "/new/foo/bar"]]],
1355    "create a directory",
1356    "\
1357 Create a directory named C<path>.");
1358
1359   ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
1360    [InitBasicFS, Always, TestOutputTrue
1361       [["mkdir_p"; "/new/foo/bar"];
1362        ["is_dir"; "/new/foo/bar"]];
1363     InitBasicFS, Always, TestOutputTrue
1364       [["mkdir_p"; "/new/foo/bar"];
1365        ["is_dir"; "/new/foo"]];
1366     InitBasicFS, Always, TestOutputTrue
1367       [["mkdir_p"; "/new/foo/bar"];
1368        ["is_dir"; "/new"]];
1369     (* Regression tests for RHBZ#503133: *)
1370     InitBasicFS, Always, TestRun
1371       [["mkdir"; "/new"];
1372        ["mkdir_p"; "/new"]];
1373     InitBasicFS, Always, TestLastFail
1374       [["touch"; "/new"];
1375        ["mkdir_p"; "/new"]]],
1376    "create a directory and parents",
1377    "\
1378 Create a directory named C<path>, creating any parent directories
1379 as necessary.  This is like the C<mkdir -p> shell command.");
1380
1381   ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
1382    [], (* XXX Need stat command to test *)
1383    "change file mode",
1384    "\
1385 Change the mode (permissions) of C<path> to C<mode>.  Only
1386 numeric modes are supported.
1387
1388 I<Note>: When using this command from guestfish, C<mode>
1389 by default would be decimal, unless you prefix it with
1390 C<0> to get octal, ie. use C<0700> not C<700>.
1391
1392 The mode actually set is affected by the umask.");
1393
1394   ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
1395    [], (* XXX Need stat command to test *)
1396    "change file owner and group",
1397    "\
1398 Change the file owner to C<owner> and group to C<group>.
1399
1400 Only numeric uid and gid are supported.  If you want to use
1401 names, you will need to locate and parse the password file
1402 yourself (Augeas support makes this relatively easy).");
1403
1404   ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
1405    [InitISOFS, Always, TestOutputTrue (
1406       [["exists"; "/empty"]]);
1407     InitISOFS, Always, TestOutputTrue (
1408       [["exists"; "/directory"]])],
1409    "test if file or directory exists",
1410    "\
1411 This returns C<true> if and only if there is a file, directory
1412 (or anything) with the given C<path> name.
1413
1414 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
1415
1416   ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
1417    [InitISOFS, Always, TestOutputTrue (
1418       [["is_file"; "/known-1"]]);
1419     InitISOFS, Always, TestOutputFalse (
1420       [["is_file"; "/directory"]])],
1421    "test if file exists",
1422    "\
1423 This returns C<true> if and only if there is a file
1424 with the given C<path> name.  Note that it returns false for
1425 other objects like directories.
1426
1427 See also C<guestfs_stat>.");
1428
1429   ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
1430    [InitISOFS, Always, TestOutputFalse (
1431       [["is_dir"; "/known-3"]]);
1432     InitISOFS, Always, TestOutputTrue (
1433       [["is_dir"; "/directory"]])],
1434    "test if file exists",
1435    "\
1436 This returns C<true> if and only if there is a directory
1437 with the given C<path> name.  Note that it returns false for
1438 other objects like files.
1439
1440 See also C<guestfs_stat>.");
1441
1442   ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
1443    [InitEmpty, Always, TestOutputListOfDevices (
1444       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1445        ["pvcreate"; "/dev/sda1"];
1446        ["pvcreate"; "/dev/sda2"];
1447        ["pvcreate"; "/dev/sda3"];
1448        ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
1449    "create an LVM physical volume",
1450    "\
1451 This creates an LVM physical volume on the named C<device>,
1452 where C<device> should usually be a partition name such
1453 as C</dev/sda1>.");
1454
1455   ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
1456    [InitEmpty, Always, TestOutputList (
1457       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1458        ["pvcreate"; "/dev/sda1"];
1459        ["pvcreate"; "/dev/sda2"];
1460        ["pvcreate"; "/dev/sda3"];
1461        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1462        ["vgcreate"; "VG2"; "/dev/sda3"];
1463        ["vgs"]], ["VG1"; "VG2"])],
1464    "create an LVM volume group",
1465    "\
1466 This creates an LVM volume group called C<volgroup>
1467 from the non-empty list of physical volumes C<physvols>.");
1468
1469   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
1470    [InitEmpty, Always, TestOutputList (
1471       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1472        ["pvcreate"; "/dev/sda1"];
1473        ["pvcreate"; "/dev/sda2"];
1474        ["pvcreate"; "/dev/sda3"];
1475        ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
1476        ["vgcreate"; "VG2"; "/dev/sda3"];
1477        ["lvcreate"; "LV1"; "VG1"; "50"];
1478        ["lvcreate"; "LV2"; "VG1"; "50"];
1479        ["lvcreate"; "LV3"; "VG2"; "50"];
1480        ["lvcreate"; "LV4"; "VG2"; "50"];
1481        ["lvcreate"; "LV5"; "VG2"; "50"];
1482        ["lvs"]],
1483       ["/dev/VG1/LV1"; "/dev/VG1/LV2";
1484        "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
1485    "create an LVM logical volume",
1486    "\
1487 This creates an LVM logical volume called C<logvol>
1488 on the volume group C<volgroup>, with C<size> megabytes.");
1489
1490   ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
1491    [InitEmpty, Always, TestOutput (
1492       [["part_disk"; "/dev/sda"; "mbr"];
1493        ["mkfs"; "ext2"; "/dev/sda1"];
1494        ["mount_options"; ""; "/dev/sda1"; "/"];
1495        ["write_file"; "/new"; "new file contents"; "0"];
1496        ["cat"; "/new"]], "new file contents")],
1497    "make a filesystem",
1498    "\
1499 This creates a filesystem on C<device> (usually a partition
1500 or LVM logical volume).  The filesystem type is C<fstype>, for
1501 example C<ext3>.");
1502
1503   ("sfdisk", (RErr, [Device "device";
1504                      Int "cyls"; Int "heads"; Int "sectors";
1505                      StringList "lines"]), 43, [DangerWillRobinson],
1506    [],
1507    "create partitions on a block device",
1508    "\
1509 This is a direct interface to the L<sfdisk(8)> program for creating
1510 partitions on block devices.
1511
1512 C<device> should be a block device, for example C</dev/sda>.
1513
1514 C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
1515 and sectors on the device, which are passed directly to sfdisk as
1516 the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
1517 of these, then the corresponding parameter is omitted.  Usually for
1518 'large' disks, you can just pass C<0> for these, but for small
1519 (floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
1520 out the right geometry and you will need to tell it.
1521
1522 C<lines> is a list of lines that we feed to C<sfdisk>.  For more
1523 information refer to the L<sfdisk(8)> manpage.
1524
1525 To create a single partition occupying the whole disk, you would
1526 pass C<lines> as a single element list, when the single element being
1527 the string C<,> (comma).
1528
1529 See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
1530 C<guestfs_part_init>");
1531
1532   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
1533    [InitBasicFS, Always, TestOutput (
1534       [["write_file"; "/new"; "new file contents"; "0"];
1535        ["cat"; "/new"]], "new file contents");
1536     InitBasicFS, Always, TestOutput (
1537       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
1538        ["cat"; "/new"]], "\nnew file contents\n");
1539     InitBasicFS, Always, TestOutput (
1540       [["write_file"; "/new"; "\n\n"; "0"];
1541        ["cat"; "/new"]], "\n\n");
1542     InitBasicFS, Always, TestOutput (
1543       [["write_file"; "/new"; ""; "0"];
1544        ["cat"; "/new"]], "");
1545     InitBasicFS, Always, TestOutput (
1546       [["write_file"; "/new"; "\n\n\n"; "0"];
1547        ["cat"; "/new"]], "\n\n\n");
1548     InitBasicFS, Always, TestOutput (
1549       [["write_file"; "/new"; "\n"; "0"];
1550        ["cat"; "/new"]], "\n")],
1551    "create a file",
1552    "\
1553 This call creates a file called C<path>.  The contents of the
1554 file is the string C<content> (which can contain any 8 bit data),
1555 with length C<size>.
1556
1557 As a special case, if C<size> is C<0>
1558 then the length is calculated using C<strlen> (so in this case
1559 the content cannot contain embedded ASCII NULs).
1560
1561 I<NB.> Owing to a bug, writing content containing ASCII NUL
1562 characters does I<not> work, even if the length is specified.
1563 We hope to resolve this bug in a future version.  In the meantime
1564 use C<guestfs_upload>.");
1565
1566   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
1567    [InitEmpty, Always, TestOutputListOfDevices (
1568       [["part_disk"; "/dev/sda"; "mbr"];
1569        ["mkfs"; "ext2"; "/dev/sda1"];
1570        ["mount_options"; ""; "/dev/sda1"; "/"];
1571        ["mounts"]], ["/dev/sda1"]);
1572     InitEmpty, Always, TestOutputList (
1573       [["part_disk"; "/dev/sda"; "mbr"];
1574        ["mkfs"; "ext2"; "/dev/sda1"];
1575        ["mount_options"; ""; "/dev/sda1"; "/"];
1576        ["umount"; "/"];
1577        ["mounts"]], [])],
1578    "unmount a filesystem",
1579    "\
1580 This unmounts the given filesystem.  The filesystem may be
1581 specified either by its mountpoint (path) or the device which
1582 contains the filesystem.");
1583
1584   ("mounts", (RStringList "devices", []), 46, [],
1585    [InitBasicFS, Always, TestOutputListOfDevices (
1586       [["mounts"]], ["/dev/sda1"])],
1587    "show mounted filesystems",
1588    "\
1589 This returns the list of currently mounted filesystems.  It returns
1590 the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
1591
1592 Some internal mounts are not shown.
1593
1594 See also: C<guestfs_mountpoints>");
1595
1596   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
1597    [InitBasicFS, Always, TestOutputList (
1598       [["umount_all"];
1599        ["mounts"]], []);
1600     (* check that umount_all can unmount nested mounts correctly: *)
1601     InitEmpty, Always, TestOutputList (
1602       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
1603        ["mkfs"; "ext2"; "/dev/sda1"];
1604        ["mkfs"; "ext2"; "/dev/sda2"];
1605        ["mkfs"; "ext2"; "/dev/sda3"];
1606        ["mount_options"; ""; "/dev/sda1"; "/"];
1607        ["mkdir"; "/mp1"];
1608        ["mount_options"; ""; "/dev/sda2"; "/mp1"];
1609        ["mkdir"; "/mp1/mp2"];
1610        ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
1611        ["mkdir"; "/mp1/mp2/mp3"];
1612        ["umount_all"];
1613        ["mounts"]], [])],
1614    "unmount all filesystems",
1615    "\
1616 This unmounts all mounted filesystems.
1617
1618 Some internal mounts are not unmounted by this call.");
1619
1620   ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
1621    [],
1622    "remove all LVM LVs, VGs and PVs",
1623    "\
1624 This command removes all LVM logical volumes, volume groups
1625 and physical volumes.");
1626
1627   ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
1628    [InitISOFS, Always, TestOutput (
1629       [["file"; "/empty"]], "empty");
1630     InitISOFS, Always, TestOutput (
1631       [["file"; "/known-1"]], "ASCII text");
1632     InitISOFS, Always, TestLastFail (
1633       [["file"; "/notexists"]])],
1634    "determine file type",
1635    "\
1636 This call uses the standard L<file(1)> command to determine
1637 the type or contents of the file.  This also works on devices,
1638 for example to find out whether a partition contains a filesystem.
1639
1640 This call will also transparently look inside various types
1641 of compressed file.
1642
1643 The exact command which runs is C<file -zbsL path>.  Note in
1644 particular that the filename is not prepended to the output
1645 (the C<-b> option).");
1646
1647   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
1648    [InitBasicFS, Always, TestOutput (
1649       [["upload"; "test-command"; "/test-command"];
1650        ["chmod"; "0o755"; "/test-command"];
1651        ["command"; "/test-command 1"]], "Result1");
1652     InitBasicFS, Always, TestOutput (
1653       [["upload"; "test-command"; "/test-command"];
1654        ["chmod"; "0o755"; "/test-command"];
1655        ["command"; "/test-command 2"]], "Result2\n");
1656     InitBasicFS, Always, TestOutput (
1657       [["upload"; "test-command"; "/test-command"];
1658        ["chmod"; "0o755"; "/test-command"];
1659        ["command"; "/test-command 3"]], "\nResult3");
1660     InitBasicFS, Always, TestOutput (
1661       [["upload"; "test-command"; "/test-command"];
1662        ["chmod"; "0o755"; "/test-command"];
1663        ["command"; "/test-command 4"]], "\nResult4\n");
1664     InitBasicFS, Always, TestOutput (
1665       [["upload"; "test-command"; "/test-command"];
1666        ["chmod"; "0o755"; "/test-command"];
1667        ["command"; "/test-command 5"]], "\nResult5\n\n");
1668     InitBasicFS, Always, TestOutput (
1669       [["upload"; "test-command"; "/test-command"];
1670        ["chmod"; "0o755"; "/test-command"];
1671        ["command"; "/test-command 6"]], "\n\nResult6\n\n");
1672     InitBasicFS, Always, TestOutput (
1673       [["upload"; "test-command"; "/test-command"];
1674        ["chmod"; "0o755"; "/test-command"];
1675        ["command"; "/test-command 7"]], "");
1676     InitBasicFS, Always, TestOutput (
1677       [["upload"; "test-command"; "/test-command"];
1678        ["chmod"; "0o755"; "/test-command"];
1679        ["command"; "/test-command 8"]], "\n");
1680     InitBasicFS, Always, TestOutput (
1681       [["upload"; "test-command"; "/test-command"];
1682        ["chmod"; "0o755"; "/test-command"];
1683        ["command"; "/test-command 9"]], "\n\n");
1684     InitBasicFS, Always, TestOutput (
1685       [["upload"; "test-command"; "/test-command"];
1686        ["chmod"; "0o755"; "/test-command"];
1687        ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
1688     InitBasicFS, Always, TestOutput (
1689       [["upload"; "test-command"; "/test-command"];
1690        ["chmod"; "0o755"; "/test-command"];
1691        ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
1692     InitBasicFS, Always, TestLastFail (
1693       [["upload"; "test-command"; "/test-command"];
1694        ["chmod"; "0o755"; "/test-command"];
1695        ["command"; "/test-command"]])],
1696    "run a command from the guest filesystem",
1697    "\
1698 This call runs a command from the guest filesystem.  The
1699 filesystem must be mounted, and must contain a compatible
1700 operating system (ie. something Linux, with the same
1701 or compatible processor architecture).
1702
1703 The single parameter is an argv-style list of arguments.
1704 The first element is the name of the program to run.
1705 Subsequent elements are parameters.  The list must be
1706 non-empty (ie. must contain a program name).  Note that
1707 the command runs directly, and is I<not> invoked via
1708 the shell (see C<guestfs_sh>).
1709
1710 The return value is anything printed to I<stdout> by
1711 the command.
1712
1713 If the command returns a non-zero exit status, then
1714 this function returns an error message.  The error message
1715 string is the content of I<stderr> from the command.
1716
1717 The C<$PATH> environment variable will contain at least
1718 C</usr/bin> and C</bin>.  If you require a program from
1719 another location, you should provide the full path in the
1720 first parameter.
1721
1722 Shared libraries and data files required by the program
1723 must be available on filesystems which are mounted in the
1724 correct places.  It is the caller's responsibility to ensure
1725 all filesystems that are needed are mounted at the right
1726 locations.");
1727
1728   ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
1729    [InitBasicFS, Always, TestOutputList (
1730       [["upload"; "test-command"; "/test-command"];
1731        ["chmod"; "0o755"; "/test-command"];
1732        ["command_lines"; "/test-command 1"]], ["Result1"]);
1733     InitBasicFS, Always, TestOutputList (
1734       [["upload"; "test-command"; "/test-command"];
1735        ["chmod"; "0o755"; "/test-command"];
1736        ["command_lines"; "/test-command 2"]], ["Result2"]);
1737     InitBasicFS, Always, TestOutputList (
1738       [["upload"; "test-command"; "/test-command"];
1739        ["chmod"; "0o755"; "/test-command"];
1740        ["command_lines"; "/test-command 3"]], ["";"Result3"]);
1741     InitBasicFS, Always, TestOutputList (
1742       [["upload"; "test-command"; "/test-command"];
1743        ["chmod"; "0o755"; "/test-command"];
1744        ["command_lines"; "/test-command 4"]], ["";"Result4"]);
1745     InitBasicFS, Always, TestOutputList (
1746       [["upload"; "test-command"; "/test-command"];
1747        ["chmod"; "0o755"; "/test-command"];
1748        ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
1749     InitBasicFS, Always, TestOutputList (
1750       [["upload"; "test-command"; "/test-command"];
1751        ["chmod"; "0o755"; "/test-command"];
1752        ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
1753     InitBasicFS, Always, TestOutputList (
1754       [["upload"; "test-command"; "/test-command"];
1755        ["chmod"; "0o755"; "/test-command"];
1756        ["command_lines"; "/test-command 7"]], []);
1757     InitBasicFS, Always, TestOutputList (
1758       [["upload"; "test-command"; "/test-command"];
1759        ["chmod"; "0o755"; "/test-command"];
1760        ["command_lines"; "/test-command 8"]], [""]);
1761     InitBasicFS, Always, TestOutputList (
1762       [["upload"; "test-command"; "/test-command"];
1763        ["chmod"; "0o755"; "/test-command"];
1764        ["command_lines"; "/test-command 9"]], ["";""]);
1765     InitBasicFS, Always, TestOutputList (
1766       [["upload"; "test-command"; "/test-command"];
1767        ["chmod"; "0o755"; "/test-command"];
1768        ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
1769     InitBasicFS, Always, TestOutputList (
1770       [["upload"; "test-command"; "/test-command"];
1771        ["chmod"; "0o755"; "/test-command"];
1772        ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
1773    "run a command, returning lines",
1774    "\
1775 This is the same as C<guestfs_command>, but splits the
1776 result into a list of lines.
1777
1778 See also: C<guestfs_sh_lines>");
1779
1780   ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
1781    [InitISOFS, Always, TestOutputStruct (
1782       [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
1783    "get file information",
1784    "\
1785 Returns file information for the given C<path>.
1786
1787 This is the same as the C<stat(2)> system call.");
1788
1789   ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
1790    [InitISOFS, Always, TestOutputStruct (
1791       [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
1792    "get file information for a symbolic link",
1793    "\
1794 Returns file information for the given C<path>.
1795
1796 This is the same as C<guestfs_stat> except that if C<path>
1797 is a symbolic link, then the link is stat-ed, not the file it
1798 refers to.
1799
1800 This is the same as the C<lstat(2)> system call.");
1801
1802   ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
1803    [InitISOFS, Always, TestOutputStruct (
1804       [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
1805    "get file system statistics",
1806    "\
1807 Returns file system statistics for any mounted file system.
1808 C<path> should be a file or directory in the mounted file system
1809 (typically it is the mount point itself, but it doesn't need to be).
1810
1811 This is the same as the C<statvfs(2)> system call.");
1812
1813   ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
1814    [], (* XXX test *)
1815    "get ext2/ext3/ext4 superblock details",
1816    "\
1817 This returns the contents of the ext2, ext3 or ext4 filesystem
1818 superblock on C<device>.
1819
1820 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
1821 manpage for more details.  The list of fields returned isn't
1822 clearly defined, and depends on both the version of C<tune2fs>
1823 that libguestfs was built against, and the filesystem itself.");
1824
1825   ("blockdev_setro", (RErr, [Device "device"]), 56, [],
1826    [InitEmpty, Always, TestOutputTrue (
1827       [["blockdev_setro"; "/dev/sda"];
1828        ["blockdev_getro"; "/dev/sda"]])],
1829    "set block device to read-only",
1830    "\
1831 Sets the block device named C<device> to read-only.
1832
1833 This uses the L<blockdev(8)> command.");
1834
1835   ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
1836    [InitEmpty, Always, TestOutputFalse (
1837       [["blockdev_setrw"; "/dev/sda"];
1838        ["blockdev_getro"; "/dev/sda"]])],
1839    "set block device to read-write",
1840    "\
1841 Sets the block device named C<device> to read-write.
1842
1843 This uses the L<blockdev(8)> command.");
1844
1845   ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
1846    [InitEmpty, Always, TestOutputTrue (
1847       [["blockdev_setro"; "/dev/sda"];
1848        ["blockdev_getro"; "/dev/sda"]])],
1849    "is block device set to read-only",
1850    "\
1851 Returns a boolean indicating if the block device is read-only
1852 (true if read-only, false if not).
1853
1854 This uses the L<blockdev(8)> command.");
1855
1856   ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
1857    [InitEmpty, Always, TestOutputInt (
1858       [["blockdev_getss"; "/dev/sda"]], 512)],
1859    "get sectorsize of block device",
1860    "\
1861 This returns the size of sectors on a block device.
1862 Usually 512, but can be larger for modern devices.
1863
1864 (Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
1865 for that).
1866
1867 This uses the L<blockdev(8)> command.");
1868
1869   ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
1870    [InitEmpty, Always, TestOutputInt (
1871       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
1872    "get blocksize of block device",
1873    "\
1874 This returns the block size of a device.
1875
1876 (Note this is different from both I<size in blocks> and
1877 I<filesystem block size>).
1878
1879 This uses the L<blockdev(8)> command.");
1880
1881   ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
1882    [], (* XXX test *)
1883    "set blocksize of block device",
1884    "\
1885 This sets the block size of a device.
1886
1887 (Note this is different from both I<size in blocks> and
1888 I<filesystem block size>).
1889
1890 This uses the L<blockdev(8)> command.");
1891
1892   ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
1893    [InitEmpty, Always, TestOutputInt (
1894       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
1895    "get total size of device in 512-byte sectors",
1896    "\
1897 This returns the size of the device in units of 512-byte sectors
1898 (even if the sectorsize isn't 512 bytes ... weird).
1899
1900 See also C<guestfs_blockdev_getss> for the real sector size of
1901 the device, and C<guestfs_blockdev_getsize64> for the more
1902 useful I<size in bytes>.
1903
1904 This uses the L<blockdev(8)> command.");
1905
1906   ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
1907    [InitEmpty, Always, TestOutputInt (
1908       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
1909    "get total size of device in bytes",
1910    "\
1911 This returns the size of the device in bytes.
1912
1913 See also C<guestfs_blockdev_getsz>.
1914
1915 This uses the L<blockdev(8)> command.");
1916
1917   ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
1918    [InitEmpty, Always, TestRun
1919       [["blockdev_flushbufs"; "/dev/sda"]]],
1920    "flush device buffers",
1921    "\
1922 This tells the kernel to flush internal buffers associated
1923 with C<device>.
1924
1925 This uses the L<blockdev(8)> command.");
1926
1927   ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
1928    [InitEmpty, Always, TestRun
1929       [["blockdev_rereadpt"; "/dev/sda"]]],
1930    "reread partition table",
1931    "\
1932 Reread the partition table on C<device>.
1933
1934 This uses the L<blockdev(8)> command.");
1935
1936   ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
1937    [InitBasicFS, Always, TestOutput (
1938       (* Pick a file from cwd which isn't likely to change. *)
1939       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1940        ["checksum"; "md5"; "/COPYING.LIB"]],
1941       Digest.to_hex (Digest.file "COPYING.LIB"))],
1942    "upload a file from the local machine",
1943    "\
1944 Upload local file C<filename> to C<remotefilename> on the
1945 filesystem.
1946
1947 C<filename> can also be a named pipe.
1948
1949 See also C<guestfs_download>.");
1950
1951   ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
1952    [InitBasicFS, Always, TestOutput (
1953       (* Pick a file from cwd which isn't likely to change. *)
1954       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
1955        ["download"; "/COPYING.LIB"; "testdownload.tmp"];
1956        ["upload"; "testdownload.tmp"; "/upload"];
1957        ["checksum"; "md5"; "/upload"]],
1958       Digest.to_hex (Digest.file "COPYING.LIB"))],
1959    "download a file to the local machine",
1960    "\
1961 Download file C<remotefilename> and save it as C<filename>
1962 on the local machine.
1963
1964 C<filename> can also be a named pipe.
1965
1966 See also C<guestfs_upload>, C<guestfs_cat>.");
1967
1968   ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
1969    [InitISOFS, Always, TestOutput (
1970       [["checksum"; "crc"; "/known-3"]], "2891671662");
1971     InitISOFS, Always, TestLastFail (
1972       [["checksum"; "crc"; "/notexists"]]);
1973     InitISOFS, Always, TestOutput (
1974       [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
1975     InitISOFS, Always, TestOutput (
1976       [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
1977     InitISOFS, Always, TestOutput (
1978       [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
1979     InitISOFS, Always, TestOutput (
1980       [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
1981     InitISOFS, Always, TestOutput (
1982       [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
1983     InitISOFS, Always, TestOutput (
1984       [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
1985    "compute MD5, SHAx or CRC checksum of file",
1986    "\
1987 This call computes the MD5, SHAx or CRC checksum of the
1988 file named C<path>.
1989
1990 The type of checksum to compute is given by the C<csumtype>
1991 parameter which must have one of the following values:
1992
1993 =over 4
1994
1995 =item C<crc>
1996
1997 Compute the cyclic redundancy check (CRC) specified by POSIX
1998 for the C<cksum> command.
1999
2000 =item C<md5>
2001
2002 Compute the MD5 hash (using the C<md5sum> program).
2003
2004 =item C<sha1>
2005
2006 Compute the SHA1 hash (using the C<sha1sum> program).
2007
2008 =item C<sha224>
2009
2010 Compute the SHA224 hash (using the C<sha224sum> program).
2011
2012 =item C<sha256>
2013
2014 Compute the SHA256 hash (using the C<sha256sum> program).
2015
2016 =item C<sha384>
2017
2018 Compute the SHA384 hash (using the C<sha384sum> program).
2019
2020 =item C<sha512>
2021
2022 Compute the SHA512 hash (using the C<sha512sum> program).
2023
2024 =back
2025
2026 The checksum is returned as a printable string.");
2027
2028   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
2029    [InitBasicFS, Always, TestOutput (
2030       [["tar_in"; "../images/helloworld.tar"; "/"];
2031        ["cat"; "/hello"]], "hello\n")],
2032    "unpack tarfile to directory",
2033    "\
2034 This command uploads and unpacks local file C<tarfile> (an
2035 I<uncompressed> tar file) into C<directory>.
2036
2037 To upload a compressed tarball, use C<guestfs_tgz_in>.");
2038
2039   ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
2040    [],
2041    "pack directory into tarfile",
2042    "\
2043 This command packs the contents of C<directory> and downloads
2044 it to local file C<tarfile>.
2045
2046 To download a compressed tarball, use C<guestfs_tgz_out>.");
2047
2048   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
2049    [InitBasicFS, Always, TestOutput (
2050       [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
2051        ["cat"; "/hello"]], "hello\n")],
2052    "unpack compressed tarball to directory",
2053    "\
2054 This command uploads and unpacks local file C<tarball> (a
2055 I<gzip compressed> tar file) into C<directory>.
2056
2057 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
2058
2059   ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
2060    [],
2061    "pack directory into compressed tarball",
2062    "\
2063 This command packs the contents of C<directory> and downloads
2064 it to local file C<tarball>.
2065
2066 To download an uncompressed tarball, use C<guestfs_tar_out>.");
2067
2068   ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
2069    [InitBasicFS, Always, TestLastFail (
2070       [["umount"; "/"];
2071        ["mount_ro"; "/dev/sda1"; "/"];
2072        ["touch"; "/new"]]);
2073     InitBasicFS, Always, TestOutput (
2074       [["write_file"; "/new"; "data"; "0"];
2075        ["umount"; "/"];
2076        ["mount_ro"; "/dev/sda1"; "/"];
2077        ["cat"; "/new"]], "data")],
2078    "mount a guest disk, read-only",
2079    "\
2080 This is the same as the C<guestfs_mount> command, but it
2081 mounts the filesystem with the read-only (I<-o ro>) flag.");
2082
2083   ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
2084    [],
2085    "mount a guest disk with mount options",
2086    "\
2087 This is the same as the C<guestfs_mount> command, but it
2088 allows you to set the mount options as for the
2089 L<mount(8)> I<-o> flag.
2090
2091 If the C<options> parameter is an empty string, then
2092 no options are passed (all options default to whatever
2093 the filesystem uses).");
2094
2095   ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
2096    [],
2097    "mount a guest disk with mount options and vfstype",
2098    "\
2099 This is the same as the C<guestfs_mount> command, but it
2100 allows you to set both the mount options and the vfstype
2101 as for the L<mount(8)> I<-o> and I<-t> flags.");
2102
2103   ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
2104    [],
2105    "debugging and internals",
2106    "\
2107 The C<guestfs_debug> command exposes some internals of
2108 C<guestfsd> (the guestfs daemon) that runs inside the
2109 qemu subprocess.
2110
2111 There is no comprehensive help for this command.  You have
2112 to look at the file C<daemon/debug.c> in the libguestfs source
2113 to find out what you can do.");
2114
2115   ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
2116    [InitEmpty, Always, TestOutputList (
2117       [["part_disk"; "/dev/sda"; "mbr"];
2118        ["pvcreate"; "/dev/sda1"];
2119        ["vgcreate"; "VG"; "/dev/sda1"];
2120        ["lvcreate"; "LV1"; "VG"; "50"];
2121        ["lvcreate"; "LV2"; "VG"; "50"];
2122        ["lvremove"; "/dev/VG/LV1"];
2123        ["lvs"]], ["/dev/VG/LV2"]);
2124     InitEmpty, Always, TestOutputList (
2125       [["part_disk"; "/dev/sda"; "mbr"];
2126        ["pvcreate"; "/dev/sda1"];
2127        ["vgcreate"; "VG"; "/dev/sda1"];
2128        ["lvcreate"; "LV1"; "VG"; "50"];
2129        ["lvcreate"; "LV2"; "VG"; "50"];
2130        ["lvremove"; "/dev/VG"];
2131        ["lvs"]], []);
2132     InitEmpty, Always, TestOutputList (
2133       [["part_disk"; "/dev/sda"; "mbr"];
2134        ["pvcreate"; "/dev/sda1"];
2135        ["vgcreate"; "VG"; "/dev/sda1"];
2136        ["lvcreate"; "LV1"; "VG"; "50"];
2137        ["lvcreate"; "LV2"; "VG"; "50"];
2138        ["lvremove"; "/dev/VG"];
2139        ["vgs"]], ["VG"])],
2140    "remove an LVM logical volume",
2141    "\
2142 Remove an LVM logical volume C<device>, where C<device> is
2143 the path to the LV, such as C</dev/VG/LV>.
2144
2145 You can also remove all LVs in a volume group by specifying
2146 the VG name, C</dev/VG>.");
2147
2148   ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
2149    [InitEmpty, Always, TestOutputList (
2150       [["part_disk"; "/dev/sda"; "mbr"];
2151        ["pvcreate"; "/dev/sda1"];
2152        ["vgcreate"; "VG"; "/dev/sda1"];
2153        ["lvcreate"; "LV1"; "VG"; "50"];
2154        ["lvcreate"; "LV2"; "VG"; "50"];
2155        ["vgremove"; "VG"];
2156        ["lvs"]], []);
2157     InitEmpty, Always, TestOutputList (
2158       [["part_disk"; "/dev/sda"; "mbr"];
2159        ["pvcreate"; "/dev/sda1"];
2160        ["vgcreate"; "VG"; "/dev/sda1"];
2161        ["lvcreate"; "LV1"; "VG"; "50"];
2162        ["lvcreate"; "LV2"; "VG"; "50"];
2163        ["vgremove"; "VG"];
2164        ["vgs"]], [])],
2165    "remove an LVM volume group",
2166    "\
2167 Remove an LVM volume group C<vgname>, (for example C<VG>).
2168
2169 This also forcibly removes all logical volumes in the volume
2170 group (if any).");
2171
2172   ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
2173    [InitEmpty, Always, TestOutputListOfDevices (
2174       [["part_disk"; "/dev/sda"; "mbr"];
2175        ["pvcreate"; "/dev/sda1"];
2176        ["vgcreate"; "VG"; "/dev/sda1"];
2177        ["lvcreate"; "LV1"; "VG"; "50"];
2178        ["lvcreate"; "LV2"; "VG"; "50"];
2179        ["vgremove"; "VG"];
2180        ["pvremove"; "/dev/sda1"];
2181        ["lvs"]], []);
2182     InitEmpty, Always, TestOutputListOfDevices (
2183       [["part_disk"; "/dev/sda"; "mbr"];
2184        ["pvcreate"; "/dev/sda1"];
2185        ["vgcreate"; "VG"; "/dev/sda1"];
2186        ["lvcreate"; "LV1"; "VG"; "50"];
2187        ["lvcreate"; "LV2"; "VG"; "50"];
2188        ["vgremove"; "VG"];
2189        ["pvremove"; "/dev/sda1"];
2190        ["vgs"]], []);
2191     InitEmpty, Always, TestOutputListOfDevices (
2192       [["part_disk"; "/dev/sda"; "mbr"];
2193        ["pvcreate"; "/dev/sda1"];
2194        ["vgcreate"; "VG"; "/dev/sda1"];
2195        ["lvcreate"; "LV1"; "VG"; "50"];
2196        ["lvcreate"; "LV2"; "VG"; "50"];
2197        ["vgremove"; "VG"];
2198        ["pvremove"; "/dev/sda1"];
2199        ["pvs"]], [])],
2200    "remove an LVM physical volume",
2201    "\
2202 This wipes a physical volume C<device> so that LVM will no longer
2203 recognise it.
2204
2205 The implementation uses the C<pvremove> command which refuses to
2206 wipe physical volumes that contain any volume groups, so you have
2207 to remove those first.");
2208
2209   ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
2210    [InitBasicFS, Always, TestOutput (
2211       [["set_e2label"; "/dev/sda1"; "testlabel"];
2212        ["get_e2label"; "/dev/sda1"]], "testlabel")],
2213    "set the ext2/3/4 filesystem label",
2214    "\
2215 This sets the ext2/3/4 filesystem label of the filesystem on
2216 C<device> to C<label>.  Filesystem labels are limited to
2217 16 characters.
2218
2219 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
2220 to return the existing label on a filesystem.");
2221
2222   ("get_e2label", (RString "label", [Device "device"]), 81, [],
2223    [],
2224    "get the ext2/3/4 filesystem label",
2225    "\
2226 This returns the ext2/3/4 filesystem label of the filesystem on
2227 C<device>.");
2228
2229   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
2230    (let uuid = uuidgen () in
2231     [InitBasicFS, Always, TestOutput (
2232        [["set_e2uuid"; "/dev/sda1"; uuid];
2233         ["get_e2uuid"; "/dev/sda1"]], uuid);
2234      InitBasicFS, Always, TestOutput (
2235        [["set_e2uuid"; "/dev/sda1"; "clear"];
2236         ["get_e2uuid"; "/dev/sda1"]], "");
2237      (* We can't predict what UUIDs will be, so just check the commands run. *)
2238      InitBasicFS, Always, TestRun (
2239        [["set_e2uuid"; "/dev/sda1"; "random"]]);
2240      InitBasicFS, Always, TestRun (
2241        [["set_e2uuid"; "/dev/sda1"; "time"]])]),
2242    "set the ext2/3/4 filesystem UUID",
2243    "\
2244 This sets the ext2/3/4 filesystem UUID of the filesystem on
2245 C<device> to C<uuid>.  The format of the UUID and alternatives
2246 such as C<clear>, C<random> and C<time> are described in the
2247 L<tune2fs(8)> manpage.
2248
2249 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
2250 to return the existing UUID of a filesystem.");
2251
2252   ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
2253    [],
2254    "get the ext2/3/4 filesystem UUID",
2255    "\
2256 This returns the ext2/3/4 filesystem UUID of the filesystem on
2257 C<device>.");
2258
2259   ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
2260    [InitBasicFS, Always, TestOutputInt (
2261       [["umount"; "/dev/sda1"];
2262        ["fsck"; "ext2"; "/dev/sda1"]], 0);
2263     InitBasicFS, Always, TestOutputInt (
2264       [["umount"; "/dev/sda1"];
2265        ["zero"; "/dev/sda1"];
2266        ["fsck"; "ext2"; "/dev/sda1"]], 8)],
2267    "run the filesystem checker",
2268    "\
2269 This runs the filesystem checker (fsck) on C<device> which
2270 should have filesystem type C<fstype>.
2271
2272 The returned integer is the status.  See L<fsck(8)> for the
2273 list of status codes from C<fsck>.
2274
2275 Notes:
2276
2277 =over 4
2278
2279 =item *
2280
2281 Multiple status codes can be summed together.
2282
2283 =item *
2284
2285 A non-zero return code can mean \"success\", for example if
2286 errors have been corrected on the filesystem.
2287
2288 =item *
2289
2290 Checking or repairing NTFS volumes is not supported
2291 (by linux-ntfs).
2292
2293 =back
2294
2295 This command is entirely equivalent to running C<fsck -a -t fstype device>.");
2296
2297   ("zero", (RErr, [Device "device"]), 85, [],
2298    [InitBasicFS, Always, TestOutput (
2299       [["umount"; "/dev/sda1"];
2300        ["zero"; "/dev/sda1"];
2301        ["file"; "/dev/sda1"]], "data")],
2302    "write zeroes to the device",
2303    "\
2304 This command writes zeroes over the first few blocks of C<device>.
2305
2306 How many blocks are zeroed isn't specified (but it's I<not> enough
2307 to securely wipe the device).  It should be sufficient to remove
2308 any partition tables, filesystem superblocks and so on.
2309
2310 See also: C<guestfs_scrub_device>.");
2311
2312   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
2313    (* Test disabled because grub-install incompatible with virtio-blk driver.
2314     * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
2315     *)
2316    [InitBasicFS, Disabled, TestOutputTrue (
2317       [["grub_install"; "/"; "/dev/sda1"];
2318        ["is_dir"; "/boot"]])],
2319    "install GRUB",
2320    "\
2321 This command installs GRUB (the Grand Unified Bootloader) on
2322 C<device>, with the root directory being C<root>.");
2323
2324   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
2325    [InitBasicFS, Always, TestOutput (
2326       [["write_file"; "/old"; "file content"; "0"];
2327        ["cp"; "/old"; "/new"];
2328        ["cat"; "/new"]], "file content");
2329     InitBasicFS, Always, TestOutputTrue (
2330       [["write_file"; "/old"; "file content"; "0"];
2331        ["cp"; "/old"; "/new"];
2332        ["is_file"; "/old"]]);
2333     InitBasicFS, Always, TestOutput (
2334       [["write_file"; "/old"; "file content"; "0"];
2335        ["mkdir"; "/dir"];
2336        ["cp"; "/old"; "/dir/new"];
2337        ["cat"; "/dir/new"]], "file content")],
2338    "copy a file",
2339    "\
2340 This copies a file from C<src> to C<dest> where C<dest> is
2341 either a destination filename or destination directory.");
2342
2343   ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
2344    [InitBasicFS, Always, TestOutput (
2345       [["mkdir"; "/olddir"];
2346        ["mkdir"; "/newdir"];
2347        ["write_file"; "/olddir/file"; "file content"; "0"];
2348        ["cp_a"; "/olddir"; "/newdir"];
2349        ["cat"; "/newdir/olddir/file"]], "file content")],
2350    "copy a file or directory recursively",
2351    "\
2352 This copies a file or directory from C<src> to C<dest>
2353 recursively using the C<cp -a> command.");
2354
2355   ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
2356    [InitBasicFS, Always, TestOutput (
2357       [["write_file"; "/old"; "file content"; "0"];
2358        ["mv"; "/old"; "/new"];
2359        ["cat"; "/new"]], "file content");
2360     InitBasicFS, Always, TestOutputFalse (
2361       [["write_file"; "/old"; "file content"; "0"];
2362        ["mv"; "/old"; "/new"];
2363        ["is_file"; "/old"]])],
2364    "move a file",
2365    "\
2366 This moves a file from C<src> to C<dest> where C<dest> is
2367 either a destination filename or destination directory.");
2368
2369   ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
2370    [InitEmpty, Always, TestRun (
2371       [["drop_caches"; "3"]])],
2372    "drop kernel page cache, dentries and inodes",
2373    "\
2374 This instructs the guest kernel to drop its page cache,
2375 and/or dentries and inode caches.  The parameter C<whattodrop>
2376 tells the kernel what precisely to drop, see
2377 L<http://linux-mm.org/Drop_Caches>
2378
2379 Setting C<whattodrop> to 3 should drop everything.
2380
2381 This automatically calls L<sync(2)> before the operation,
2382 so that the maximum guest memory is freed.");
2383
2384   ("dmesg", (RString "kmsgs", []), 91, [],
2385    [InitEmpty, Always, TestRun (
2386       [["dmesg"]])],
2387    "return kernel messages",
2388    "\
2389 This returns the kernel messages (C<dmesg> output) from
2390 the guest kernel.  This is sometimes useful for extended
2391 debugging of problems.
2392
2393 Another way to get the same information is to enable
2394 verbose messages with C<guestfs_set_verbose> or by setting
2395 the environment variable C<LIBGUESTFS_DEBUG=1> before
2396 running the program.");
2397
2398   ("ping_daemon", (RErr, []), 92, [],
2399    [InitEmpty, Always, TestRun (
2400       [["ping_daemon"]])],
2401    "ping the guest daemon",
2402    "\
2403 This is a test probe into the guestfs daemon running inside
2404 the qemu subprocess.  Calling this function checks that the
2405 daemon responds to the ping message, without affecting the daemon
2406 or attached block device(s) in any other way.");
2407
2408   ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
2409    [InitBasicFS, Always, TestOutputTrue (
2410       [["write_file"; "/file1"; "contents of a file"; "0"];
2411        ["cp"; "/file1"; "/file2"];
2412        ["equal"; "/file1"; "/file2"]]);
2413     InitBasicFS, Always, TestOutputFalse (
2414       [["write_file"; "/file1"; "contents of a file"; "0"];
2415        ["write_file"; "/file2"; "contents of another file"; "0"];
2416        ["equal"; "/file1"; "/file2"]]);
2417     InitBasicFS, Always, TestLastFail (
2418       [["equal"; "/file1"; "/file2"]])],
2419    "test if two files have equal contents",
2420    "\
2421 This compares the two files C<file1> and C<file2> and returns
2422 true if their content is exactly equal, or false otherwise.
2423
2424 The external L<cmp(1)> program is used for the comparison.");
2425
2426   ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
2427    [InitISOFS, Always, TestOutputList (
2428       [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
2429     InitISOFS, Always, TestOutputList (
2430       [["strings"; "/empty"]], [])],
2431    "print the printable strings in a file",
2432    "\
2433 This runs the L<strings(1)> command on a file and returns
2434 the list of printable strings found.");
2435
2436   ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
2437    [InitISOFS, Always, TestOutputList (
2438       [["strings_e"; "b"; "/known-5"]], []);
2439     InitBasicFS, Disabled, TestOutputList (
2440       [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
2441        ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
2442    "print the printable strings in a file",
2443    "\
2444 This is like the C<guestfs_strings> command, but allows you to
2445 specify the encoding.
2446
2447 See the L<strings(1)> manpage for the full list of encodings.
2448
2449 Commonly useful encodings are C<l> (lower case L) which will
2450 show strings inside Windows/x86 files.
2451
2452 The returned strings are transcoded to UTF-8.");
2453
2454   ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
2455    [InitISOFS, Always, TestOutput (
2456       [["hexdump"; "/known-4"]], "00000000  61 62 63 0a 64 65 66 0a  67 68 69                 |abc.def.ghi|\n0000000b\n");
2457     (* Test for RHBZ#501888c2 regression which caused large hexdump
2458      * commands to segfault.
2459      *)
2460     InitISOFS, Always, TestRun (
2461       [["hexdump"; "/100krandom"]])],
2462    "dump a file in hexadecimal",
2463    "\
2464 This runs C<hexdump -C> on the given C<path>.  The result is
2465 the human-readable, canonical hex dump of the file.");
2466
2467   ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
2468    [InitNone, Always, TestOutput (
2469       [["part_disk"; "/dev/sda"; "mbr"];
2470        ["mkfs"; "ext3"; "/dev/sda1"];
2471        ["mount_options"; ""; "/dev/sda1"; "/"];
2472        ["write_file"; "/new"; "test file"; "0"];
2473        ["umount"; "/dev/sda1"];
2474        ["zerofree"; "/dev/sda1"];
2475        ["mount_options"; ""; "/dev/sda1"; "/"];
2476        ["cat"; "/new"]], "test file")],
2477    "zero unused inodes and disk blocks on ext2/3 filesystem",
2478    "\
2479 This runs the I<zerofree> program on C<device>.  This program
2480 claims to zero unused inodes and disk blocks on an ext2/3
2481 filesystem, thus making it possible to compress the filesystem
2482 more effectively.
2483
2484 You should B<not> run this program if the filesystem is
2485 mounted.
2486
2487 It is possible that using this program can damage the filesystem
2488 or data on the filesystem.");
2489
2490   ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
2491    [],
2492    "resize an LVM physical volume",
2493    "\
2494 This resizes (expands or shrinks) an existing LVM physical
2495 volume to match the new size of the underlying device.");
2496
2497   ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
2498                        Int "cyls"; Int "heads"; Int "sectors";
2499                        String "line"]), 99, [DangerWillRobinson],
2500    [],
2501    "modify a single partition on a block device",
2502    "\
2503 This runs L<sfdisk(8)> option to modify just the single
2504 partition C<n> (note: C<n> counts from 1).
2505
2506 For other parameters, see C<guestfs_sfdisk>.  You should usually
2507 pass C<0> for the cyls/heads/sectors parameters.
2508
2509 See also: C<guestfs_part_add>");
2510
2511   ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
2512    [],
2513    "display the partition table",
2514    "\
2515 This displays the partition table on C<device>, in the
2516 human-readable output of the L<sfdisk(8)> command.  It is
2517 not intended to be parsed.
2518
2519 See also: C<guestfs_part_list>");
2520
2521   ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
2522    [],
2523    "display the kernel geometry",
2524    "\
2525 This displays the kernel's idea of the geometry of C<device>.
2526
2527 The result is in human-readable format, and not designed to
2528 be parsed.");
2529
2530   ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
2531    [],
2532    "display the disk geometry from the partition table",
2533    "\
2534 This displays the disk geometry of C<device> read from the
2535 partition table.  Especially in the case where the underlying
2536 block device has been resized, this can be different from the
2537 kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
2538
2539 The result is in human-readable format, and not designed to
2540 be parsed.");
2541
2542   ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
2543    [],
2544    "activate or deactivate all volume groups",
2545    "\
2546 This command activates or (if C<activate> is false) deactivates
2547 all logical volumes in all volume groups.
2548 If activated, then they are made known to the
2549 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2550 then those devices disappear.
2551
2552 This command is the same as running C<vgchange -a y|n>");
2553
2554   ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
2555    [],
2556    "activate or deactivate some volume groups",
2557    "\
2558 This command activates or (if C<activate> is false) deactivates
2559 all logical volumes in the listed volume groups C<volgroups>.
2560 If activated, then they are made known to the
2561 kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
2562 then those devices disappear.
2563
2564 This command is the same as running C<vgchange -a y|n volgroups...>
2565
2566 Note that if C<volgroups> is an empty list then B<all> volume groups
2567 are activated or deactivated.");
2568
2569   ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
2570    [InitNone, Always, TestOutput (
2571       [["part_disk"; "/dev/sda"; "mbr"];
2572        ["pvcreate"; "/dev/sda1"];
2573        ["vgcreate"; "VG"; "/dev/sda1"];
2574        ["lvcreate"; "LV"; "VG"; "10"];
2575        ["mkfs"; "ext2"; "/dev/VG/LV"];
2576        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2577        ["write_file"; "/new"; "test content"; "0"];
2578        ["umount"; "/"];
2579        ["lvresize"; "/dev/VG/LV"; "20"];
2580        ["e2fsck_f"; "/dev/VG/LV"];
2581        ["resize2fs"; "/dev/VG/LV"];
2582        ["mount_options"; ""; "/dev/VG/LV"; "/"];
2583        ["cat"; "/new"]], "test content");
2584     InitNone, Always, TestRun (
2585       (* Make an LV smaller to test RHBZ#587484. *)
2586       [["part_disk"; "/dev/sda"; "mbr"];
2587        ["pvcreate"; "/dev/sda1"];
2588        ["vgcreate"; "VG"; "/dev/sda1"];
2589        ["lvcreate"; "LV"; "VG"; "20"];
2590        ["lvresize"; "/dev/VG/LV"; "10"]])],
2591    "resize an LVM logical volume",
2592    "\
2593 This resizes (expands or shrinks) an existing LVM logical
2594 volume to C<mbytes>.  When reducing, data in the reduced part
2595 is lost.");
2596
2597   ("resize2fs", (RErr, [Device "device"]), 106, [],
2598    [], (* lvresize tests this *)
2599    "resize an ext2/ext3 filesystem",
2600    "\
2601 This resizes an ext2 or ext3 filesystem to match the size of
2602 the underlying device.
2603
2604 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
2605 on the C<device> before calling this command.  For unknown reasons
2606 C<resize2fs> sometimes gives an error about this and sometimes not.
2607 In any case, it is always safe to call C<guestfs_e2fsck_f> before
2608 calling this function.");
2609
2610   ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
2611    [InitBasicFS, Always, TestOutputList (
2612       [["find"; "/"]], ["lost+found"]);
2613     InitBasicFS, Always, TestOutputList (
2614       [["touch"; "/a"];
2615        ["mkdir"; "/b"];
2616        ["touch"; "/b/c"];
2617        ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
2618     InitBasicFS, Always, TestOutputList (
2619       [["mkdir_p"; "/a/b/c"];
2620        ["touch"; "/a/b/c/d"];
2621        ["find"; "/a/b/"]], ["c"; "c/d"])],
2622    "find all files and directories",
2623    "\
2624 This command lists out all files and directories, recursively,
2625 starting at C<directory>.  It is essentially equivalent to
2626 running the shell command C<find directory -print> but some
2627 post-processing happens on the output, described below.
2628
2629 This returns a list of strings I<without any prefix>.  Thus
2630 if the directory structure was:
2631
2632  /tmp/a
2633  /tmp/b
2634  /tmp/c/d
2635
2636 then the returned list from C<guestfs_find> C</tmp> would be
2637 4 elements:
2638
2639  a
2640  b
2641  c
2642  c/d
2643
2644 If C<directory> is not a directory, then this command returns
2645 an error.
2646
2647 The returned list is sorted.
2648
2649 See also C<guestfs_find0>.");
2650
2651   ("e2fsck_f", (RErr, [Device "device"]), 108, [],
2652    [], (* lvresize tests this *)
2653    "check an ext2/ext3 filesystem",
2654    "\
2655 This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
2656 filesystem checker on C<device>, noninteractively (C<-p>),
2657 even if the filesystem appears to be clean (C<-f>).
2658
2659 This command is only needed because of C<guestfs_resize2fs>
2660 (q.v.).  Normally you should use C<guestfs_fsck>.");
2661
2662   ("sleep", (RErr, [Int "secs"]), 109, [],
2663    [InitNone, Always, TestRun (
2664       [["sleep"; "1"]])],
2665    "sleep for some seconds",
2666    "\
2667 Sleep for C<secs> seconds.");
2668
2669   ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
2670    [InitNone, Always, TestOutputInt (
2671       [["part_disk"; "/dev/sda"; "mbr"];
2672        ["mkfs"; "ntfs"; "/dev/sda1"];
2673        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
2674     InitNone, Always, TestOutputInt (
2675       [["part_disk"; "/dev/sda"; "mbr"];
2676        ["mkfs"; "ext2"; "/dev/sda1"];
2677        ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
2678    "probe NTFS volume",
2679    "\
2680 This command runs the L<ntfs-3g.probe(8)> command which probes
2681 an NTFS C<device> for mountability.  (Not all NTFS volumes can
2682 be mounted read-write, and some cannot be mounted at all).
2683
2684 C<rw> is a boolean flag.  Set it to true if you want to test
2685 if the volume can be mounted read-write.  Set it to false if
2686 you want to test if the volume can be mounted read-only.
2687
2688 The return value is an integer which C<0> if the operation
2689 would succeed, or some non-zero value documented in the
2690 L<ntfs-3g.probe(8)> manual page.");
2691
2692   ("sh", (RString "output", [String "command"]), 111, [],
2693    [], (* XXX needs tests *)
2694    "run a command via the shell",
2695    "\
2696 This call runs a command from the guest filesystem via the
2697 guest's C</bin/sh>.
2698
2699 This is like C<guestfs_command>, but passes the command to:
2700
2701  /bin/sh -c \"command\"
2702
2703 Depending on the guest's shell, this usually results in
2704 wildcards being expanded, shell expressions being interpolated
2705 and so on.
2706
2707 All the provisos about C<guestfs_command> apply to this call.");
2708
2709   ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
2710    [], (* XXX needs tests *)
2711    "run a command via the shell returning lines",
2712    "\
2713 This is the same as C<guestfs_sh>, but splits the result
2714 into a list of lines.
2715
2716 See also: C<guestfs_command_lines>");
2717
2718   ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
2719    (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
2720     * code in stubs.c, since all valid glob patterns must start with "/".
2721     * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
2722     *)
2723    [InitBasicFS, Always, TestOutputList (
2724       [["mkdir_p"; "/a/b/c"];
2725        ["touch"; "/a/b/c/d"];
2726        ["touch"; "/a/b/c/e"];
2727        ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2728     InitBasicFS, Always, TestOutputList (
2729       [["mkdir_p"; "/a/b/c"];
2730        ["touch"; "/a/b/c/d"];
2731        ["touch"; "/a/b/c/e"];
2732        ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
2733     InitBasicFS, Always, TestOutputList (
2734       [["mkdir_p"; "/a/b/c"];
2735        ["touch"; "/a/b/c/d"];
2736        ["touch"; "/a/b/c/e"];
2737        ["glob_expand"; "/a/*/x/*"]], [])],
2738    "expand a wildcard path",
2739    "\
2740 This command searches for all the pathnames matching
2741 C<pattern> according to the wildcard expansion rules
2742 used by the shell.
2743
2744 If no paths match, then this returns an empty list
2745 (note: not an error).
2746
2747 It is just a wrapper around the C L<glob(3)> function
2748 with flags C<GLOB_MARK|GLOB_BRACE>.
2749 See that manual page for more details.");
2750
2751   ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
2752    [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
2753       [["scrub_device"; "/dev/sdc"]])],
2754    "scrub (securely wipe) a device",
2755    "\
2756 This command writes patterns over C<device> to make data retrieval
2757 more difficult.
2758
2759 It is an interface to the L<scrub(1)> program.  See that
2760 manual page for more details.");
2761
2762   ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
2763    [InitBasicFS, Always, TestRun (
2764       [["write_file"; "/file"; "content"; "0"];
2765        ["scrub_file"; "/file"]])],
2766    "scrub (securely wipe) a file",
2767    "\
2768 This command writes patterns over a file to make data retrieval
2769 more difficult.
2770
2771 The file is I<removed> after scrubbing.
2772
2773 It is an interface to the L<scrub(1)> program.  See that
2774 manual page for more details.");
2775
2776   ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
2777    [], (* XXX needs testing *)
2778    "scrub (securely wipe) free space",
2779    "\
2780 This command creates the directory C<dir> and then fills it
2781 with files until the filesystem is full, and scrubs the files
2782 as for C<guestfs_scrub_file>, and deletes them.
2783 The intention is to scrub any free space on the partition
2784 containing C<dir>.
2785
2786 It is an interface to the L<scrub(1)> program.  See that
2787 manual page for more details.");
2788
2789   ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
2790    [InitBasicFS, Always, TestRun (
2791       [["mkdir"; "/tmp"];
2792        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
2793    "create a temporary directory",
2794    "\
2795 This command creates a temporary directory.  The
2796 C<template> parameter should be a full pathname for the
2797 temporary directory name with the final six characters being
2798 \"XXXXXX\".
2799
2800 For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
2801 the second one being suitable for Windows filesystems.
2802
2803 The name of the temporary directory that was created
2804 is returned.
2805
2806 The temporary directory is created with mode 0700
2807 and is owned by root.
2808
2809 The caller is responsible for deleting the temporary
2810 directory and its contents after use.
2811
2812 See also: L<mkdtemp(3)>");
2813
2814   ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
2815    [InitISOFS, Always, TestOutputInt (
2816       [["wc_l"; "/10klines"]], 10000)],
2817    "count lines in a file",
2818    "\
2819 This command counts the lines in a file, using the
2820 C<wc -l> external command.");
2821
2822   ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
2823    [InitISOFS, Always, TestOutputInt (
2824       [["wc_w"; "/10klines"]], 10000)],
2825    "count words in a file",
2826    "\
2827 This command counts the words in a file, using the
2828 C<wc -w> external command.");
2829
2830   ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
2831    [InitISOFS, Always, TestOutputInt (
2832       [["wc_c"; "/100kallspaces"]], 102400)],
2833    "count characters in a file",
2834    "\
2835 This command counts the characters in a file, using the
2836 C<wc -c> external command.");
2837
2838   ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
2839    [InitISOFS, Always, TestOutputList (
2840       [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
2841    "return first 10 lines of a file",
2842    "\
2843 This command returns up to the first 10 lines of a file as
2844 a list of strings.");
2845
2846   ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
2847    [InitISOFS, Always, TestOutputList (
2848       [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2849     InitISOFS, Always, TestOutputList (
2850       [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
2851     InitISOFS, Always, TestOutputList (
2852       [["head_n"; "0"; "/10klines"]], [])],
2853    "return first N lines of a file",
2854    "\
2855 If the parameter C<nrlines> is a positive number, this returns the first
2856 C<nrlines> lines of the file C<path>.
2857
2858 If the parameter C<nrlines> is a negative number, this returns lines
2859 from the file C<path>, excluding the last C<nrlines> lines.
2860
2861 If the parameter C<nrlines> is zero, this returns an empty list.");
2862
2863   ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
2864    [InitISOFS, Always, TestOutputList (
2865       [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
2866    "return last 10 lines of a file",
2867    "\
2868 This command returns up to the last 10 lines of a file as
2869 a list of strings.");
2870
2871   ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
2872    [InitISOFS, Always, TestOutputList (
2873       [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2874     InitISOFS, Always, TestOutputList (
2875       [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
2876     InitISOFS, Always, TestOutputList (
2877       [["tail_n"; "0"; "/10klines"]], [])],
2878    "return last N lines of a file",
2879    "\
2880 If the parameter C<nrlines> is a positive number, this returns the last
2881 C<nrlines> lines of the file C<path>.
2882
2883 If the parameter C<nrlines> is a negative number, this returns lines
2884 from the file C<path>, starting with the C<-nrlines>th line.
2885
2886 If the parameter C<nrlines> is zero, this returns an empty list.");
2887
2888   ("df", (RString "output", []), 125, [],
2889    [], (* XXX Tricky to test because it depends on the exact format
2890         * of the 'df' command and other imponderables.
2891         *)
2892    "report file system disk space usage",
2893    "\
2894 This command runs the C<df> command to report disk space used.
2895
2896 This command is mostly useful for interactive sessions.  It
2897 is I<not> intended that you try to parse the output string.
2898 Use C<statvfs> from programs.");
2899
2900   ("df_h", (RString "output", []), 126, [],
2901    [], (* XXX Tricky to test because it depends on the exact format
2902         * of the 'df' command and other imponderables.
2903         *)
2904    "report file system disk space usage (human readable)",
2905    "\
2906 This command runs the C<df -h> command to report disk space used
2907 in human-readable format.
2908
2909 This command is mostly useful for interactive sessions.  It
2910 is I<not> intended that you try to parse the output string.
2911 Use C<statvfs> from programs.");
2912
2913   ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
2914    [InitISOFS, Always, TestOutputInt (
2915       [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
2916    "estimate file space usage",
2917    "\
2918 This command runs the C<du -s> command to estimate file space
2919 usage for C<path>.
2920
2921 C<path> can be a file or a directory.  If C<path> is a directory
2922 then the estimate includes the contents of the directory and all
2923 subdirectories (recursively).
2924
2925 The result is the estimated size in I<kilobytes>
2926 (ie. units of 1024 bytes).");
2927
2928   ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
2929    [InitISOFS, Always, TestOutputList (
2930       [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
2931    "list files in an initrd",
2932    "\
2933 This command lists out files contained in an initrd.
2934
2935 The files are listed without any initial C</> character.  The
2936 files are listed in the order they appear (not necessarily
2937 alphabetical).  Directory names are listed as separate items.
2938
2939 Old Linux kernels (2.4 and earlier) used a compressed ext2
2940 filesystem as initrd.  We I<only> support the newer initramfs
2941 format (compressed cpio files).");
2942
2943   ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
2944    [],
2945    "mount a file using the loop device",
2946    "\
2947 This command lets you mount C<file> (a filesystem image
2948 in a file) on a mount point.  It is entirely equivalent to
2949 the command C<mount -o loop file mountpoint>.");
2950
2951   ("mkswap", (RErr, [Device "device"]), 130, [],
2952    [InitEmpty, Always, TestRun (
2953       [["part_disk"; "/dev/sda"; "mbr"];
2954        ["mkswap"; "/dev/sda1"]])],
2955    "create a swap partition",
2956    "\
2957 Create a swap partition on C<device>.");
2958
2959   ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
2960    [InitEmpty, Always, TestRun (
2961       [["part_disk"; "/dev/sda"; "mbr"];
2962        ["mkswap_L"; "hello"; "/dev/sda1"]])],
2963    "create a swap partition with a label",
2964    "\
2965 Create a swap partition on C<device> with label C<label>.
2966
2967 Note that you cannot attach a swap label to a block device
2968 (eg. C</dev/sda>), just to a partition.  This appears to be
2969 a limitation of the kernel or swap tools.");
2970
2971   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
2972    (let uuid = uuidgen () in
2973     [InitEmpty, Always, TestRun (
2974        [["part_disk"; "/dev/sda"; "mbr"];
2975         ["mkswap_U"; uuid; "/dev/sda1"]])]),
2976    "create a swap partition with an explicit UUID",
2977    "\
2978 Create a swap partition on C<device> with UUID C<uuid>.");
2979
2980   ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
2981    [InitBasicFS, Always, TestOutputStruct (
2982       [["mknod"; "0o10777"; "0"; "0"; "/node"];
2983        (* NB: default umask 022 means 0777 -> 0755 in these tests *)
2984        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
2985     InitBasicFS, Always, TestOutputStruct (
2986       [["mknod"; "0o60777"; "66"; "99"; "/node"];
2987        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
2988    "make block, character or FIFO devices",
2989    "\
2990 This call creates block or character special devices, or
2991 named pipes (FIFOs).
2992
2993 The C<mode> parameter should be the mode, using the standard
2994 constants.  C<devmajor> and C<devminor> are the
2995 device major and minor numbers, only used when creating block
2996 and character special devices.
2997
2998 Note that, just like L<mknod(2)>, the mode must be bitwise
2999 OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
3000 just creates a regular file).  These constants are
3001 available in the standard Linux header files, or you can use
3002 C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
3003 which are wrappers around this command which bitwise OR
3004 in the appropriate constant for you.
3005
3006 The mode actually set is affected by the umask.");
3007
3008   ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
3009    [InitBasicFS, Always, TestOutputStruct (
3010       [["mkfifo"; "0o777"; "/node"];
3011        ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
3012    "make FIFO (named pipe)",
3013    "\
3014 This call creates a FIFO (named pipe) called C<path> with
3015 mode C<mode>.  It is just a convenient wrapper around
3016 C<guestfs_mknod>.
3017
3018 The mode actually set is affected by the umask.");
3019
3020   ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
3021    [InitBasicFS, Always, TestOutputStruct (
3022       [["mknod_b"; "0o777"; "99"; "66"; "/node"];
3023        ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
3024    "make block device node",
3025    "\
3026 This call creates a block device node called C<path> with
3027 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3028 It is just a convenient wrapper around C<guestfs_mknod>.
3029
3030 The mode actually set is affected by the umask.");
3031
3032   ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
3033    [InitBasicFS, Always, TestOutputStruct (
3034       [["mknod_c"; "0o777"; "99"; "66"; "/node"];
3035        ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
3036    "make char device node",
3037    "\
3038 This call creates a char device node called C<path> with
3039 mode C<mode> and device major/minor C<devmajor> and C<devminor>.
3040 It is just a convenient wrapper around C<guestfs_mknod>.
3041
3042 The mode actually set is affected by the umask.");
3043
3044   ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
3045    [InitEmpty, Always, TestOutputInt (
3046       [["umask"; "0o22"]], 0o22)],
3047    "set file mode creation mask (umask)",
3048    "\
3049 This function sets the mask used for creating new files and
3050 device nodes to C<mask & 0777>.
3051
3052 Typical umask values would be C<022> which creates new files
3053 with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
3054 C<002> which creates new files with permissions like
3055 \"-rw-rw-r--\" or \"-rwxrwxr-x\".
3056
3057 The default umask is C<022>.  This is important because it
3058 means that directories and device nodes will be created with
3059 C<0644> or C<0755> mode even if you specify C<0777>.
3060
3061 See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
3062
3063 This call returns the previous umask.");
3064
3065   ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
3066    [],
3067    "read directories entries",
3068    "\
3069 This returns the list of directory entries in directory C<dir>.
3070
3071 All entries in the directory are returned, including C<.> and
3072 C<..>.  The entries are I<not> sorted, but returned in the same
3073 order as the underlying filesystem.
3074
3075 Also this call returns basic file type information about each
3076 file.  The C<ftyp> field will contain one of the following characters:
3077
3078 =over 4
3079
3080 =item 'b'
3081
3082 Block special
3083
3084 =item 'c'
3085
3086 Char special
3087
3088 =item 'd'
3089
3090 Directory
3091
3092 =item 'f'
3093
3094 FIFO (named pipe)
3095
3096 =item 'l'
3097
3098 Symbolic link
3099
3100 =item 'r'
3101
3102 Regular file
3103
3104 =item 's'
3105
3106 Socket
3107
3108 =item 'u'
3109
3110 Unknown file type
3111
3112 =item '?'
3113
3114 The L<readdir(3)> returned a C<d_type> field with an
3115 unexpected value
3116
3117 =back
3118
3119 This function is primarily intended for use by programs.  To
3120 get a simple list of names, use C<guestfs_ls>.  To get a printable
3121 directory for human consumption, use C<guestfs_ll>.");
3122
3123   ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
3124    [],
3125    "create partitions on a block device",
3126    "\
3127 This is a simplified interface to the C<guestfs_sfdisk>
3128 command, where partition sizes are specified in megabytes
3129 only (rounded to the nearest cylinder) and you don't need
3130 to specify the cyls, heads and sectors parameters which
3131 were rarely if ever used anyway.
3132
3133 See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
3134 and C<guestfs_part_disk>");
3135
3136   ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
3137    [],
3138    "determine file type inside a compressed file",
3139    "\
3140 This command runs C<file> after first decompressing C<path>
3141 using C<method>.
3142
3143 C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
3144
3145 Since 1.0.63, use C<guestfs_file> instead which can now
3146 process compressed files.");
3147
3148   ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
3149    [],
3150    "list extended attributes of a file or directory",
3151    "\
3152 This call lists the extended attributes of the file or directory
3153 C<path>.
3154
3155 At the system call level, this is a combination of the
3156 L<listxattr(2)> and L<getxattr(2)> calls.
3157
3158 See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
3159
3160   ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
3161    [],
3162    "list extended attributes of a file or directory",
3163    "\
3164 This is the same as C<guestfs_getxattrs>, but if C<path>
3165 is a symbolic link, then it returns the extended attributes
3166 of the link itself.");
3167
3168   ("setxattr", (RErr, [String "xattr";
3169                        String "val"; Int "vallen"; (* will be BufferIn *)
3170                        Pathname "path"]), 143, [Optional "linuxxattrs"],
3171    [],
3172    "set extended attribute of a file or directory",
3173    "\
3174 This call sets the extended attribute named C<xattr>
3175 of the file C<path> to the value C<val> (of length C<vallen>).
3176 The value is arbitrary 8 bit data.
3177
3178 See also: C<guestfs_lsetxattr>, L<attr(5)>.");
3179
3180   ("lsetxattr", (RErr, [String "xattr";
3181                         String "val"; Int "vallen"; (* will be BufferIn *)
3182                         Pathname "path"]), 144, [Optional "linuxxattrs"],
3183    [],
3184    "set extended attribute of a file or directory",
3185    "\
3186 This is the same as C<guestfs_setxattr>, but if C<path>
3187 is a symbolic link, then it sets an extended attribute
3188 of the link itself.");
3189
3190   ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
3191    [],
3192    "remove extended attribute of a file or directory",
3193    "\
3194 This call removes the extended attribute named C<xattr>
3195 of the file C<path>.
3196
3197 See also: C<guestfs_lremovexattr>, L<attr(5)>.");
3198
3199   ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
3200    [],
3201    "remove extended attribute of a file or directory",
3202    "\
3203 This is the same as C<guestfs_removexattr>, but if C<path>
3204 is a symbolic link, then it removes an extended attribute
3205 of the link itself.");
3206
3207   ("mountpoints", (RHashtable "mps", []), 147, [],
3208    [],
3209    "show mountpoints",
3210    "\
3211 This call is similar to C<guestfs_mounts>.  That call returns
3212 a list of devices.  This one returns a hash table (map) of
3213 device name to directory where the device is mounted.");
3214
3215   ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
3216    (* This is a special case: while you would expect a parameter
3217     * of type "Pathname", that doesn't work, because it implies
3218     * NEED_ROOT in the generated calling code in stubs.c, and
3219     * this function cannot use NEED_ROOT.
3220     *)
3221    [],
3222    "create a mountpoint",
3223    "\
3224 C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
3225 specialized calls that can be used to create extra mountpoints
3226 before mounting the first filesystem.
3227
3228 These calls are I<only> necessary in some very limited circumstances,
3229 mainly the case where you want to mount a mix of unrelated and/or
3230 read-only filesystems together.
3231
3232 For example, live CDs often contain a \"Russian doll\" nest of
3233 filesystems, an ISO outer layer, with a squashfs image inside, with
3234 an ext2/3 image inside that.  You can unpack this as follows
3235 in guestfish:
3236
3237  add-ro Fedora-11-i686-Live.iso
3238  run
3239  mkmountpoint /cd
3240  mkmountpoint /squash
3241  mkmountpoint /ext3
3242  mount /dev/sda /cd
3243  mount-loop /cd/LiveOS/squashfs.img /squash
3244  mount-loop /squash/LiveOS/ext3fs.img /ext3
3245
3246 The inner filesystem is now unpacked under the /ext3 mountpoint.");
3247
3248   ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
3249    [],
3250    "remove a mountpoint",
3251    "\
3252 This calls removes a mountpoint that was previously created
3253 with C<guestfs_mkmountpoint>.  See C<guestfs_mkmountpoint>
3254 for full details.");
3255
3256   ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
3257    [InitISOFS, Always, TestOutputBuffer (
3258       [["read_file"; "/known-4"]], "abc\ndef\nghi");
3259     (* Test various near large, large and too large files (RHBZ#589039). *)
3260     InitBasicFS, Always, TestLastFail (
3261       [["touch"; "/a"];
3262        ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
3263        ["read_file"; "/a"]]);
3264     InitBasicFS, Always, TestLastFail (
3265       [["touch"; "/a"];
3266        ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
3267        ["read_file"; "/a"]]);
3268     InitBasicFS, Always, TestLastFail (
3269       [["touch"; "/a"];
3270        ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
3271        ["read_file"; "/a"]])],
3272    "read a file",
3273    "\
3274 This calls returns the contents of the file C<path> as a
3275 buffer.
3276
3277 Unlike C<guestfs_cat>, this function can correctly
3278 handle files that contain embedded ASCII NUL characters.
3279 However unlike C<guestfs_download>, this function is limited
3280 in the total size of file that can be handled.");
3281
3282   ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
3283    [InitISOFS, Always, TestOutputList (
3284       [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
3285     InitISOFS, Always, TestOutputList (
3286       [["grep"; "nomatch"; "/test-grep.txt"]], [])],
3287    "return lines matching a pattern",
3288    "\
3289 This calls the external C<grep> program and returns the
3290 matching lines.");
3291
3292   ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
3293    [InitISOFS, Always, TestOutputList (
3294       [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3295    "return lines matching a pattern",
3296    "\
3297 This calls the external C<egrep> program and returns the
3298 matching lines.");
3299
3300   ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
3301    [InitISOFS, Always, TestOutputList (
3302       [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
3303    "return lines matching a pattern",
3304    "\
3305 This calls the external C<fgrep> program and returns the
3306 matching lines.");
3307
3308   ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
3309    [InitISOFS, Always, TestOutputList (
3310       [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3311    "return lines matching a pattern",
3312    "\
3313 This calls the external C<grep -i> program and returns the
3314 matching lines.");
3315
3316   ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
3317    [InitISOFS, Always, TestOutputList (
3318       [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3319    "return lines matching a pattern",
3320    "\
3321 This calls the external C<egrep -i> program and returns the
3322 matching lines.");
3323
3324   ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
3325    [InitISOFS, Always, TestOutputList (
3326       [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
3327    "return lines matching a pattern",
3328    "\
3329 This calls the external C<fgrep -i> program and returns the
3330 matching lines.");
3331
3332   ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
3333    [InitISOFS, Always, TestOutputList (
3334       [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3335    "return lines matching a pattern",
3336    "\
3337 This calls the external C<zgrep> program and returns the
3338 matching lines.");
3339
3340   ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
3341    [InitISOFS, Always, TestOutputList (
3342       [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3343    "return lines matching a pattern",
3344    "\
3345 This calls the external C<zegrep> program and returns the
3346 matching lines.");
3347
3348   ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
3349    [InitISOFS, Always, TestOutputList (
3350       [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
3351    "return lines matching a pattern",
3352    "\
3353 This calls the external C<zfgrep> program and returns the
3354 matching lines.");
3355
3356   ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
3357    [InitISOFS, Always, TestOutputList (
3358       [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3359    "return lines matching a pattern",
3360    "\
3361 This calls the external C<zgrep -i> program and returns the
3362 matching lines.");
3363
3364   ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
3365    [InitISOFS, Always, TestOutputList (
3366       [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3367    "return lines matching a pattern",
3368    "\
3369 This calls the external C<zegrep -i> program and returns the
3370 matching lines.");
3371
3372   ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
3373    [InitISOFS, Always, TestOutputList (
3374       [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
3375    "return lines matching a pattern",
3376    "\
3377 This calls the external C<zfgrep -i> program and returns the
3378 matching lines.");
3379
3380   ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
3381    [InitISOFS, Always, TestOutput (
3382       [["realpath"; "/../directory"]], "/directory")],
3383    "canonicalized absolute pathname",
3384    "\
3385 Return the canonicalized absolute pathname of C<path>.  The
3386 returned path has no C<.>, C<..> or symbolic link path elements.");
3387
3388   ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
3389    [InitBasicFS, Always, TestOutputStruct (
3390       [["touch"; "/a"];
3391        ["ln"; "/a"; "/b"];
3392        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3393    "create a hard link",
3394    "\
3395 This command creates a hard link using the C<ln> command.");
3396
3397   ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
3398    [InitBasicFS, Always, TestOutputStruct (
3399       [["touch"; "/a"];
3400        ["touch"; "/b"];
3401        ["ln_f"; "/a"; "/b"];
3402        ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
3403    "create a hard link",
3404    "\
3405 This command creates a hard link using the C<ln -f> command.
3406 The C<-f> option removes the link (C<linkname>) if it exists already.");
3407
3408   ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
3409    [InitBasicFS, Always, TestOutputStruct (
3410       [["touch"; "/a"];
3411        ["ln_s"; "a"; "/b"];
3412        ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
3413    "create a symbolic link",
3414    "\
3415 This command creates a symbolic link using the C<ln -s> command.");
3416
3417   ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
3418    [InitBasicFS, Always, TestOutput (
3419       [["mkdir_p"; "/a/b"];
3420        ["touch"; "/a/b/c"];
3421        ["ln_sf"; "../d"; "/a/b/c"];
3422        ["readlink"; "/a/b/c"]], "../d")],
3423    "create a symbolic link",
3424    "\
3425 This command creates a symbolic link using the C<ln -sf> command,
3426 The C<-f> option removes the link (C<linkname>) if it exists already.");
3427
3428   ("readlink", (RString "link", [Pathname "path"]), 168, [],
3429    [] (* XXX tested above *),
3430    "read the target of a symbolic link",
3431    "\
3432 This command reads the target of a symbolic link.");
3433
3434   ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
3435    [InitBasicFS, Always, TestOutputStruct (
3436       [["fallocate"; "/a"; "1000000"];
3437        ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
3438    "preallocate a file in the guest filesystem",
3439    "\
3440 This command preallocates a file (containing zero bytes) named
3441 C<path> of size C<len> bytes.  If the file exists already, it
3442 is overwritten.
3443
3444 Do not confuse this with the guestfish-specific
3445 C<alloc> command which allocates a file in the host and
3446 attaches it as a device.");
3447
3448   ("swapon_device", (RErr, [Device "device"]), 170, [],
3449    [InitPartition, Always, TestRun (
3450       [["mkswap"; "/dev/sda1"];
3451        ["swapon_device"; "/dev/sda1"];
3452        ["swapoff_device"; "/dev/sda1"]])],
3453    "enable swap on device",
3454    "\
3455 This command enables the libguestfs appliance to use the
3456 swap device or partition named C<device>.  The increased
3457 memory is made available for all commands, for example
3458 those run using C<guestfs_command> or C<guestfs_sh>.
3459
3460 Note that you should not swap to existing guest swap
3461 partitions unless you know what you are doing.  They may
3462 contain hibernation information, or other information that
3463 the guest doesn't want you to trash.  You also risk leaking
3464 information about the host to the guest this way.  Instead,
3465 attach a new host device to the guest and swap on that.");
3466
3467   ("swapoff_device", (RErr, [Device "device"]), 171, [],
3468    [], (* XXX tested by swapon_device *)
3469    "disable swap on device",
3470    "\
3471 This command disables the libguestfs appliance swap
3472 device or partition named C<device>.
3473 See C<guestfs_swapon_device>.");
3474
3475   ("swapon_file", (RErr, [Pathname "file"]), 172, [],
3476    [InitBasicFS, Always, TestRun (
3477       [["fallocate"; "/swap"; "8388608"];
3478        ["mkswap_file"; "/swap"];
3479        ["swapon_file"; "/swap"];
3480        ["swapoff_file"; "/swap"]])],
3481    "enable swap on file",
3482    "\
3483 This command enables swap to a file.
3484 See C<guestfs_swapon_device> for other notes.");
3485
3486   ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
3487    [], (* XXX tested by swapon_file *)
3488    "disable swap on file",
3489    "\
3490 This command disables the libguestfs appliance swap on file.");
3491
3492   ("swapon_label", (RErr, [String "label"]), 174, [],
3493    [InitEmpty, Always, TestRun (
3494       [["part_disk"; "/dev/sdb"; "mbr"];
3495        ["mkswap_L"; "swapit"; "/dev/sdb1"];
3496        ["swapon_label"; "swapit"];
3497        ["swapoff_label"; "swapit"];
3498        ["zero"; "/dev/sdb"];
3499        ["blockdev_rereadpt"; "/dev/sdb"]])],
3500    "enable swap on labeled swap partition",
3501    "\
3502 This command enables swap to a labeled swap partition.
3503 See C<guestfs_swapon_device> for other notes.");
3504
3505   ("swapoff_label", (RErr, [String "label"]), 175, [],
3506    [], (* XXX tested by swapon_label *)
3507    "disable swap on labeled swap partition",
3508    "\
3509 This command disables the libguestfs appliance swap on
3510 labeled swap partition.");
3511
3512   ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
3513    (let uuid = uuidgen () in
3514     [InitEmpty, Always, TestRun (
3515        [["mkswap_U"; uuid; "/dev/sdb"];
3516         ["swapon_uuid"; uuid];
3517         ["swapoff_uuid"; uuid]])]),
3518    "enable swap on swap partition by UUID",
3519    "\
3520 This command enables swap to a swap partition with the given UUID.
3521 See C<guestfs_swapon_device> for other notes.");
3522
3523   ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
3524    [], (* XXX tested by swapon_uuid *)
3525    "disable swap on swap partition by UUID",
3526    "\
3527 This command disables the libguestfs appliance swap partition
3528 with the given UUID.");
3529
3530   ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
3531    [InitBasicFS, Always, TestRun (
3532       [["fallocate"; "/swap"; "8388608"];
3533        ["mkswap_file"; "/swap"]])],
3534    "create a swap file",
3535    "\
3536 Create a swap file.
3537
3538 This command just writes a swap file signature to an existing
3539 file.  To create the file itself, use something like C<guestfs_fallocate>.");
3540
3541   ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
3542    [InitISOFS, Always, TestRun (
3543       [["inotify_init"; "0"]])],
3544    "create an inotify handle",
3545    "\
3546 This command creates a new inotify handle.
3547 The inotify subsystem can be used to notify events which happen to
3548 objects in the guest filesystem.
3549
3550 C<maxevents> is the maximum number of events which will be
3551 queued up between calls to C<guestfs_inotify_read> or
3552 C<guestfs_inotify_files>.
3553 If this is passed as C<0>, then the kernel (or previously set)
3554 default is used.  For Linux 2.6.29 the default was 16384 events.
3555 Beyond this limit, the kernel throws away events, but records
3556 the fact that it threw them away by setting a flag
3557 C<IN_Q_OVERFLOW> in the returned structure list (see
3558 C<guestfs_inotify_read>).
3559
3560 Before any events are generated, you have to add some
3561 watches to the internal watch list.  See:
3562 C<guestfs_inotify_add_watch>,
3563 C<guestfs_inotify_rm_watch> and
3564 C<guestfs_inotify_watch_all>.
3565
3566 Queued up events should be read periodically by calling
3567 C<guestfs_inotify_read>
3568 (or C<guestfs_inotify_files> which is just a helpful
3569 wrapper around C<guestfs_inotify_read>).  If you don't
3570 read the events out often enough then you risk the internal
3571 queue overflowing.
3572
3573 The handle should be closed after use by calling
3574 C<guestfs_inotify_close>.  This also removes any
3575 watches automatically.
3576
3577 See also L<inotify(7)> for an overview of the inotify interface
3578 as exposed by the Linux kernel, which is roughly what we expose
3579 via libguestfs.  Note that there is one global inotify handle
3580 per libguestfs instance.");
3581
3582   ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
3583    [InitBasicFS, Always, TestOutputList (
3584       [["inotify_init"; "0"];
3585        ["inotify_add_watch"; "/"; "1073741823"];
3586        ["touch"; "/a"];
3587        ["touch"; "/b"];
3588        ["inotify_files"]], ["a"; "b"])],
3589    "add an inotify watch",
3590    "\
3591 Watch C<path> for the events listed in C<mask>.
3592
3593 Note that if C<path> is a directory then events within that
3594 directory are watched, but this does I<not> happen recursively
3595 (in subdirectories).
3596
3597 Note for non-C or non-Linux callers: the inotify events are
3598 defined by the Linux kernel ABI and are listed in
3599 C</usr/include/sys/inotify.h>.");
3600
3601   ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
3602    [],
3603    "remove an inotify watch",
3604    "\
3605 Remove a previously defined inotify watch.
3606 See C<guestfs_inotify_add_watch>.");
3607
3608   ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
3609    [],
3610    "return list of inotify events",
3611    "\
3612 Return the complete queue of events that have happened
3613 since the previous read call.
3614
3615 If no events have happened, this returns an empty list.
3616
3617 I<Note>: In order to make sure that all events have been
3618 read, you must call this function repeatedly until it
3619 returns an empty list.  The reason is that the call will
3620 read events up to the maximum appliance-to-host message
3621 size and leave remaining events in the queue.");
3622
3623   ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
3624    [],
3625    "return list of watched files that had events",
3626    "\
3627 This function is a helpful wrapper around C<guestfs_inotify_read>
3628 which just returns a list of pathnames of objects that were
3629 touched.  The returned pathnames are sorted and deduplicated.");
3630
3631   ("inotify_close", (RErr, []), 184, [Optional "inotify"],
3632    [],
3633    "close the inotify handle",
3634    "\
3635 This closes the inotify handle which was previously
3636 opened by inotify_init.  It removes all watches, throws
3637 away any pending events, and deallocates all resources.");
3638
3639   ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
3640    [],
3641    "set SELinux security context",
3642    "\
3643 This sets the SELinux security context of the daemon
3644 to the string C<context>.
3645
3646 See the documentation about SELINUX in L<guestfs(3)>.");
3647
3648   ("getcon", (RString "context", []), 186, [Optional "selinux"],
3649    [],
3650    "get SELinux security context",
3651    "\
3652 This gets the SELinux security context of the daemon.
3653
3654 See the documentation about SELINUX in L<guestfs(3)>,
3655 and C<guestfs_setcon>");
3656
3657   ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
3658    [InitEmpty, Always, TestOutput (
3659       [["part_disk"; "/dev/sda"; "mbr"];
3660        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
3661        ["mount_options"; ""; "/dev/sda1"; "/"];
3662        ["write_file"; "/new"; "new file contents"; "0"];
3663        ["cat"; "/new"]], "new file contents")],
3664    "make a filesystem with block size",
3665    "\
3666 This call is similar to C<guestfs_mkfs>, but it allows you to
3667 control the block size of the resulting filesystem.  Supported
3668 block sizes depend on the filesystem type, but typically they
3669 are C<1024>, C<2048> or C<4096> only.");
3670
3671   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
3672    [InitEmpty, Always, TestOutput (
3673       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3674        ["mke2journal"; "4096"; "/dev/sda1"];
3675        ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
3676        ["mount_options"; ""; "/dev/sda2"; "/"];
3677        ["write_file"; "/new"; "new file contents"; "0"];
3678        ["cat"; "/new"]], "new file contents")],
3679    "make ext2/3/4 external journal",
3680    "\
3681 This creates an ext2 external journal on C<device>.  It is equivalent
3682 to the command:
3683
3684  mke2fs -O journal_dev -b blocksize device");
3685
3686   ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
3687    [InitEmpty, Always, TestOutput (
3688       [["sfdiskM"; "/dev/sda"; ",100 ,"];
3689        ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
3690        ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
3691        ["mount_options"; ""; "/dev/sda2"; "/"];
3692        ["write_file"; "/new"; "new file contents"; "0"];
3693        ["cat"; "/new"]], "new file contents")],
3694    "make ext2/3/4 external journal with label",
3695    "\
3696 This creates an ext2 external journal on C<device> with label C<label>.");
3697
3698   ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
3699    (let uuid = uuidgen () in
3700     [InitEmpty, Always, TestOutput (
3701        [["sfdiskM"; "/dev/sda"; ",100 ,"];
3702         ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
3703         ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
3704         ["mount_options"; ""; "/dev/sda2"; "/"];
3705         ["write_file"; "/new"; "new file contents"; "0"];
3706         ["cat"; "/new"]], "new file contents")]),
3707    "make ext2/3/4 external journal with UUID",
3708    "\
3709 This creates an ext2 external journal on C<device> with UUID C<uuid>.");
3710
3711   ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
3712    [],
3713    "make ext2/3/4 filesystem with external journal",
3714    "\
3715 This creates an ext2/3/4 filesystem on C<device> with
3716 an external journal on C<journal>.  It is equivalent
3717 to the command:
3718
3719  mke2fs -t fstype -b blocksize -J device=<journal> <device>
3720
3721 See also C<guestfs_mke2journal>.");
3722
3723   ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
3724    [],
3725    "make ext2/3/4 filesystem with external journal",
3726    "\
3727 This creates an ext2/3/4 filesystem on C<device> with
3728 an external journal on the journal labeled C<label>.
3729
3730 See also C<guestfs_mke2journal_L>.");
3731
3732   ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
3733    [],
3734    "make ext2/3/4 filesystem with external journal",
3735    "\
3736 This creates an ext2/3/4 filesystem on C<device> with
3737 an external journal on the journal with UUID C<uuid>.
3738
3739 See also C<guestfs_mke2journal_U>.");
3740
3741   ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
3742    [InitNone, Always, TestRun [["modprobe"; "fat"]]],
3743    "load a kernel module",
3744    "\
3745 This loads a kernel module in the appliance.
3746
3747 The kernel module must have been whitelisted when libguestfs
3748 was built (see C<appliance/kmod.whitelist.in> in the source).");
3749
3750   ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
3751    [InitNone, Always, TestOutput (
3752       [["echo_daemon"; "This is a test"]], "This is a test"
3753     )],
3754    "echo arguments back to the client",
3755    "\
3756 This command concatenate the list of C<words> passed with single spaces between
3757 them and returns the resulting string.
3758
3759 You can use this command to test the connection through to the daemon.
3760
3761 See also C<guestfs_ping_daemon>.");
3762
3763   ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
3764    [], (* There is a regression test for this. *)
3765    "find all files and directories, returning NUL-separated list",
3766    "\
3767 This command lists out all files and directories, recursively,
3768 starting at C<directory>, placing the resulting list in the
3769 external file called C<files>.
3770
3771 This command works the same way as C<guestfs_find> with the
3772 following exceptions:
3773
3774 =over 4
3775
3776 =item *
3777
3778 The resulting list is written to an external file.
3779
3780 =item *
3781
3782 Items (filenames) in the result are separated
3783 by C<\\0> characters.  See L<find(1)> option I<-print0>.
3784
3785 =item *
3786
3787 This command is not limited in the number of names that it
3788 can return.
3789
3790 =item *
3791
3792 The result list is not sorted.
3793
3794 =back");
3795
3796   ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
3797    [InitISOFS, Always, TestOutput (
3798       [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
3799     InitISOFS, Always, TestOutput (
3800       [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
3801     InitISOFS, Always, TestOutput (
3802       [["case_sensitive_path"; "/Known-1"]], "/known-1");
3803     InitISOFS, Always, TestLastFail (
3804       [["case_sensitive_path"; "/Known-1/"]]);
3805     InitBasicFS, Always, TestOutput (
3806       [["mkdir"; "/a"];
3807        ["mkdir"; "/a/bbb"];
3808        ["touch"; "/a/bbb/c"];
3809        ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
3810     InitBasicFS, Always, TestOutput (
3811       [["mkdir"; "/a"];
3812        ["mkdir"; "/a/bbb"];
3813        ["touch"; "/a/bbb/c"];
3814        ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
3815     InitBasicFS, Always, TestLastFail (
3816       [["mkdir"; "/a"];
3817        ["mkdir"; "/a/bbb"];
3818        ["touch"; "/a/bbb/c"];
3819        ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
3820    "return true path on case-insensitive filesystem",
3821    "\
3822 This can be used to resolve case insensitive paths on
3823 a filesystem which is case sensitive.  The use case is
3824 to resolve paths which you have read from Windows configuration
3825 files or the Windows Registry, to the true path.
3826
3827 The command handles a peculiarity of the Linux ntfs-3g
3828 filesystem driver (and probably others), which is that although
3829 the underlying filesystem is case-insensitive, the driver
3830 exports the filesystem to Linux as case-sensitive.
3831
3832 One consequence of this is that special directories such
3833 as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
3834 (or other things) depending on the precise details of how
3835 they were created.  In Windows itself this would not be
3836 a problem.
3837
3838 Bug or feature?  You decide:
3839 L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
3840
3841 This function resolves the true case of each element in the
3842 path and returns the case-sensitive path.
3843
3844 Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
3845 might return C<\"/WINDOWS/system32\"> (the exact return value
3846 would depend on details of how the directories were originally
3847 created under Windows).
3848
3849 I<Note>:
3850 This function does not handle drive names, backslashes etc.
3851
3852 See also C<guestfs_realpath>.");
3853
3854   ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
3855    [InitBasicFS, Always, TestOutput (
3856       [["vfs_type"; "/dev/sda1"]], "ext2")],
3857    "get the Linux VFS type corresponding to a mounted device",
3858    "\
3859 This command gets the block device type corresponding to
3860 a mounted device called C<device>.
3861
3862 Usually the result is the name of the Linux VFS module that
3863 is used to mount this device (probably determined automatically
3864 if you used the C<guestfs_mount> call).");
3865
3866   ("truncate", (RErr, [Pathname "path"]), 199, [],
3867    [InitBasicFS, Always, TestOutputStruct (
3868       [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
3869        ["truncate"; "/test"];
3870        ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
3871    "truncate a file to zero size",
3872    "\
3873 This command truncates C<path> to a zero-length file.  The
3874 file must exist already.");
3875
3876   ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
3877    [InitBasicFS, Always, TestOutputStruct (
3878       [["touch"; "/test"];
3879        ["truncate_size"; "/test"; "1000"];
3880        ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
3881    "truncate a file to a particular size",
3882    "\
3883 This command truncates C<path> to size C<size> bytes.  The file
3884 must exist already.  If the file is smaller than C<size> then
3885 the file is extended to the required size with null bytes.");
3886
3887   ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
3888    [InitBasicFS, Always, TestOutputStruct (
3889       [["touch"; "/test"];
3890        ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
3891        ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
3892    "set timestamp of a file with nanosecond precision",
3893    "\
3894 This command sets the timestamps of a file with nanosecond
3895 precision.
3896
3897 C<atsecs, atnsecs> are the last access time (atime) in secs and
3898 nanoseconds from the epoch.
3899
3900 C<mtsecs, mtnsecs> are the last modification time (mtime) in
3901 secs and nanoseconds from the epoch.
3902
3903 If the C<*nsecs> field contains the special value C<-1> then
3904 the corresponding timestamp is set to the current time.  (The
3905 C<*secs> field is ignored in this case).
3906
3907 If the C<*nsecs> field contains the special value C<-2> then
3908 the corresponding timestamp is left unchanged.  (The
3909 C<*secs> field is ignored in this case).");
3910
3911   ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
3912    [InitBasicFS, Always, TestOutputStruct (
3913       [["mkdir_mode"; "/test"; "0o111"];
3914        ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
3915    "create a directory with a particular mode",
3916    "\
3917 This command creates a directory, setting the initial permissions
3918 of the directory to C<mode>.
3919
3920 For common Linux filesystems, the actual mode which is set will
3921 be C<mode & ~umask & 01777>.  Non-native-Linux filesystems may
3922 interpret the mode in other ways.
3923
3924 See also C<guestfs_mkdir>, C<guestfs_umask>");
3925
3926   ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
3927    [], (* XXX *)
3928    "change file owner and group",
3929    "\
3930 Change the file owner to C<owner> and group to C<group>.
3931 This is like C<guestfs_chown> but if C<path> is a symlink then
3932 the link itself is changed, not the target.
3933
3934 Only numeric uid and gid are supported.  If you want to use
3935 names, you will need to locate and parse the password file
3936 yourself (Augeas support makes this relatively easy).");
3937
3938   ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
3939    [], (* XXX *)
3940    "lstat on multiple files",
3941    "\
3942 This call allows you to perform the C<guestfs_lstat> operation
3943 on multiple files, where all files are in the directory C<path>.
3944 C<names> is the list of files from this directory.
3945
3946 On return you get a list of stat structs, with a one-to-one
3947 correspondence to the C<names> list.  If any name did not exist
3948 or could not be lstat'd, then the C<ino> field of that structure
3949 is set to C<-1>.
3950
3951 This call is intended for programs that want to efficiently
3952 list a directory contents without making many round-trips.
3953 See also C<guestfs_lxattrlist> for a similarly efficient call
3954 for getting extended attributes.  Very long directory listings
3955 might cause the protocol message size to be exceeded, causing
3956 this call to fail.  The caller must split up such requests
3957 into smaller groups of names.");
3958
3959   ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
3960    [], (* XXX *)
3961    "lgetxattr on multiple files",
3962    "\
3963 This call allows you to get the extended attributes
3964 of multiple files, where all files are in the directory C<path>.
3965 C<names> is the list of files from this directory.
3966
3967 On return you get a flat list of xattr structs which must be
3968 interpreted sequentially.  The first xattr struct always has a zero-length
3969 C<attrname>.  C<attrval> in this struct is zero-length
3970 to indicate there was an error doing C<lgetxattr> for this
3971 file, I<or> is a C string which is a decimal number
3972 (the number of following attributes for this file, which could
3973 be C<\"0\">).  Then after the first xattr struct are the
3974 zero or more attributes for the first named file.
3975 This repeats for the second and subsequent files.
3976
3977 This call is intended for programs that want to efficiently
3978 list a directory contents without making many round-trips.
3979 See also C<guestfs_lstatlist> for a similarly efficient call
3980 for getting standard stats.  Very long directory listings
3981 might cause the protocol message size to be exceeded, causing
3982 this call to fail.  The caller must split up such requests
3983 into smaller groups of names.");
3984
3985   ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
3986    [], (* XXX *)
3987    "readlink on multiple files",
3988    "\
3989 This call allows you to do a C<readlink> operation
3990 on multiple files, where all files are in the directory C<path>.
3991 C<names> is the list of files from this directory.
3992
3993 On return you get a list of strings, with a one-to-one
3994 correspondence to the C<names> list.  Each string is the
3995 value of the symbol link.
3996
3997 If the C<readlink(2)> operation fails on any name, then
3998 the corresponding result string is the empty string C<\"\">.
3999 However the whole operation is completed even if there
4000 were C<readlink(2)> errors, and so you can call this
4001 function with names where you don't know if they are
4002 symbolic links already (albeit slightly less efficient).
4003
4004 This call is intended for programs that want to efficiently
4005 list a directory contents without making many round-trips.
4006 Very long directory listings might cause the protocol
4007 message size to be exceeded, causing
4008 this call to fail.  The caller must split up such requests
4009 into smaller groups of names.");
4010
4011   ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
4012    [InitISOFS, Always, TestOutputBuffer (
4013       [["pread"; "/known-4"; "1"; "3"]], "\n");
4014     InitISOFS, Always, TestOutputBuffer (
4015       [["pread"; "/empty"; "0"; "100"]], "")],
4016    "read part of a file",
4017    "\
4018 This command lets you read part of a file.  It reads C<count>
4019 bytes of the file, starting at C<offset>, from file C<path>.
4020
4021 This may read fewer bytes than requested.  For further details
4022 see the L<pread(2)> system call.");
4023
4024   ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
4025    [InitEmpty, Always, TestRun (
4026       [["part_init"; "/dev/sda"; "gpt"]])],
4027    "create an empty partition table",
4028    "\
4029 This creates an empty partition table on C<device> of one of the
4030 partition types listed below.  Usually C<parttype> should be
4031 either C<msdos> or C<gpt> (for large disks).
4032
4033 Initially there are no partitions.  Following this, you should
4034 call C<guestfs_part_add> for each partition required.
4035
4036 Possible values for C<parttype> are:
4037
4038 =over 4
4039
4040 =item B<efi> | B<gpt>
4041
4042 Intel EFI / GPT partition table.
4043
4044 This is recommended for >= 2 TB partitions that will be accessed
4045 from Linux and Intel-based Mac OS X.  It also has limited backwards
4046 compatibility with the C<mbr> format.
4047
4048 =item B<mbr> | B<msdos>
4049
4050 The standard PC \"Master Boot Record\" (MBR) format used
4051 by MS-DOS and Windows.  This partition type will B<only> work
4052 for device sizes up to 2 TB.  For large disks we recommend
4053 using C<gpt>.
4054
4055 =back
4056
4057 Other partition table types that may work but are not
4058 supported include:
4059
4060 =over 4
4061
4062 =item B<aix>
4063
4064 AIX disk labels.
4065
4066 =item B<amiga> | B<rdb>
4067
4068 Amiga \"Rigid Disk Block\" format.
4069
4070 =item B<bsd>
4071
4072 BSD disk labels.
4073
4074 =item B<dasd>
4075
4076 DASD, used on IBM mainframes.
4077
4078 =item B<dvh>
4079
4080 MIPS/SGI volumes.
4081
4082 =item B<mac>
4083
4084 Old Mac partition format.  Modern Macs use C<gpt>.
4085
4086 =item B<pc98>
4087
4088 NEC PC-98 format, common in Japan apparently.
4089
4090 =item B<sun>
4091
4092 Sun disk labels.
4093
4094 =back");
4095
4096   ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
4097    [InitEmpty, Always, TestRun (
4098       [["part_init"; "/dev/sda"; "mbr"];
4099        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
4100     InitEmpty, Always, TestRun (
4101       [["part_init"; "/dev/sda"; "gpt"];
4102        ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
4103        ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
4104     InitEmpty, Always, TestRun (
4105       [["part_init"; "/dev/sda"; "mbr"];
4106        ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
4107        ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
4108        ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
4109        ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
4110    "add a partition to the device",
4111    "\
4112 This command adds a partition to C<device>.  If there is no partition
4113 table on the device, call C<guestfs_part_init> first.
4114
4115 The C<prlogex> parameter is the type of partition.  Normally you
4116 should pass C<p> or C<primary> here, but MBR partition tables also
4117 support C<l> (or C<logical>) and C<e> (or C<extended>) partition
4118 types.
4119
4120 C<startsect> and C<endsect> are the start and end of the partition
4121 in I<sectors>.  C<endsect> may be negative, which means it counts
4122 backwards from the end of the disk (C<-1> is the last sector).
4123
4124 Creating a partition which covers the whole disk is not so easy.
4125 Use C<guestfs_part_disk> to do that.");
4126
4127   ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
4128    [InitEmpty, Always, TestRun (
4129       [["part_disk"; "/dev/sda"; "mbr"]]);
4130     InitEmpty, Always, TestRun (
4131       [["part_disk"; "/dev/sda"; "gpt"]])],
4132    "partition whole disk with a single primary partition",
4133    "\
4134 This command is simply a combination of C<guestfs_part_init>
4135 followed by C<guestfs_part_add> to create a single primary partition
4136 covering the whole disk.
4137
4138 C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
4139 but other possible values are described in C<guestfs_part_init>.");
4140
4141   ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
4142    [InitEmpty, Always, TestRun (
4143       [["part_disk"; "/dev/sda"; "mbr"];
4144        ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
4145    "make a partition bootable",
4146    "\
4147 This sets the bootable flag on partition numbered C<partnum> on
4148 device C<device>.  Note that partitions are numbered from 1.
4149
4150 The bootable flag is used by some operating systems (notably
4151 Windows) to determine which partition to boot from.  It is by
4152 no means universally recognized.");
4153
4154   ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
4155    [InitEmpty, Always, TestRun (
4156       [["part_disk"; "/dev/sda"; "gpt"];
4157        ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
4158    "set partition name",
4159    "\
4160 This sets the partition name on partition numbered C<partnum> on
4161 device C<device>.  Note that partitions are numbered from 1.
4162
4163 The partition name can only be set on certain types of partition
4164 table.  This works on C<gpt> but not on C<mbr> partitions.");
4165
4166   ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
4167    [], (* XXX Add a regression test for this. *)
4168    "list partitions on a device",
4169    "\
4170 This command parses the partition table on C<device> and
4171 returns the list of partitions found.
4172
4173 The fields in the returned structure are:
4174
4175 =over 4
4176
4177 =item B<part_num>
4178
4179 Partition number, counting from 1.
4180
4181 =item B<part_start>
4182
4183 Start of the partition I<in bytes>.  To get sectors you have to
4184 divide by the device's sector size, see C<guestfs_blockdev_getss>.
4185
4186 =item B<part_end>
4187
4188 End of the partition in bytes.
4189
4190 =item B<part_size>
4191
4192 Size of the partition in bytes.
4193
4194 =back");
4195
4196   ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
4197    [InitEmpty, Always, TestOutput (
4198       [["part_disk"; "/dev/sda"; "gpt"];
4199        ["part_get_parttype"; "/dev/sda"]], "gpt")],
4200    "get the partition table type",
4201    "\
4202 This command examines the partition table on C<device> and
4203 returns the partition table type (format) being used.
4204
4205 Common return values include: C<msdos> (a DOS/Windows style MBR
4206 partition table), C<gpt> (a GPT/EFI-style partition table).  Other
4207 values are possible, although unusual.  See C<guestfs_part_init>
4208 for a full list.");
4209
4210   ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
4211    [InitBasicFS, Always, TestOutputBuffer (
4212       [["fill"; "0x63"; "10"; "/test"];
4213        ["read_file"; "/test"]], "cccccccccc")],
4214    "fill a file with octets",
4215    "\
4216 This command creates a new file called C<path>.  The initial
4217 content of the file is C<len> octets of C<c>, where C<c>
4218 must be a number in the range C<[0..255]>.
4219
4220 To fill a file with zero bytes (sparsely), it is
4221 much more efficient to use C<guestfs_truncate_size>.");
4222
4223   ("available", (RErr, [StringList "groups"]), 216, [],
4224    [InitNone, Always, TestRun [["available"; ""]]],
4225    "test availability of some parts of the API",
4226    "\
4227 This command is used to check the availability of some
4228 groups of functionality in the appliance, which not all builds of
4229 the libguestfs appliance will be able to provide.
4230
4231 The libguestfs groups, and the functions that those
4232 groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
4233
4234 The argument C<groups> is a list of group names, eg:
4235 C<[\"inotify\", \"augeas\"]> would check for the availability of
4236 the Linux inotify functions and Augeas (configuration file
4237 editing) functions.
4238
4239 The command returns no error if I<all> requested groups are available.
4240
4241 It fails with an error if one or more of the requested
4242 groups is unavailable in the appliance.
4243
4244 If an unknown group name is included in the
4245 list of groups then an error is always returned.
4246
4247 I<Notes:>
4248
4249 =over 4
4250
4251 =item *
4252
4253 You must call C<guestfs_launch> before calling this function.
4254
4255 The reason is because we don't know what groups are
4256 supported by the appliance/daemon until it is running and can
4257 be queried.
4258
4259 =item *
4260
4261 If a group of functions is available, this does not necessarily
4262 mean that they will work.  You still have to check for errors
4263 when calling individual API functions even if they are
4264 available.
4265
4266 =item *
4267
4268 It is usually the job of distro packagers to build
4269 complete functionality into the libguestfs appliance.
4270 Upstream libguestfs, if built from source with all
4271 requirements satisfied, will support everything.
4272
4273 =item *
4274
4275 This call was added in version C<1.0.80>.  In previous
4276 versions of libguestfs all you could do would be to speculatively
4277 execute a command to find out if the daemon implemented it.
4278 See also C<guestfs_version>.
4279
4280 =back");
4281
4282   ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
4283    [InitBasicFS, Always, TestOutputBuffer (
4284       [["write_file"; "/src"; "hello, world"; "0"];
4285        ["dd"; "/src"; "/dest"];
4286        ["read_file"; "/dest"]], "hello, world")],
4287    "copy from source to destination using dd",
4288    "\
4289 This command copies from one source device or file C<src>
4290 to another destination device or file C<dest>.  Normally you
4291 would use this to copy to or from a device or partition, for
4292 example to duplicate a filesystem.
4293
4294 If the destination is a device, it must be as large or larger
4295 than the source file or device, otherwise the copy will fail.
4296 This command cannot do partial copies (see C<guestfs_copy_size>).");
4297
4298   ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
4299    [InitBasicFS, Always, TestOutputInt (
4300       [["write_file"; "/file"; "hello, world"; "0"];
4301        ["filesize"; "/file"]], 12)],
4302    "return the size of the file in bytes",
4303    "\
4304 This command returns the size of C<file> in bytes.
4305
4306 To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
4307 C<guestfs_is_dir>, C<guestfs_is_file> etc.
4308 To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
4309
4310   ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
4311    [InitBasicFSonLVM, Always, TestOutputList (
4312       [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
4313        ["lvs"]], ["/dev/VG/LV2"])],
4314    "rename an LVM logical volume",
4315    "\
4316 Rename a logical volume C<logvol> with the new name C<newlogvol>.");
4317
4318   ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
4319    [InitBasicFSonLVM, Always, TestOutputList (
4320       [["umount"; "/"];
4321        ["vg_activate"; "false"; "VG"];
4322        ["vgrename"; "VG"; "VG2"];
4323        ["vg_activate"; "true"; "VG2"];
4324        ["mount_options"; ""; "/dev/VG2/LV"; "/"];
4325        ["vgs"]], ["VG2"])],
4326    "rename an LVM volume group",
4327    "\
4328 Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
4329
4330   ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
4331    [InitISOFS, Always, TestOutputBuffer (
4332       [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
4333    "list the contents of a single file in an initrd",
4334    "\
4335 This command unpacks the file C<filename> from the initrd file
4336 called C<initrdpath>.  The filename must be given I<without> the
4337 initial C</> character.
4338
4339 For example, in guestfish you could use the following command
4340 to examine the boot script (usually called C</init>)
4341 contained in a Linux initrd or initramfs image:
4342
4343  initrd-cat /boot/initrd-<version>.img init
4344
4345 See also C<guestfs_initrd_list>.");
4346
4347   ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
4348    [],
4349    "get the UUID of a physical volume",
4350    "\
4351 This command returns the UUID of the LVM PV C<device>.");
4352
4353   ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
4354    [],
4355    "get the UUID of a volume group",
4356    "\
4357 This command returns the UUID of the LVM VG named C<vgname>.");
4358
4359   ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
4360    [],
4361    "get the UUID of a logical volume",
4362    "\
4363 This command returns the UUID of the LVM LV C<device>.");
4364
4365   ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
4366    [],
4367    "get the PV UUIDs containing the volume group",
4368    "\
4369 Given a VG called C<vgname>, this returns the UUIDs of all
4370 the physical volumes that this volume group resides on.
4371
4372 You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
4373 calls to associate physical volumes and volume groups.
4374
4375 See also C<guestfs_vglvuuids>.");
4376
4377   ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
4378    [],
4379    "get the LV UUIDs of all LVs in the volume group",
4380    "\
4381 Given a VG called C<vgname>, this returns the UUIDs of all
4382 the logical volumes created in this volume group.
4383
4384 You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
4385 calls to associate logical volumes and volume groups.
4386
4387 See also C<guestfs_vgpvuuids>.");
4388
4389   ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
4390    [InitBasicFS, Always, TestOutputBuffer (
4391       [["write_file"; "/src"; "hello, world"; "0"];
4392        ["copy_size"; "/src"; "/dest"; "5"];
4393        ["read_file"; "/dest"]], "hello")],
4394    "copy size bytes from source to destination using dd",
4395    "\
4396 This command copies exactly C<size> bytes from one source device
4397 or file C<src> to another destination device or file C<dest>.
4398
4399 Note this will fail if the source is too short or if the destination
4400 is not large enough.");
4401
4402   ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
4403    [InitEmpty, Always, TestRun (
4404       [["part_init"; "/dev/sda"; "mbr"];
4405        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4406        ["part_del"; "/dev/sda"; "1"]])],
4407    "delete a partition",
4408    "\
4409 This command deletes the partition numbered C<partnum> on C<device>.
4410
4411 Note that in the case of MBR partitioning, deleting an
4412 extended partition also deletes any logical partitions
4413 it contains.");
4414
4415   ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
4416    [InitEmpty, Always, TestOutputTrue (
4417       [["part_init"; "/dev/sda"; "mbr"];
4418        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4419        ["part_set_bootable"; "/dev/sda"; "1"; "true"];
4420        ["part_get_bootable"; "/dev/sda"; "1"]])],
4421    "return true if a partition is bootable",
4422    "\
4423 This command returns true if the partition C<partnum> on
4424 C<device> has the bootable flag set.
4425
4426 See also C<guestfs_part_set_bootable>.");
4427
4428   ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [],
4429    [InitEmpty, Always, TestOutputInt (
4430       [["part_init"; "/dev/sda"; "mbr"];
4431        ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
4432        ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
4433        ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
4434    "get the MBR type byte (ID byte) from a partition",
4435    "\
4436 Returns the MBR type byte (also known as the ID byte) from
4437 the numbered partition C<partnum>.
4438
4439 Note that only MBR (old DOS-style) partitions have type bytes.
4440 You will get undefined results for other partition table
4441 types (see C<guestfs_part_get_parttype>).");
4442
4443   ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
4444    [], (* tested by part_get_mbr_id *)
4445    "set the MBR type byte (ID byte) of a partition",
4446    "\
4447 Sets the MBR type byte (also known as the ID byte) of
4448 the numbered partition C<partnum> to C<idbyte>.  Note
4449 that the type bytes quoted in most documentation are
4450 in fact hexadecimal numbers, but usually documented
4451 without any leading \"0x\" which might be confusing.
4452
4453 Note that only MBR (old DOS-style) partitions have type bytes.
4454 You will get undefined results for other partition table
4455 types (see C<guestfs_part_get_parttype>).");
4456
4457 ]
4458
4459 let all_functions = non_daemon_functions @ daemon_functions
4460
4461 (* In some places we want the functions to be displayed sorted
4462  * alphabetically, so this is useful:
4463  *)
4464 let all_functions_sorted =
4465   List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
4466                compare n1 n2) all_functions
4467
4468 (* Field types for structures. *)
4469 type field =
4470   | FChar                       (* C 'char' (really, a 7 bit byte). *)
4471   | FString                     (* nul-terminated ASCII string, NOT NULL. *)
4472   | FBuffer                     (* opaque buffer of bytes, (char *, int) pair *)
4473   | FUInt32
4474   | FInt32
4475   | FUInt64
4476   | FInt64
4477   | FBytes                      (* Any int measure that counts bytes. *)
4478   | FUUID                       (* 32 bytes long, NOT nul-terminated. *)
4479   | FOptPercent                 (* [0..100], or -1 meaning "not present". *)
4480
4481 (* Because we generate extra parsing code for LVM command line tools,
4482  * we have to pull out the LVM columns separately here.
4483  *)
4484 let lvm_pv_cols = [
4485   "pv_name", FString;
4486   "pv_uuid", FUUID;
4487   "pv_fmt", FString;
4488   "pv_size", FBytes;
4489   "dev_size", FBytes;
4490   "pv_free", FBytes;
4491   "pv_used", FBytes;
4492   "pv_attr", FString (* XXX *);
4493   "pv_pe_count", FInt64;
4494   "pv_pe_alloc_count", FInt64;
4495   "pv_tags", FString;
4496   "pe_start", FBytes;
4497   "pv_mda_count", FInt64;
4498   "pv_mda_free", FBytes;
4499   (* Not in Fedora 10:
4500      "pv_mda_size", FBytes;
4501   *)
4502 ]
4503 let lvm_vg_cols = [
4504   "vg_name", FString;
4505   "vg_uuid", FUUID;
4506   "vg_fmt", FString;
4507   "vg_attr", FString (* XXX *);
4508   "vg_size", FBytes;
4509   "vg_free", FBytes;
4510   "vg_sysid", FString;
4511   "vg_extent_size", FBytes;
4512   "vg_extent_count", FInt64;
4513   "vg_free_count", FInt64;
4514   "max_lv", FInt64;
4515   "max_pv", FInt64;
4516   "pv_count", FInt64;
4517   "lv_count", FInt64;
4518   "snap_count", FInt64;
4519   "vg_seqno", FInt64;
4520   "vg_tags", FString;
4521   "vg_mda_count", FInt64;
4522   "vg_mda_free", FBytes;
4523   (* Not in Fedora 10:
4524      "vg_mda_size", FBytes;
4525   *)
4526 ]
4527 let lvm_lv_cols = [
4528   "lv_name", FString;
4529   "lv_uuid", FUUID;
4530   "lv_attr", FString (* XXX *);
4531   "lv_major", FInt64;
4532   "lv_minor", FInt64;
4533   "lv_kernel_major", FInt64;
4534   "lv_kernel_minor", FInt64;
4535   "lv_size", FBytes;
4536   "seg_count", FInt64;
4537   "origin", FString;
4538   "snap_percent", FOptPercent;
4539   "copy_percent", FOptPercent;
4540   "move_pv", FString;
4541   "lv_tags", FString;
4542   "mirror_log", FString;
4543   "modules", FString;
4544 ]
4545
4546 (* Names and fields in all structures (in RStruct and RStructList)
4547  * that we support.
4548  *)
4549 let structs = [
4550   (* The old RIntBool return type, only ever used for aug_defnode.  Do
4551    * not use this struct in any new code.
4552    *)
4553   "int_bool", [
4554     "i", FInt32;                (* for historical compatibility *)
4555     "b", FInt32;                (* for historical compatibility *)
4556   ];
4557
4558   (* LVM PVs, VGs, LVs. *)
4559   "lvm_pv", lvm_pv_cols;
4560   "lvm_vg", lvm_vg_cols;
4561   "lvm_lv", lvm_lv_cols;
4562
4563   (* Column names and types from stat structures.
4564    * NB. Can't use things like 'st_atime' because glibc header files
4565    * define some of these as macros.  Ugh.
4566    *)
4567   "stat", [
4568     "dev", FInt64;
4569     "ino", FInt64;
4570     "mode", FInt64;
4571     "nlink", FInt64;
4572     "uid", FInt64;
4573     "gid", FInt64;
4574     "rdev", FInt64;
4575     "size", FInt64;
4576     "blksize", FInt64;
4577     "blocks", FInt64;
4578     "atime", FInt64;
4579     "mtime", FInt64;
4580     "ctime", FInt64;
4581   ];
4582   "statvfs", [
4583     "bsize", FInt64;
4584     "frsize", FInt64;
4585     "blocks", FInt64;
4586     "bfree", FInt64;
4587     "bavail", FInt64;
4588     "files", FInt64;
4589     "ffree", FInt64;
4590     "favail", FInt64;
4591     "fsid", FInt64;
4592     "flag", FInt64;
4593     "namemax", FInt64;
4594   ];
4595
4596   (* Column names in dirent structure. *)
4597   "dirent", [
4598     "ino", FInt64;
4599     (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
4600     "ftyp", FChar;
4601     "name", FString;
4602   ];
4603
4604   (* Version numbers. *)
4605   "version", [
4606     "major", FInt64;
4607     "minor", FInt64;
4608     "release", FInt64;
4609     "extra", FString;
4610   ];
4611
4612   (* Extended attribute. *)
4613   "xattr", [
4614     "attrname", FString;
4615     "attrval", FBuffer;
4616   ];
4617
4618   (* Inotify events. *)
4619   "inotify_event", [
4620     "in_wd", FInt64;
4621     "in_mask", FUInt32;
4622     "in_cookie", FUInt32;
4623     "in_name", FString;
4624   ];
4625
4626   (* Partition table entry. *)
4627   "partition", [
4628     "part_num", FInt32;
4629     "part_start", FBytes;
4630     "part_end", FBytes;
4631     "part_size", FBytes;
4632   ];
4633 ] (* end of structs *)
4634
4635 (* Ugh, Java has to be different ..
4636  * These names are also used by the Haskell bindings.
4637  *)
4638 let java_structs = [
4639   "int_bool", "IntBool";
4640   "lvm_pv", "PV";
4641   "lvm_vg", "VG";
4642   "lvm_lv", "LV";
4643   "stat", "Stat";
4644   "statvfs", "StatVFS";
4645   "dirent", "Dirent";
4646   "version", "Version";
4647   "xattr", "XAttr";
4648   "inotify_event", "INotifyEvent";
4649   "partition", "Partition";
4650 ]
4651
4652 (* What structs are actually returned. *)
4653 type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
4654
4655 (* Returns a list of RStruct/RStructList structs that are returned
4656  * by any function.  Each element of returned list is a pair:
4657  *
4658  * (structname, RStructOnly)
4659  *    == there exists function which returns RStruct (_, structname)
4660  * (structname, RStructListOnly)
4661  *    == there exists function which returns RStructList (_, structname)
4662  * (structname, RStructAndList)
4663  *    == there are functions returning both RStruct (_, structname)
4664  *                                      and RStructList (_, structname)
4665  *)
4666 let rstructs_used_by functions =
4667   (* ||| is a "logical OR" for rstructs_used_t *)
4668   let (|||) a b =
4669     match a, b with
4670     | RStructAndList, _
4671     | _, RStructAndList -> RStructAndList
4672     | RStructOnly, RStructListOnly
4673     | RStructListOnly, RStructOnly -> RStructAndList
4674     | RStructOnly, RStructOnly -> RStructOnly
4675     | RStructListOnly, RStructListOnly -> RStructListOnly
4676   in
4677
4678   let h = Hashtbl.create 13 in
4679
4680   (* if elem->oldv exists, update entry using ||| operator,
4681    * else just add elem->newv to the hash
4682    *)
4683   let update elem newv =
4684     try  let oldv = Hashtbl.find h elem in
4685          Hashtbl.replace h elem (newv ||| oldv)
4686     with Not_found -> Hashtbl.add h elem newv
4687   in
4688
4689   List.iter (
4690     fun (_, style, _, _, _, _, _) ->
4691       match fst style with
4692       | RStruct (_, structname) -> update structname RStructOnly
4693       | RStructList (_, structname) -> update structname RStructListOnly
4694       | _ -> ()
4695   ) functions;
4696
4697   (* return key->values as a list of (key,value) *)
4698   Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
4699
4700 (* Used for testing language bindings. *)
4701 type callt =
4702   | CallString of string
4703   | CallOptString of string option
4704   | CallStringList of string list
4705   | CallInt of int
4706   | CallInt64 of int64
4707   | CallBool of bool
4708
4709 (* Used to memoize the result of pod2text. *)
4710 let pod2text_memo_filename = "src/.pod2text.data"
4711 let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
4712   try
4713     let chan = open_in pod2text_memo_filename in
4714     let v = input_value chan in
4715     close_in chan;
4716     v
4717   with
4718     _ -> Hashtbl.create 13
4719 let pod2text_memo_updated () =
4720   let chan = open_out pod2text_memo_filename in
4721   output_value chan pod2text_memo;
4722   close_out chan
4723
4724 (* Useful functions.
4725  * Note we don't want to use any external OCaml libraries which
4726  * makes this a bit harder than it should be.
4727  *)
4728 module StringMap = Map.Make (String)
4729
4730 let failwithf fs = ksprintf failwith fs
4731
4732 let unique = let i = ref 0 in fun () -> incr i; !i
4733
4734 let replace_char s c1 c2 =
4735   let s2 = String.copy s in
4736   let r = ref false in
4737   for i = 0 to String.length s2 - 1 do
4738     if String.unsafe_get s2 i = c1 then (
4739       String.unsafe_set s2 i c2;
4740       r := true
4741     )
4742   done;
4743   if not !r then s else s2
4744
4745 let isspace c =
4746   c = ' '
4747   (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
4748
4749 let triml ?(test = isspace) str =
4750   let i = ref 0 in
4751   let n = ref (String.length str) in
4752   while !n > 0 && test str.[!i]; do
4753     decr n;
4754     incr i
4755   done;
4756   if !i = 0 then str
4757   else String.sub str !i !n
4758
4759 let trimr ?(test = isspace) str =
4760   let n = ref (String.length str) in
4761   while !n > 0 && test str.[!n-1]; do
4762     decr n
4763   done;
4764   if !n = String.length str then str
4765   else String.sub str 0 !n
4766
4767 let trim ?(test = isspace) str =
4768   trimr ~test (triml ~test str)
4769
4770 let rec find s sub =
4771   let len = String.length s in
4772   let sublen = String.length sub in
4773   let rec loop i =
4774     if i <= len-sublen then (
4775       let rec loop2 j =
4776         if j < sublen then (
4777           if s.[i+j] = sub.[j] then loop2 (j+1)
4778           else -1
4779         ) else
4780           i (* found *)
4781       in
4782       let r = loop2 0 in
4783       if r = -1 then loop (i+1) else r
4784     ) else
4785       -1 (* not found *)
4786   in
4787   loop 0
4788
4789 let rec replace_str s s1 s2 =
4790   let len = String.length s in
4791   let sublen = String.length s1 in
4792   let i = find s s1 in
4793   if i = -1 then s
4794   else (
4795     let s' = String.sub s 0 i in
4796     let s'' = String.sub s (i+sublen) (len-i-sublen) in
4797     s' ^ s2 ^ replace_str s'' s1 s2
4798   )
4799
4800 let rec string_split sep str =
4801   let len = String.length str in
4802   let seplen = String.length sep in
4803   let i = find str sep in
4804   if i = -1 then [str]
4805   else (
4806     let s' = String.sub str 0 i in
4807     let s'' = String.sub str (i+seplen) (len-i-seplen) in
4808     s' :: string_split sep s''
4809   )
4810
4811 let files_equal n1 n2 =
4812   let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
4813   match Sys.command cmd with
4814   | 0 -> true
4815   | 1 -> false
4816   | i -> failwithf "%s: failed with error code %d" cmd i
4817
4818 let rec filter_map f = function
4819   | [] -> []
4820   | x :: xs ->
4821       match f x with
4822       | Some y -> y :: filter_map f xs
4823       | None -> filter_map f xs
4824
4825 let rec find_map f = function
4826   | [] -> raise Not_found
4827   | x :: xs ->
4828       match f x with
4829       | Some y -> y
4830       | None -> find_map f xs
4831
4832 let iteri f xs =
4833   let rec loop i = function
4834     | [] -> ()
4835     | x :: xs -> f i x; loop (i+1) xs
4836   in
4837   loop 0 xs
4838
4839 let mapi f xs =
4840   let rec loop i = function
4841     | [] -> []
4842     | x :: xs -> let r = f i x in r :: loop (i+1) xs
4843   in
4844   loop 0 xs
4845
4846 let count_chars c str =
4847   let count = ref 0 in
4848   for i = 0 to String.length str - 1 do
4849     if c = String.unsafe_get str i then incr count
4850   done;
4851   !count
4852
4853 let name_of_argt = function
4854   | Pathname n | Device n | Dev_or_Path n | String n | OptString n
4855   | StringList n | DeviceList n | Bool n | Int n | Int64 n
4856   | FileIn n | FileOut n -> n
4857
4858 let java_name_of_struct typ =
4859   try List.assoc typ java_structs
4860   with Not_found ->
4861     failwithf
4862       "java_name_of_struct: no java_structs entry corresponding to %s" typ
4863
4864 let cols_of_struct typ =
4865   try List.assoc typ structs
4866   with Not_found ->
4867     failwithf "cols_of_struct: unknown struct %s" typ
4868
4869 let seq_of_test = function
4870   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
4871   | TestOutputListOfDevices (s, _)
4872   | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
4873   | TestOutputTrue s | TestOutputFalse s
4874   | TestOutputLength (s, _) | TestOutputBuffer (s, _)
4875   | TestOutputStruct (s, _)
4876   | TestLastFail s -> s
4877
4878 (* Handling for function flags. *)
4879 let protocol_limit_warning =
4880   "Because of the message protocol, there is a transfer limit
4881 of somewhere between 2MB and 4MB.  See L<guestfs(3)/PROTOCOL LIMITS>."
4882
4883 let danger_will_robinson =
4884   "B<This command is dangerous.  Without careful use you
4885 can easily destroy all your data>."
4886
4887 let deprecation_notice flags =
4888   try
4889     let alt =
4890       find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
4891     let txt =
4892       sprintf "This function is deprecated.
4893 In new code, use the C<%s> call instead.
4894
4895 Deprecated functions will not be removed from the API, but the
4896 fact that they are deprecated indicates that there are problems
4897 with correct use of these functions." alt in
4898     Some txt
4899   with
4900     Not_found -> None
4901
4902 (* Create list of optional groups. *)
4903 let optgroups =
4904   let h = Hashtbl.create 13 in
4905   List.iter (
4906     fun (name, _, _, flags, _, _, _) ->
4907       List.iter (
4908         function
4909         | Optional group ->
4910             let names = try Hashtbl.find h group with Not_found -> [] in
4911             Hashtbl.replace h group (name :: names)
4912         | _ -> ()
4913       ) flags
4914   ) daemon_functions;
4915   let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
4916   let groups =
4917     List.map (
4918       fun group -> group, List.sort compare (Hashtbl.find h group)
4919     ) groups in
4920   List.sort (fun x y -> compare (fst x) (fst y)) groups
4921
4922 (* Check function names etc. for consistency. *)
4923 let check_functions () =
4924   let contains_uppercase str =
4925     let len = String.length str in
4926     let rec loop i =
4927       if i >= len then false
4928       else (
4929         let c = str.[i] in
4930         if c >= 'A' && c <= 'Z' then true
4931         else loop (i+1)
4932       )
4933     in
4934     loop 0
4935   in
4936
4937   (* Check function names. *)
4938   List.iter (
4939     fun (name, _, _, _, _, _, _) ->
4940       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
4941         failwithf "function name %s does not need 'guestfs' prefix" name;
4942       if name = "" then
4943         failwithf "function name is empty";
4944       if name.[0] < 'a' || name.[0] > 'z' then
4945         failwithf "function name %s must start with lowercase a-z" name;
4946       if String.contains name '-' then
4947         failwithf "function name %s should not contain '-', use '_' instead."
4948           name
4949   ) all_functions;
4950
4951   (* Check function parameter/return names. *)
4952   List.iter (
4953     fun (name, style, _, _, _, _, _) ->
4954       let check_arg_ret_name n =
4955         if contains_uppercase n then
4956           failwithf "%s param/ret %s should not contain uppercase chars"
4957             name n;
4958         if String.contains n '-' || String.contains n '_' then
4959           failwithf "%s param/ret %s should not contain '-' or '_'"
4960             name n;
4961         if n = "value" then
4962           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;
4963         if n = "int" || n = "char" || n = "short" || n = "long" then
4964           failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
4965         if n = "i" || n = "n" then
4966           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
4967         if n = "argv" || n = "args" then
4968           failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
4969
4970         (* List Haskell, OCaml and C keywords here.
4971          * http://www.haskell.org/haskellwiki/Keywords
4972          * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
4973          * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
4974          * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
4975          *   |perl -pe 's/(.+)/"$1";/'|fmt -70
4976          * Omitting _-containing words, since they're handled above.
4977          * Omitting the OCaml reserved word, "val", is ok,
4978          * and saves us from renaming several parameters.
4979          *)
4980         let reserved = [
4981           "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
4982           "char"; "class"; "const"; "constraint"; "continue"; "data";
4983           "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
4984           "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
4985           "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
4986           "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
4987           "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
4988           "interface";
4989           "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
4990           "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
4991           "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
4992           "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
4993           "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
4994           "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
4995           "volatile"; "when"; "where"; "while";
4996           ] in
4997         if List.mem n reserved then
4998           failwithf "%s has param/ret using reserved word %s" name n;
4999       in
5000
5001       (match fst style with
5002        | RErr -> ()
5003        | RInt n | RInt64 n | RBool n
5004        | RConstString n | RConstOptString n | RString n
5005        | RStringList n | RStruct (n, _) | RStructList (n, _)
5006        | RHashtable n | RBufferOut n ->
5007            check_arg_ret_name n
5008       );
5009       List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
5010   ) all_functions;
5011
5012   (* Check short descriptions. *)
5013   List.iter (
5014     fun (name, _, _, _, _, shortdesc, _) ->
5015       if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
5016         failwithf "short description of %s should begin with lowercase." name;
5017       let c = shortdesc.[String.length shortdesc-1] in
5018       if c = '\n' || c = '.' then
5019         failwithf "short description of %s should not end with . or \\n." name
5020   ) all_functions;
5021
5022   (* Check long descriptions. *)
5023   List.iter (
5024     fun (name, _, _, _, _, _, longdesc) ->
5025       if longdesc.[String.length longdesc-1] = '\n' then
5026         failwithf "long description of %s should not end with \\n." name
5027   ) all_functions;
5028
5029   (* Check proc_nrs. *)
5030   List.iter (
5031     fun (name, _, proc_nr, _, _, _, _) ->
5032       if proc_nr <= 0 then
5033         failwithf "daemon function %s should have proc_nr > 0" name
5034   ) daemon_functions;
5035
5036   List.iter (
5037     fun (name, _, proc_nr, _, _, _, _) ->
5038       if proc_nr <> -1 then
5039         failwithf "non-daemon function %s should have proc_nr -1" name
5040   ) non_daemon_functions;
5041
5042   let proc_nrs =
5043     List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
5044       daemon_functions in
5045   let proc_nrs =
5046     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
5047   let rec loop = function
5048     | [] -> ()
5049     | [_] -> ()
5050     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
5051         loop rest
5052     | (name1,nr1) :: (name2,nr2) :: _ ->
5053         failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
5054           name1 name2 nr1 nr2
5055   in
5056   loop proc_nrs;
5057
5058   (* Check tests. *)
5059   List.iter (
5060     function
5061       (* Ignore functions that have no tests.  We generate a
5062        * warning when the user does 'make check' instead.
5063        *)
5064     | name, _, _, _, [], _, _ -> ()
5065     | name, _, _, _, tests, _, _ ->
5066         let funcs =
5067           List.map (
5068             fun (_, _, test) ->
5069               match seq_of_test test with
5070               | [] ->
5071                   failwithf "%s has a test containing an empty sequence" name
5072               | cmds -> List.map List.hd cmds
5073           ) tests in
5074         let funcs = List.flatten funcs in
5075
5076         let tested = List.mem name funcs in
5077
5078         if not tested then
5079           failwithf "function %s has tests but does not test itself" name
5080   ) all_functions
5081
5082 (* 'pr' prints to the current output file. *)
5083 let chan = ref Pervasives.stdout
5084 let lines = ref 0
5085 let pr fs =
5086   ksprintf
5087     (fun str ->
5088        let i = count_chars '\n' str in
5089        lines := !lines + i;
5090        output_string !chan str
5091     ) fs
5092
5093 let copyright_years =
5094   let this_year = 1900 + (localtime (time ())).tm_year in
5095   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
5096
5097 (* Generate a header block in a number of standard styles. *)
5098 type comment_style =
5099     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
5100 type license = GPLv2plus | LGPLv2plus
5101
5102 let generate_header ?(extra_inputs = []) comment license =
5103   let inputs = "src/generator.ml" :: extra_inputs in
5104   let c = match comment with
5105     | CStyle ->         pr "/* "; " *"
5106     | CPlusPlusStyle -> pr "// "; "//"
5107     | HashStyle ->      pr "# ";  "#"
5108     | OCamlStyle ->     pr "(* "; " *"
5109     | HaskellStyle ->   pr "{- "; "  " in
5110   pr "libguestfs generated file\n";
5111   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
5112   List.iter (pr "%s   %s\n" c) inputs;
5113   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
5114   pr "%s\n" c;
5115   pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
5116   pr "%s\n" c;
5117   (match license with
5118    | GPLv2plus ->
5119        pr "%s This program is free software; you can redistribute it and/or modify\n" c;
5120        pr "%s it under the terms of the GNU General Public License as published by\n" c;
5121        pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
5122        pr "%s (at your option) any later version.\n" c;
5123        pr "%s\n" c;
5124        pr "%s This program is distributed in the hope that it will be useful,\n" c;
5125        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5126        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
5127        pr "%s GNU General Public License for more details.\n" c;
5128        pr "%s\n" c;
5129        pr "%s You should have received a copy of the GNU General Public License along\n" c;
5130        pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
5131        pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
5132
5133    | LGPLv2plus ->
5134        pr "%s This library is free software; you can redistribute it and/or\n" c;
5135        pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
5136        pr "%s License as published by the Free Software Foundation; either\n" c;
5137        pr "%s version 2 of the License, or (at your option) any later version.\n" c;
5138        pr "%s\n" c;
5139        pr "%s This library is distributed in the hope that it will be useful,\n" c;
5140        pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
5141        pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
5142        pr "%s Lesser General Public License for more details.\n" c;
5143        pr "%s\n" c;
5144        pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
5145        pr "%s License along with this library; if not, write to the Free Software\n" c;
5146        pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
5147   );
5148   (match comment with
5149    | CStyle -> pr " */\n"
5150    | CPlusPlusStyle
5151    | HashStyle -> ()
5152    | OCamlStyle -> pr " *)\n"
5153    | HaskellStyle -> pr "-}\n"
5154   );
5155   pr "\n"
5156
5157 (* Start of main code generation functions below this line. *)
5158
5159 (* Generate the pod documentation for the C API. *)
5160 let rec generate_actions_pod () =
5161   List.iter (
5162     fun (shortname, style, _, flags, _, _, longdesc) ->
5163       if not (List.mem NotInDocs flags) then (
5164         let name = "guestfs_" ^ shortname in
5165         pr "=head2 %s\n\n" name;
5166         pr " ";
5167         generate_prototype ~extern:false ~handle:"g" name style;
5168         pr "\n\n";
5169         pr "%s\n\n" longdesc;
5170         (match fst style with
5171          | RErr ->
5172              pr "This function returns 0 on success or -1 on error.\n\n"
5173          | RInt _ ->
5174              pr "On error this function returns -1.\n\n"
5175          | RInt64 _ ->
5176              pr "On error this function returns -1.\n\n"
5177          | RBool _ ->
5178              pr "This function returns a C truth value on success or -1 on error.\n\n"
5179          | RConstString _ ->
5180              pr "This function returns a string, or NULL on error.
5181 The string is owned by the guest handle and must I<not> be freed.\n\n"
5182          | RConstOptString _ ->
5183              pr "This function returns a string which may be NULL.
5184 There is way to return an error from this function.
5185 The string is owned by the guest handle and must I<not> be freed.\n\n"
5186          | RString _ ->
5187              pr "This function returns a string, or NULL on error.
5188 I<The caller must free the returned string after use>.\n\n"
5189          | RStringList _ ->
5190              pr "This function returns a NULL-terminated array of strings
5191 (like L<environ(3)>), or NULL if there was an error.
5192 I<The caller must free the strings and the array after use>.\n\n"
5193          | RStruct (_, typ) ->
5194              pr "This function returns a C<struct guestfs_%s *>,
5195 or NULL if there was an error.
5196 I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
5197          | RStructList (_, typ) ->
5198              pr "This function returns a C<struct guestfs_%s_list *>
5199 (see E<lt>guestfs-structs.hE<gt>),
5200 or NULL if there was an error.
5201 I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
5202          | RHashtable _ ->
5203              pr "This function returns a NULL-terminated array of
5204 strings, or NULL if there was an error.
5205 The array of strings will always have length C<2n+1>, where
5206 C<n> keys and values alternate, followed by the trailing NULL entry.
5207 I<The caller must free the strings and the array after use>.\n\n"
5208          | RBufferOut _ ->
5209              pr "This function returns a buffer, or NULL on error.
5210 The size of the returned buffer is written to C<*size_r>.
5211 I<The caller must free the returned buffer after use>.\n\n"
5212         );
5213         if List.mem ProtocolLimitWarning flags then
5214           pr "%s\n\n" protocol_limit_warning;
5215         if List.mem DangerWillRobinson flags then
5216           pr "%s\n\n" danger_will_robinson;
5217         match deprecation_notice flags with
5218         | None -> ()
5219         | Some txt -> pr "%s\n\n" txt
5220       )
5221   ) all_functions_sorted
5222
5223 and generate_structs_pod () =
5224   (* Structs documentation. *)
5225   List.iter (
5226     fun (typ, cols) ->
5227       pr "=head2 guestfs_%s\n" typ;
5228       pr "\n";
5229       pr " struct guestfs_%s {\n" typ;
5230       List.iter (
5231         function
5232         | name, FChar -> pr "   char %s;\n" name
5233         | name, FUInt32 -> pr "   uint32_t %s;\n" name
5234         | name, FInt32 -> pr "   int32_t %s;\n" name
5235         | name, (FUInt64|FBytes) -> pr "   uint64_t %s;\n" name
5236         | name, FInt64 -> pr "   int64_t %s;\n" name
5237         | name, FString -> pr "   char *%s;\n" name
5238         | name, FBuffer ->
5239             pr "   /* The next two fields describe a byte array. */\n";
5240             pr "   uint32_t %s_len;\n" name;
5241             pr "   char *%s;\n" name
5242         | name, FUUID ->
5243             pr "   /* The next field is NOT nul-terminated, be careful when printing it: */\n";
5244             pr "   char %s[32];\n" name
5245         | name, FOptPercent ->
5246             pr "   /* The next field is [0..100] or -1 meaning 'not present': */\n";
5247             pr "   float %s;\n" name
5248       ) cols;
5249       pr " };\n";
5250       pr " \n";
5251       pr " struct guestfs_%s_list {\n" typ;
5252       pr "   uint32_t len; /* Number of elements in list. */\n";
5253       pr "   struct guestfs_%s *val; /* Elements. */\n" typ;
5254       pr " };\n";
5255       pr " \n";
5256       pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
5257       pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
5258         typ typ;
5259       pr "\n"
5260   ) structs
5261
5262 and generate_availability_pod () =
5263   (* Availability documentation. *)
5264   pr "=over 4\n";
5265   pr "\n";
5266   List.iter (
5267     fun (group, functions) ->
5268       pr "=item B<%s>\n" group;
5269       pr "\n";
5270       pr "The following functions:\n";
5271       List.iter (pr "L</guestfs_%s>\n") functions;
5272       pr "\n"
5273   ) optgroups;
5274   pr "=back\n";
5275   pr "\n"
5276
5277 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
5278  * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
5279  *
5280  * We have to use an underscore instead of a dash because otherwise
5281  * rpcgen generates incorrect code.
5282  *
5283  * This header is NOT exported to clients, but see also generate_structs_h.
5284  *)
5285 and generate_xdr () =
5286   generate_header CStyle LGPLv2plus;
5287
5288   (* This has to be defined to get around a limitation in Sun's rpcgen. *)
5289   pr "typedef string str<>;\n";
5290   pr "\n";
5291
5292   (* Internal structures. *)
5293   List.iter (
5294     function
5295     | typ, cols ->
5296         pr "struct guestfs_int_%s {\n" typ;
5297         List.iter (function
5298                    | name, FChar -> pr "  char %s;\n" name
5299                    | name, FString -> pr "  string %s<>;\n" name
5300                    | name, FBuffer -> pr "  opaque %s<>;\n" name
5301                    | name, FUUID -> pr "  opaque %s[32];\n" name
5302                    | name, (FInt32|FUInt32) -> pr "  int %s;\n" name
5303                    | name, (FInt64|FUInt64|FBytes) -> pr "  hyper %s;\n" name
5304                    | name, FOptPercent -> pr "  float %s;\n" name
5305                   ) cols;
5306         pr "};\n";
5307         pr "\n";
5308         pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
5309         pr "\n";
5310   ) structs;
5311
5312   List.iter (
5313     fun (shortname, style, _, _, _, _, _) ->
5314       let name = "guestfs_" ^ shortname in
5315
5316       (match snd style with
5317        | [] -> ()
5318        | args ->
5319            pr "struct %s_args {\n" name;
5320            List.iter (
5321              function
5322              | Pathname n | Device n | Dev_or_Path n | String n ->
5323                  pr "  string %s<>;\n" n
5324              | OptString n -> pr "  str *%s;\n" n
5325              | StringList n | DeviceList n -> pr "  str %s<>;\n" n
5326              | Bool n -> pr "  bool %s;\n" n
5327              | Int n -> pr "  int %s;\n" n
5328              | Int64 n -> pr "  hyper %s;\n" n
5329              | FileIn _ | FileOut _ -> ()
5330            ) args;
5331            pr "};\n\n"
5332       );
5333       (match fst style with
5334        | RErr -> ()
5335        | RInt n ->
5336            pr "struct %s_ret {\n" name;
5337            pr "  int %s;\n" n;
5338            pr "};\n\n"
5339        | RInt64 n ->
5340            pr "struct %s_ret {\n" name;
5341            pr "  hyper %s;\n" n;
5342            pr "};\n\n"
5343        | RBool n ->
5344            pr "struct %s_ret {\n" name;
5345            pr "  bool %s;\n" n;
5346            pr "};\n\n"
5347        | RConstString _ | RConstOptString _ ->
5348            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5349        | RString n ->
5350            pr "struct %s_ret {\n" name;
5351            pr "  string %s<>;\n" n;
5352            pr "};\n\n"
5353        | RStringList n ->
5354            pr "struct %s_ret {\n" name;
5355            pr "  str %s<>;\n" n;
5356            pr "};\n\n"
5357        | RStruct (n, typ) ->
5358            pr "struct %s_ret {\n" name;
5359            pr "  guestfs_int_%s %s;\n" typ n;
5360            pr "};\n\n"
5361        | RStructList (n, typ) ->
5362            pr "struct %s_ret {\n" name;
5363            pr "  guestfs_int_%s_list %s;\n" typ n;
5364            pr "};\n\n"
5365        | RHashtable n ->
5366            pr "struct %s_ret {\n" name;
5367            pr "  str %s<>;\n" n;
5368            pr "};\n\n"
5369        | RBufferOut n ->
5370            pr "struct %s_ret {\n" name;
5371            pr "  opaque %s<>;\n" n;
5372            pr "};\n\n"
5373       );
5374   ) daemon_functions;
5375
5376   (* Table of procedure numbers. *)
5377   pr "enum guestfs_procedure {\n";
5378   List.iter (
5379     fun (shortname, _, proc_nr, _, _, _, _) ->
5380       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
5381   ) daemon_functions;
5382   pr "  GUESTFS_PROC_NR_PROCS\n";
5383   pr "};\n";
5384   pr "\n";
5385
5386   (* Having to choose a maximum message size is annoying for several
5387    * reasons (it limits what we can do in the API), but it (a) makes
5388    * the protocol a lot simpler, and (b) provides a bound on the size
5389    * of the daemon which operates in limited memory space.
5390    *)
5391   pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
5392   pr "\n";
5393
5394   (* Message header, etc. *)
5395   pr "\
5396 /* The communication protocol is now documented in the guestfs(3)
5397  * manpage.
5398  */
5399
5400 const GUESTFS_PROGRAM = 0x2000F5F5;
5401 const GUESTFS_PROTOCOL_VERSION = 1;
5402
5403 /* These constants must be larger than any possible message length. */
5404 const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
5405 const GUESTFS_CANCEL_FLAG = 0xffffeeee;
5406
5407 enum guestfs_message_direction {
5408   GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
5409   GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
5410 };
5411
5412 enum guestfs_message_status {
5413   GUESTFS_STATUS_OK = 0,
5414   GUESTFS_STATUS_ERROR = 1
5415 };
5416
5417 const GUESTFS_ERROR_LEN = 256;
5418
5419 struct guestfs_message_error {
5420   string error_message<GUESTFS_ERROR_LEN>;
5421 };
5422
5423 struct guestfs_message_header {
5424   unsigned prog;                     /* GUESTFS_PROGRAM */
5425   unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
5426   guestfs_procedure proc;            /* GUESTFS_PROC_x */
5427   guestfs_message_direction direction;
5428   unsigned serial;                   /* message serial number */
5429   guestfs_message_status status;
5430 };
5431
5432 const GUESTFS_MAX_CHUNK_SIZE = 8192;
5433
5434 struct guestfs_chunk {
5435   int cancel;                        /* if non-zero, transfer is cancelled */
5436   /* data size is 0 bytes if the transfer has finished successfully */
5437   opaque data<GUESTFS_MAX_CHUNK_SIZE>;
5438 };
5439 "
5440
5441 (* Generate the guestfs-structs.h file. *)
5442 and generate_structs_h () =
5443   generate_header CStyle LGPLv2plus;
5444
5445   (* This is a public exported header file containing various
5446    * structures.  The structures are carefully written to have
5447    * exactly the same in-memory format as the XDR structures that
5448    * we use on the wire to the daemon.  The reason for creating
5449    * copies of these structures here is just so we don't have to
5450    * export the whole of guestfs_protocol.h (which includes much
5451    * unrelated and XDR-dependent stuff that we don't want to be
5452    * public, or required by clients).
5453    *
5454    * To reiterate, we will pass these structures to and from the
5455    * client with a simple assignment or memcpy, so the format
5456    * must be identical to what rpcgen / the RFC defines.
5457    *)
5458
5459   (* Public structures. *)
5460   List.iter (
5461     fun (typ, cols) ->
5462       pr "struct guestfs_%s {\n" typ;
5463       List.iter (
5464         function
5465         | name, FChar -> pr "  char %s;\n" name
5466         | name, FString -> pr "  char *%s;\n" name
5467         | name, FBuffer ->
5468             pr "  uint32_t %s_len;\n" name;
5469             pr "  char *%s;\n" name
5470         | name, FUUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
5471         | name, FUInt32 -> pr "  uint32_t %s;\n" name
5472         | name, FInt32 -> pr "  int32_t %s;\n" name
5473         | name, (FUInt64|FBytes) -> pr "  uint64_t %s;\n" name
5474         | name, FInt64 -> pr "  int64_t %s;\n" name
5475         | name, FOptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
5476       ) cols;
5477       pr "};\n";
5478       pr "\n";
5479       pr "struct guestfs_%s_list {\n" typ;
5480       pr "  uint32_t len;\n";
5481       pr "  struct guestfs_%s *val;\n" typ;
5482       pr "};\n";
5483       pr "\n";
5484       pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
5485       pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
5486       pr "\n"
5487   ) structs
5488
5489 (* Generate the guestfs-actions.h file. *)
5490 and generate_actions_h () =
5491   generate_header CStyle LGPLv2plus;
5492   List.iter (
5493     fun (shortname, style, _, _, _, _, _) ->
5494       let name = "guestfs_" ^ shortname in
5495       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5496         name style
5497   ) all_functions
5498
5499 (* Generate the guestfs-internal-actions.h file. *)
5500 and generate_internal_actions_h () =
5501   generate_header CStyle LGPLv2plus;
5502   List.iter (
5503     fun (shortname, style, _, _, _, _, _) ->
5504       let name = "guestfs__" ^ shortname in
5505       generate_prototype ~single_line:true ~newline:true ~handle:"g"
5506         name style
5507   ) non_daemon_functions
5508
5509 (* Generate the client-side dispatch stubs. *)
5510 and generate_client_actions () =
5511   generate_header CStyle LGPLv2plus;
5512
5513   pr "\
5514 #include <stdio.h>
5515 #include <stdlib.h>
5516 #include <stdint.h>
5517 #include <string.h>
5518 #include <inttypes.h>
5519
5520 #include \"guestfs.h\"
5521 #include \"guestfs-internal.h\"
5522 #include \"guestfs-internal-actions.h\"
5523 #include \"guestfs_protocol.h\"
5524
5525 #define error guestfs_error
5526 //#define perrorf guestfs_perrorf
5527 #define safe_malloc guestfs_safe_malloc
5528 #define safe_realloc guestfs_safe_realloc
5529 //#define safe_strdup guestfs_safe_strdup
5530 #define safe_memdup guestfs_safe_memdup
5531
5532 /* Check the return message from a call for validity. */
5533 static int
5534 check_reply_header (guestfs_h *g,
5535                     const struct guestfs_message_header *hdr,
5536                     unsigned int proc_nr, unsigned int serial)
5537 {
5538   if (hdr->prog != GUESTFS_PROGRAM) {
5539     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
5540     return -1;
5541   }
5542   if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
5543     error (g, \"wrong protocol version (%%d/%%d)\",
5544            hdr->vers, GUESTFS_PROTOCOL_VERSION);
5545     return -1;
5546   }
5547   if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
5548     error (g, \"unexpected message direction (%%d/%%d)\",
5549            hdr->direction, GUESTFS_DIRECTION_REPLY);
5550     return -1;
5551   }
5552   if (hdr->proc != proc_nr) {
5553     error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
5554     return -1;
5555   }
5556   if (hdr->serial != serial) {
5557     error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
5558     return -1;
5559   }
5560
5561   return 0;
5562 }
5563
5564 /* Check we are in the right state to run a high-level action. */
5565 static int
5566 check_state (guestfs_h *g, const char *caller)
5567 {
5568   if (!guestfs__is_ready (g)) {
5569     if (guestfs__is_config (g) || guestfs__is_launching (g))
5570       error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
5571         caller);
5572     else
5573       error (g, \"%%s called from the wrong state, %%d != READY\",
5574         caller, guestfs__get_state (g));
5575     return -1;
5576   }
5577   return 0;
5578 }
5579
5580 ";
5581
5582   (* Generate code to generate guestfish call traces. *)
5583   let trace_call shortname style =
5584     pr "  if (guestfs__get_trace (g)) {\n";
5585
5586     let needs_i =
5587       List.exists (function
5588                    | StringList _ | DeviceList _ -> true
5589                    | _ -> false) (snd style) in
5590     if needs_i then (
5591       pr "    int i;\n";
5592       pr "\n"
5593     );
5594
5595     pr "    printf (\"%s\");\n" shortname;
5596     List.iter (
5597       function
5598       | String n                        (* strings *)
5599       | Device n
5600       | Pathname n
5601       | Dev_or_Path n
5602       | FileIn n
5603       | FileOut n ->
5604           (* guestfish doesn't support string escaping, so neither do we *)
5605           pr "    printf (\" \\\"%%s\\\"\", %s);\n" n
5606       | OptString n ->                  (* string option *)
5607           pr "    if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
5608           pr "    else printf (\" null\");\n"
5609       | StringList n
5610       | DeviceList n ->                 (* string list *)
5611           pr "    putchar (' ');\n";
5612           pr "    putchar ('\"');\n";
5613           pr "    for (i = 0; %s[i]; ++i) {\n" n;
5614           pr "      if (i > 0) putchar (' ');\n";
5615           pr "      fputs (%s[i], stdout);\n" n;
5616           pr "    }\n";
5617           pr "    putchar ('\"');\n";
5618       | Bool n ->                       (* boolean *)
5619           pr "    fputs (%s ? \" true\" : \" false\", stdout);\n" n
5620       | Int n ->                        (* int *)
5621           pr "    printf (\" %%d\", %s);\n" n
5622       | Int64 n ->
5623           pr "    printf (\" %%\" PRIi64, %s);\n" n
5624     ) (snd style);
5625     pr "    putchar ('\\n');\n";
5626     pr "  }\n";
5627     pr "\n";
5628   in
5629
5630   (* For non-daemon functions, generate a wrapper around each function. *)
5631   List.iter (
5632     fun (shortname, style, _, _, _, _, _) ->
5633       let name = "guestfs_" ^ shortname in
5634
5635       generate_prototype ~extern:false ~semicolon:false ~newline:true
5636         ~handle:"g" name style;
5637       pr "{\n";
5638       trace_call shortname style;
5639       pr "  return guestfs__%s " shortname;
5640       generate_c_call_args ~handle:"g" style;
5641       pr ";\n";
5642       pr "}\n";
5643       pr "\n"
5644   ) non_daemon_functions;
5645
5646   (* Client-side stubs for each function. *)
5647   List.iter (
5648     fun (shortname, style, _, _, _, _, _) ->
5649       let name = "guestfs_" ^ shortname in
5650
5651       (* Generate the action stub. *)
5652       generate_prototype ~extern:false ~semicolon:false ~newline:true
5653         ~handle:"g" name style;
5654
5655       let error_code =
5656         match fst style with
5657         | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
5658         | RConstString _ | RConstOptString _ ->
5659             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5660         | RString _ | RStringList _
5661         | RStruct _ | RStructList _
5662         | RHashtable _ | RBufferOut _ ->
5663             "NULL" in
5664
5665       pr "{\n";
5666
5667       (match snd style with
5668        | [] -> ()
5669        | _ -> pr "  struct %s_args args;\n" name
5670       );
5671
5672       pr "  guestfs_message_header hdr;\n";
5673       pr "  guestfs_message_error err;\n";
5674       let has_ret =
5675         match fst style with
5676         | RErr -> false
5677         | RConstString _ | RConstOptString _ ->
5678             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5679         | RInt _ | RInt64 _
5680         | RBool _ | RString _ | RStringList _
5681         | RStruct _ | RStructList _
5682         | RHashtable _ | RBufferOut _ ->
5683             pr "  struct %s_ret ret;\n" name;
5684             true in
5685
5686       pr "  int serial;\n";
5687       pr "  int r;\n";
5688       pr "\n";
5689       trace_call shortname style;
5690       pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
5691       pr "  guestfs___set_busy (g);\n";
5692       pr "\n";
5693
5694       (* Send the main header and arguments. *)
5695       (match snd style with
5696        | [] ->
5697            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
5698              (String.uppercase shortname)
5699        | args ->
5700            List.iter (
5701              function
5702              | Pathname n | Device n | Dev_or_Path n | String n ->
5703                  pr "  args.%s = (char *) %s;\n" n n
5704              | OptString n ->
5705                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
5706              | StringList n | DeviceList n ->
5707                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
5708                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
5709              | Bool n ->
5710                  pr "  args.%s = %s;\n" n n
5711              | Int n ->
5712                  pr "  args.%s = %s;\n" n n
5713              | Int64 n ->
5714                  pr "  args.%s = %s;\n" n n
5715              | FileIn _ | FileOut _ -> ()
5716            ) args;
5717            pr "  serial = guestfs___send (g, GUESTFS_PROC_%s,\n"
5718              (String.uppercase shortname);
5719            pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
5720              name;
5721       );
5722       pr "  if (serial == -1) {\n";
5723       pr "    guestfs___end_busy (g);\n";
5724       pr "    return %s;\n" error_code;
5725       pr "  }\n";
5726       pr "\n";
5727
5728       (* Send any additional files (FileIn) requested. *)
5729       let need_read_reply_label = ref false in
5730       List.iter (
5731         function
5732         | FileIn n ->
5733             pr "  r = guestfs___send_file (g, %s);\n" n;
5734             pr "  if (r == -1) {\n";
5735             pr "    guestfs___end_busy (g);\n";
5736             pr "    return %s;\n" error_code;
5737             pr "  }\n";
5738             pr "  if (r == -2) /* daemon cancelled */\n";
5739             pr "    goto read_reply;\n";
5740             need_read_reply_label := true;
5741             pr "\n";
5742         | _ -> ()
5743       ) (snd style);
5744
5745       (* Wait for the reply from the remote end. *)
5746       if !need_read_reply_label then pr " read_reply:\n";
5747       pr "  memset (&hdr, 0, sizeof hdr);\n";
5748       pr "  memset (&err, 0, sizeof err);\n";
5749       if has_ret then pr "  memset (&ret, 0, sizeof ret);\n";
5750       pr "\n";
5751       pr "  r = guestfs___recv (g, \"%s\", &hdr, &err,\n        " shortname;
5752       if not has_ret then
5753         pr "NULL, NULL"
5754       else
5755         pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
5756       pr ");\n";
5757
5758       pr "  if (r == -1) {\n";
5759       pr "    guestfs___end_busy (g);\n";
5760       pr "    return %s;\n" error_code;
5761       pr "  }\n";
5762       pr "\n";
5763
5764       pr "  if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
5765         (String.uppercase shortname);
5766       pr "    guestfs___end_busy (g);\n";
5767       pr "    return %s;\n" error_code;
5768       pr "  }\n";
5769       pr "\n";
5770
5771       pr "  if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
5772       pr "    error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
5773       pr "    free (err.error_message);\n";
5774       pr "    guestfs___end_busy (g);\n";
5775       pr "    return %s;\n" error_code;
5776       pr "  }\n";
5777       pr "\n";
5778
5779       (* Expecting to receive further files (FileOut)? *)
5780       List.iter (
5781         function
5782         | FileOut n ->
5783             pr "  if (guestfs___recv_file (g, %s) == -1) {\n" n;
5784             pr "    guestfs___end_busy (g);\n";
5785             pr "    return %s;\n" error_code;
5786             pr "  }\n";
5787             pr "\n";
5788         | _ -> ()
5789       ) (snd style);
5790
5791       pr "  guestfs___end_busy (g);\n";
5792
5793       (match fst style with
5794        | RErr -> pr "  return 0;\n"
5795        | RInt n | RInt64 n | RBool n ->
5796            pr "  return ret.%s;\n" n
5797        | RConstString _ | RConstOptString _ ->
5798            failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5799        | RString n ->
5800            pr "  return ret.%s; /* caller will free */\n" n
5801        | RStringList n | RHashtable n ->
5802            pr "  /* caller will free this, but we need to add a NULL entry */\n";
5803            pr "  ret.%s.%s_val =\n" n n;
5804            pr "    safe_realloc (g, ret.%s.%s_val,\n" n n;
5805            pr "                  sizeof (char *) * (ret.%s.%s_len + 1));\n"
5806              n n;
5807            pr "  ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
5808            pr "  return ret.%s.%s_val;\n" n n
5809        | RStruct (n, _) ->
5810            pr "  /* caller will free this */\n";
5811            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5812        | RStructList (n, _) ->
5813            pr "  /* caller will free this */\n";
5814            pr "  return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
5815        | RBufferOut n ->
5816            pr "  /* RBufferOut is tricky: If the buffer is zero-length, then\n";
5817            pr "   * _val might be NULL here.  To make the API saner for\n";
5818            pr "   * callers, we turn this case into a unique pointer (using\n";
5819            pr "   * malloc(1)).\n";
5820            pr "   */\n";
5821            pr "  if (ret.%s.%s_len > 0) {\n" n n;
5822            pr "    *size_r = ret.%s.%s_len;\n" n n;
5823            pr "    return ret.%s.%s_val; /* caller will free */\n" n n;
5824            pr "  } else {\n";
5825            pr "    free (ret.%s.%s_val);\n" n n;
5826            pr "    char *p = safe_malloc (g, 1);\n";
5827            pr "    *size_r = ret.%s.%s_len;\n" n n;
5828            pr "    return p;\n";
5829            pr "  }\n";
5830       );
5831
5832       pr "}\n\n"
5833   ) daemon_functions;
5834
5835   (* Functions to free structures. *)
5836   pr "/* Structure-freeing functions.  These rely on the fact that the\n";
5837   pr " * structure format is identical to the XDR format.  See note in\n";
5838   pr " * generator.ml.\n";
5839   pr " */\n";
5840   pr "\n";
5841
5842   List.iter (
5843     fun (typ, _) ->
5844       pr "void\n";
5845       pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
5846       pr "{\n";
5847       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
5848       pr "  free (x);\n";
5849       pr "}\n";
5850       pr "\n";
5851
5852       pr "void\n";
5853       pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
5854       pr "{\n";
5855       pr "  xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
5856       pr "  free (x);\n";
5857       pr "}\n";
5858       pr "\n";
5859
5860   ) structs;
5861
5862 (* Generate daemon/actions.h. *)
5863 and generate_daemon_actions_h () =
5864   generate_header CStyle GPLv2plus;
5865
5866   pr "#include \"../src/guestfs_protocol.h\"\n";
5867   pr "\n";
5868
5869   List.iter (
5870     fun (name, style, _, _, _, _, _) ->
5871       generate_prototype
5872         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
5873         name style;
5874   ) daemon_functions
5875
5876 (* Generate the linker script which controls the visibility of
5877  * symbols in the public ABI and ensures no other symbols get
5878  * exported accidentally.
5879  *)
5880 and generate_linker_script () =
5881   generate_header HashStyle GPLv2plus;
5882
5883   let globals = [
5884     "guestfs_create";
5885     "guestfs_close";
5886     "guestfs_get_error_handler";
5887     "guestfs_get_out_of_memory_handler";
5888     "guestfs_last_error";
5889     "guestfs_set_error_handler";
5890     "guestfs_set_launch_done_callback";
5891     "guestfs_set_log_message_callback";
5892     "guestfs_set_out_of_memory_handler";
5893     "guestfs_set_subprocess_quit_callback";
5894
5895     (* Unofficial parts of the API: the bindings code use these
5896      * functions, so it is useful to export them.
5897      *)
5898     "guestfs_safe_calloc";
5899     "guestfs_safe_malloc";
5900   ] in
5901   let functions =
5902     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
5903       all_functions in
5904   let structs =
5905     List.concat (
5906       List.map (fun (typ, _) ->
5907                   ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
5908         structs
5909     ) in
5910   let globals = List.sort compare (globals @ functions @ structs) in
5911
5912   pr "{\n";
5913   pr "    global:\n";
5914   List.iter (pr "        %s;\n") globals;
5915   pr "\n";
5916
5917   pr "    local:\n";
5918   pr "        *;\n";
5919   pr "};\n"
5920
5921 (* Generate the server-side stubs. *)
5922 and generate_daemon_actions () =
5923   generate_header CStyle GPLv2plus;
5924
5925   pr "#include <config.h>\n";
5926   pr "\n";
5927   pr "#include <stdio.h>\n";
5928   pr "#include <stdlib.h>\n";
5929   pr "#include <string.h>\n";
5930   pr "#include <inttypes.h>\n";
5931   pr "#include <rpc/types.h>\n";
5932   pr "#include <rpc/xdr.h>\n";
5933   pr "\n";
5934   pr "#include \"daemon.h\"\n";
5935   pr "#include \"c-ctype.h\"\n";
5936   pr "#include \"../src/guestfs_protocol.h\"\n";
5937   pr "#include \"actions.h\"\n";
5938   pr "\n";
5939
5940   List.iter (
5941     fun (name, style, _, _, _, _, _) ->
5942       (* Generate server-side stubs. *)
5943       pr "static void %s_stub (XDR *xdr_in)\n" name;
5944       pr "{\n";
5945       let error_code =
5946         match fst style with
5947         | RErr | RInt _ -> pr "  int r;\n"; "-1"
5948         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
5949         | RBool _ -> pr "  int r;\n"; "-1"
5950         | RConstString _ | RConstOptString _ ->
5951             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
5952         | RString _ -> pr "  char *r;\n"; "NULL"
5953         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
5954         | RStruct (_, typ) -> pr "  guestfs_int_%s *r;\n" typ; "NULL"
5955         | RStructList (_, typ) -> pr "  guestfs_int_%s_list *r;\n" typ; "NULL"
5956         | RBufferOut _ ->
5957             pr "  size_t size = 1;\n";
5958             pr "  char *r;\n";
5959             "NULL" in
5960
5961       (match snd style with
5962        | [] -> ()
5963        | args ->
5964            pr "  struct guestfs_%s_args args;\n" name;
5965            List.iter (
5966              function
5967              | Device n | Dev_or_Path n
5968              | Pathname n
5969              | String n -> ()
5970              | OptString n -> pr "  char *%s;\n" n
5971              | StringList n | DeviceList n -> pr "  char **%s;\n" n
5972              | Bool n -> pr "  int %s;\n" n
5973              | Int n -> pr "  int %s;\n" n
5974              | Int64 n -> pr "  int64_t %s;\n" n
5975              | FileIn _ | FileOut _ -> ()
5976            ) args
5977       );
5978       pr "\n";
5979
5980       (match snd style with
5981        | [] -> ()
5982        | args ->
5983            pr "  memset (&args, 0, sizeof args);\n";
5984            pr "\n";
5985            pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
5986            pr "    reply_with_error (\"daemon failed to decode procedure arguments\");\n";
5987            pr "    return;\n";
5988            pr "  }\n";
5989            let pr_args n =
5990              pr "  char *%s = args.%s;\n" n n
5991            in
5992            let pr_list_handling_code n =
5993              pr "  %s = realloc (args.%s.%s_val,\n" n n n;
5994              pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
5995              pr "  if (%s == NULL) {\n" n;
5996              pr "    reply_with_perror (\"realloc\");\n";
5997              pr "    goto done;\n";
5998              pr "  }\n";
5999              pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
6000              pr "  args.%s.%s_val = %s;\n" n n n;
6001            in
6002            List.iter (
6003              function
6004              | Pathname n ->
6005                  pr_args n;
6006                  pr "  ABS_PATH (%s, goto done);\n" n;
6007              | Device n ->
6008                  pr_args n;
6009                  pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
6010              | Dev_or_Path n ->
6011                  pr_args n;
6012                  pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
6013              | String n -> pr_args n
6014              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
6015              | StringList n ->
6016                  pr_list_handling_code n;
6017              | DeviceList n ->
6018                  pr_list_handling_code n;
6019                  pr "  /* Ensure that each is a device,\n";
6020                  pr "   * and perform device name translation. */\n";
6021                  pr "  { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
6022                  pr "    RESOLVE_DEVICE (physvols[pvi], goto done);\n";
6023                  pr "  }\n";
6024              | Bool n -> pr "  %s = args.%s;\n" n n
6025              | Int n -> pr "  %s = args.%s;\n" n n
6026              | Int64 n -> pr "  %s = args.%s;\n" n n
6027              | FileIn _ | FileOut _ -> ()
6028            ) args;
6029            pr "\n"
6030       );
6031
6032
6033       (* this is used at least for do_equal *)
6034       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
6035         (* Emit NEED_ROOT just once, even when there are two or
6036            more Pathname args *)
6037         pr "  NEED_ROOT (goto done);\n";
6038       );
6039
6040       (* Don't want to call the impl with any FileIn or FileOut
6041        * parameters, since these go "outside" the RPC protocol.
6042        *)
6043       let args' =
6044         List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
6045           (snd style) in
6046       pr "  r = do_%s " name;
6047       generate_c_call_args (fst style, args');
6048       pr ";\n";
6049
6050       (match fst style with
6051        | RErr | RInt _ | RInt64 _ | RBool _
6052        | RConstString _ | RConstOptString _
6053        | RString _ | RStringList _ | RHashtable _
6054        | RStruct (_, _) | RStructList (_, _) ->
6055            pr "  if (r == %s)\n" error_code;
6056            pr "    /* do_%s has already called reply_with_error */\n" name;
6057            pr "    goto done;\n";
6058            pr "\n"
6059        | RBufferOut _ ->
6060            pr "  /* size == 0 && r == NULL could be a non-error case (just\n";
6061            pr "   * an ordinary zero-length buffer), so be careful ...\n";
6062            pr "   */\n";
6063            pr "  if (size == 1 && r == %s)\n" error_code;
6064            pr "    /* do_%s has already called reply_with_error */\n" name;
6065            pr "    goto done;\n";
6066            pr "\n"
6067       );
6068
6069       (* If there are any FileOut parameters, then the impl must
6070        * send its own reply.
6071        *)
6072       let no_reply =
6073         List.exists (function FileOut _ -> true | _ -> false) (snd style) in
6074       if no_reply then
6075         pr "  /* do_%s has already sent a reply */\n" name
6076       else (
6077         match fst style with
6078         | RErr -> pr "  reply (NULL, NULL);\n"
6079         | RInt n | RInt64 n | RBool n ->
6080             pr "  struct guestfs_%s_ret ret;\n" name;
6081             pr "  ret.%s = r;\n" n;
6082             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6083               name
6084         | RConstString _ | RConstOptString _ ->
6085             failwithf "RConstString|RConstOptString cannot be used by daemon functions"
6086         | RString n ->
6087             pr "  struct guestfs_%s_ret ret;\n" name;
6088             pr "  ret.%s = r;\n" n;
6089             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6090               name;
6091             pr "  free (r);\n"
6092         | RStringList n | RHashtable n ->
6093             pr "  struct guestfs_%s_ret ret;\n" name;
6094             pr "  ret.%s.%s_len = count_strings (r);\n" n n;
6095             pr "  ret.%s.%s_val = r;\n" n n;
6096             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6097               name;
6098             pr "  free_strings (r);\n"
6099         | RStruct (n, _) ->
6100             pr "  struct guestfs_%s_ret ret;\n" name;
6101             pr "  ret.%s = *r;\n" n;
6102             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6103               name;
6104             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6105               name
6106         | RStructList (n, _) ->
6107             pr "  struct guestfs_%s_ret ret;\n" name;
6108             pr "  ret.%s = *r;\n" n;
6109             pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6110               name;
6111             pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
6112               name
6113         | RBufferOut n ->
6114             pr "  struct guestfs_%s_ret ret;\n" name;
6115             pr "  ret.%s.%s_val = r;\n" n n;
6116             pr "  ret.%s.%s_len = size;\n" n n;
6117             pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
6118               name;
6119             pr "  free (r);\n"
6120       );
6121
6122       (* Free the args. *)
6123       (match snd style with
6124        | [] ->
6125            pr "done: ;\n";
6126        | _ ->
6127            pr "done:\n";
6128            pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
6129              name
6130       );
6131
6132       pr "}\n\n";
6133   ) daemon_functions;
6134
6135   (* Dispatch function. *)
6136   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
6137   pr "{\n";
6138   pr "  switch (proc_nr) {\n";
6139
6140   List.iter (
6141     fun (name, style, _, _, _, _, _) ->
6142       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
6143       pr "      %s_stub (xdr_in);\n" name;
6144       pr "      break;\n"
6145   ) daemon_functions;
6146
6147   pr "    default:\n";
6148   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";
6149   pr "  }\n";
6150   pr "}\n";
6151   pr "\n";
6152
6153   (* LVM columns and tokenization functions. *)
6154   (* XXX This generates crap code.  We should rethink how we
6155    * do this parsing.
6156    *)
6157   List.iter (
6158     function
6159     | typ, cols ->
6160         pr "static const char *lvm_%s_cols = \"%s\";\n"
6161           typ (String.concat "," (List.map fst cols));
6162         pr "\n";
6163
6164         pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
6165         pr "{\n";
6166         pr "  char *tok, *p, *next;\n";
6167         pr "  int i, j;\n";
6168         pr "\n";
6169         (*
6170           pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
6171           pr "\n";
6172         *)
6173         pr "  if (!str) {\n";
6174         pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
6175         pr "    return -1;\n";
6176         pr "  }\n";
6177         pr "  if (!*str || c_isspace (*str)) {\n";
6178         pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
6179         pr "    return -1;\n";
6180         pr "  }\n";
6181         pr "  tok = str;\n";
6182         List.iter (
6183           fun (name, coltype) ->
6184             pr "  if (!tok) {\n";
6185             pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
6186             pr "    return -1;\n";
6187             pr "  }\n";
6188             pr "  p = strchrnul (tok, ',');\n";
6189             pr "  if (*p) next = p+1; else next = NULL;\n";
6190             pr "  *p = '\\0';\n";
6191             (match coltype with
6192              | FString ->
6193                  pr "  r->%s = strdup (tok);\n" name;
6194                  pr "  if (r->%s == NULL) {\n" name;
6195                  pr "    perror (\"strdup\");\n";
6196                  pr "    return -1;\n";
6197                  pr "  }\n"
6198              | FUUID ->
6199                  pr "  for (i = j = 0; i < 32; ++j) {\n";
6200                  pr "    if (tok[j] == '\\0') {\n";
6201                  pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
6202                  pr "      return -1;\n";
6203                  pr "    } else if (tok[j] != '-')\n";
6204                  pr "      r->%s[i++] = tok[j];\n" name;
6205                  pr "  }\n";
6206              | FBytes ->
6207                  pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
6208                  pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6209                  pr "    return -1;\n";
6210                  pr "  }\n";
6211              | FInt64 ->
6212                  pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
6213                  pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6214                  pr "    return -1;\n";
6215                  pr "  }\n";
6216              | FOptPercent ->
6217                  pr "  if (tok[0] == '\\0')\n";
6218                  pr "    r->%s = -1;\n" name;
6219                  pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
6220                  pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
6221                  pr "    return -1;\n";
6222                  pr "  }\n";
6223              | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
6224                  assert false (* can never be an LVM column *)
6225             );
6226             pr "  tok = next;\n";
6227         ) cols;
6228
6229         pr "  if (tok != NULL) {\n";
6230         pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
6231         pr "    return -1;\n";
6232         pr "  }\n";
6233         pr "  return 0;\n";
6234         pr "}\n";
6235         pr "\n";
6236
6237         pr "guestfs_int_lvm_%s_list *\n" typ;
6238         pr "parse_command_line_%ss (void)\n" typ;
6239         pr "{\n";
6240         pr "  char *out, *err;\n";
6241         pr "  char *p, *pend;\n";
6242         pr "  int r, i;\n";
6243         pr "  guestfs_int_lvm_%s_list *ret;\n" typ;
6244         pr "  void *newp;\n";
6245         pr "\n";
6246         pr "  ret = malloc (sizeof *ret);\n";
6247         pr "  if (!ret) {\n";
6248         pr "    reply_with_perror (\"malloc\");\n";
6249         pr "    return NULL;\n";
6250         pr "  }\n";
6251         pr "\n";
6252         pr "  ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
6253         pr "  ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
6254         pr "\n";
6255         pr "  r = command (&out, &err,\n";
6256         pr "           \"lvm\", \"%ss\",\n" typ;
6257         pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
6258         pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
6259         pr "  if (r == -1) {\n";
6260         pr "    reply_with_error (\"%%s\", err);\n";
6261         pr "    free (out);\n";
6262         pr "    free (err);\n";
6263         pr "    free (ret);\n";
6264         pr "    return NULL;\n";
6265         pr "  }\n";
6266         pr "\n";
6267         pr "  free (err);\n";
6268         pr "\n";
6269         pr "  /* Tokenize each line of the output. */\n";
6270         pr "  p = out;\n";
6271         pr "  i = 0;\n";
6272         pr "  while (p) {\n";
6273         pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
6274         pr "    if (pend) {\n";
6275         pr "      *pend = '\\0';\n";
6276         pr "      pend++;\n";
6277         pr "    }\n";
6278         pr "\n";
6279         pr "    while (*p && c_isspace (*p))    /* Skip any leading whitespace. */\n";
6280         pr "      p++;\n";
6281         pr "\n";
6282         pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
6283         pr "      p = pend;\n";
6284         pr "      continue;\n";
6285         pr "    }\n";
6286         pr "\n";
6287         pr "    /* Allocate some space to store this next entry. */\n";
6288         pr "    newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
6289         pr "                sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
6290         pr "    if (newp == NULL) {\n";
6291         pr "      reply_with_perror (\"realloc\");\n";
6292         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6293         pr "      free (ret);\n";
6294         pr "      free (out);\n";
6295         pr "      return NULL;\n";
6296         pr "    }\n";
6297         pr "    ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
6298         pr "\n";
6299         pr "    /* Tokenize the next entry. */\n";
6300         pr "    r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
6301         pr "    if (r == -1) {\n";
6302         pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
6303         pr "      free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
6304         pr "      free (ret);\n";
6305         pr "      free (out);\n";
6306         pr "      return NULL;\n";
6307         pr "    }\n";
6308         pr "\n";
6309         pr "    ++i;\n";
6310         pr "    p = pend;\n";
6311         pr "  }\n";
6312         pr "\n";
6313         pr "  ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
6314         pr "\n";
6315         pr "  free (out);\n";
6316         pr "  return ret;\n";
6317         pr "}\n"
6318
6319   ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
6320
6321 (* Generate a list of function names, for debugging in the daemon.. *)
6322 and generate_daemon_names () =
6323   generate_header CStyle GPLv2plus;
6324
6325   pr "#include <config.h>\n";
6326   pr "\n";
6327   pr "#include \"daemon.h\"\n";
6328   pr "\n";
6329
6330   pr "/* This array is indexed by proc_nr.  See guestfs_protocol.x. */\n";
6331   pr "const char *function_names[] = {\n";
6332   List.iter (
6333     fun (name, _, proc_nr, _, _, _, _) -> pr "  [%d] = \"%s\",\n" proc_nr name
6334   ) daemon_functions;
6335   pr "};\n";
6336
6337 (* Generate the optional groups for the daemon to implement
6338  * guestfs_available.
6339  *)
6340 and generate_daemon_optgroups_c () =
6341   generate_header CStyle GPLv2plus;
6342
6343   pr "#include <config.h>\n";
6344   pr "\n";
6345   pr "#include \"daemon.h\"\n";
6346   pr "#include \"optgroups.h\"\n";
6347   pr "\n";
6348
6349   pr "struct optgroup optgroups[] = {\n";
6350   List.iter (
6351     fun (group, _) ->
6352       pr "  { \"%s\", optgroup_%s_available },\n" group group
6353   ) optgroups;
6354   pr "  { NULL, NULL }\n";
6355   pr "};\n"
6356
6357 and generate_daemon_optgroups_h () =
6358   generate_header CStyle GPLv2plus;
6359
6360   List.iter (
6361     fun (group, _) ->
6362       pr "extern int optgroup_%s_available (void);\n" group
6363   ) optgroups
6364
6365 (* Generate the tests. *)
6366 and generate_tests () =
6367   generate_header CStyle GPLv2plus;
6368
6369   pr "\
6370 #include <stdio.h>
6371 #include <stdlib.h>
6372 #include <string.h>
6373 #include <unistd.h>
6374 #include <sys/types.h>
6375 #include <fcntl.h>
6376
6377 #include \"guestfs.h\"
6378 #include \"guestfs-internal.h\"
6379
6380 static guestfs_h *g;
6381 static int suppress_error = 0;
6382
6383 static void print_error (guestfs_h *g, void *data, const char *msg)
6384 {
6385   if (!suppress_error)
6386     fprintf (stderr, \"%%s\\n\", msg);
6387 }
6388
6389 /* FIXME: nearly identical code appears in fish.c */
6390 static void print_strings (char *const *argv)
6391 {
6392   int argc;
6393
6394   for (argc = 0; argv[argc] != NULL; ++argc)
6395     printf (\"\\t%%s\\n\", argv[argc]);
6396 }
6397
6398 /*
6399 static void print_table (char const *const *argv)
6400 {
6401   int i;
6402
6403   for (i = 0; argv[i] != NULL; i += 2)
6404     printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
6405 }
6406 */
6407
6408 ";
6409
6410   (* Generate a list of commands which are not tested anywhere. *)
6411   pr "static void no_test_warnings (void)\n";
6412   pr "{\n";
6413
6414   let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
6415   List.iter (
6416     fun (_, _, _, _, tests, _, _) ->
6417       let tests = filter_map (
6418         function
6419         | (_, (Always|If _|Unless _), test) -> Some test
6420         | (_, Disabled, _) -> None
6421       ) tests in
6422       let seq = List.concat (List.map seq_of_test tests) in
6423       let cmds_tested = List.map List.hd seq in
6424       List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
6425   ) all_functions;
6426
6427   List.iter (
6428     fun (name, _, _, _, _, _, _) ->
6429       if not (Hashtbl.mem hash name) then
6430         pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
6431   ) all_functions;
6432
6433   pr "}\n";
6434   pr "\n";
6435
6436   (* Generate the actual tests.  Note that we generate the tests
6437    * in reverse order, deliberately, so that (in general) the
6438    * newest tests run first.  This makes it quicker and easier to
6439    * debug them.
6440    *)
6441   let test_names =
6442     List.map (
6443       fun (name, _, _, flags, tests, _, _) ->
6444         mapi (generate_one_test name flags) tests
6445     ) (List.rev all_functions) in
6446   let test_names = List.concat test_names in
6447   let nr_tests = List.length test_names in
6448
6449   pr "\
6450 int main (int argc, char *argv[])
6451 {
6452   char c = 0;
6453   unsigned long int n_failed = 0;
6454   const char *filename;
6455   int fd;
6456   int nr_tests, test_num = 0;
6457
6458   setbuf (stdout, NULL);
6459
6460   no_test_warnings ();
6461
6462   g = guestfs_create ();
6463   if (g == NULL) {
6464     printf (\"guestfs_create FAILED\\n\");
6465     exit (EXIT_FAILURE);
6466   }
6467
6468   guestfs_set_error_handler (g, print_error, NULL);
6469
6470   guestfs_set_path (g, \"../appliance\");
6471
6472   filename = \"test1.img\";
6473   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6474   if (fd == -1) {
6475     perror (filename);
6476     exit (EXIT_FAILURE);
6477   }
6478   if (lseek (fd, %d, SEEK_SET) == -1) {
6479     perror (\"lseek\");
6480     close (fd);
6481     unlink (filename);
6482     exit (EXIT_FAILURE);
6483   }
6484   if (write (fd, &c, 1) == -1) {
6485     perror (\"write\");
6486     close (fd);
6487     unlink (filename);
6488     exit (EXIT_FAILURE);
6489   }
6490   if (close (fd) == -1) {
6491     perror (filename);
6492     unlink (filename);
6493     exit (EXIT_FAILURE);
6494   }
6495   if (guestfs_add_drive (g, filename) == -1) {
6496     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6497     exit (EXIT_FAILURE);
6498   }
6499
6500   filename = \"test2.img\";
6501   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6502   if (fd == -1) {
6503     perror (filename);
6504     exit (EXIT_FAILURE);
6505   }
6506   if (lseek (fd, %d, SEEK_SET) == -1) {
6507     perror (\"lseek\");
6508     close (fd);
6509     unlink (filename);
6510     exit (EXIT_FAILURE);
6511   }
6512   if (write (fd, &c, 1) == -1) {
6513     perror (\"write\");
6514     close (fd);
6515     unlink (filename);
6516     exit (EXIT_FAILURE);
6517   }
6518   if (close (fd) == -1) {
6519     perror (filename);
6520     unlink (filename);
6521     exit (EXIT_FAILURE);
6522   }
6523   if (guestfs_add_drive (g, filename) == -1) {
6524     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6525     exit (EXIT_FAILURE);
6526   }
6527
6528   filename = \"test3.img\";
6529   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
6530   if (fd == -1) {
6531     perror (filename);
6532     exit (EXIT_FAILURE);
6533   }
6534   if (lseek (fd, %d, SEEK_SET) == -1) {
6535     perror (\"lseek\");
6536     close (fd);
6537     unlink (filename);
6538     exit (EXIT_FAILURE);
6539   }
6540   if (write (fd, &c, 1) == -1) {
6541     perror (\"write\");
6542     close (fd);
6543     unlink (filename);
6544     exit (EXIT_FAILURE);
6545   }
6546   if (close (fd) == -1) {
6547     perror (filename);
6548     unlink (filename);
6549     exit (EXIT_FAILURE);
6550   }
6551   if (guestfs_add_drive (g, filename) == -1) {
6552     printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
6553     exit (EXIT_FAILURE);
6554   }
6555
6556   if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
6557     printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
6558     exit (EXIT_FAILURE);
6559   }
6560
6561   /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
6562   alarm (600);
6563
6564   if (guestfs_launch (g) == -1) {
6565     printf (\"guestfs_launch FAILED\\n\");
6566     exit (EXIT_FAILURE);
6567   }
6568
6569   /* Cancel previous alarm. */
6570   alarm (0);
6571
6572   nr_tests = %d;
6573
6574 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
6575
6576   iteri (
6577     fun i test_name ->
6578       pr "  test_num++;\n";
6579       pr "  if (guestfs_get_verbose (g))\n";
6580       pr "    printf (\"-------------------------------------------------------------------------------\\n\");\n";
6581       pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
6582       pr "  if (%s () == -1) {\n" test_name;
6583       pr "    printf (\"%s FAILED\\n\");\n" test_name;
6584       pr "    n_failed++;\n";
6585       pr "  }\n";
6586   ) test_names;
6587   pr "\n";
6588
6589   pr "  guestfs_close (g);\n";
6590   pr "  unlink (\"test1.img\");\n";
6591   pr "  unlink (\"test2.img\");\n";
6592   pr "  unlink (\"test3.img\");\n";
6593   pr "\n";
6594
6595   pr "  if (n_failed > 0) {\n";
6596   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
6597   pr "    exit (EXIT_FAILURE);\n";
6598   pr "  }\n";
6599   pr "\n";
6600
6601   pr "  exit (EXIT_SUCCESS);\n";
6602   pr "}\n"
6603
6604 and generate_one_test name flags i (init, prereq, test) =
6605   let test_name = sprintf "test_%s_%d" name i in
6606
6607   pr "\
6608 static int %s_skip (void)
6609 {
6610   const char *str;
6611
6612   str = getenv (\"TEST_ONLY\");
6613   if (str)
6614     return strstr (str, \"%s\") == NULL;
6615   str = getenv (\"SKIP_%s\");
6616   if (str && STREQ (str, \"1\")) return 1;
6617   str = getenv (\"SKIP_TEST_%s\");
6618   if (str && STREQ (str, \"1\")) return 1;
6619   return 0;
6620 }
6621
6622 " test_name name (String.uppercase test_name) (String.uppercase name);
6623
6624   (match prereq with
6625    | Disabled | Always -> ()
6626    | If code | Unless code ->
6627        pr "static int %s_prereq (void)\n" test_name;
6628        pr "{\n";
6629        pr "  %s\n" code;
6630        pr "}\n";
6631        pr "\n";
6632   );
6633
6634   pr "\
6635 static int %s (void)
6636 {
6637   if (%s_skip ()) {
6638     printf (\"        %%s skipped (reason: environment variable set)\\n\", \"%s\");
6639     return 0;
6640   }
6641
6642 " test_name test_name test_name;
6643
6644   (* Optional functions should only be tested if the relevant
6645    * support is available in the daemon.
6646    *)
6647   List.iter (
6648     function
6649     | Optional group ->
6650         pr "  {\n";
6651         pr "    const char *groups[] = { \"%s\", NULL };\n" group;
6652         pr "    int r;\n";
6653         pr "    suppress_error = 1;\n";
6654         pr "    r = guestfs_available (g, (char **) groups);\n";
6655         pr "    suppress_error = 0;\n";
6656         pr "    if (r == -1) {\n";
6657         pr "      printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", groups[0]);\n" test_name;
6658         pr "      return 0;\n";
6659         pr "    }\n";
6660         pr "  }\n";
6661     | _ -> ()
6662   ) flags;
6663
6664   (match prereq with
6665    | Disabled ->
6666        pr "  printf (\"        %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
6667    | If _ ->
6668        pr "  if (! %s_prereq ()) {\n" test_name;
6669        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6670        pr "    return 0;\n";
6671        pr "  }\n";
6672        pr "\n";
6673        generate_one_test_body name i test_name init test;
6674    | Unless _ ->
6675        pr "  if (%s_prereq ()) {\n" test_name;
6676        pr "    printf (\"        %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
6677        pr "    return 0;\n";
6678        pr "  }\n";
6679        pr "\n";
6680        generate_one_test_body name i test_name init test;
6681    | Always ->
6682        generate_one_test_body name i test_name init test
6683   );
6684
6685   pr "  return 0;\n";
6686   pr "}\n";
6687   pr "\n";
6688   test_name
6689
6690 and generate_one_test_body name i test_name init test =
6691   (match init with
6692    | InitNone (* XXX at some point, InitNone and InitEmpty became
6693                * folded together as the same thing.  Really we should
6694                * make InitNone do nothing at all, but the tests may
6695                * need to be checked to make sure this is OK.
6696                *)
6697    | InitEmpty ->
6698        pr "  /* InitNone|InitEmpty for %s */\n" test_name;
6699        List.iter (generate_test_command_call test_name)
6700          [["blockdev_setrw"; "/dev/sda"];
6701           ["umount_all"];
6702           ["lvm_remove_all"]]
6703    | InitPartition ->
6704        pr "  /* InitPartition for %s: create /dev/sda1 */\n" test_name;
6705        List.iter (generate_test_command_call test_name)
6706          [["blockdev_setrw"; "/dev/sda"];
6707           ["umount_all"];
6708           ["lvm_remove_all"];
6709           ["part_disk"; "/dev/sda"; "mbr"]]
6710    | InitBasicFS ->
6711        pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
6712        List.iter (generate_test_command_call test_name)
6713          [["blockdev_setrw"; "/dev/sda"];
6714           ["umount_all"];
6715           ["lvm_remove_all"];
6716           ["part_disk"; "/dev/sda"; "mbr"];
6717           ["mkfs"; "ext2"; "/dev/sda1"];
6718           ["mount_options"; ""; "/dev/sda1"; "/"]]
6719    | InitBasicFSonLVM ->
6720        pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
6721          test_name;
6722        List.iter (generate_test_command_call test_name)
6723          [["blockdev_setrw"; "/dev/sda"];
6724           ["umount_all"];
6725           ["lvm_remove_all"];
6726           ["part_disk"; "/dev/sda"; "mbr"];
6727           ["pvcreate"; "/dev/sda1"];
6728           ["vgcreate"; "VG"; "/dev/sda1"];
6729           ["lvcreate"; "LV"; "VG"; "8"];
6730           ["mkfs"; "ext2"; "/dev/VG/LV"];
6731           ["mount_options"; ""; "/dev/VG/LV"; "/"]]
6732    | InitISOFS ->
6733        pr "  /* InitISOFS for %s */\n" test_name;
6734        List.iter (generate_test_command_call test_name)
6735          [["blockdev_setrw"; "/dev/sda"];
6736           ["umount_all"];
6737           ["lvm_remove_all"];
6738           ["mount_ro"; "/dev/sdd"; "/"]]
6739   );
6740
6741   let get_seq_last = function
6742     | [] ->
6743         failwithf "%s: you cannot use [] (empty list) when expecting a command"
6744           test_name
6745     | seq ->
6746         let seq = List.rev seq in
6747         List.rev (List.tl seq), List.hd seq
6748   in
6749
6750   match test with
6751   | TestRun seq ->
6752       pr "  /* TestRun for %s (%d) */\n" name i;
6753       List.iter (generate_test_command_call test_name) seq
6754   | TestOutput (seq, expected) ->
6755       pr "  /* TestOutput for %s (%d) */\n" name i;
6756       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6757       let seq, last = get_seq_last seq in
6758       let test () =
6759         pr "    if (STRNEQ (r, expected)) {\n";
6760         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6761         pr "      return -1;\n";
6762         pr "    }\n"
6763       in
6764       List.iter (generate_test_command_call test_name) seq;
6765       generate_test_command_call ~test test_name last
6766   | TestOutputList (seq, expected) ->
6767       pr "  /* TestOutputList for %s (%d) */\n" name i;
6768       let seq, last = get_seq_last seq in
6769       let test () =
6770         iteri (
6771           fun i str ->
6772             pr "    if (!r[%d]) {\n" i;
6773             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6774             pr "      print_strings (r);\n";
6775             pr "      return -1;\n";
6776             pr "    }\n";
6777             pr "    {\n";
6778             pr "      const char *expected = \"%s\";\n" (c_quote str);
6779             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6780             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6781             pr "        return -1;\n";
6782             pr "      }\n";
6783             pr "    }\n"
6784         ) expected;
6785         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6786         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6787           test_name;
6788         pr "      print_strings (r);\n";
6789         pr "      return -1;\n";
6790         pr "    }\n"
6791       in
6792       List.iter (generate_test_command_call test_name) seq;
6793       generate_test_command_call ~test test_name last
6794   | TestOutputListOfDevices (seq, expected) ->
6795       pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
6796       let seq, last = get_seq_last seq in
6797       let test () =
6798         iteri (
6799           fun i str ->
6800             pr "    if (!r[%d]) {\n" i;
6801             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
6802             pr "      print_strings (r);\n";
6803             pr "      return -1;\n";
6804             pr "    }\n";
6805             pr "    {\n";
6806             pr "      const char *expected = \"%s\";\n" (c_quote str);
6807             pr "      r[%d][5] = 's';\n" i;
6808             pr "      if (STRNEQ (r[%d], expected)) {\n" i;
6809             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
6810             pr "        return -1;\n";
6811             pr "      }\n";
6812             pr "    }\n"
6813         ) expected;
6814         pr "    if (r[%d] != NULL) {\n" (List.length expected);
6815         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
6816           test_name;
6817         pr "      print_strings (r);\n";
6818         pr "      return -1;\n";
6819         pr "    }\n"
6820       in
6821       List.iter (generate_test_command_call test_name) seq;
6822       generate_test_command_call ~test test_name last
6823   | TestOutputInt (seq, expected) ->
6824       pr "  /* TestOutputInt for %s (%d) */\n" name i;
6825       let seq, last = get_seq_last seq in
6826       let test () =
6827         pr "    if (r != %d) {\n" expected;
6828         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
6829           test_name expected;
6830         pr "               (int) r);\n";
6831         pr "      return -1;\n";
6832         pr "    }\n"
6833       in
6834       List.iter (generate_test_command_call test_name) seq;
6835       generate_test_command_call ~test test_name last
6836   | TestOutputIntOp (seq, op, expected) ->
6837       pr "  /* TestOutputIntOp for %s (%d) */\n" name i;
6838       let seq, last = get_seq_last seq in
6839       let test () =
6840         pr "    if (! (r %s %d)) {\n" op expected;
6841         pr "      fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
6842           test_name op expected;
6843         pr "               (int) r);\n";
6844         pr "      return -1;\n";
6845         pr "    }\n"
6846       in
6847       List.iter (generate_test_command_call test_name) seq;
6848       generate_test_command_call ~test test_name last
6849   | TestOutputTrue seq ->
6850       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
6851       let seq, last = get_seq_last seq in
6852       let test () =
6853         pr "    if (!r) {\n";
6854         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
6855           test_name;
6856         pr "      return -1;\n";
6857         pr "    }\n"
6858       in
6859       List.iter (generate_test_command_call test_name) seq;
6860       generate_test_command_call ~test test_name last
6861   | TestOutputFalse seq ->
6862       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
6863       let seq, last = get_seq_last seq in
6864       let test () =
6865         pr "    if (r) {\n";
6866         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
6867           test_name;
6868         pr "      return -1;\n";
6869         pr "    }\n"
6870       in
6871       List.iter (generate_test_command_call test_name) seq;
6872       generate_test_command_call ~test test_name last
6873   | TestOutputLength (seq, expected) ->
6874       pr "  /* TestOutputLength for %s (%d) */\n" name i;
6875       let seq, last = get_seq_last seq in
6876       let test () =
6877         pr "    int j;\n";
6878         pr "    for (j = 0; j < %d; ++j)\n" expected;
6879         pr "      if (r[j] == NULL) {\n";
6880         pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
6881           test_name;
6882         pr "        print_strings (r);\n";
6883         pr "        return -1;\n";
6884         pr "      }\n";
6885         pr "    if (r[j] != NULL) {\n";
6886         pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
6887           test_name;
6888         pr "      print_strings (r);\n";
6889         pr "      return -1;\n";
6890         pr "    }\n"
6891       in
6892       List.iter (generate_test_command_call test_name) seq;
6893       generate_test_command_call ~test test_name last
6894   | TestOutputBuffer (seq, expected) ->
6895       pr "  /* TestOutputBuffer for %s (%d) */\n" name i;
6896       pr "  const char *expected = \"%s\";\n" (c_quote expected);
6897       let seq, last = get_seq_last seq in
6898       let len = String.length expected in
6899       let test () =
6900         pr "    if (size != %d) {\n" len;
6901         pr "      fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
6902         pr "      return -1;\n";
6903         pr "    }\n";
6904         pr "    if (STRNEQLEN (r, expected, size)) {\n";
6905         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
6906         pr "      return -1;\n";
6907         pr "    }\n"
6908       in
6909       List.iter (generate_test_command_call test_name) seq;
6910       generate_test_command_call ~test test_name last
6911   | TestOutputStruct (seq, checks) ->
6912       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
6913       let seq, last = get_seq_last seq in
6914       let test () =
6915         List.iter (
6916           function
6917           | CompareWithInt (field, expected) ->
6918               pr "    if (r->%s != %d) {\n" field expected;
6919               pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
6920                 test_name field expected;
6921               pr "               (int) r->%s);\n" field;
6922               pr "      return -1;\n";
6923               pr "    }\n"
6924           | CompareWithIntOp (field, op, expected) ->
6925               pr "    if (!(r->%s %s %d)) {\n" field op expected;
6926               pr "      fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
6927                 test_name field op expected;
6928               pr "               (int) r->%s);\n" field;
6929               pr "      return -1;\n";
6930               pr "    }\n"
6931           | CompareWithString (field, expected) ->
6932               pr "    if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
6933               pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
6934                 test_name field expected;
6935               pr "               r->%s);\n" field;
6936               pr "      return -1;\n";
6937               pr "    }\n"
6938           | CompareFieldsIntEq (field1, field2) ->
6939               pr "    if (r->%s != r->%s) {\n" field1 field2;
6940               pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
6941                 test_name field1 field2;
6942               pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
6943               pr "      return -1;\n";
6944               pr "    }\n"
6945           | CompareFieldsStrEq (field1, field2) ->
6946               pr "    if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
6947               pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
6948                 test_name field1 field2;
6949               pr "               r->%s, r->%s);\n" field1 field2;
6950               pr "      return -1;\n";
6951               pr "    }\n"
6952         ) checks
6953       in
6954       List.iter (generate_test_command_call test_name) seq;
6955       generate_test_command_call ~test test_name last
6956   | TestLastFail seq ->
6957       pr "  /* TestLastFail for %s (%d) */\n" name i;
6958       let seq, last = get_seq_last seq in
6959       List.iter (generate_test_command_call test_name) seq;
6960       generate_test_command_call test_name ~expect_error:true last
6961
6962 (* Generate the code to run a command, leaving the result in 'r'.
6963  * If you expect to get an error then you should set expect_error:true.
6964  *)
6965 and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
6966   match cmd with
6967   | [] -> assert false
6968   | name :: args ->
6969       (* Look up the command to find out what args/ret it has. *)
6970       let style =
6971         try
6972           let _, style, _, _, _, _, _ =
6973             List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
6974           style
6975         with Not_found ->
6976           failwithf "%s: in test, command %s was not found" test_name name in
6977
6978       if List.length (snd style) <> List.length args then
6979         failwithf "%s: in test, wrong number of args given to %s"
6980           test_name name;
6981
6982       pr "  {\n";
6983
6984       List.iter (
6985         function
6986         | OptString n, "NULL" -> ()
6987         | Pathname n, arg
6988         | Device n, arg
6989         | Dev_or_Path n, arg
6990         | String n, arg
6991         | OptString n, arg ->
6992             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
6993         | Int _, _
6994         | Int64 _, _
6995         | Bool _, _
6996         | FileIn _, _ | FileOut _, _ -> ()
6997         | StringList n, "" | DeviceList n, "" ->
6998             pr "    const char *const %s[1] = { NULL };\n" n
6999         | StringList n, arg | DeviceList n, arg ->
7000             let strs = string_split " " arg in
7001             iteri (
7002               fun i str ->
7003                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
7004             ) strs;
7005             pr "    const char *const %s[] = {\n" n;
7006             iteri (
7007               fun i _ -> pr "      %s_%d,\n" n i
7008             ) strs;
7009             pr "      NULL\n";
7010             pr "    };\n";
7011       ) (List.combine (snd style) args);
7012
7013       let error_code =
7014         match fst style with
7015         | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
7016         | RInt64 _ -> pr "    int64_t r;\n"; "-1"
7017         | RConstString _ | RConstOptString _ ->
7018             pr "    const char *r;\n"; "NULL"
7019         | RString _ -> pr "    char *r;\n"; "NULL"
7020         | RStringList _ | RHashtable _ ->
7021             pr "    char **r;\n";
7022             pr "    int i;\n";
7023             "NULL"
7024         | RStruct (_, typ) ->
7025             pr "    struct guestfs_%s *r;\n" typ; "NULL"
7026         | RStructList (_, typ) ->
7027             pr "    struct guestfs_%s_list *r;\n" typ; "NULL"
7028         | RBufferOut _ ->
7029             pr "    char *r;\n";
7030             pr "    size_t size;\n";
7031             "NULL" in
7032
7033       pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
7034       pr "    r = guestfs_%s (g" name;
7035
7036       (* Generate the parameters. *)
7037       List.iter (
7038         function
7039         | OptString _, "NULL" -> pr ", NULL"
7040         | Pathname n, _
7041         | Device n, _ | Dev_or_Path n, _
7042         | String n, _
7043         | OptString n, _ ->
7044             pr ", %s" n
7045         | FileIn _, arg | FileOut _, arg ->
7046             pr ", \"%s\"" (c_quote arg)
7047         | StringList n, _ | DeviceList n, _ ->
7048             pr ", (char **) %s" n
7049         | Int _, arg ->
7050             let i =
7051               try int_of_string arg
7052               with Failure "int_of_string" ->
7053                 failwithf "%s: expecting an int, but got '%s'" test_name arg in
7054             pr ", %d" i
7055         | Int64 _, arg ->
7056             let i =
7057               try Int64.of_string arg
7058               with Failure "int_of_string" ->
7059                 failwithf "%s: expecting an int64, but got '%s'" test_name arg in
7060             pr ", %Ld" i
7061         | Bool _, arg ->
7062             let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
7063       ) (List.combine (snd style) args);
7064
7065       (match fst style with
7066        | RBufferOut _ -> pr ", &size"
7067        | _ -> ()
7068       );
7069
7070       pr ");\n";
7071
7072       if not expect_error then
7073         pr "    if (r == %s)\n" error_code
7074       else
7075         pr "    if (r != %s)\n" error_code;
7076       pr "      return -1;\n";
7077
7078       (* Insert the test code. *)
7079       (match test with
7080        | None -> ()
7081        | Some f -> f ()
7082       );
7083
7084       (match fst style with
7085        | RErr | RInt _ | RInt64 _ | RBool _
7086        | RConstString _ | RConstOptString _ -> ()
7087        | RString _ | RBufferOut _ -> pr "    free (r);\n"
7088        | RStringList _ | RHashtable _ ->
7089            pr "    for (i = 0; r[i] != NULL; ++i)\n";
7090            pr "      free (r[i]);\n";
7091            pr "    free (r);\n"
7092        | RStruct (_, typ) ->
7093            pr "    guestfs_free_%s (r);\n" typ
7094        | RStructList (_, typ) ->
7095            pr "    guestfs_free_%s_list (r);\n" typ
7096       );
7097
7098       pr "  }\n"
7099
7100 and c_quote str =
7101   let str = replace_str str "\r" "\\r" in
7102   let str = replace_str str "\n" "\\n" in
7103   let str = replace_str str "\t" "\\t" in
7104   let str = replace_str str "\000" "\\0" in
7105   str
7106
7107 (* Generate a lot of different functions for guestfish. *)
7108 and generate_fish_cmds () =
7109   generate_header CStyle GPLv2plus;
7110
7111   let all_functions =
7112     List.filter (
7113       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7114     ) all_functions in
7115   let all_functions_sorted =
7116     List.filter (
7117       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7118     ) all_functions_sorted in
7119
7120   pr "#include <config.h>\n";
7121   pr "\n";
7122   pr "#include <stdio.h>\n";
7123   pr "#include <stdlib.h>\n";
7124   pr "#include <string.h>\n";
7125   pr "#include <inttypes.h>\n";
7126   pr "\n";
7127   pr "#include <guestfs.h>\n";
7128   pr "#include \"c-ctype.h\"\n";
7129   pr "#include \"full-write.h\"\n";
7130   pr "#include \"xstrtol.h\"\n";
7131   pr "#include \"fish.h\"\n";
7132   pr "\n";
7133
7134   (* list_commands function, which implements guestfish -h *)
7135   pr "void list_commands (void)\n";
7136   pr "{\n";
7137   pr "  printf (\"    %%-16s     %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
7138   pr "  list_builtin_commands ();\n";
7139   List.iter (
7140     fun (name, _, _, flags, _, shortdesc, _) ->
7141       let name = replace_char name '_' '-' in
7142       pr "  printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
7143         name shortdesc
7144   ) all_functions_sorted;
7145   pr "  printf (\"    %%s\\n\",";
7146   pr "          _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
7147   pr "}\n";
7148   pr "\n";
7149
7150   (* display_command function, which implements guestfish -h cmd *)
7151   pr "void display_command (const char *cmd)\n";
7152   pr "{\n";
7153   List.iter (
7154     fun (name, style, _, flags, _, shortdesc, longdesc) ->
7155       let name2 = replace_char name '_' '-' in
7156       let alias =
7157         try find_map (function FishAlias n -> Some n | _ -> None) flags
7158         with Not_found -> name in
7159       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
7160       let synopsis =
7161         match snd style with
7162         | [] -> name2
7163         | args ->
7164             sprintf "%s %s"
7165               name2 (String.concat " " (List.map name_of_argt args)) in
7166
7167       let warnings =
7168         if List.mem ProtocolLimitWarning flags then
7169           ("\n\n" ^ protocol_limit_warning)
7170         else "" in
7171
7172       (* For DangerWillRobinson commands, we should probably have
7173        * guestfish prompt before allowing you to use them (especially
7174        * in interactive mode). XXX
7175        *)
7176       let warnings =
7177         warnings ^
7178           if List.mem DangerWillRobinson flags then
7179             ("\n\n" ^ danger_will_robinson)
7180           else "" in
7181
7182       let warnings =
7183         warnings ^
7184           match deprecation_notice flags with
7185           | None -> ""
7186           | Some txt -> "\n\n" ^ txt in
7187
7188       let describe_alias =
7189         if name <> alias then
7190           sprintf "\n\nYou can use '%s' as an alias for this command." alias
7191         else "" in
7192
7193       pr "  if (";
7194       pr "STRCASEEQ (cmd, \"%s\")" name;
7195       if name <> name2 then
7196         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7197       if name <> alias then
7198         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7199       pr ")\n";
7200       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
7201         name2 shortdesc
7202         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
7203          "=head1 DESCRIPTION\n\n" ^
7204          longdesc ^ warnings ^ describe_alias);
7205       pr "  else\n"
7206   ) all_functions;
7207   pr "    display_builtin_command (cmd);\n";
7208   pr "}\n";
7209   pr "\n";
7210
7211   let emit_print_list_function typ =
7212     pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
7213       typ typ typ;
7214     pr "{\n";
7215     pr "  unsigned int i;\n";
7216     pr "\n";
7217     pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
7218     pr "    printf (\"[%%d] = {\\n\", i);\n";
7219     pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
7220     pr "    printf (\"}\\n\");\n";
7221     pr "  }\n";
7222     pr "}\n";
7223     pr "\n";
7224   in
7225
7226   (* print_* functions *)
7227   List.iter (
7228     fun (typ, cols) ->
7229       let needs_i =
7230         List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
7231
7232       pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
7233       pr "{\n";
7234       if needs_i then (
7235         pr "  unsigned int i;\n";
7236         pr "\n"
7237       );
7238       List.iter (
7239         function
7240         | name, FString ->
7241             pr "  printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
7242         | name, FUUID ->
7243             pr "  printf (\"%%s%s: \", indent);\n" name;
7244             pr "  for (i = 0; i < 32; ++i)\n";
7245             pr "    printf (\"%%c\", %s->%s[i]);\n" typ name;
7246             pr "  printf (\"\\n\");\n"
7247         | name, FBuffer ->
7248             pr "  printf (\"%%s%s: \", indent);\n" name;
7249             pr "  for (i = 0; i < %s->%s_len; ++i)\n" typ name;
7250             pr "    if (c_isprint (%s->%s[i]))\n" typ name;
7251             pr "      printf (\"%%c\", %s->%s[i]);\n" typ name;
7252             pr "    else\n";
7253             pr "      printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
7254             pr "  printf (\"\\n\");\n"
7255         | name, (FUInt64|FBytes) ->
7256             pr "  printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
7257               name typ name
7258         | name, FInt64 ->
7259             pr "  printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
7260               name typ name
7261         | name, FUInt32 ->
7262             pr "  printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
7263               name typ name
7264         | name, FInt32 ->
7265             pr "  printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
7266               name typ name
7267         | name, FChar ->
7268             pr "  printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
7269               name typ name
7270         | name, FOptPercent ->
7271             pr "  if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
7272               typ name name typ name;
7273             pr "  else printf (\"%%s%s: \\n\", indent);\n" name
7274       ) cols;
7275       pr "}\n";
7276       pr "\n";
7277   ) structs;
7278
7279   (* Emit a print_TYPE_list function definition only if that function is used. *)
7280   List.iter (
7281     function
7282     | typ, (RStructListOnly | RStructAndList) ->
7283         (* generate the function for typ *)
7284         emit_print_list_function typ
7285     | typ, _ -> () (* empty *)
7286   ) (rstructs_used_by all_functions);
7287
7288   (* Emit a print_TYPE function definition only if that function is used. *)
7289   List.iter (
7290     function
7291     | typ, (RStructOnly | RStructAndList) ->
7292         pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
7293         pr "{\n";
7294         pr "  print_%s_indent (%s, \"\");\n" typ typ;
7295         pr "}\n";
7296         pr "\n";
7297     | typ, _ -> () (* empty *)
7298   ) (rstructs_used_by all_functions);
7299
7300   (* run_<action> actions *)
7301   List.iter (
7302     fun (name, style, _, flags, _, _, _) ->
7303       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
7304       pr "{\n";
7305       (match fst style with
7306        | RErr
7307        | RInt _
7308        | RBool _ -> pr "  int r;\n"
7309        | RInt64 _ -> pr "  int64_t r;\n"
7310        | RConstString _ | RConstOptString _ -> pr "  const char *r;\n"
7311        | RString _ -> pr "  char *r;\n"
7312        | RStringList _ | RHashtable _ -> pr "  char **r;\n"
7313        | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ
7314        | RStructList (_, typ) -> pr "  struct guestfs_%s_list *r;\n" typ
7315        | RBufferOut _ ->
7316            pr "  char *r;\n";
7317            pr "  size_t size;\n";
7318       );
7319       List.iter (
7320         function
7321         | Device n
7322         | String n
7323         | OptString n
7324         | FileIn n
7325         | FileOut n -> pr "  const char *%s;\n" n
7326         | Pathname n
7327         | Dev_or_Path n -> pr "  char *%s;\n" n
7328         | StringList n | DeviceList n -> pr "  char **%s;\n" n
7329         | Bool n -> pr "  int %s;\n" n
7330         | Int n -> pr "  int %s;\n" n
7331         | Int64 n -> pr "  int64_t %s;\n" n
7332       ) (snd style);
7333
7334       (* Check and convert parameters. *)
7335       let argc_expected = List.length (snd style) in
7336       pr "  if (argc != %d) {\n" argc_expected;
7337       pr "    fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
7338         argc_expected;
7339       pr "    fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
7340       pr "    return -1;\n";
7341       pr "  }\n";
7342
7343       let parse_integer fn fntyp rtyp range name i =
7344         pr "  {\n";
7345         pr "    strtol_error xerr;\n";
7346         pr "    %s r;\n" fntyp;
7347         pr "\n";
7348         pr "    xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
7349         pr "    if (xerr != LONGINT_OK) {\n";
7350         pr "      fprintf (stderr,\n";
7351         pr "               _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
7352         pr "               cmd, \"%s\", \"%s\", xerr);\n" name fn;
7353         pr "      return -1;\n";
7354         pr "    }\n";
7355         (match range with
7356          | None -> ()
7357          | Some (min, max, comment) ->
7358              pr "    /* %s */\n" comment;
7359              pr "    if (r < %s || r > %s) {\n" min max;
7360              pr "      fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
7361                name;
7362              pr "      return -1;\n";
7363              pr "    }\n";
7364              pr "    /* The check above should ensure this assignment does not overflow. */\n";
7365         );
7366         pr "    %s = r;\n" name;
7367         pr "  }\n";
7368       in
7369
7370       iteri (
7371         fun i ->
7372           function
7373           | Device name
7374           | String name ->
7375               pr "  %s = argv[%d];\n" name i
7376           | Pathname name
7377           | Dev_or_Path name ->
7378               pr "  %s = resolve_win_path (argv[%d]);\n" name i;
7379               pr "  if (%s == NULL) return -1;\n" name
7380           | OptString name ->
7381               pr "  %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
7382                 name i i
7383           | FileIn name ->
7384               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
7385                 name i i
7386           | FileOut name ->
7387               pr "  %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
7388                 name i i
7389           | StringList name | DeviceList name ->
7390               pr "  %s = parse_string_list (argv[%d]);\n" name i;
7391               pr "  if (%s == NULL) return -1;\n" name;
7392           | Bool name ->
7393               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
7394           | Int name ->
7395               let range =
7396                 let min = "(-(2LL<<30))"
7397                 and max = "((2LL<<30)-1)"
7398                 and comment =
7399                   "The Int type in the generator is a signed 31 bit int." in
7400                 Some (min, max, comment) in
7401               parse_integer "xstrtoll" "long long" "int" range name i
7402           | Int64 name ->
7403               parse_integer "xstrtoll" "long long" "int64_t" None name i
7404       ) (snd style);
7405
7406       (* Call C API function. *)
7407       let fn =
7408         try find_map (function FishAction n -> Some n | _ -> None) flags
7409         with Not_found -> sprintf "guestfs_%s" name in
7410       pr "  r = %s " fn;
7411       generate_c_call_args ~handle:"g" style;
7412       pr ";\n";
7413
7414       List.iter (
7415         function
7416         | Device name | String name
7417         | OptString name | FileIn name | FileOut name | Bool name
7418         | Int name | Int64 name -> ()
7419         | Pathname name | Dev_or_Path name ->
7420             pr "  free (%s);\n" name
7421         | StringList name | DeviceList name ->
7422             pr "  free_strings (%s);\n" name
7423       ) (snd style);
7424
7425       (* Check return value for errors and display command results. *)
7426       (match fst style with
7427        | RErr -> pr "  return r;\n"
7428        | RInt _ ->
7429            pr "  if (r == -1) return -1;\n";
7430            pr "  printf (\"%%d\\n\", r);\n";
7431            pr "  return 0;\n"
7432        | RInt64 _ ->
7433            pr "  if (r == -1) return -1;\n";
7434            pr "  printf (\"%%\" PRIi64 \"\\n\", r);\n";
7435            pr "  return 0;\n"
7436        | RBool _ ->
7437            pr "  if (r == -1) return -1;\n";
7438            pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
7439            pr "  return 0;\n"
7440        | RConstString _ ->
7441            pr "  if (r == NULL) return -1;\n";
7442            pr "  printf (\"%%s\\n\", r);\n";
7443            pr "  return 0;\n"
7444        | RConstOptString _ ->
7445            pr "  printf (\"%%s\\n\", r ? : \"(null)\");\n";
7446            pr "  return 0;\n"
7447        | RString _ ->
7448            pr "  if (r == NULL) return -1;\n";
7449            pr "  printf (\"%%s\\n\", r);\n";
7450            pr "  free (r);\n";
7451            pr "  return 0;\n"
7452        | RStringList _ ->
7453            pr "  if (r == NULL) return -1;\n";
7454            pr "  print_strings (r);\n";
7455            pr "  free_strings (r);\n";
7456            pr "  return 0;\n"
7457        | RStruct (_, typ) ->
7458            pr "  if (r == NULL) return -1;\n";
7459            pr "  print_%s (r);\n" typ;
7460            pr "  guestfs_free_%s (r);\n" typ;
7461            pr "  return 0;\n"
7462        | RStructList (_, typ) ->
7463            pr "  if (r == NULL) return -1;\n";
7464            pr "  print_%s_list (r);\n" typ;
7465            pr "  guestfs_free_%s_list (r);\n" typ;
7466            pr "  return 0;\n"
7467        | RHashtable _ ->
7468            pr "  if (r == NULL) return -1;\n";
7469            pr "  print_table (r);\n";
7470            pr "  free_strings (r);\n";
7471            pr "  return 0;\n"
7472        | RBufferOut _ ->
7473            pr "  if (r == NULL) return -1;\n";
7474            pr "  if (full_write (1, r, size) != size) {\n";
7475            pr "    perror (\"write\");\n";
7476            pr "    free (r);\n";
7477            pr "    return -1;\n";
7478            pr "  }\n";
7479            pr "  free (r);\n";
7480            pr "  return 0;\n"
7481       );
7482       pr "}\n";
7483       pr "\n"
7484   ) all_functions;
7485
7486   (* run_action function *)
7487   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
7488   pr "{\n";
7489   List.iter (
7490     fun (name, _, _, flags, _, _, _) ->
7491       let name2 = replace_char name '_' '-' in
7492       let alias =
7493         try find_map (function FishAlias n -> Some n | _ -> None) flags
7494         with Not_found -> name in
7495       pr "  if (";
7496       pr "STRCASEEQ (cmd, \"%s\")" name;
7497       if name <> name2 then
7498         pr " || STRCASEEQ (cmd, \"%s\")" name2;
7499       if name <> alias then
7500         pr " || STRCASEEQ (cmd, \"%s\")" alias;
7501       pr ")\n";
7502       pr "    return run_%s (cmd, argc, argv);\n" name;
7503       pr "  else\n";
7504   ) all_functions;
7505   pr "    {\n";
7506   pr "      fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
7507   pr "      if (command_num == 1)\n";
7508   pr "        extended_help_message ();\n";
7509   pr "      return -1;\n";
7510   pr "    }\n";
7511   pr "  return 0;\n";
7512   pr "}\n";
7513   pr "\n"
7514
7515 (* Readline completion for guestfish. *)
7516 and generate_fish_completion () =
7517   generate_header CStyle GPLv2plus;
7518
7519   let all_functions =
7520     List.filter (
7521       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
7522     ) all_functions in
7523
7524   pr "\
7525 #include <config.h>
7526
7527 #include <stdio.h>
7528 #include <stdlib.h>
7529 #include <string.h>
7530
7531 #ifdef HAVE_LIBREADLINE
7532 #include <readline/readline.h>
7533 #endif
7534
7535 #include \"fish.h\"
7536
7537 #ifdef HAVE_LIBREADLINE
7538
7539 static const char *const commands[] = {
7540   BUILTIN_COMMANDS_FOR_COMPLETION,
7541 ";
7542
7543   (* Get the commands, including the aliases.  They don't need to be
7544    * sorted - the generator() function just does a dumb linear search.
7545    *)
7546   let commands =
7547     List.map (
7548       fun (name, _, _, flags, _, _, _) ->
7549         let name2 = replace_char name '_' '-' in
7550         let alias =
7551           try find_map (function FishAlias n -> Some n | _ -> None) flags
7552           with Not_found -> name in
7553
7554         if name <> alias then [name2; alias] else [name2]
7555     ) all_functions in
7556   let commands = List.flatten commands in
7557
7558   List.iter (pr "  \"%s\",\n") commands;
7559
7560   pr "  NULL
7561 };
7562
7563 static char *
7564 generator (const char *text, int state)
7565 {
7566   static int index, len;
7567   const char *name;
7568
7569   if (!state) {
7570     index = 0;
7571     len = strlen (text);
7572   }
7573
7574   rl_attempted_completion_over = 1;
7575
7576   while ((name = commands[index]) != NULL) {
7577     index++;
7578     if (STRCASEEQLEN (name, text, len))
7579       return strdup (name);
7580   }
7581
7582   return NULL;
7583 }
7584
7585 #endif /* HAVE_LIBREADLINE */
7586
7587 #ifdef HAVE_RL_COMPLETION_MATCHES
7588 #define RL_COMPLETION_MATCHES rl_completion_matches
7589 #else
7590 #ifdef HAVE_COMPLETION_MATCHES
7591 #define RL_COMPLETION_MATCHES completion_matches
7592 #endif
7593 #endif /* else just fail if we don't have either symbol */
7594
7595 char **
7596 do_completion (const char *text, int start, int end)
7597 {
7598   char **matches = NULL;
7599
7600 #ifdef HAVE_LIBREADLINE
7601   rl_completion_append_character = ' ';
7602
7603   if (start == 0)
7604     matches = RL_COMPLETION_MATCHES (text, generator);
7605   else if (complete_dest_paths)
7606     matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
7607 #endif
7608
7609   return matches;
7610 }
7611 ";
7612
7613 (* Generate the POD documentation for guestfish. *)
7614 and generate_fish_actions_pod () =
7615   let all_functions_sorted =
7616     List.filter (
7617       fun (_, _, _, flags, _, _, _) ->
7618         not (List.mem NotInFish flags || List.mem NotInDocs flags)
7619     ) all_functions_sorted in
7620
7621   let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
7622
7623   List.iter (
7624     fun (name, style, _, flags, _, _, longdesc) ->
7625       let longdesc =
7626         Str.global_substitute rex (
7627           fun s ->
7628             let sub =
7629               try Str.matched_group 1 s
7630               with Not_found ->
7631                 failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
7632             "C<" ^ replace_char sub '_' '-' ^ ">"
7633         ) longdesc in
7634       let name = replace_char name '_' '-' in
7635       let alias =
7636         try find_map (function FishAlias n -> Some n | _ -> None) flags
7637         with Not_found -> name in
7638
7639       pr "=head2 %s" name;
7640       if name <> alias then
7641         pr " | %s" alias;
7642       pr "\n";
7643       pr "\n";
7644       pr " %s" name;
7645       List.iter (
7646         function
7647         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
7648         | OptString n -> pr " %s" n
7649         | StringList n | DeviceList n -> pr " '%s ...'" n
7650         | Bool _ -> pr " true|false"
7651         | Int n -> pr " %s" n
7652         | Int64 n -> pr " %s" n
7653         | FileIn n | FileOut n -> pr " (%s|-)" n
7654       ) (snd style);
7655       pr "\n";
7656       pr "\n";
7657       pr "%s\n\n" longdesc;
7658
7659       if List.exists (function FileIn _ | FileOut _ -> true
7660                       | _ -> false) (snd style) then
7661         pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
7662
7663       if List.mem ProtocolLimitWarning flags then
7664         pr "%s\n\n" protocol_limit_warning;
7665
7666       if List.mem DangerWillRobinson flags then
7667         pr "%s\n\n" danger_will_robinson;
7668
7669       match deprecation_notice flags with
7670       | None -> ()
7671       | Some txt -> pr "%s\n\n" txt
7672   ) all_functions_sorted
7673
7674 (* Generate a C function prototype. *)
7675 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
7676     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
7677     ?(prefix = "")
7678     ?handle name style =
7679   if extern then pr "extern ";
7680   if static then pr "static ";
7681   (match fst style with
7682    | RErr -> pr "int "
7683    | RInt _ -> pr "int "
7684    | RInt64 _ -> pr "int64_t "
7685    | RBool _ -> pr "int "
7686    | RConstString _ | RConstOptString _ -> pr "const char *"
7687    | RString _ | RBufferOut _ -> pr "char *"
7688    | RStringList _ | RHashtable _ -> pr "char **"
7689    | RStruct (_, typ) ->
7690        if not in_daemon then pr "struct guestfs_%s *" typ
7691        else pr "guestfs_int_%s *" typ
7692    | RStructList (_, typ) ->
7693        if not in_daemon then pr "struct guestfs_%s_list *" typ
7694        else pr "guestfs_int_%s_list *" typ
7695   );
7696   let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
7697   pr "%s%s (" prefix name;
7698   if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
7699     pr "void"
7700   else (
7701     let comma = ref false in
7702     (match handle with
7703      | None -> ()
7704      | Some handle -> pr "guestfs_h *%s" handle; comma := true
7705     );
7706     let next () =
7707       if !comma then (
7708         if single_line then pr ", " else pr ",\n\t\t"
7709       );
7710       comma := true
7711     in
7712     List.iter (
7713       function
7714       | Pathname n
7715       | Device n | Dev_or_Path n
7716       | String n
7717       | OptString n ->
7718           next ();
7719           pr "const char *%s" n
7720       | StringList n | DeviceList n ->
7721           next ();
7722           pr "char *const *%s" n
7723       | Bool n -> next (); pr "int %s" n
7724       | Int n -> next (); pr "int %s" n
7725       | Int64 n -> next (); pr "int64_t %s" n
7726       | FileIn n
7727       | FileOut n ->
7728           if not in_daemon then (next (); pr "const char *%s" n)
7729     ) (snd style);
7730     if is_RBufferOut then (next (); pr "size_t *size_r");
7731   );
7732   pr ")";
7733   if semicolon then pr ";";
7734   if newline then pr "\n"
7735
7736 (* Generate C call arguments, eg "(handle, foo, bar)" *)
7737 and generate_c_call_args ?handle ?(decl = false) style =
7738   pr "(";
7739   let comma = ref false in
7740   let next () =
7741     if !comma then pr ", ";
7742     comma := true
7743   in
7744   (match handle with
7745    | None -> ()
7746    | Some handle -> pr "%s" handle; comma := true
7747   );
7748   List.iter (
7749     fun arg ->
7750       next ();
7751       pr "%s" (name_of_argt arg)
7752   ) (snd style);
7753   (* For RBufferOut calls, add implicit &size parameter. *)
7754   if not decl then (
7755     match fst style with
7756     | RBufferOut _ ->
7757         next ();
7758         pr "&size"
7759     | _ -> ()
7760   );
7761   pr ")"
7762
7763 (* Generate the OCaml bindings interface. *)
7764 and generate_ocaml_mli () =
7765   generate_header OCamlStyle LGPLv2plus;
7766
7767   pr "\
7768 (** For API documentation you should refer to the C API
7769     in the guestfs(3) manual page.  The OCaml API uses almost
7770     exactly the same calls. *)
7771
7772 type t
7773 (** A [guestfs_h] handle. *)
7774
7775 exception Error of string
7776 (** This exception is raised when there is an error. *)
7777
7778 exception Handle_closed of string
7779 (** This exception is raised if you use a {!Guestfs.t} handle
7780     after calling {!close} on it.  The string is the name of
7781     the function. *)
7782
7783 val create : unit -> t
7784 (** Create a {!Guestfs.t} handle. *)
7785
7786 val close : t -> unit
7787 (** Close the {!Guestfs.t} handle and free up all resources used
7788     by it immediately.
7789
7790     Handles are closed by the garbage collector when they become
7791     unreferenced, but callers can call this in order to provide
7792     predictable cleanup. *)
7793
7794 ";
7795   generate_ocaml_structure_decls ();
7796
7797   (* The actions. *)
7798   List.iter (
7799     fun (name, style, _, _, _, shortdesc, _) ->
7800       generate_ocaml_prototype name style;
7801       pr "(** %s *)\n" shortdesc;
7802       pr "\n"
7803   ) all_functions_sorted
7804
7805 (* Generate the OCaml bindings implementation. *)
7806 and generate_ocaml_ml () =
7807   generate_header OCamlStyle LGPLv2plus;
7808
7809   pr "\
7810 type t
7811
7812 exception Error of string
7813 exception Handle_closed of string
7814
7815 external create : unit -> t = \"ocaml_guestfs_create\"
7816 external close : t -> unit = \"ocaml_guestfs_close\"
7817
7818 (* Give the exceptions names, so they can be raised from the C code. *)
7819 let () =
7820   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
7821   Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
7822
7823 ";
7824
7825   generate_ocaml_structure_decls ();
7826
7827   (* The actions. *)
7828   List.iter (
7829     fun (name, style, _, _, _, shortdesc, _) ->
7830       generate_ocaml_prototype ~is_external:true name style;
7831   ) all_functions_sorted
7832
7833 (* Generate the OCaml bindings C implementation. *)
7834 and generate_ocaml_c () =
7835   generate_header CStyle LGPLv2plus;
7836
7837   pr "\
7838 #include <stdio.h>
7839 #include <stdlib.h>
7840 #include <string.h>
7841
7842 #include <caml/config.h>
7843 #include <caml/alloc.h>
7844 #include <caml/callback.h>
7845 #include <caml/fail.h>
7846 #include <caml/memory.h>
7847 #include <caml/mlvalues.h>
7848 #include <caml/signals.h>
7849
7850 #include <guestfs.h>
7851
7852 #include \"guestfs_c.h\"
7853
7854 /* Copy a hashtable of string pairs into an assoc-list.  We return
7855  * the list in reverse order, but hashtables aren't supposed to be
7856  * ordered anyway.
7857  */
7858 static CAMLprim value
7859 copy_table (char * const * argv)
7860 {
7861   CAMLparam0 ();
7862   CAMLlocal5 (rv, pairv, kv, vv, cons);
7863   int i;
7864
7865   rv = Val_int (0);
7866   for (i = 0; argv[i] != NULL; i += 2) {
7867     kv = caml_copy_string (argv[i]);
7868     vv = caml_copy_string (argv[i+1]);
7869     pairv = caml_alloc (2, 0);
7870     Store_field (pairv, 0, kv);
7871     Store_field (pairv, 1, vv);
7872     cons = caml_alloc (2, 0);
7873     Store_field (cons, 1, rv);
7874     rv = cons;
7875     Store_field (cons, 0, pairv);
7876   }
7877
7878   CAMLreturn (rv);
7879 }
7880
7881 ";
7882
7883   (* Struct copy functions. *)
7884
7885   let emit_ocaml_copy_list_function typ =
7886     pr "static CAMLprim value\n";
7887     pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
7888     pr "{\n";
7889     pr "  CAMLparam0 ();\n";
7890     pr "  CAMLlocal2 (rv, v);\n";
7891     pr "  unsigned int i;\n";
7892     pr "\n";
7893     pr "  if (%ss->len == 0)\n" typ;
7894     pr "    CAMLreturn (Atom (0));\n";
7895     pr "  else {\n";
7896     pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
7897     pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
7898     pr "      v = copy_%s (&%ss->val[i]);\n" typ typ;
7899     pr "      caml_modify (&Field (rv, i), v);\n";
7900     pr "    }\n";
7901     pr "    CAMLreturn (rv);\n";
7902     pr "  }\n";
7903     pr "}\n";
7904     pr "\n";
7905   in
7906
7907   List.iter (
7908     fun (typ, cols) ->
7909       let has_optpercent_col =
7910         List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
7911
7912       pr "static CAMLprim value\n";
7913       pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
7914       pr "{\n";
7915       pr "  CAMLparam0 ();\n";
7916       if has_optpercent_col then
7917         pr "  CAMLlocal3 (rv, v, v2);\n"
7918       else
7919         pr "  CAMLlocal2 (rv, v);\n";
7920       pr "\n";
7921       pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
7922       iteri (
7923         fun i col ->
7924           (match col with
7925            | name, FString ->
7926                pr "  v = caml_copy_string (%s->%s);\n" typ name
7927            | name, FBuffer ->
7928                pr "  v = caml_alloc_string (%s->%s_len);\n" typ name;
7929                pr "  memcpy (String_val (v), %s->%s, %s->%s_len);\n"
7930                  typ name typ name
7931            | name, FUUID ->
7932                pr "  v = caml_alloc_string (32);\n";
7933                pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
7934            | name, (FBytes|FInt64|FUInt64) ->
7935                pr "  v = caml_copy_int64 (%s->%s);\n" typ name
7936            | name, (FInt32|FUInt32) ->
7937                pr "  v = caml_copy_int32 (%s->%s);\n" typ name
7938            | name, FOptPercent ->
7939                pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
7940                pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
7941                pr "    v = caml_alloc (1, 0);\n";
7942                pr "    Store_field (v, 0, v2);\n";
7943                pr "  } else /* None */\n";
7944                pr "    v = Val_int (0);\n";
7945            | name, FChar ->
7946                pr "  v = Val_int (%s->%s);\n" typ name
7947           );
7948           pr "  Store_field (rv, %d, v);\n" i
7949       ) cols;
7950       pr "  CAMLreturn (rv);\n";
7951       pr "}\n";
7952       pr "\n";
7953   ) structs;
7954
7955   (* Emit a copy_TYPE_list function definition only if that function is used. *)
7956   List.iter (
7957     function
7958     | typ, (RStructListOnly | RStructAndList) ->
7959         (* generate the function for typ *)
7960         emit_ocaml_copy_list_function typ
7961     | typ, _ -> () (* empty *)
7962   ) (rstructs_used_by all_functions);
7963
7964   (* The wrappers. *)
7965   List.iter (
7966     fun (name, style, _, _, _, _, _) ->
7967       pr "/* Automatically generated wrapper for function\n";
7968       pr " * ";
7969       generate_ocaml_prototype name style;
7970       pr " */\n";
7971       pr "\n";
7972
7973       let params =
7974         "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
7975
7976       let needs_extra_vs =
7977         match fst style with RConstOptString _ -> true | _ -> false in
7978
7979       pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
7980       pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
7981       List.iter (pr ", value %s") (List.tl params); pr ");\n";
7982       pr "\n";
7983
7984       pr "CAMLprim value\n";
7985       pr "ocaml_guestfs_%s (value %s" name (List.hd params);
7986       List.iter (pr ", value %s") (List.tl params);
7987       pr ")\n";
7988       pr "{\n";
7989
7990       (match params with
7991        | [p1; p2; p3; p4; p5] ->
7992            pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
7993        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
7994            pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
7995            pr "  CAMLxparam%d (%s);\n"
7996              (List.length rest) (String.concat ", " rest)
7997        | ps ->
7998            pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
7999       );
8000       if not needs_extra_vs then
8001         pr "  CAMLlocal1 (rv);\n"
8002       else
8003         pr "  CAMLlocal3 (rv, v, v2);\n";
8004       pr "\n";
8005
8006       pr "  guestfs_h *g = Guestfs_val (gv);\n";
8007       pr "  if (g == NULL)\n";
8008       pr "    ocaml_guestfs_raise_closed (\"%s\");\n" name;
8009       pr "\n";
8010
8011       List.iter (
8012         function
8013         | Pathname n
8014         | Device n | Dev_or_Path n
8015         | String n
8016         | FileIn n
8017         | FileOut n ->
8018             pr "  const char *%s = String_val (%sv);\n" n n
8019         | OptString n ->
8020             pr "  const char *%s =\n" n;
8021             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
8022               n n
8023         | StringList n | DeviceList n ->
8024             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
8025         | Bool n ->
8026             pr "  int %s = Bool_val (%sv);\n" n n
8027         | Int n ->
8028             pr "  int %s = Int_val (%sv);\n" n n
8029         | Int64 n ->
8030             pr "  int64_t %s = Int64_val (%sv);\n" n n
8031       ) (snd style);
8032       let error_code =
8033         match fst style with
8034         | RErr -> pr "  int r;\n"; "-1"
8035         | RInt _ -> pr "  int r;\n"; "-1"
8036         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8037         | RBool _ -> pr "  int r;\n"; "-1"
8038         | RConstString _ | RConstOptString _ ->
8039             pr "  const char *r;\n"; "NULL"
8040         | RString _ -> pr "  char *r;\n"; "NULL"
8041         | RStringList _ ->
8042             pr "  int i;\n";
8043             pr "  char **r;\n";
8044             "NULL"
8045         | RStruct (_, typ) ->
8046             pr "  struct guestfs_%s *r;\n" typ; "NULL"
8047         | RStructList (_, typ) ->
8048             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8049         | RHashtable _ ->
8050             pr "  int i;\n";
8051             pr "  char **r;\n";
8052             "NULL"
8053         | RBufferOut _ ->
8054             pr "  char *r;\n";
8055             pr "  size_t size;\n";
8056             "NULL" in
8057       pr "\n";
8058
8059       pr "  caml_enter_blocking_section ();\n";
8060       pr "  r = guestfs_%s " name;
8061       generate_c_call_args ~handle:"g" style;
8062       pr ";\n";
8063       pr "  caml_leave_blocking_section ();\n";
8064
8065       List.iter (
8066         function
8067         | StringList n | DeviceList n ->
8068             pr "  ocaml_guestfs_free_strings (%s);\n" n;
8069         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8070         | Bool _ | Int _ | Int64 _
8071         | FileIn _ | FileOut _ -> ()
8072       ) (snd style);
8073
8074       pr "  if (r == %s)\n" error_code;
8075       pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
8076       pr "\n";
8077
8078       (match fst style with
8079        | RErr -> pr "  rv = Val_unit;\n"
8080        | RInt _ -> pr "  rv = Val_int (r);\n"
8081        | RInt64 _ ->
8082            pr "  rv = caml_copy_int64 (r);\n"
8083        | RBool _ -> pr "  rv = Val_bool (r);\n"
8084        | RConstString _ ->
8085            pr "  rv = caml_copy_string (r);\n"
8086        | RConstOptString _ ->
8087            pr "  if (r) { /* Some string */\n";
8088            pr "    v = caml_alloc (1, 0);\n";
8089            pr "    v2 = caml_copy_string (r);\n";
8090            pr "    Store_field (v, 0, v2);\n";
8091            pr "  } else /* None */\n";
8092            pr "    v = Val_int (0);\n";
8093        | RString _ ->
8094            pr "  rv = caml_copy_string (r);\n";
8095            pr "  free (r);\n"
8096        | RStringList _ ->
8097            pr "  rv = caml_copy_string_array ((const char **) r);\n";
8098            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8099            pr "  free (r);\n"
8100        | RStruct (_, typ) ->
8101            pr "  rv = copy_%s (r);\n" typ;
8102            pr "  guestfs_free_%s (r);\n" typ;
8103        | RStructList (_, typ) ->
8104            pr "  rv = copy_%s_list (r);\n" typ;
8105            pr "  guestfs_free_%s_list (r);\n" typ;
8106        | RHashtable _ ->
8107            pr "  rv = copy_table (r);\n";
8108            pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
8109            pr "  free (r);\n";
8110        | RBufferOut _ ->
8111            pr "  rv = caml_alloc_string (size);\n";
8112            pr "  memcpy (String_val (rv), r, size);\n";
8113       );
8114
8115       pr "  CAMLreturn (rv);\n";
8116       pr "}\n";
8117       pr "\n";
8118
8119       if List.length params > 5 then (
8120         pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
8121         pr "CAMLprim value ";
8122         pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
8123         pr "CAMLprim value\n";
8124         pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
8125         pr "{\n";
8126         pr "  return ocaml_guestfs_%s (argv[0]" name;
8127         iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
8128         pr ");\n";
8129         pr "}\n";
8130         pr "\n"
8131       )
8132   ) all_functions_sorted
8133
8134 and generate_ocaml_structure_decls () =
8135   List.iter (
8136     fun (typ, cols) ->
8137       pr "type %s = {\n" typ;
8138       List.iter (
8139         function
8140         | name, FString -> pr "  %s : string;\n" name
8141         | name, FBuffer -> pr "  %s : string;\n" name
8142         | name, FUUID -> pr "  %s : string;\n" name
8143         | name, (FBytes|FInt64|FUInt64) -> pr "  %s : int64;\n" name
8144         | name, (FInt32|FUInt32) -> pr "  %s : int32;\n" name
8145         | name, FChar -> pr "  %s : char;\n" name
8146         | name, FOptPercent -> pr "  %s : float option;\n" name
8147       ) cols;
8148       pr "}\n";
8149       pr "\n"
8150   ) structs
8151
8152 and generate_ocaml_prototype ?(is_external = false) name style =
8153   if is_external then pr "external " else pr "val ";
8154   pr "%s : t -> " name;
8155   List.iter (
8156     function
8157     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
8158     | OptString _ -> pr "string option -> "
8159     | StringList _ | DeviceList _ -> pr "string array -> "
8160     | Bool _ -> pr "bool -> "
8161     | Int _ -> pr "int -> "
8162     | Int64 _ -> pr "int64 -> "
8163   ) (snd style);
8164   (match fst style with
8165    | RErr -> pr "unit" (* all errors are turned into exceptions *)
8166    | RInt _ -> pr "int"
8167    | RInt64 _ -> pr "int64"
8168    | RBool _ -> pr "bool"
8169    | RConstString _ -> pr "string"
8170    | RConstOptString _ -> pr "string option"
8171    | RString _ | RBufferOut _ -> pr "string"
8172    | RStringList _ -> pr "string array"
8173    | RStruct (_, typ) -> pr "%s" typ
8174    | RStructList (_, typ) -> pr "%s array" typ
8175    | RHashtable _ -> pr "(string * string) list"
8176   );
8177   if is_external then (
8178     pr " = ";
8179     if List.length (snd style) + 1 > 5 then
8180       pr "\"ocaml_guestfs_%s_byte\" " name;
8181     pr "\"ocaml_guestfs_%s\"" name
8182   );
8183   pr "\n"
8184
8185 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
8186 and generate_perl_xs () =
8187   generate_header CStyle LGPLv2plus;
8188
8189   pr "\
8190 #include \"EXTERN.h\"
8191 #include \"perl.h\"
8192 #include \"XSUB.h\"
8193
8194 #include <guestfs.h>
8195
8196 #ifndef PRId64
8197 #define PRId64 \"lld\"
8198 #endif
8199
8200 static SV *
8201 my_newSVll(long long val) {
8202 #ifdef USE_64_BIT_ALL
8203   return newSViv(val);
8204 #else
8205   char buf[100];
8206   int len;
8207   len = snprintf(buf, 100, \"%%\" PRId64, val);
8208   return newSVpv(buf, len);
8209 #endif
8210 }
8211
8212 #ifndef PRIu64
8213 #define PRIu64 \"llu\"
8214 #endif
8215
8216 static SV *
8217 my_newSVull(unsigned long long val) {
8218 #ifdef USE_64_BIT_ALL
8219   return newSVuv(val);
8220 #else
8221   char buf[100];
8222   int len;
8223   len = snprintf(buf, 100, \"%%\" PRIu64, val);
8224   return newSVpv(buf, len);
8225 #endif
8226 }
8227
8228 /* http://www.perlmonks.org/?node_id=680842 */
8229 static char **
8230 XS_unpack_charPtrPtr (SV *arg) {
8231   char **ret;
8232   AV *av;
8233   I32 i;
8234
8235   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
8236     croak (\"array reference expected\");
8237
8238   av = (AV *)SvRV (arg);
8239   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
8240   if (!ret)
8241     croak (\"malloc failed\");
8242
8243   for (i = 0; i <= av_len (av); i++) {
8244     SV **elem = av_fetch (av, i, 0);
8245
8246     if (!elem || !*elem)
8247       croak (\"missing element in list\");
8248
8249     ret[i] = SvPV_nolen (*elem);
8250   }
8251
8252   ret[i] = NULL;
8253
8254   return ret;
8255 }
8256
8257 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
8258
8259 PROTOTYPES: ENABLE
8260
8261 guestfs_h *
8262 _create ()
8263    CODE:
8264       RETVAL = guestfs_create ();
8265       if (!RETVAL)
8266         croak (\"could not create guestfs handle\");
8267       guestfs_set_error_handler (RETVAL, NULL, NULL);
8268  OUTPUT:
8269       RETVAL
8270
8271 void
8272 DESTROY (g)
8273       guestfs_h *g;
8274  PPCODE:
8275       guestfs_close (g);
8276
8277 ";
8278
8279   List.iter (
8280     fun (name, style, _, _, _, _, _) ->
8281       (match fst style with
8282        | RErr -> pr "void\n"
8283        | RInt _ -> pr "SV *\n"
8284        | RInt64 _ -> pr "SV *\n"
8285        | RBool _ -> pr "SV *\n"
8286        | RConstString _ -> pr "SV *\n"
8287        | RConstOptString _ -> pr "SV *\n"
8288        | RString _ -> pr "SV *\n"
8289        | RBufferOut _ -> pr "SV *\n"
8290        | RStringList _
8291        | RStruct _ | RStructList _
8292        | RHashtable _ ->
8293            pr "void\n" (* all lists returned implictly on the stack *)
8294       );
8295       (* Call and arguments. *)
8296       pr "%s " name;
8297       generate_c_call_args ~handle:"g" ~decl:true style;
8298       pr "\n";
8299       pr "      guestfs_h *g;\n";
8300       iteri (
8301         fun i ->
8302           function
8303           | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8304               pr "      char *%s;\n" n
8305           | OptString n ->
8306               (* http://www.perlmonks.org/?node_id=554277
8307                * Note that the implicit handle argument means we have
8308                * to add 1 to the ST(x) operator.
8309                *)
8310               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
8311           | StringList n | DeviceList n -> pr "      char **%s;\n" n
8312           | Bool n -> pr "      int %s;\n" n
8313           | Int n -> pr "      int %s;\n" n
8314           | Int64 n -> pr "      int64_t %s;\n" n
8315       ) (snd style);
8316
8317       let do_cleanups () =
8318         List.iter (
8319           function
8320           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
8321           | Bool _ | Int _ | Int64 _
8322           | FileIn _ | FileOut _ -> ()
8323           | StringList n | DeviceList n -> pr "      free (%s);\n" n
8324         ) (snd style)
8325       in
8326
8327       (* Code. *)
8328       (match fst style with
8329        | RErr ->
8330            pr "PREINIT:\n";
8331            pr "      int r;\n";
8332            pr " PPCODE:\n";
8333            pr "      r = guestfs_%s " name;
8334            generate_c_call_args ~handle:"g" style;
8335            pr ";\n";
8336            do_cleanups ();
8337            pr "      if (r == -1)\n";
8338            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8339        | RInt n
8340        | RBool n ->
8341            pr "PREINIT:\n";
8342            pr "      int %s;\n" n;
8343            pr "   CODE:\n";
8344            pr "      %s = guestfs_%s " n name;
8345            generate_c_call_args ~handle:"g" style;
8346            pr ";\n";
8347            do_cleanups ();
8348            pr "      if (%s == -1)\n" n;
8349            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8350            pr "      RETVAL = newSViv (%s);\n" n;
8351            pr " OUTPUT:\n";
8352            pr "      RETVAL\n"
8353        | RInt64 n ->
8354            pr "PREINIT:\n";
8355            pr "      int64_t %s;\n" n;
8356            pr "   CODE:\n";
8357            pr "      %s = guestfs_%s " n name;
8358            generate_c_call_args ~handle:"g" style;
8359            pr ";\n";
8360            do_cleanups ();
8361            pr "      if (%s == -1)\n" n;
8362            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8363            pr "      RETVAL = my_newSVll (%s);\n" n;
8364            pr " OUTPUT:\n";
8365            pr "      RETVAL\n"
8366        | RConstString n ->
8367            pr "PREINIT:\n";
8368            pr "      const char *%s;\n" n;
8369            pr "   CODE:\n";
8370            pr "      %s = guestfs_%s " n name;
8371            generate_c_call_args ~handle:"g" style;
8372            pr ";\n";
8373            do_cleanups ();
8374            pr "      if (%s == NULL)\n" n;
8375            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8376            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8377            pr " OUTPUT:\n";
8378            pr "      RETVAL\n"
8379        | RConstOptString n ->
8380            pr "PREINIT:\n";
8381            pr "      const char *%s;\n" n;
8382            pr "   CODE:\n";
8383            pr "      %s = guestfs_%s " n name;
8384            generate_c_call_args ~handle:"g" style;
8385            pr ";\n";
8386            do_cleanups ();
8387            pr "      if (%s == NULL)\n" n;
8388            pr "        RETVAL = &PL_sv_undef;\n";
8389            pr "      else\n";
8390            pr "        RETVAL = newSVpv (%s, 0);\n" n;
8391            pr " OUTPUT:\n";
8392            pr "      RETVAL\n"
8393        | RString n ->
8394            pr "PREINIT:\n";
8395            pr "      char *%s;\n" n;
8396            pr "   CODE:\n";
8397            pr "      %s = guestfs_%s " n name;
8398            generate_c_call_args ~handle:"g" style;
8399            pr ";\n";
8400            do_cleanups ();
8401            pr "      if (%s == NULL)\n" n;
8402            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8403            pr "      RETVAL = newSVpv (%s, 0);\n" n;
8404            pr "      free (%s);\n" n;
8405            pr " OUTPUT:\n";
8406            pr "      RETVAL\n"
8407        | RStringList n | RHashtable n ->
8408            pr "PREINIT:\n";
8409            pr "      char **%s;\n" n;
8410            pr "      int i, n;\n";
8411            pr " PPCODE:\n";
8412            pr "      %s = guestfs_%s " n name;
8413            generate_c_call_args ~handle:"g" style;
8414            pr ";\n";
8415            do_cleanups ();
8416            pr "      if (%s == NULL)\n" n;
8417            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8418            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
8419            pr "      EXTEND (SP, n);\n";
8420            pr "      for (i = 0; i < n; ++i) {\n";
8421            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
8422            pr "        free (%s[i]);\n" n;
8423            pr "      }\n";
8424            pr "      free (%s);\n" n;
8425        | RStruct (n, typ) ->
8426            let cols = cols_of_struct typ in
8427            generate_perl_struct_code typ cols name style n do_cleanups
8428        | RStructList (n, typ) ->
8429            let cols = cols_of_struct typ in
8430            generate_perl_struct_list_code typ cols name style n do_cleanups
8431        | RBufferOut n ->
8432            pr "PREINIT:\n";
8433            pr "      char *%s;\n" n;
8434            pr "      size_t size;\n";
8435            pr "   CODE:\n";
8436            pr "      %s = guestfs_%s " n name;
8437            generate_c_call_args ~handle:"g" style;
8438            pr ";\n";
8439            do_cleanups ();
8440            pr "      if (%s == NULL)\n" n;
8441            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8442            pr "      RETVAL = newSVpvn (%s, size);\n" n;
8443            pr "      free (%s);\n" n;
8444            pr " OUTPUT:\n";
8445            pr "      RETVAL\n"
8446       );
8447
8448       pr "\n"
8449   ) all_functions
8450
8451 and generate_perl_struct_list_code typ cols name style n do_cleanups =
8452   pr "PREINIT:\n";
8453   pr "      struct guestfs_%s_list *%s;\n" typ n;
8454   pr "      int i;\n";
8455   pr "      HV *hv;\n";
8456   pr " PPCODE:\n";
8457   pr "      %s = guestfs_%s " n name;
8458   generate_c_call_args ~handle:"g" style;
8459   pr ";\n";
8460   do_cleanups ();
8461   pr "      if (%s == NULL)\n" n;
8462   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8463   pr "      EXTEND (SP, %s->len);\n" n;
8464   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
8465   pr "        hv = newHV ();\n";
8466   List.iter (
8467     function
8468     | name, FString ->
8469         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
8470           name (String.length name) n name
8471     | name, FUUID ->
8472         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
8473           name (String.length name) n name
8474     | name, FBuffer ->
8475         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
8476           name (String.length name) n name n name
8477     | name, (FBytes|FUInt64) ->
8478         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
8479           name (String.length name) n name
8480     | name, FInt64 ->
8481         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
8482           name (String.length name) n name
8483     | name, (FInt32|FUInt32) ->
8484         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8485           name (String.length name) n name
8486     | name, FChar ->
8487         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
8488           name (String.length name) n name
8489     | name, FOptPercent ->
8490         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
8491           name (String.length name) n name
8492   ) cols;
8493   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
8494   pr "      }\n";
8495   pr "      guestfs_free_%s_list (%s);\n" typ n
8496
8497 and generate_perl_struct_code typ cols name style n do_cleanups =
8498   pr "PREINIT:\n";
8499   pr "      struct guestfs_%s *%s;\n" typ n;
8500   pr " PPCODE:\n";
8501   pr "      %s = guestfs_%s " n name;
8502   generate_c_call_args ~handle:"g" style;
8503   pr ";\n";
8504   do_cleanups ();
8505   pr "      if (%s == NULL)\n" n;
8506   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
8507   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
8508   List.iter (
8509     fun ((name, _) as col) ->
8510       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
8511
8512       match col with
8513       | name, FString ->
8514           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
8515             n name
8516       | name, FBuffer ->
8517           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
8518             n name n name
8519       | name, FUUID ->
8520           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
8521             n name
8522       | name, (FBytes|FUInt64) ->
8523           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
8524             n name
8525       | name, FInt64 ->
8526           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
8527             n name
8528       | name, (FInt32|FUInt32) ->
8529           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8530             n name
8531       | name, FChar ->
8532           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
8533             n name
8534       | name, FOptPercent ->
8535           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
8536             n name
8537   ) cols;
8538   pr "      free (%s);\n" n
8539
8540 (* Generate Sys/Guestfs.pm. *)
8541 and generate_perl_pm () =
8542   generate_header HashStyle LGPLv2plus;
8543
8544   pr "\
8545 =pod
8546
8547 =head1 NAME
8548
8549 Sys::Guestfs - Perl bindings for libguestfs
8550
8551 =head1 SYNOPSIS
8552
8553  use Sys::Guestfs;
8554
8555  my $h = Sys::Guestfs->new ();
8556  $h->add_drive ('guest.img');
8557  $h->launch ();
8558  $h->mount ('/dev/sda1', '/');
8559  $h->touch ('/hello');
8560  $h->sync ();
8561
8562 =head1 DESCRIPTION
8563
8564 The C<Sys::Guestfs> module provides a Perl XS binding to the
8565 libguestfs API for examining and modifying virtual machine
8566 disk images.
8567
8568 Amongst the things this is good for: making batch configuration
8569 changes to guests, getting disk used/free statistics (see also:
8570 virt-df), migrating between virtualization systems (see also:
8571 virt-p2v), performing partial backups, performing partial guest
8572 clones, cloning guests and changing registry/UUID/hostname info, and
8573 much else besides.
8574
8575 Libguestfs uses Linux kernel and qemu code, and can access any type of
8576 guest filesystem that Linux and qemu can, including but not limited
8577 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
8578 schemes, qcow, qcow2, vmdk.
8579
8580 Libguestfs provides ways to enumerate guest storage (eg. partitions,
8581 LVs, what filesystem is in each LV, etc.).  It can also run commands
8582 in the context of the guest.  Also you can access filesystems over
8583 FUSE.
8584
8585 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
8586 functions for using libguestfs from Perl, including integration
8587 with libvirt.
8588
8589 =head1 ERRORS
8590
8591 All errors turn into calls to C<croak> (see L<Carp(3)>).
8592
8593 =head1 METHODS
8594
8595 =over 4
8596
8597 =cut
8598
8599 package Sys::Guestfs;
8600
8601 use strict;
8602 use warnings;
8603
8604 require XSLoader;
8605 XSLoader::load ('Sys::Guestfs');
8606
8607 =item $h = Sys::Guestfs->new ();
8608
8609 Create a new guestfs handle.
8610
8611 =cut
8612
8613 sub new {
8614   my $proto = shift;
8615   my $class = ref ($proto) || $proto;
8616
8617   my $self = Sys::Guestfs::_create ();
8618   bless $self, $class;
8619   return $self;
8620 }
8621
8622 ";
8623
8624   (* Actions.  We only need to print documentation for these as
8625    * they are pulled in from the XS code automatically.
8626    *)
8627   List.iter (
8628     fun (name, style, _, flags, _, _, longdesc) ->
8629       if not (List.mem NotInDocs flags) then (
8630         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
8631         pr "=item ";
8632         generate_perl_prototype name style;
8633         pr "\n\n";
8634         pr "%s\n\n" longdesc;
8635         if List.mem ProtocolLimitWarning flags then
8636           pr "%s\n\n" protocol_limit_warning;
8637         if List.mem DangerWillRobinson flags then
8638           pr "%s\n\n" danger_will_robinson;
8639         match deprecation_notice flags with
8640         | None -> ()
8641         | Some txt -> pr "%s\n\n" txt
8642       )
8643   ) all_functions_sorted;
8644
8645   (* End of file. *)
8646   pr "\
8647 =cut
8648
8649 1;
8650
8651 =back
8652
8653 =head1 COPYRIGHT
8654
8655 Copyright (C) %s Red Hat Inc.
8656
8657 =head1 LICENSE
8658
8659 Please see the file COPYING.LIB for the full license.
8660
8661 =head1 SEE ALSO
8662
8663 L<guestfs(3)>,
8664 L<guestfish(1)>,
8665 L<http://libguestfs.org>,
8666 L<Sys::Guestfs::Lib(3)>.
8667
8668 =cut
8669 " copyright_years
8670
8671 and generate_perl_prototype name style =
8672   (match fst style with
8673    | RErr -> ()
8674    | RBool n
8675    | RInt n
8676    | RInt64 n
8677    | RConstString n
8678    | RConstOptString n
8679    | RString n
8680    | RBufferOut n -> pr "$%s = " n
8681    | RStruct (n,_)
8682    | RHashtable n -> pr "%%%s = " n
8683    | RStringList n
8684    | RStructList (n,_) -> pr "@%s = " n
8685   );
8686   pr "$h->%s (" name;
8687   let comma = ref false in
8688   List.iter (
8689     fun arg ->
8690       if !comma then pr ", ";
8691       comma := true;
8692       match arg with
8693       | Pathname n | Device n | Dev_or_Path n | String n
8694       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n ->
8695           pr "$%s" n
8696       | StringList n | DeviceList n ->
8697           pr "\\@%s" n
8698   ) (snd style);
8699   pr ");"
8700
8701 (* Generate Python C module. *)
8702 and generate_python_c () =
8703   generate_header CStyle LGPLv2plus;
8704
8705   pr "\
8706 #include <Python.h>
8707
8708 #include <stdio.h>
8709 #include <stdlib.h>
8710 #include <assert.h>
8711
8712 #include \"guestfs.h\"
8713
8714 typedef struct {
8715   PyObject_HEAD
8716   guestfs_h *g;
8717 } Pyguestfs_Object;
8718
8719 static guestfs_h *
8720 get_handle (PyObject *obj)
8721 {
8722   assert (obj);
8723   assert (obj != Py_None);
8724   return ((Pyguestfs_Object *) obj)->g;
8725 }
8726
8727 static PyObject *
8728 put_handle (guestfs_h *g)
8729 {
8730   assert (g);
8731   return
8732     PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
8733 }
8734
8735 /* This list should be freed (but not the strings) after use. */
8736 static char **
8737 get_string_list (PyObject *obj)
8738 {
8739   int i, len;
8740   char **r;
8741
8742   assert (obj);
8743
8744   if (!PyList_Check (obj)) {
8745     PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
8746     return NULL;
8747   }
8748
8749   len = PyList_Size (obj);
8750   r = malloc (sizeof (char *) * (len+1));
8751   if (r == NULL) {
8752     PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
8753     return NULL;
8754   }
8755
8756   for (i = 0; i < len; ++i)
8757     r[i] = PyString_AsString (PyList_GetItem (obj, i));
8758   r[len] = NULL;
8759
8760   return r;
8761 }
8762
8763 static PyObject *
8764 put_string_list (char * const * const argv)
8765 {
8766   PyObject *list;
8767   int argc, i;
8768
8769   for (argc = 0; argv[argc] != NULL; ++argc)
8770     ;
8771
8772   list = PyList_New (argc);
8773   for (i = 0; i < argc; ++i)
8774     PyList_SetItem (list, i, PyString_FromString (argv[i]));
8775
8776   return list;
8777 }
8778
8779 static PyObject *
8780 put_table (char * const * const argv)
8781 {
8782   PyObject *list, *item;
8783   int argc, i;
8784
8785   for (argc = 0; argv[argc] != NULL; ++argc)
8786     ;
8787
8788   list = PyList_New (argc >> 1);
8789   for (i = 0; i < argc; i += 2) {
8790     item = PyTuple_New (2);
8791     PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
8792     PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
8793     PyList_SetItem (list, i >> 1, item);
8794   }
8795
8796   return list;
8797 }
8798
8799 static void
8800 free_strings (char **argv)
8801 {
8802   int argc;
8803
8804   for (argc = 0; argv[argc] != NULL; ++argc)
8805     free (argv[argc]);
8806   free (argv);
8807 }
8808
8809 static PyObject *
8810 py_guestfs_create (PyObject *self, PyObject *args)
8811 {
8812   guestfs_h *g;
8813
8814   g = guestfs_create ();
8815   if (g == NULL) {
8816     PyErr_SetString (PyExc_RuntimeError,
8817                      \"guestfs.create: failed to allocate handle\");
8818     return NULL;
8819   }
8820   guestfs_set_error_handler (g, NULL, NULL);
8821   return put_handle (g);
8822 }
8823
8824 static PyObject *
8825 py_guestfs_close (PyObject *self, PyObject *args)
8826 {
8827   PyObject *py_g;
8828   guestfs_h *g;
8829
8830   if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
8831     return NULL;
8832   g = get_handle (py_g);
8833
8834   guestfs_close (g);
8835
8836   Py_INCREF (Py_None);
8837   return Py_None;
8838 }
8839
8840 ";
8841
8842   let emit_put_list_function typ =
8843     pr "static PyObject *\n";
8844     pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
8845     pr "{\n";
8846     pr "  PyObject *list;\n";
8847     pr "  int i;\n";
8848     pr "\n";
8849     pr "  list = PyList_New (%ss->len);\n" typ;
8850     pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
8851     pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
8852     pr "  return list;\n";
8853     pr "};\n";
8854     pr "\n"
8855   in
8856
8857   (* Structures, turned into Python dictionaries. *)
8858   List.iter (
8859     fun (typ, cols) ->
8860       pr "static PyObject *\n";
8861       pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
8862       pr "{\n";
8863       pr "  PyObject *dict;\n";
8864       pr "\n";
8865       pr "  dict = PyDict_New ();\n";
8866       List.iter (
8867         function
8868         | name, FString ->
8869             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8870             pr "                        PyString_FromString (%s->%s));\n"
8871               typ name
8872         | name, FBuffer ->
8873             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8874             pr "                        PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
8875               typ name typ name
8876         | name, FUUID ->
8877             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8878             pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
8879               typ name
8880         | name, (FBytes|FUInt64) ->
8881             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8882             pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
8883               typ name
8884         | name, FInt64 ->
8885             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8886             pr "                        PyLong_FromLongLong (%s->%s));\n"
8887               typ name
8888         | name, FUInt32 ->
8889             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8890             pr "                        PyLong_FromUnsignedLong (%s->%s));\n"
8891               typ name
8892         | name, FInt32 ->
8893             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8894             pr "                        PyLong_FromLong (%s->%s));\n"
8895               typ name
8896         | name, FOptPercent ->
8897             pr "  if (%s->%s >= 0)\n" typ name;
8898             pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
8899             pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
8900               typ name;
8901             pr "  else {\n";
8902             pr "    Py_INCREF (Py_None);\n";
8903             pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
8904             pr "  }\n"
8905         | name, FChar ->
8906             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
8907             pr "                        PyString_FromStringAndSize (&dirent->%s, 1));\n" name
8908       ) cols;
8909       pr "  return dict;\n";
8910       pr "};\n";
8911       pr "\n";
8912
8913   ) structs;
8914
8915   (* Emit a put_TYPE_list function definition only if that function is used. *)
8916   List.iter (
8917     function
8918     | typ, (RStructListOnly | RStructAndList) ->
8919         (* generate the function for typ *)
8920         emit_put_list_function typ
8921     | typ, _ -> () (* empty *)
8922   ) (rstructs_used_by all_functions);
8923
8924   (* Python wrapper functions. *)
8925   List.iter (
8926     fun (name, style, _, _, _, _, _) ->
8927       pr "static PyObject *\n";
8928       pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
8929       pr "{\n";
8930
8931       pr "  PyObject *py_g;\n";
8932       pr "  guestfs_h *g;\n";
8933       pr "  PyObject *py_r;\n";
8934
8935       let error_code =
8936         match fst style with
8937         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
8938         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
8939         | RConstString _ | RConstOptString _ ->
8940             pr "  const char *r;\n"; "NULL"
8941         | RString _ -> pr "  char *r;\n"; "NULL"
8942         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
8943         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
8944         | RStructList (_, typ) ->
8945             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
8946         | RBufferOut _ ->
8947             pr "  char *r;\n";
8948             pr "  size_t size;\n";
8949             "NULL" in
8950
8951       List.iter (
8952         function
8953         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
8954             pr "  const char *%s;\n" n
8955         | OptString n -> pr "  const char *%s;\n" n
8956         | StringList n | DeviceList n ->
8957             pr "  PyObject *py_%s;\n" n;
8958             pr "  char **%s;\n" n
8959         | Bool n -> pr "  int %s;\n" n
8960         | Int n -> pr "  int %s;\n" n
8961         | Int64 n -> pr "  long long %s;\n" n
8962       ) (snd style);
8963
8964       pr "\n";
8965
8966       (* Convert the parameters. *)
8967       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
8968       List.iter (
8969         function
8970         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
8971         | OptString _ -> pr "z"
8972         | StringList _ | DeviceList _ -> pr "O"
8973         | Bool _ -> pr "i" (* XXX Python has booleans? *)
8974         | Int _ -> pr "i"
8975         | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
8976                              * emulate C's int/long/long long in Python?
8977                              *)
8978       ) (snd style);
8979       pr ":guestfs_%s\",\n" name;
8980       pr "                         &py_g";
8981       List.iter (
8982         function
8983         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
8984         | OptString n -> pr ", &%s" n
8985         | StringList n | DeviceList n -> pr ", &py_%s" n
8986         | Bool n -> pr ", &%s" n
8987         | Int n -> pr ", &%s" n
8988         | Int64 n -> pr ", &%s" n
8989       ) (snd style);
8990
8991       pr "))\n";
8992       pr "    return NULL;\n";
8993
8994       pr "  g = get_handle (py_g);\n";
8995       List.iter (
8996         function
8997         | Pathname _ | Device _ | Dev_or_Path _ | String _
8998         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
8999         | StringList n | DeviceList n ->
9000             pr "  %s = get_string_list (py_%s);\n" n n;
9001             pr "  if (!%s) return NULL;\n" n
9002       ) (snd style);
9003
9004       pr "\n";
9005
9006       pr "  r = guestfs_%s " name;
9007       generate_c_call_args ~handle:"g" style;
9008       pr ";\n";
9009
9010       List.iter (
9011         function
9012         | Pathname _ | Device _ | Dev_or_Path _ | String _
9013         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9014         | StringList n | DeviceList n ->
9015             pr "  free (%s);\n" n
9016       ) (snd style);
9017
9018       pr "  if (r == %s) {\n" error_code;
9019       pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
9020       pr "    return NULL;\n";
9021       pr "  }\n";
9022       pr "\n";
9023
9024       (match fst style with
9025        | RErr ->
9026            pr "  Py_INCREF (Py_None);\n";
9027            pr "  py_r = Py_None;\n"
9028        | RInt _
9029        | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
9030        | RInt64 _ -> pr "  py_r = PyLong_FromLongLong (r);\n"
9031        | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
9032        | RConstOptString _ ->
9033            pr "  if (r)\n";
9034            pr "    py_r = PyString_FromString (r);\n";
9035            pr "  else {\n";
9036            pr "    Py_INCREF (Py_None);\n";
9037            pr "    py_r = Py_None;\n";
9038            pr "  }\n"
9039        | RString _ ->
9040            pr "  py_r = PyString_FromString (r);\n";
9041            pr "  free (r);\n"
9042        | RStringList _ ->
9043            pr "  py_r = put_string_list (r);\n";
9044            pr "  free_strings (r);\n"
9045        | RStruct (_, typ) ->
9046            pr "  py_r = put_%s (r);\n" typ;
9047            pr "  guestfs_free_%s (r);\n" typ
9048        | RStructList (_, typ) ->
9049            pr "  py_r = put_%s_list (r);\n" typ;
9050            pr "  guestfs_free_%s_list (r);\n" typ
9051        | RHashtable n ->
9052            pr "  py_r = put_table (r);\n";
9053            pr "  free_strings (r);\n"
9054        | RBufferOut _ ->
9055            pr "  py_r = PyString_FromStringAndSize (r, size);\n";
9056            pr "  free (r);\n"
9057       );
9058
9059       pr "  return py_r;\n";
9060       pr "}\n";
9061       pr "\n"
9062   ) all_functions;
9063
9064   (* Table of functions. *)
9065   pr "static PyMethodDef methods[] = {\n";
9066   pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
9067   pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
9068   List.iter (
9069     fun (name, _, _, _, _, _, _) ->
9070       pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
9071         name name
9072   ) all_functions;
9073   pr "  { NULL, NULL, 0, NULL }\n";
9074   pr "};\n";
9075   pr "\n";
9076
9077   (* Init function. *)
9078   pr "\
9079 void
9080 initlibguestfsmod (void)
9081 {
9082   static int initialized = 0;
9083
9084   if (initialized) return;
9085   Py_InitModule ((char *) \"libguestfsmod\", methods);
9086   initialized = 1;
9087 }
9088 "
9089
9090 (* Generate Python module. *)
9091 and generate_python_py () =
9092   generate_header HashStyle LGPLv2plus;
9093
9094   pr "\
9095 u\"\"\"Python bindings for libguestfs
9096
9097 import guestfs
9098 g = guestfs.GuestFS ()
9099 g.add_drive (\"guest.img\")
9100 g.launch ()
9101 parts = g.list_partitions ()
9102
9103 The guestfs module provides a Python binding to the libguestfs API
9104 for examining and modifying virtual machine disk images.
9105
9106 Amongst the things this is good for: making batch configuration
9107 changes to guests, getting disk used/free statistics (see also:
9108 virt-df), migrating between virtualization systems (see also:
9109 virt-p2v), performing partial backups, performing partial guest
9110 clones, cloning guests and changing registry/UUID/hostname info, and
9111 much else besides.
9112
9113 Libguestfs uses Linux kernel and qemu code, and can access any type of
9114 guest filesystem that Linux and qemu can, including but not limited
9115 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
9116 schemes, qcow, qcow2, vmdk.
9117
9118 Libguestfs provides ways to enumerate guest storage (eg. partitions,
9119 LVs, what filesystem is in each LV, etc.).  It can also run commands
9120 in the context of the guest.  Also you can access filesystems over
9121 FUSE.
9122
9123 Errors which happen while using the API are turned into Python
9124 RuntimeError exceptions.
9125
9126 To create a guestfs handle you usually have to perform the following
9127 sequence of calls:
9128
9129 # Create the handle, call add_drive at least once, and possibly
9130 # several times if the guest has multiple block devices:
9131 g = guestfs.GuestFS ()
9132 g.add_drive (\"guest.img\")
9133
9134 # Launch the qemu subprocess and wait for it to become ready:
9135 g.launch ()
9136
9137 # Now you can issue commands, for example:
9138 logvols = g.lvs ()
9139
9140 \"\"\"
9141
9142 import libguestfsmod
9143
9144 class GuestFS:
9145     \"\"\"Instances of this class are libguestfs API handles.\"\"\"
9146
9147     def __init__ (self):
9148         \"\"\"Create a new libguestfs handle.\"\"\"
9149         self._o = libguestfsmod.create ()
9150
9151     def __del__ (self):
9152         libguestfsmod.close (self._o)
9153
9154 ";
9155
9156   List.iter (
9157     fun (name, style, _, flags, _, _, longdesc) ->
9158       pr "    def %s " name;
9159       generate_py_call_args ~handle:"self" (snd style);
9160       pr ":\n";
9161
9162       if not (List.mem NotInDocs flags) then (
9163         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9164         let doc =
9165           match fst style with
9166           | RErr | RInt _ | RInt64 _ | RBool _
9167           | RConstOptString _ | RConstString _
9168           | RString _ | RBufferOut _ -> doc
9169           | RStringList _ ->
9170               doc ^ "\n\nThis function returns a list of strings."
9171           | RStruct (_, typ) ->
9172               doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
9173           | RStructList (_, typ) ->
9174               doc ^ sprintf "\n\nThis function returns a list of %ss.  Each %s is represented as a dictionary." typ typ
9175           | RHashtable _ ->
9176               doc ^ "\n\nThis function returns a dictionary." in
9177         let doc =
9178           if List.mem ProtocolLimitWarning flags then
9179             doc ^ "\n\n" ^ protocol_limit_warning
9180           else doc in
9181         let doc =
9182           if List.mem DangerWillRobinson flags then
9183             doc ^ "\n\n" ^ danger_will_robinson
9184           else doc in
9185         let doc =
9186           match deprecation_notice flags with
9187           | None -> doc
9188           | Some txt -> doc ^ "\n\n" ^ txt in
9189         let doc = pod2text ~width:60 name doc in
9190         let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
9191         let doc = String.concat "\n        " doc in
9192         pr "        u\"\"\"%s\"\"\"\n" doc;
9193       );
9194       pr "        return libguestfsmod.%s " name;
9195       generate_py_call_args ~handle:"self._o" (snd style);
9196       pr "\n";
9197       pr "\n";
9198   ) all_functions
9199
9200 (* Generate Python call arguments, eg "(handle, foo, bar)" *)
9201 and generate_py_call_args ~handle args =
9202   pr "(%s" handle;
9203   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9204   pr ")"
9205
9206 (* Useful if you need the longdesc POD text as plain text.  Returns a
9207  * list of lines.
9208  *
9209  * Because this is very slow (the slowest part of autogeneration),
9210  * we memoize the results.
9211  *)
9212 and pod2text ~width name longdesc =
9213   let key = width, name, longdesc in
9214   try Hashtbl.find pod2text_memo key
9215   with Not_found ->
9216     let filename, chan = Filename.open_temp_file "gen" ".tmp" in
9217     fprintf chan "=head1 %s\n\n%s\n" name longdesc;
9218     close_out chan;
9219     let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
9220     let chan = open_process_in cmd in
9221     let lines = ref [] in
9222     let rec loop i =
9223       let line = input_line chan in
9224       if i = 1 then             (* discard the first line of output *)
9225         loop (i+1)
9226       else (
9227         let line = triml line in
9228         lines := line :: !lines;
9229         loop (i+1)
9230       ) in
9231     let lines = try loop 1 with End_of_file -> List.rev !lines in
9232     unlink filename;
9233     (match close_process_in chan with
9234      | WEXITED 0 -> ()
9235      | WEXITED i ->
9236          failwithf "pod2text: process exited with non-zero status (%d)" i
9237      | WSIGNALED i | WSTOPPED i ->
9238          failwithf "pod2text: process signalled or stopped by signal %d" i
9239     );
9240     Hashtbl.add pod2text_memo key lines;
9241     pod2text_memo_updated ();
9242     lines
9243
9244 (* Generate ruby bindings. *)
9245 and generate_ruby_c () =
9246   generate_header CStyle LGPLv2plus;
9247
9248   pr "\
9249 #include <stdio.h>
9250 #include <stdlib.h>
9251
9252 #include <ruby.h>
9253
9254 #include \"guestfs.h\"
9255
9256 #include \"extconf.h\"
9257
9258 /* For Ruby < 1.9 */
9259 #ifndef RARRAY_LEN
9260 #define RARRAY_LEN(r) (RARRAY((r))->len)
9261 #endif
9262
9263 static VALUE m_guestfs;                 /* guestfs module */
9264 static VALUE c_guestfs;                 /* guestfs_h handle */
9265 static VALUE e_Error;                   /* used for all errors */
9266
9267 static void ruby_guestfs_free (void *p)
9268 {
9269   if (!p) return;
9270   guestfs_close ((guestfs_h *) p);
9271 }
9272
9273 static VALUE ruby_guestfs_create (VALUE m)
9274 {
9275   guestfs_h *g;
9276
9277   g = guestfs_create ();
9278   if (!g)
9279     rb_raise (e_Error, \"failed to create guestfs handle\");
9280
9281   /* Don't print error messages to stderr by default. */
9282   guestfs_set_error_handler (g, NULL, NULL);
9283
9284   /* Wrap it, and make sure the close function is called when the
9285    * handle goes away.
9286    */
9287   return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
9288 }
9289
9290 static VALUE ruby_guestfs_close (VALUE gv)
9291 {
9292   guestfs_h *g;
9293   Data_Get_Struct (gv, guestfs_h, g);
9294
9295   ruby_guestfs_free (g);
9296   DATA_PTR (gv) = NULL;
9297
9298   return Qnil;
9299 }
9300
9301 ";
9302
9303   List.iter (
9304     fun (name, style, _, _, _, _, _) ->
9305       pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
9306       List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
9307       pr ")\n";
9308       pr "{\n";
9309       pr "  guestfs_h *g;\n";
9310       pr "  Data_Get_Struct (gv, guestfs_h, g);\n";
9311       pr "  if (!g)\n";
9312       pr "    rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
9313         name;
9314       pr "\n";
9315
9316       List.iter (
9317         function
9318         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
9319             pr "  Check_Type (%sv, T_STRING);\n" n;
9320             pr "  const char *%s = StringValueCStr (%sv);\n" n n;
9321             pr "  if (!%s)\n" n;
9322             pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
9323             pr "              \"%s\", \"%s\");\n" n name
9324         | OptString n ->
9325             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
9326         | StringList n | DeviceList n ->
9327             pr "  char **%s;\n" n;
9328             pr "  Check_Type (%sv, T_ARRAY);\n" n;
9329             pr "  {\n";
9330             pr "    int i, len;\n";
9331             pr "    len = RARRAY_LEN (%sv);\n" n;
9332             pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
9333               n;
9334             pr "    for (i = 0; i < len; ++i) {\n";
9335             pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
9336             pr "      %s[i] = StringValueCStr (v);\n" n;
9337             pr "    }\n";
9338             pr "    %s[len] = NULL;\n" n;
9339             pr "  }\n";
9340         | Bool n ->
9341             pr "  int %s = RTEST (%sv);\n" n n
9342         | Int n ->
9343             pr "  int %s = NUM2INT (%sv);\n" n n
9344         | Int64 n ->
9345             pr "  long long %s = NUM2LL (%sv);\n" n n
9346       ) (snd style);
9347       pr "\n";
9348
9349       let error_code =
9350         match fst style with
9351         | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
9352         | RInt64 _ -> pr "  int64_t r;\n"; "-1"
9353         | RConstString _ | RConstOptString _ ->
9354             pr "  const char *r;\n"; "NULL"
9355         | RString _ -> pr "  char *r;\n"; "NULL"
9356         | RStringList _ | RHashtable _ -> pr "  char **r;\n"; "NULL"
9357         | RStruct (_, typ) -> pr "  struct guestfs_%s *r;\n" typ; "NULL"
9358         | RStructList (_, typ) ->
9359             pr "  struct guestfs_%s_list *r;\n" typ; "NULL"
9360         | RBufferOut _ ->
9361             pr "  char *r;\n";
9362             pr "  size_t size;\n";
9363             "NULL" in
9364       pr "\n";
9365
9366       pr "  r = guestfs_%s " name;
9367       generate_c_call_args ~handle:"g" style;
9368       pr ";\n";
9369
9370       List.iter (
9371         function
9372         | Pathname _ | Device _ | Dev_or_Path _ | String _
9373         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
9374         | StringList n | DeviceList n ->
9375             pr "  free (%s);\n" n
9376       ) (snd style);
9377
9378       pr "  if (r == %s)\n" error_code;
9379       pr "    rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
9380       pr "\n";
9381
9382       (match fst style with
9383        | RErr ->
9384            pr "  return Qnil;\n"
9385        | RInt _ | RBool _ ->
9386            pr "  return INT2NUM (r);\n"
9387        | RInt64 _ ->
9388            pr "  return ULL2NUM (r);\n"
9389        | RConstString _ ->
9390            pr "  return rb_str_new2 (r);\n";
9391        | RConstOptString _ ->
9392            pr "  if (r)\n";
9393            pr "    return rb_str_new2 (r);\n";
9394            pr "  else\n";
9395            pr "    return Qnil;\n";
9396        | RString _ ->
9397            pr "  VALUE rv = rb_str_new2 (r);\n";
9398            pr "  free (r);\n";
9399            pr "  return rv;\n";
9400        | RStringList _ ->
9401            pr "  int i, len = 0;\n";
9402            pr "  for (i = 0; r[i] != NULL; ++i) len++;\n";
9403            pr "  VALUE rv = rb_ary_new2 (len);\n";
9404            pr "  for (i = 0; r[i] != NULL; ++i) {\n";
9405            pr "    rb_ary_push (rv, rb_str_new2 (r[i]));\n";
9406            pr "    free (r[i]);\n";
9407            pr "  }\n";
9408            pr "  free (r);\n";
9409            pr "  return rv;\n"
9410        | RStruct (_, typ) ->
9411            let cols = cols_of_struct typ in
9412            generate_ruby_struct_code typ cols
9413        | RStructList (_, typ) ->
9414            let cols = cols_of_struct typ in
9415            generate_ruby_struct_list_code typ cols
9416        | RHashtable _ ->
9417            pr "  VALUE rv = rb_hash_new ();\n";
9418            pr "  int i;\n";
9419            pr "  for (i = 0; r[i] != NULL; i+=2) {\n";
9420            pr "    rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
9421            pr "    free (r[i]);\n";
9422            pr "    free (r[i+1]);\n";
9423            pr "  }\n";
9424            pr "  free (r);\n";
9425            pr "  return rv;\n"
9426        | RBufferOut _ ->
9427            pr "  VALUE rv = rb_str_new (r, size);\n";
9428            pr "  free (r);\n";
9429            pr "  return rv;\n";
9430       );
9431
9432       pr "}\n";
9433       pr "\n"
9434   ) all_functions;
9435
9436   pr "\
9437 /* Initialize the module. */
9438 void Init__guestfs ()
9439 {
9440   m_guestfs = rb_define_module (\"Guestfs\");
9441   c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
9442   e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
9443
9444   rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
9445   rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
9446
9447 ";
9448   (* Define the rest of the methods. *)
9449   List.iter (
9450     fun (name, style, _, _, _, _, _) ->
9451       pr "  rb_define_method (c_guestfs, \"%s\",\n" name;
9452       pr "        ruby_guestfs_%s, %d);\n" name (List.length (snd style))
9453   ) all_functions;
9454
9455   pr "}\n"
9456
9457 (* Ruby code to return a struct. *)
9458 and generate_ruby_struct_code typ cols =
9459   pr "  VALUE rv = rb_hash_new ();\n";
9460   List.iter (
9461     function
9462     | name, FString ->
9463         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
9464     | name, FBuffer ->
9465         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
9466     | name, FUUID ->
9467         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
9468     | name, (FBytes|FUInt64) ->
9469         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9470     | name, FInt64 ->
9471         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
9472     | name, FUInt32 ->
9473         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
9474     | name, FInt32 ->
9475         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
9476     | name, FOptPercent ->
9477         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
9478     | name, FChar -> (* XXX wrong? *)
9479         pr "  rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
9480   ) cols;
9481   pr "  guestfs_free_%s (r);\n" typ;
9482   pr "  return rv;\n"
9483
9484 (* Ruby code to return a struct list. *)
9485 and generate_ruby_struct_list_code typ cols =
9486   pr "  VALUE rv = rb_ary_new2 (r->len);\n";
9487   pr "  int i;\n";
9488   pr "  for (i = 0; i < r->len; ++i) {\n";
9489   pr "    VALUE hv = rb_hash_new ();\n";
9490   List.iter (
9491     function
9492     | name, FString ->
9493         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
9494     | name, FBuffer ->
9495         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, r->val[i].%s_len));\n" name name name
9496     | name, FUUID ->
9497         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
9498     | name, (FBytes|FUInt64) ->
9499         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9500     | name, FInt64 ->
9501         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
9502     | name, FUInt32 ->
9503         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
9504     | name, FInt32 ->
9505         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
9506     | name, FOptPercent ->
9507         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
9508     | name, FChar -> (* XXX wrong? *)
9509         pr "    rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
9510   ) cols;
9511   pr "    rb_ary_push (rv, hv);\n";
9512   pr "  }\n";
9513   pr "  guestfs_free_%s_list (r);\n" typ;
9514   pr "  return rv;\n"
9515
9516 (* Generate Java bindings GuestFS.java file. *)
9517 and generate_java_java () =
9518   generate_header CStyle LGPLv2plus;
9519
9520   pr "\
9521 package com.redhat.et.libguestfs;
9522
9523 import java.util.HashMap;
9524 import com.redhat.et.libguestfs.LibGuestFSException;
9525 import com.redhat.et.libguestfs.PV;
9526 import com.redhat.et.libguestfs.VG;
9527 import com.redhat.et.libguestfs.LV;
9528 import com.redhat.et.libguestfs.Stat;
9529 import com.redhat.et.libguestfs.StatVFS;
9530 import com.redhat.et.libguestfs.IntBool;
9531 import com.redhat.et.libguestfs.Dirent;
9532
9533 /**
9534  * The GuestFS object is a libguestfs handle.
9535  *
9536  * @author rjones
9537  */
9538 public class GuestFS {
9539   // Load the native code.
9540   static {
9541     System.loadLibrary (\"guestfs_jni\");
9542   }
9543
9544   /**
9545    * The native guestfs_h pointer.
9546    */
9547   long g;
9548
9549   /**
9550    * Create a libguestfs handle.
9551    *
9552    * @throws LibGuestFSException
9553    */
9554   public GuestFS () throws LibGuestFSException
9555   {
9556     g = _create ();
9557   }
9558   private native long _create () throws LibGuestFSException;
9559
9560   /**
9561    * Close a libguestfs handle.
9562    *
9563    * You can also leave handles to be collected by the garbage
9564    * collector, but this method ensures that the resources used
9565    * by the handle are freed up immediately.  If you call any
9566    * other methods after closing the handle, you will get an
9567    * exception.
9568    *
9569    * @throws LibGuestFSException
9570    */
9571   public void close () throws LibGuestFSException
9572   {
9573     if (g != 0)
9574       _close (g);
9575     g = 0;
9576   }
9577   private native void _close (long g) throws LibGuestFSException;
9578
9579   public void finalize () throws LibGuestFSException
9580   {
9581     close ();
9582   }
9583
9584 ";
9585
9586   List.iter (
9587     fun (name, style, _, flags, _, shortdesc, longdesc) ->
9588       if not (List.mem NotInDocs flags); then (
9589         let doc = replace_str longdesc "C<guestfs_" "C<g." in
9590         let doc =
9591           if List.mem ProtocolLimitWarning flags then
9592             doc ^ "\n\n" ^ protocol_limit_warning
9593           else doc in
9594         let doc =
9595           if List.mem DangerWillRobinson flags then
9596             doc ^ "\n\n" ^ danger_will_robinson
9597           else doc in
9598         let doc =
9599           match deprecation_notice flags with
9600           | None -> doc
9601           | Some txt -> doc ^ "\n\n" ^ txt in
9602         let doc = pod2text ~width:60 name doc in
9603         let doc = List.map (            (* RHBZ#501883 *)
9604           function
9605           | "" -> "<p>"
9606           | nonempty -> nonempty
9607         ) doc in
9608         let doc = String.concat "\n   * " doc in
9609
9610         pr "  /**\n";
9611         pr "   * %s\n" shortdesc;
9612         pr "   * <p>\n";
9613         pr "   * %s\n" doc;
9614         pr "   * @throws LibGuestFSException\n";
9615         pr "   */\n";
9616         pr "  ";
9617       );
9618       generate_java_prototype ~public:true ~semicolon:false name style;
9619       pr "\n";
9620       pr "  {\n";
9621       pr "    if (g == 0)\n";
9622       pr "      throw new LibGuestFSException (\"%s: handle is closed\");\n"
9623         name;
9624       pr "    ";
9625       if fst style <> RErr then pr "return ";
9626       pr "_%s " name;
9627       generate_java_call_args ~handle:"g" (snd style);
9628       pr ";\n";
9629       pr "  }\n";
9630       pr "  ";
9631       generate_java_prototype ~privat:true ~native:true name style;
9632       pr "\n";
9633       pr "\n";
9634   ) all_functions;
9635
9636   pr "}\n"
9637
9638 (* Generate Java call arguments, eg "(handle, foo, bar)" *)
9639 and generate_java_call_args ~handle args =
9640   pr "(%s" handle;
9641   List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
9642   pr ")"
9643
9644 and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
9645     ?(semicolon=true) name style =
9646   if privat then pr "private ";
9647   if public then pr "public ";
9648   if native then pr "native ";
9649
9650   (* return type *)
9651   (match fst style with
9652    | RErr -> pr "void ";
9653    | RInt _ -> pr "int ";
9654    | RInt64 _ -> pr "long ";
9655    | RBool _ -> pr "boolean ";
9656    | RConstString _ | RConstOptString _ | RString _
9657    | RBufferOut _ -> pr "String ";
9658    | RStringList _ -> pr "String[] ";
9659    | RStruct (_, typ) ->
9660        let name = java_name_of_struct typ in
9661        pr "%s " name;
9662    | RStructList (_, typ) ->
9663        let name = java_name_of_struct typ in
9664        pr "%s[] " name;
9665    | RHashtable _ -> pr "HashMap<String,String> ";
9666   );
9667
9668   if native then pr "_%s " name else pr "%s " name;
9669   pr "(";
9670   let needs_comma = ref false in
9671   if native then (
9672     pr "long g";
9673     needs_comma := true
9674   );
9675
9676   (* args *)
9677   List.iter (
9678     fun arg ->
9679       if !needs_comma then pr ", ";
9680       needs_comma := true;
9681
9682       match arg with
9683       | Pathname n
9684       | Device n | Dev_or_Path n
9685       | String n
9686       | OptString n
9687       | FileIn n
9688       | FileOut n ->
9689           pr "String %s" n
9690       | StringList n | DeviceList n ->
9691           pr "String[] %s" n
9692       | Bool n ->
9693           pr "boolean %s" n
9694       | Int n ->
9695           pr "int %s" n
9696       | Int64 n ->
9697           pr "long %s" n
9698   ) (snd style);
9699
9700   pr ")\n";
9701   pr "    throws LibGuestFSException";
9702   if semicolon then pr ";"
9703
9704 and generate_java_struct jtyp cols () =
9705   generate_header CStyle LGPLv2plus;
9706
9707   pr "\
9708 package com.redhat.et.libguestfs;
9709
9710 /**
9711  * Libguestfs %s structure.
9712  *
9713  * @author rjones
9714  * @see GuestFS
9715  */
9716 public class %s {
9717 " jtyp jtyp;
9718
9719   List.iter (
9720     function
9721     | name, FString
9722     | name, FUUID
9723     | name, FBuffer -> pr "  public String %s;\n" name
9724     | name, (FBytes|FUInt64|FInt64) -> pr "  public long %s;\n" name
9725     | name, (FUInt32|FInt32) -> pr "  public int %s;\n" name
9726     | name, FChar -> pr "  public char %s;\n" name
9727     | name, FOptPercent ->
9728         pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
9729         pr "  public float %s;\n" name
9730   ) cols;
9731
9732   pr "}\n"
9733
9734 and generate_java_c () =
9735   generate_header CStyle LGPLv2plus;
9736
9737   pr "\
9738 #include <stdio.h>
9739 #include <stdlib.h>
9740 #include <string.h>
9741
9742 #include \"com_redhat_et_libguestfs_GuestFS.h\"
9743 #include \"guestfs.h\"
9744
9745 /* Note that this function returns.  The exception is not thrown
9746  * until after the wrapper function returns.
9747  */
9748 static void
9749 throw_exception (JNIEnv *env, const char *msg)
9750 {
9751   jclass cl;
9752   cl = (*env)->FindClass (env,
9753                           \"com/redhat/et/libguestfs/LibGuestFSException\");
9754   (*env)->ThrowNew (env, cl, msg);
9755 }
9756
9757 JNIEXPORT jlong JNICALL
9758 Java_com_redhat_et_libguestfs_GuestFS__1create
9759   (JNIEnv *env, jobject obj)
9760 {
9761   guestfs_h *g;
9762
9763   g = guestfs_create ();
9764   if (g == NULL) {
9765     throw_exception (env, \"GuestFS.create: failed to allocate handle\");
9766     return 0;
9767   }
9768   guestfs_set_error_handler (g, NULL, NULL);
9769   return (jlong) (long) g;
9770 }
9771
9772 JNIEXPORT void JNICALL
9773 Java_com_redhat_et_libguestfs_GuestFS__1close
9774   (JNIEnv *env, jobject obj, jlong jg)
9775 {
9776   guestfs_h *g = (guestfs_h *) (long) jg;
9777   guestfs_close (g);
9778 }
9779
9780 ";
9781
9782   List.iter (
9783     fun (name, style, _, _, _, _, _) ->
9784       pr "JNIEXPORT ";
9785       (match fst style with
9786        | RErr -> pr "void ";
9787        | RInt _ -> pr "jint ";
9788        | RInt64 _ -> pr "jlong ";
9789        | RBool _ -> pr "jboolean ";
9790        | RConstString _ | RConstOptString _ | RString _
9791        | RBufferOut _ -> pr "jstring ";
9792        | RStruct _ | RHashtable _ ->
9793            pr "jobject ";
9794        | RStringList _ | RStructList _ ->
9795            pr "jobjectArray ";
9796       );
9797       pr "JNICALL\n";
9798       pr "Java_com_redhat_et_libguestfs_GuestFS_";
9799       pr "%s" (replace_str ("_" ^ name) "_" "_1");
9800       pr "\n";
9801       pr "  (JNIEnv *env, jobject obj, jlong jg";
9802       List.iter (
9803         function
9804         | Pathname n
9805         | Device n | Dev_or_Path n
9806         | String n
9807         | OptString n
9808         | FileIn n
9809         | FileOut n ->
9810             pr ", jstring j%s" n
9811         | StringList n | DeviceList n ->
9812             pr ", jobjectArray j%s" n
9813         | Bool n ->
9814             pr ", jboolean j%s" n
9815         | Int n ->
9816             pr ", jint j%s" n
9817         | Int64 n ->
9818             pr ", jlong j%s" n
9819       ) (snd style);
9820       pr ")\n";
9821       pr "{\n";
9822       pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
9823       let error_code, no_ret =
9824         match fst style with
9825         | RErr -> pr "  int r;\n"; "-1", ""
9826         | RBool _
9827         | RInt _ -> pr "  int r;\n"; "-1", "0"
9828         | RInt64 _ -> pr "  int64_t r;\n"; "-1", "0"
9829         | RConstString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9830         | RConstOptString _ -> pr "  const char *r;\n"; "NULL", "NULL"
9831         | RString _ ->
9832             pr "  jstring jr;\n";
9833             pr "  char *r;\n"; "NULL", "NULL"
9834         | RStringList _ ->
9835             pr "  jobjectArray jr;\n";
9836             pr "  int r_len;\n";
9837             pr "  jclass cl;\n";
9838             pr "  jstring jstr;\n";
9839             pr "  char **r;\n"; "NULL", "NULL"
9840         | RStruct (_, typ) ->
9841             pr "  jobject jr;\n";
9842             pr "  jclass cl;\n";
9843             pr "  jfieldID fl;\n";
9844             pr "  struct guestfs_%s *r;\n" typ; "NULL", "NULL"
9845         | RStructList (_, typ) ->
9846             pr "  jobjectArray jr;\n";
9847             pr "  jclass cl;\n";
9848             pr "  jfieldID fl;\n";
9849             pr "  jobject jfl;\n";
9850             pr "  struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
9851         | RHashtable _ -> pr "  char **r;\n"; "NULL", "NULL"
9852         | RBufferOut _ ->
9853             pr "  jstring jr;\n";
9854             pr "  char *r;\n";
9855             pr "  size_t size;\n";
9856             "NULL", "NULL" in
9857       List.iter (
9858         function
9859         | Pathname n
9860         | Device n | Dev_or_Path n
9861         | String n
9862         | OptString n
9863         | FileIn n
9864         | FileOut n ->
9865             pr "  const char *%s;\n" n
9866         | StringList n | DeviceList n ->
9867             pr "  int %s_len;\n" n;
9868             pr "  const char **%s;\n" n
9869         | Bool n
9870         | Int n ->
9871             pr "  int %s;\n" n
9872         | Int64 n ->
9873             pr "  int64_t %s;\n" n
9874       ) (snd style);
9875
9876       let needs_i =
9877         (match fst style with
9878          | RStringList _ | RStructList _ -> true
9879          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
9880          | RConstOptString _
9881          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
9882           List.exists (function
9883                        | StringList _ -> true
9884                        | DeviceList _ -> true
9885                        | _ -> false) (snd style) in
9886       if needs_i then
9887         pr "  int i;\n";
9888
9889       pr "\n";
9890
9891       (* Get the parameters. *)
9892       List.iter (
9893         function
9894         | Pathname n
9895         | Device n | Dev_or_Path n
9896         | String n
9897         | FileIn n
9898         | FileOut n ->
9899             pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
9900         | OptString n ->
9901             (* This is completely undocumented, but Java null becomes
9902              * a NULL parameter.
9903              *)
9904             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
9905         | StringList n | DeviceList n ->
9906             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
9907             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
9908             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9909             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9910               n;
9911             pr "    %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
9912             pr "  }\n";
9913             pr "  %s[%s_len] = NULL;\n" n n;
9914         | Bool n
9915         | Int n
9916         | Int64 n ->
9917             pr "  %s = j%s;\n" n n
9918       ) (snd style);
9919
9920       (* Make the call. *)
9921       pr "  r = guestfs_%s " name;
9922       generate_c_call_args ~handle:"g" style;
9923       pr ";\n";
9924
9925       (* Release the parameters. *)
9926       List.iter (
9927         function
9928         | Pathname n
9929         | Device n | Dev_or_Path n
9930         | String n
9931         | FileIn n
9932         | FileOut n ->
9933             pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
9934         | OptString n ->
9935             pr "  if (j%s)\n" n;
9936             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
9937         | StringList n | DeviceList n ->
9938             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
9939             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
9940               n;
9941             pr "    (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
9942             pr "  }\n";
9943             pr "  free (%s);\n" n
9944         | Bool n
9945         | Int n
9946         | Int64 n -> ()
9947       ) (snd style);
9948
9949       (* Check for errors. *)
9950       pr "  if (r == %s) {\n" error_code;
9951       pr "    throw_exception (env, guestfs_last_error (g));\n";
9952       pr "    return %s;\n" no_ret;
9953       pr "  }\n";
9954
9955       (* Return value. *)
9956       (match fst style with
9957        | RErr -> ()
9958        | RInt _ -> pr "  return (jint) r;\n"
9959        | RBool _ -> pr "  return (jboolean) r;\n"
9960        | RInt64 _ -> pr "  return (jlong) r;\n"
9961        | RConstString _ -> pr "  return (*env)->NewStringUTF (env, r);\n"
9962        | RConstOptString _ ->
9963            pr "  return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
9964        | RString _ ->
9965            pr "  jr = (*env)->NewStringUTF (env, r);\n";
9966            pr "  free (r);\n";
9967            pr "  return jr;\n"
9968        | RStringList _ ->
9969            pr "  for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
9970            pr "  cl = (*env)->FindClass (env, \"java/lang/String\");\n";
9971            pr "  jstr = (*env)->NewStringUTF (env, \"\");\n";
9972            pr "  jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
9973            pr "  for (i = 0; i < r_len; ++i) {\n";
9974            pr "    jstr = (*env)->NewStringUTF (env, r[i]);\n";
9975            pr "    (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
9976            pr "    free (r[i]);\n";
9977            pr "  }\n";
9978            pr "  free (r);\n";
9979            pr "  return jr;\n"
9980        | RStruct (_, typ) ->
9981            let jtyp = java_name_of_struct typ in
9982            let cols = cols_of_struct typ in
9983            generate_java_struct_return typ jtyp cols
9984        | RStructList (_, typ) ->
9985            let jtyp = java_name_of_struct typ in
9986            let cols = cols_of_struct typ in
9987            generate_java_struct_list_return typ jtyp cols
9988        | RHashtable _ ->
9989            (* XXX *)
9990            pr "  throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
9991            pr "  return NULL;\n"
9992        | RBufferOut _ ->
9993            pr "  jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
9994            pr "  free (r);\n";
9995            pr "  return jr;\n"
9996       );
9997
9998       pr "}\n";
9999       pr "\n"
10000   ) all_functions
10001
10002 and generate_java_struct_return typ jtyp cols =
10003   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10004   pr "  jr = (*env)->AllocObject (env, cl);\n";
10005   List.iter (
10006     function
10007     | name, FString ->
10008         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10009         pr "  (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
10010     | name, FUUID ->
10011         pr "  {\n";
10012         pr "    char s[33];\n";
10013         pr "    memcpy (s, r->%s, 32);\n" name;
10014         pr "    s[32] = 0;\n";
10015         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10016         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10017         pr "  }\n";
10018     | name, FBuffer ->
10019         pr "  {\n";
10020         pr "    int len = r->%s_len;\n" name;
10021         pr "    char s[len+1];\n";
10022         pr "    memcpy (s, r->%s, len);\n" name;
10023         pr "    s[len] = 0;\n";
10024         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10025         pr "    (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
10026         pr "  }\n";
10027     | name, (FBytes|FUInt64|FInt64) ->
10028         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10029         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10030     | name, (FUInt32|FInt32) ->
10031         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10032         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10033     | name, FOptPercent ->
10034         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10035         pr "  (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
10036     | name, FChar ->
10037         pr "  fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10038         pr "  (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
10039   ) cols;
10040   pr "  free (r);\n";
10041   pr "  return jr;\n"
10042
10043 and generate_java_struct_list_return typ jtyp cols =
10044   pr "  cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
10045   pr "  jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
10046   pr "  for (i = 0; i < r->len; ++i) {\n";
10047   pr "    jfl = (*env)->AllocObject (env, cl);\n";
10048   List.iter (
10049     function
10050     | name, FString ->
10051         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10052         pr "    (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
10053     | name, FUUID ->
10054         pr "    {\n";
10055         pr "      char s[33];\n";
10056         pr "      memcpy (s, r->val[i].%s, 32);\n" name;
10057         pr "      s[32] = 0;\n";
10058         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10059         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10060         pr "    }\n";
10061     | name, FBuffer ->
10062         pr "    {\n";
10063         pr "      int len = r->val[i].%s_len;\n" name;
10064         pr "      char s[len+1];\n";
10065         pr "      memcpy (s, r->val[i].%s, len);\n" name;
10066         pr "      s[len] = 0;\n";
10067         pr "      fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
10068         pr "      (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
10069         pr "    }\n";
10070     | name, (FBytes|FUInt64|FInt64) ->
10071         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
10072         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10073     | name, (FUInt32|FInt32) ->
10074         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
10075         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10076     | name, FOptPercent ->
10077         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
10078         pr "    (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
10079     | name, FChar ->
10080         pr "    fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
10081         pr "    (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
10082   ) cols;
10083   pr "    (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
10084   pr "  }\n";
10085   pr "  guestfs_free_%s_list (r);\n" typ;
10086   pr "  return jr;\n"
10087
10088 and generate_java_makefile_inc () =
10089   generate_header HashStyle GPLv2plus;
10090
10091   pr "java_built_sources = \\\n";
10092   List.iter (
10093     fun (typ, jtyp) ->
10094         pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
10095   ) java_structs;
10096   pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
10097
10098 and generate_haskell_hs () =
10099   generate_header HaskellStyle LGPLv2plus;
10100
10101   (* XXX We only know how to generate partial FFI for Haskell
10102    * at the moment.  Please help out!
10103    *)
10104   let can_generate style =
10105     match style with
10106     | RErr, _
10107     | RInt _, _
10108     | RInt64 _, _ -> true
10109     | RBool _, _
10110     | RConstString _, _
10111     | RConstOptString _, _
10112     | RString _, _
10113     | RStringList _, _
10114     | RStruct _, _
10115     | RStructList _, _
10116     | RHashtable _, _
10117     | RBufferOut _, _ -> false in
10118
10119   pr "\
10120 {-# INCLUDE <guestfs.h> #-}
10121 {-# LANGUAGE ForeignFunctionInterface #-}
10122
10123 module Guestfs (
10124   create";
10125
10126   (* List out the names of the actions we want to export. *)
10127   List.iter (
10128     fun (name, style, _, _, _, _, _) ->
10129       if can_generate style then pr ",\n  %s" name
10130   ) all_functions;
10131
10132   pr "
10133   ) where
10134
10135 -- Unfortunately some symbols duplicate ones already present
10136 -- in Prelude.  We don't know which, so we hard-code a list
10137 -- here.
10138 import Prelude hiding (truncate)
10139
10140 import Foreign
10141 import Foreign.C
10142 import Foreign.C.Types
10143 import IO
10144 import Control.Exception
10145 import Data.Typeable
10146
10147 data GuestfsS = GuestfsS            -- represents the opaque C struct
10148 type GuestfsP = Ptr GuestfsS        -- guestfs_h *
10149 type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
10150
10151 -- XXX define properly later XXX
10152 data PV = PV
10153 data VG = VG
10154 data LV = LV
10155 data IntBool = IntBool
10156 data Stat = Stat
10157 data StatVFS = StatVFS
10158 data Hashtable = Hashtable
10159
10160 foreign import ccall unsafe \"guestfs_create\" c_create
10161   :: IO GuestfsP
10162 foreign import ccall unsafe \"&guestfs_close\" c_close
10163   :: FunPtr (GuestfsP -> IO ())
10164 foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
10165   :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
10166
10167 create :: IO GuestfsH
10168 create = do
10169   p <- c_create
10170   c_set_error_handler p nullPtr nullPtr
10171   h <- newForeignPtr c_close p
10172   return h
10173
10174 foreign import ccall unsafe \"guestfs_last_error\" c_last_error
10175   :: GuestfsP -> IO CString
10176
10177 -- last_error :: GuestfsH -> IO (Maybe String)
10178 -- last_error h = do
10179 --   str <- withForeignPtr h (\\p -> c_last_error p)
10180 --   maybePeek peekCString str
10181
10182 last_error :: GuestfsH -> IO (String)
10183 last_error h = do
10184   str <- withForeignPtr h (\\p -> c_last_error p)
10185   if (str == nullPtr)
10186     then return \"no error\"
10187     else peekCString str
10188
10189 ";
10190
10191   (* Generate wrappers for each foreign function. *)
10192   List.iter (
10193     fun (name, style, _, _, _, _, _) ->
10194       if can_generate style then (
10195         pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
10196         pr "  :: ";
10197         generate_haskell_prototype ~handle:"GuestfsP" style;
10198         pr "\n";
10199         pr "\n";
10200         pr "%s :: " name;
10201         generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
10202         pr "\n";
10203         pr "%s %s = do\n" name
10204           (String.concat " " ("h" :: List.map name_of_argt (snd style)));
10205         pr "  r <- ";
10206         (* Convert pointer arguments using with* functions. *)
10207         List.iter (
10208           function
10209           | FileIn n
10210           | FileOut n
10211           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
10212           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
10213           | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
10214           | Bool _ | Int _ | Int64 _ -> ()
10215         ) (snd style);
10216         (* Convert integer arguments. *)
10217         let args =
10218           List.map (
10219             function
10220             | Bool n -> sprintf "(fromBool %s)" n
10221             | Int n -> sprintf "(fromIntegral %s)" n
10222             | Int64 n -> sprintf "(fromIntegral %s)" n
10223             | FileIn n | FileOut n
10224             | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
10225           ) (snd style) in
10226         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
10227           (String.concat " " ("p" :: args));
10228         (match fst style with
10229          | RErr | RInt _ | RInt64 _ | RBool _ ->
10230              pr "  if (r == -1)\n";
10231              pr "    then do\n";
10232              pr "      err <- last_error h\n";
10233              pr "      fail err\n";
10234          | RConstString _ | RConstOptString _ | RString _
10235          | RStringList _ | RStruct _
10236          | RStructList _ | RHashtable _ | RBufferOut _ ->
10237              pr "  if (r == nullPtr)\n";
10238              pr "    then do\n";
10239              pr "      err <- last_error h\n";
10240              pr "      fail err\n";
10241         );
10242         (match fst style with
10243          | RErr ->
10244              pr "    else return ()\n"
10245          | RInt _ ->
10246              pr "    else return (fromIntegral r)\n"
10247          | RInt64 _ ->
10248              pr "    else return (fromIntegral r)\n"
10249          | RBool _ ->
10250              pr "    else return (toBool r)\n"
10251          | RConstString _
10252          | RConstOptString _
10253          | RString _
10254          | RStringList _
10255          | RStruct _
10256          | RStructList _
10257          | RHashtable _
10258          | RBufferOut _ ->
10259              pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
10260         );
10261         pr "\n";
10262       )
10263   ) all_functions
10264
10265 and generate_haskell_prototype ~handle ?(hs = false) style =
10266   pr "%s -> " handle;
10267   let string = if hs then "String" else "CString" in
10268   let int = if hs then "Int" else "CInt" in
10269   let bool = if hs then "Bool" else "CInt" in
10270   let int64 = if hs then "Integer" else "Int64" in
10271   List.iter (
10272     fun arg ->
10273       (match arg with
10274        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
10275        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
10276        | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
10277        | Bool _ -> pr "%s" bool
10278        | Int _ -> pr "%s" int
10279        | Int64 _ -> pr "%s" int
10280        | FileIn _ -> pr "%s" string
10281        | FileOut _ -> pr "%s" string
10282       );
10283       pr " -> ";
10284   ) (snd style);
10285   pr "IO (";
10286   (match fst style with
10287    | RErr -> if not hs then pr "CInt"
10288    | RInt _ -> pr "%s" int
10289    | RInt64 _ -> pr "%s" int64
10290    | RBool _ -> pr "%s" bool
10291    | RConstString _ -> pr "%s" string
10292    | RConstOptString _ -> pr "Maybe %s" string
10293    | RString _ -> pr "%s" string
10294    | RStringList _ -> pr "[%s]" string
10295    | RStruct (_, typ) ->
10296        let name = java_name_of_struct typ in
10297        pr "%s" name
10298    | RStructList (_, typ) ->
10299        let name = java_name_of_struct typ in
10300        pr "[%s]" name
10301    | RHashtable _ -> pr "Hashtable"
10302    | RBufferOut _ -> pr "%s" string
10303   );
10304   pr ")"
10305
10306 and generate_csharp () =
10307   generate_header CPlusPlusStyle LGPLv2plus;
10308
10309   (* XXX Make this configurable by the C# assembly users. *)
10310   let library = "libguestfs.so.0" in
10311
10312   pr "\
10313 // These C# bindings are highly experimental at present.
10314 //
10315 // Firstly they only work on Linux (ie. Mono).  In order to get them
10316 // to work on Windows (ie. .Net) you would need to port the library
10317 // itself to Windows first.
10318 //
10319 // The second issue is that some calls are known to be incorrect and
10320 // can cause Mono to segfault.  Particularly: calls which pass or
10321 // return string[], or return any structure value.  This is because
10322 // we haven't worked out the correct way to do this from C#.
10323 //
10324 // The third issue is that when compiling you get a lot of warnings.
10325 // We are not sure whether the warnings are important or not.
10326 //
10327 // Fourthly we do not routinely build or test these bindings as part
10328 // of the make && make check cycle, which means that regressions might
10329 // go unnoticed.
10330 //
10331 // Suggestions and patches are welcome.
10332
10333 // To compile:
10334 //
10335 // gmcs Libguestfs.cs
10336 // mono Libguestfs.exe
10337 //
10338 // (You'll probably want to add a Test class / static main function
10339 // otherwise this won't do anything useful).
10340
10341 using System;
10342 using System.IO;
10343 using System.Runtime.InteropServices;
10344 using System.Runtime.Serialization;
10345 using System.Collections;
10346
10347 namespace Guestfs
10348 {
10349   class Error : System.ApplicationException
10350   {
10351     public Error (string message) : base (message) {}
10352     protected Error (SerializationInfo info, StreamingContext context) {}
10353   }
10354
10355   class Guestfs
10356   {
10357     IntPtr _handle;
10358
10359     [DllImport (\"%s\")]
10360     static extern IntPtr guestfs_create ();
10361
10362     public Guestfs ()
10363     {
10364       _handle = guestfs_create ();
10365       if (_handle == IntPtr.Zero)
10366         throw new Error (\"could not create guestfs handle\");
10367     }
10368
10369     [DllImport (\"%s\")]
10370     static extern void guestfs_close (IntPtr h);
10371
10372     ~Guestfs ()
10373     {
10374       guestfs_close (_handle);
10375     }
10376
10377     [DllImport (\"%s\")]
10378     static extern string guestfs_last_error (IntPtr h);
10379
10380 " library library library;
10381
10382   (* Generate C# structure bindings.  We prefix struct names with
10383    * underscore because C# cannot have conflicting struct names and
10384    * method names (eg. "class stat" and "stat").
10385    *)
10386   List.iter (
10387     fun (typ, cols) ->
10388       pr "    [StructLayout (LayoutKind.Sequential)]\n";
10389       pr "    public class _%s {\n" typ;
10390       List.iter (
10391         function
10392         | name, FChar -> pr "      char %s;\n" name
10393         | name, FString -> pr "      string %s;\n" name
10394         | name, FBuffer ->
10395             pr "      uint %s_len;\n" name;
10396             pr "      string %s;\n" name
10397         | name, FUUID ->
10398             pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
10399             pr "      string %s;\n" name
10400         | name, FUInt32 -> pr "      uint %s;\n" name
10401         | name, FInt32 -> pr "      int %s;\n" name
10402         | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
10403         | name, FInt64 -> pr "      long %s;\n" name
10404         | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
10405       ) cols;
10406       pr "    }\n";
10407       pr "\n"
10408   ) structs;
10409
10410   (* Generate C# function bindings. *)
10411   List.iter (
10412     fun (name, style, _, _, _, shortdesc, _) ->
10413       let rec csharp_return_type () =
10414         match fst style with
10415         | RErr -> "void"
10416         | RBool n -> "bool"
10417         | RInt n -> "int"
10418         | RInt64 n -> "long"
10419         | RConstString n
10420         | RConstOptString n
10421         | RString n
10422         | RBufferOut n -> "string"
10423         | RStruct (_,n) -> "_" ^ n
10424         | RHashtable n -> "Hashtable"
10425         | RStringList n -> "string[]"
10426         | RStructList (_,n) -> sprintf "_%s[]" n
10427
10428       and c_return_type () =
10429         match fst style with
10430         | RErr
10431         | RBool _
10432         | RInt _ -> "int"
10433         | RInt64 _ -> "long"
10434         | RConstString _
10435         | RConstOptString _
10436         | RString _
10437         | RBufferOut _ -> "string"
10438         | RStruct (_,n) -> "_" ^ n
10439         | RHashtable _
10440         | RStringList _ -> "string[]"
10441         | RStructList (_,n) -> sprintf "_%s[]" n
10442
10443       and c_error_comparison () =
10444         match fst style with
10445         | RErr
10446         | RBool _
10447         | RInt _
10448         | RInt64 _ -> "== -1"
10449         | RConstString _
10450         | RConstOptString _
10451         | RString _
10452         | RBufferOut _
10453         | RStruct (_,_)
10454         | RHashtable _
10455         | RStringList _
10456         | RStructList (_,_) -> "== null"
10457
10458       and generate_extern_prototype () =
10459         pr "    static extern %s guestfs_%s (IntPtr h"
10460           (c_return_type ()) name;
10461         List.iter (
10462           function
10463           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10464           | FileIn n | FileOut n ->
10465               pr ", [In] string %s" n
10466           | StringList n | DeviceList n ->
10467               pr ", [In] string[] %s" n
10468           | Bool n ->
10469               pr ", bool %s" n
10470           | Int n ->
10471               pr ", int %s" n
10472           | Int64 n ->
10473               pr ", long %s" n
10474         ) (snd style);
10475         pr ");\n"
10476
10477       and generate_public_prototype () =
10478         pr "    public %s %s (" (csharp_return_type ()) name;
10479         let comma = ref false in
10480         let next () =
10481           if !comma then pr ", ";
10482           comma := true
10483         in
10484         List.iter (
10485           function
10486           | Pathname n | Device n | Dev_or_Path n | String n | OptString n
10487           | FileIn n | FileOut n ->
10488               next (); pr "string %s" n
10489           | StringList n | DeviceList n ->
10490               next (); pr "string[] %s" n
10491           | Bool n ->
10492               next (); pr "bool %s" n
10493           | Int n ->
10494               next (); pr "int %s" n
10495           | Int64 n ->
10496               next (); pr "long %s" n
10497         ) (snd style);
10498         pr ")\n"
10499
10500       and generate_call () =
10501         pr "guestfs_%s (_handle" name;
10502         List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
10503         pr ");\n";
10504       in
10505
10506       pr "    [DllImport (\"%s\")]\n" library;
10507       generate_extern_prototype ();
10508       pr "\n";
10509       pr "    /// <summary>\n";
10510       pr "    /// %s\n" shortdesc;
10511       pr "    /// </summary>\n";
10512       generate_public_prototype ();
10513       pr "    {\n";
10514       pr "      %s r;\n" (c_return_type ());
10515       pr "      r = ";
10516       generate_call ();
10517       pr "      if (r %s)\n" (c_error_comparison ());
10518       pr "        throw new Error (guestfs_last_error (_handle));\n";
10519       (match fst style with
10520        | RErr -> ()
10521        | RBool _ ->
10522            pr "      return r != 0 ? true : false;\n"
10523        | RHashtable _ ->
10524            pr "      Hashtable rr = new Hashtable ();\n";
10525            pr "      for (int i = 0; i < r.Length; i += 2)\n";
10526            pr "        rr.Add (r[i], r[i+1]);\n";
10527            pr "      return rr;\n"
10528        | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
10529        | RString _ | RBufferOut _ | RStruct _ | RStringList _
10530        | RStructList _ ->
10531            pr "      return r;\n"
10532       );
10533       pr "    }\n";
10534       pr "\n";
10535   ) all_functions_sorted;
10536
10537   pr "  }
10538 }
10539 "
10540
10541 and generate_bindtests () =
10542   generate_header CStyle LGPLv2plus;
10543
10544   pr "\
10545 #include <stdio.h>
10546 #include <stdlib.h>
10547 #include <inttypes.h>
10548 #include <string.h>
10549
10550 #include \"guestfs.h\"
10551 #include \"guestfs-internal.h\"
10552 #include \"guestfs-internal-actions.h\"
10553 #include \"guestfs_protocol.h\"
10554
10555 #define error guestfs_error
10556 #define safe_calloc guestfs_safe_calloc
10557 #define safe_malloc guestfs_safe_malloc
10558
10559 static void
10560 print_strings (char *const *argv)
10561 {
10562   int argc;
10563
10564   printf (\"[\");
10565   for (argc = 0; argv[argc] != NULL; ++argc) {
10566     if (argc > 0) printf (\", \");
10567     printf (\"\\\"%%s\\\"\", argv[argc]);
10568   }
10569   printf (\"]\\n\");
10570 }
10571
10572 /* The test0 function prints its parameters to stdout. */
10573 ";
10574
10575   let test0, tests =
10576     match test_functions with
10577     | [] -> assert false
10578     | test0 :: tests -> test0, tests in
10579
10580   let () =
10581     let (name, style, _, _, _, _, _) = test0 in
10582     generate_prototype ~extern:false ~semicolon:false ~newline:true
10583       ~handle:"g" ~prefix:"guestfs__" name style;
10584     pr "{\n";
10585     List.iter (
10586       function
10587       | Pathname n
10588       | Device n | Dev_or_Path n
10589       | String n
10590       | FileIn n
10591       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
10592       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
10593       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
10594       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
10595       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
10596       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
10597     ) (snd style);
10598     pr "  /* Java changes stdout line buffering so we need this: */\n";
10599     pr "  fflush (stdout);\n";
10600     pr "  return 0;\n";
10601     pr "}\n";
10602     pr "\n" in
10603
10604   List.iter (
10605     fun (name, style, _, _, _, _, _) ->
10606       if String.sub name (String.length name - 3) 3 <> "err" then (
10607         pr "/* Test normal return. */\n";
10608         generate_prototype ~extern:false ~semicolon:false ~newline:true
10609           ~handle:"g" ~prefix:"guestfs__" name style;
10610         pr "{\n";
10611         (match fst style with
10612          | RErr ->
10613              pr "  return 0;\n"
10614          | RInt _ ->
10615              pr "  int r;\n";
10616              pr "  sscanf (val, \"%%d\", &r);\n";
10617              pr "  return r;\n"
10618          | RInt64 _ ->
10619              pr "  int64_t r;\n";
10620              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
10621              pr "  return r;\n"
10622          | RBool _ ->
10623              pr "  return STREQ (val, \"true\");\n"
10624          | RConstString _
10625          | RConstOptString _ ->
10626              (* Can't return the input string here.  Return a static
10627               * string so we ensure we get a segfault if the caller
10628               * tries to free it.
10629               *)
10630              pr "  return \"static string\";\n"
10631          | RString _ ->
10632              pr "  return strdup (val);\n"
10633          | RStringList _ ->
10634              pr "  char **strs;\n";
10635              pr "  int n, i;\n";
10636              pr "  sscanf (val, \"%%d\", &n);\n";
10637              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
10638              pr "  for (i = 0; i < n; ++i) {\n";
10639              pr "    strs[i] = safe_malloc (g, 16);\n";
10640              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
10641              pr "  }\n";
10642              pr "  strs[n] = NULL;\n";
10643              pr "  return strs;\n"
10644          | RStruct (_, typ) ->
10645              pr "  struct guestfs_%s *r;\n" typ;
10646              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10647              pr "  return r;\n"
10648          | RStructList (_, typ) ->
10649              pr "  struct guestfs_%s_list *r;\n" typ;
10650              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
10651              pr "  sscanf (val, \"%%d\", &r->len);\n";
10652              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
10653              pr "  return r;\n"
10654          | RHashtable _ ->
10655              pr "  char **strs;\n";
10656              pr "  int n, i;\n";
10657              pr "  sscanf (val, \"%%d\", &n);\n";
10658              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
10659              pr "  for (i = 0; i < n; ++i) {\n";
10660              pr "    strs[i*2] = safe_malloc (g, 16);\n";
10661              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
10662              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
10663              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
10664              pr "  }\n";
10665              pr "  strs[n*2] = NULL;\n";
10666              pr "  return strs;\n"
10667          | RBufferOut _ ->
10668              pr "  return strdup (val);\n"
10669         );
10670         pr "}\n";
10671         pr "\n"
10672       ) else (
10673         pr "/* Test error return. */\n";
10674         generate_prototype ~extern:false ~semicolon:false ~newline:true
10675           ~handle:"g" ~prefix:"guestfs__" name style;
10676         pr "{\n";
10677         pr "  error (g, \"error\");\n";
10678         (match fst style with
10679          | RErr | RInt _ | RInt64 _ | RBool _ ->
10680              pr "  return -1;\n"
10681          | RConstString _ | RConstOptString _
10682          | RString _ | RStringList _ | RStruct _
10683          | RStructList _
10684          | RHashtable _
10685          | RBufferOut _ ->
10686              pr "  return NULL;\n"
10687         );
10688         pr "}\n";
10689         pr "\n"
10690       )
10691   ) tests
10692
10693 and generate_ocaml_bindtests () =
10694   generate_header OCamlStyle GPLv2plus;
10695
10696   pr "\
10697 let () =
10698   let g = Guestfs.create () in
10699 ";
10700
10701   let mkargs args =
10702     String.concat " " (
10703       List.map (
10704         function
10705         | CallString s -> "\"" ^ s ^ "\""
10706         | CallOptString None -> "None"
10707         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
10708         | CallStringList xs ->
10709             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
10710         | CallInt i when i >= 0 -> string_of_int i
10711         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
10712         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
10713         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
10714         | CallBool b -> string_of_bool b
10715       ) args
10716     )
10717   in
10718
10719   generate_lang_bindtests (
10720     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
10721   );
10722
10723   pr "print_endline \"EOF\"\n"
10724
10725 and generate_perl_bindtests () =
10726   pr "#!/usr/bin/perl -w\n";
10727   generate_header HashStyle GPLv2plus;
10728
10729   pr "\
10730 use strict;
10731
10732 use Sys::Guestfs;
10733
10734 my $g = Sys::Guestfs->new ();
10735 ";
10736
10737   let mkargs args =
10738     String.concat ", " (
10739       List.map (
10740         function
10741         | CallString s -> "\"" ^ s ^ "\""
10742         | CallOptString None -> "undef"
10743         | CallOptString (Some s) -> sprintf "\"%s\"" s
10744         | CallStringList xs ->
10745             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10746         | CallInt i -> string_of_int i
10747         | CallInt64 i -> Int64.to_string i
10748         | CallBool b -> if b then "1" else "0"
10749       ) args
10750     )
10751   in
10752
10753   generate_lang_bindtests (
10754     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
10755   );
10756
10757   pr "print \"EOF\\n\"\n"
10758
10759 and generate_python_bindtests () =
10760   generate_header HashStyle GPLv2plus;
10761
10762   pr "\
10763 import guestfs
10764
10765 g = guestfs.GuestFS ()
10766 ";
10767
10768   let mkargs args =
10769     String.concat ", " (
10770       List.map (
10771         function
10772         | CallString s -> "\"" ^ s ^ "\""
10773         | CallOptString None -> "None"
10774         | CallOptString (Some s) -> sprintf "\"%s\"" s
10775         | CallStringList xs ->
10776             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10777         | CallInt i -> string_of_int i
10778         | CallInt64 i -> Int64.to_string i
10779         | CallBool b -> if b then "1" else "0"
10780       ) args
10781     )
10782   in
10783
10784   generate_lang_bindtests (
10785     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
10786   );
10787
10788   pr "print \"EOF\"\n"
10789
10790 and generate_ruby_bindtests () =
10791   generate_header HashStyle GPLv2plus;
10792
10793   pr "\
10794 require 'guestfs'
10795
10796 g = Guestfs::create()
10797 ";
10798
10799   let mkargs args =
10800     String.concat ", " (
10801       List.map (
10802         function
10803         | CallString s -> "\"" ^ s ^ "\""
10804         | CallOptString None -> "nil"
10805         | CallOptString (Some s) -> sprintf "\"%s\"" s
10806         | CallStringList xs ->
10807             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10808         | CallInt i -> string_of_int i
10809         | CallInt64 i -> Int64.to_string i
10810         | CallBool b -> string_of_bool b
10811       ) args
10812     )
10813   in
10814
10815   generate_lang_bindtests (
10816     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
10817   );
10818
10819   pr "print \"EOF\\n\"\n"
10820
10821 and generate_java_bindtests () =
10822   generate_header CStyle GPLv2plus;
10823
10824   pr "\
10825 import com.redhat.et.libguestfs.*;
10826
10827 public class Bindtests {
10828     public static void main (String[] argv)
10829     {
10830         try {
10831             GuestFS g = new GuestFS ();
10832 ";
10833
10834   let mkargs args =
10835     String.concat ", " (
10836       List.map (
10837         function
10838         | CallString s -> "\"" ^ s ^ "\""
10839         | CallOptString None -> "null"
10840         | CallOptString (Some s) -> sprintf "\"%s\"" s
10841         | CallStringList xs ->
10842             "new String[]{" ^
10843               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
10844         | CallInt i -> string_of_int i
10845         | CallInt64 i -> Int64.to_string i
10846         | CallBool b -> string_of_bool b
10847       ) args
10848     )
10849   in
10850
10851   generate_lang_bindtests (
10852     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
10853   );
10854
10855   pr "
10856             System.out.println (\"EOF\");
10857         }
10858         catch (Exception exn) {
10859             System.err.println (exn);
10860             System.exit (1);
10861         }
10862     }
10863 }
10864 "
10865
10866 and generate_haskell_bindtests () =
10867   generate_header HaskellStyle GPLv2plus;
10868
10869   pr "\
10870 module Bindtests where
10871 import qualified Guestfs
10872
10873 main = do
10874   g <- Guestfs.create
10875 ";
10876
10877   let mkargs args =
10878     String.concat " " (
10879       List.map (
10880         function
10881         | CallString s -> "\"" ^ s ^ "\""
10882         | CallOptString None -> "Nothing"
10883         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
10884         | CallStringList xs ->
10885             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
10886         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
10887         | CallInt i -> string_of_int i
10888         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
10889         | CallInt64 i -> Int64.to_string i
10890         | CallBool true -> "True"
10891         | CallBool false -> "False"
10892       ) args
10893     )
10894   in
10895
10896   generate_lang_bindtests (
10897     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
10898   );
10899
10900   pr "  putStrLn \"EOF\"\n"
10901
10902 (* Language-independent bindings tests - we do it this way to
10903  * ensure there is parity in testing bindings across all languages.
10904  *)
10905 and generate_lang_bindtests call =
10906   call "test0" [CallString "abc"; CallOptString (Some "def");
10907                 CallStringList []; CallBool false;
10908                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10909   call "test0" [CallString "abc"; CallOptString None;
10910                 CallStringList []; CallBool false;
10911                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10912   call "test0" [CallString ""; CallOptString (Some "def");
10913                 CallStringList []; CallBool false;
10914                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10915   call "test0" [CallString ""; CallOptString (Some "");
10916                 CallStringList []; CallBool false;
10917                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10918   call "test0" [CallString "abc"; CallOptString (Some "def");
10919                 CallStringList ["1"]; CallBool false;
10920                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10921   call "test0" [CallString "abc"; CallOptString (Some "def");
10922                 CallStringList ["1"; "2"]; CallBool false;
10923                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10924   call "test0" [CallString "abc"; CallOptString (Some "def");
10925                 CallStringList ["1"]; CallBool true;
10926                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
10927   call "test0" [CallString "abc"; CallOptString (Some "def");
10928                 CallStringList ["1"]; CallBool false;
10929                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"];
10930   call "test0" [CallString "abc"; CallOptString (Some "def");
10931                 CallStringList ["1"]; CallBool false;
10932                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"];
10933   call "test0" [CallString "abc"; CallOptString (Some "def");
10934                 CallStringList ["1"]; CallBool false;
10935                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456"];
10936   call "test0" [CallString "abc"; CallOptString (Some "def");
10937                 CallStringList ["1"]; CallBool false;
10938                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456"];
10939   call "test0" [CallString "abc"; CallOptString (Some "def");
10940                 CallStringList ["1"]; CallBool false;
10941                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"];
10942   call "test0" [CallString "abc"; CallOptString (Some "def");
10943                 CallStringList ["1"]; CallBool false;
10944                 CallInt 0; CallInt64 0L; CallString ""; CallString ""]
10945
10946 (* XXX Add here tests of the return and error functions. *)
10947
10948 (* Code to generator bindings for virt-inspector.  Currently only
10949  * implemented for OCaml code (for virt-p2v 2.0).
10950  *)
10951 let rng_input = "inspector/virt-inspector.rng"
10952
10953 (* Read the input file and parse it into internal structures.  This is
10954  * by no means a complete RELAX NG parser, but is just enough to be
10955  * able to parse the specific input file.
10956  *)
10957 type rng =
10958   | Element of string * rng list        (* <element name=name/> *)
10959   | Attribute of string * rng list        (* <attribute name=name/> *)
10960   | Interleave of rng list                (* <interleave/> *)
10961   | ZeroOrMore of rng                        (* <zeroOrMore/> *)
10962   | OneOrMore of rng                        (* <oneOrMore/> *)
10963   | Optional of rng                        (* <optional/> *)
10964   | Choice of string list                (* <choice><value/>*</choice> *)
10965   | Value of string                        (* <value>str</value> *)
10966   | Text                                (* <text/> *)
10967
10968 let rec string_of_rng = function
10969   | Element (name, xs) ->
10970       "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
10971   | Attribute (name, xs) ->
10972       "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
10973   | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
10974   | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
10975   | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
10976   | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
10977   | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
10978   | Value value -> "Value \"" ^ value ^ "\""
10979   | Text -> "Text"
10980
10981 and string_of_rng_list xs =
10982   String.concat ", " (List.map string_of_rng xs)
10983
10984 let rec parse_rng ?defines context = function
10985   | [] -> []
10986   | Xml.Element ("element", ["name", name], children) :: rest ->
10987       Element (name, parse_rng ?defines context children)
10988       :: parse_rng ?defines context rest
10989   | Xml.Element ("attribute", ["name", name], children) :: rest ->
10990       Attribute (name, parse_rng ?defines context children)
10991       :: parse_rng ?defines context rest
10992   | Xml.Element ("interleave", [], children) :: rest ->
10993       Interleave (parse_rng ?defines context children)
10994       :: parse_rng ?defines context rest
10995   | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
10996       let rng = parse_rng ?defines context [child] in
10997       (match rng with
10998        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
10999        | _ ->
11000            failwithf "%s: <zeroOrMore> contains more than one child element"
11001              context
11002       )
11003   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
11004       let rng = parse_rng ?defines context [child] in
11005       (match rng with
11006        | [child] -> OneOrMore child :: parse_rng ?defines context rest
11007        | _ ->
11008            failwithf "%s: <oneOrMore> contains more than one child element"
11009              context
11010       )
11011   | Xml.Element ("optional", [], [child]) :: rest ->
11012       let rng = parse_rng ?defines context [child] in
11013       (match rng with
11014        | [child] -> Optional child :: parse_rng ?defines context rest
11015        | _ ->
11016            failwithf "%s: <optional> contains more than one child element"
11017              context
11018       )
11019   | Xml.Element ("choice", [], children) :: rest ->
11020       let values = List.map (
11021         function Xml.Element ("value", [], [Xml.PCData value]) -> value
11022         | _ ->
11023             failwithf "%s: can't handle anything except <value> in <choice>"
11024               context
11025       ) children in
11026       Choice values
11027       :: parse_rng ?defines context rest
11028   | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
11029       Value value :: parse_rng ?defines context rest
11030   | Xml.Element ("text", [], []) :: rest ->
11031       Text :: parse_rng ?defines context rest
11032   | Xml.Element ("ref", ["name", name], []) :: rest ->
11033       (* Look up the reference.  Because of limitations in this parser,
11034        * we can't handle arbitrarily nested <ref> yet.  You can only
11035        * use <ref> from inside <start>.
11036        *)
11037       (match defines with
11038        | None ->
11039            failwithf "%s: contains <ref>, but no refs are defined yet" context
11040        | Some map ->
11041            let rng = StringMap.find name map in
11042            rng @ parse_rng ?defines context rest
11043       )
11044   | x :: _ ->
11045       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
11046
11047 let grammar =
11048   let xml = Xml.parse_file rng_input in
11049   match xml with
11050   | Xml.Element ("grammar", _,
11051                  Xml.Element ("start", _, gram) :: defines) ->
11052       (* The <define/> elements are referenced in the <start> section,
11053        * so build a map of those first.
11054        *)
11055       let defines = List.fold_left (
11056         fun map ->
11057           function Xml.Element ("define", ["name", name], defn) ->
11058             StringMap.add name defn map
11059           | _ ->
11060               failwithf "%s: expected <define name=name/>" rng_input
11061       ) StringMap.empty defines in
11062       let defines = StringMap.mapi parse_rng defines in
11063
11064       (* Parse the <start> clause, passing the defines. *)
11065       parse_rng ~defines "<start>" gram
11066   | _ ->
11067       failwithf "%s: input is not <grammar><start/><define>*</grammar>"
11068         rng_input
11069
11070 let name_of_field = function
11071   | Element (name, _) | Attribute (name, _)
11072   | ZeroOrMore (Element (name, _))
11073   | OneOrMore (Element (name, _))
11074   | Optional (Element (name, _)) -> name
11075   | Optional (Attribute (name, _)) -> name
11076   | Text -> (* an unnamed field in an element *)
11077       "data"
11078   | rng ->
11079       failwithf "name_of_field failed at: %s" (string_of_rng rng)
11080
11081 (* At the moment this function only generates OCaml types.  However we
11082  * should parameterize it later so it can generate types/structs in a
11083  * variety of languages.
11084  *)
11085 let generate_types xs =
11086   (* A simple type is one that can be printed out directly, eg.
11087    * "string option".  A complex type is one which has a name and has
11088    * to be defined via another toplevel definition, eg. a struct.
11089    *
11090    * generate_type generates code for either simple or complex types.
11091    * In the simple case, it returns the string ("string option").  In
11092    * the complex case, it returns the name ("mountpoint").  In the
11093    * complex case it has to print out the definition before returning,
11094    * so it should only be called when we are at the beginning of a
11095    * new line (BOL context).
11096    *)
11097   let rec generate_type = function
11098     | Text ->                                (* string *)
11099         "string", true
11100     | Choice values ->                        (* [`val1|`val2|...] *)
11101         "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
11102     | ZeroOrMore rng ->                        (* <rng> list *)
11103         let t, is_simple = generate_type rng in
11104         t ^ " list (* 0 or more *)", is_simple
11105     | OneOrMore rng ->                        (* <rng> list *)
11106         let t, is_simple = generate_type rng in
11107         t ^ " list (* 1 or more *)", is_simple
11108                                         (* virt-inspector hack: bool *)
11109     | Optional (Attribute (name, [Value "1"])) ->
11110         "bool", true
11111     | Optional rng ->                        (* <rng> list *)
11112         let t, is_simple = generate_type rng in
11113         t ^ " option", is_simple
11114                                         (* type name = { fields ... } *)
11115     | Element (name, fields) when is_attrs_interleave fields ->
11116         generate_type_struct name (get_attrs_interleave fields)
11117     | Element (name, [field])                (* type name = field *)
11118     | Attribute (name, [field]) ->
11119         let t, is_simple = generate_type field in
11120         if is_simple then (t, true)
11121         else (
11122           pr "type %s = %s\n" name t;
11123           name, false
11124         )
11125     | Element (name, fields) ->              (* type name = { fields ... } *)
11126         generate_type_struct name fields
11127     | rng ->
11128         failwithf "generate_type failed at: %s" (string_of_rng rng)
11129
11130   and is_attrs_interleave = function
11131     | [Interleave _] -> true
11132     | Attribute _ :: fields -> is_attrs_interleave fields
11133     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11134     | _ -> false
11135
11136   and get_attrs_interleave = function
11137     | [Interleave fields] -> fields
11138     | ((Attribute _) as field) :: fields
11139     | ((Optional (Attribute _)) as field) :: fields ->
11140         field :: get_attrs_interleave fields
11141     | _ -> assert false
11142
11143   and generate_types xs =
11144     List.iter (fun x -> ignore (generate_type x)) xs
11145
11146   and generate_type_struct name fields =
11147     (* Calculate the types of the fields first.  We have to do this
11148      * before printing anything so we are still in BOL context.
11149      *)
11150     let types = List.map fst (List.map generate_type fields) in
11151
11152     (* Special case of a struct containing just a string and another
11153      * field.  Turn it into an assoc list.
11154      *)
11155     match types with
11156     | ["string"; other] ->
11157         let fname1, fname2 =
11158           match fields with
11159           | [f1; f2] -> name_of_field f1, name_of_field f2
11160           | _ -> assert false in
11161         pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
11162         name, false
11163
11164     | types ->
11165         pr "type %s = {\n" name;
11166         List.iter (
11167           fun (field, ftype) ->
11168             let fname = name_of_field field in
11169             pr "  %s_%s : %s;\n" name fname ftype
11170         ) (List.combine fields types);
11171         pr "}\n";
11172         (* Return the name of this type, and
11173          * false because it's not a simple type.
11174          *)
11175         name, false
11176   in
11177
11178   generate_types xs
11179
11180 let generate_parsers xs =
11181   (* As for generate_type above, generate_parser makes a parser for
11182    * some type, and returns the name of the parser it has generated.
11183    * Because it (may) need to print something, it should always be
11184    * called in BOL context.
11185    *)
11186   let rec generate_parser = function
11187     | Text ->                                (* string *)
11188         "string_child_or_empty"
11189     | Choice values ->                        (* [`val1|`val2|...] *)
11190         sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
11191           (String.concat "|"
11192              (List.map (fun v -> sprintf "%S -> `%s" v v) values))
11193     | ZeroOrMore rng ->                        (* <rng> list *)
11194         let pa = generate_parser rng in
11195         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11196     | OneOrMore rng ->                        (* <rng> list *)
11197         let pa = generate_parser rng in
11198         sprintf "(fun x -> List.map %s (Xml.children x))" pa
11199                                         (* virt-inspector hack: bool *)
11200     | Optional (Attribute (name, [Value "1"])) ->
11201         sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
11202     | Optional rng ->                        (* <rng> list *)
11203         let pa = generate_parser rng in
11204         sprintf "(function None -> None | Some x -> Some (%s x))" pa
11205                                         (* type name = { fields ... } *)
11206     | Element (name, fields) when is_attrs_interleave fields ->
11207         generate_parser_struct name (get_attrs_interleave fields)
11208     | Element (name, [field]) ->        (* type name = field *)
11209         let pa = generate_parser field in
11210         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11211         pr "let %s =\n" parser_name;
11212         pr "  %s\n" pa;
11213         pr "let parse_%s = %s\n" name parser_name;
11214         parser_name
11215     | Attribute (name, [field]) ->
11216         let pa = generate_parser field in
11217         let parser_name = sprintf "parse_%s_%d" name (unique ()) in
11218         pr "let %s =\n" parser_name;
11219         pr "  %s\n" pa;
11220         pr "let parse_%s = %s\n" name parser_name;
11221         parser_name
11222     | Element (name, fields) ->              (* type name = { fields ... } *)
11223         generate_parser_struct name ([], fields)
11224     | rng ->
11225         failwithf "generate_parser failed at: %s" (string_of_rng rng)
11226
11227   and is_attrs_interleave = function
11228     | [Interleave _] -> true
11229     | Attribute _ :: fields -> is_attrs_interleave fields
11230     | Optional (Attribute _) :: fields -> is_attrs_interleave fields
11231     | _ -> false
11232
11233   and get_attrs_interleave = function
11234     | [Interleave fields] -> [], fields
11235     | ((Attribute _) as field) :: fields
11236     | ((Optional (Attribute _)) as field) :: fields ->
11237         let attrs, interleaves = get_attrs_interleave fields in
11238         (field :: attrs), interleaves
11239     | _ -> assert false
11240
11241   and generate_parsers xs =
11242     List.iter (fun x -> ignore (generate_parser x)) xs
11243
11244   and generate_parser_struct name (attrs, interleaves) =
11245     (* Generate parsers for the fields first.  We have to do this
11246      * before printing anything so we are still in BOL context.
11247      *)
11248     let fields = attrs @ interleaves in
11249     let pas = List.map generate_parser fields in
11250
11251     (* Generate an intermediate tuple from all the fields first.
11252      * If the type is just a string + another field, then we will
11253      * return this directly, otherwise it is turned into a record.
11254      *
11255      * RELAX NG note: This code treats <interleave> and plain lists of
11256      * fields the same.  In other words, it doesn't bother enforcing
11257      * any ordering of fields in the XML.
11258      *)
11259     pr "let parse_%s x =\n" name;
11260     pr "  let t = (\n    ";
11261     let comma = ref false in
11262     List.iter (
11263       fun x ->
11264         if !comma then pr ",\n    ";
11265         comma := true;
11266         match x with
11267         | Optional (Attribute (fname, [field])), pa ->
11268             pr "%s x" pa
11269         | Optional (Element (fname, [field])), pa ->
11270             pr "%s (optional_child %S x)" pa fname
11271         | Attribute (fname, [Text]), _ ->
11272             pr "attribute %S x" fname
11273         | (ZeroOrMore _ | OneOrMore _), pa ->
11274             pr "%s x" pa
11275         | Text, pa ->
11276             pr "%s x" pa
11277         | (field, pa) ->
11278             let fname = name_of_field field in
11279             pr "%s (child %S x)" pa fname
11280     ) (List.combine fields pas);
11281     pr "\n  ) in\n";
11282
11283     (match fields with
11284      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
11285          pr "  t\n"
11286
11287      | _ ->
11288          pr "  (Obj.magic t : %s)\n" name
11289 (*
11290          List.iter (
11291            function
11292            | (Optional (Attribute (fname, [field])), pa) ->
11293                pr "  %s_%s =\n" name fname;
11294                pr "    %s x;\n" pa
11295            | (Optional (Element (fname, [field])), pa) ->
11296                pr "  %s_%s =\n" name fname;
11297                pr "    (let x = optional_child %S x in\n" fname;
11298                pr "     %s x);\n" pa
11299            | (field, pa) ->
11300                let fname = name_of_field field in
11301                pr "  %s_%s =\n" name fname;
11302                pr "    (let x = child %S x in\n" fname;
11303                pr "     %s x);\n" pa
11304          ) (List.combine fields pas);
11305          pr "}\n"
11306 *)
11307     );
11308     sprintf "parse_%s" name
11309   in
11310
11311   generate_parsers xs
11312
11313 (* Generate ocaml/guestfs_inspector.mli. *)
11314 let generate_ocaml_inspector_mli () =
11315   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11316
11317   pr "\
11318 (** This is an OCaml language binding to the external [virt-inspector]
11319     program.
11320
11321     For more information, please read the man page [virt-inspector(1)].
11322 *)
11323
11324 ";
11325
11326   generate_types grammar;
11327   pr "(** The nested information returned from the {!inspect} function. *)\n";
11328   pr "\n";
11329
11330   pr "\
11331 val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
11332 (** To inspect a libvirt domain called [name], pass a singleton
11333     list: [inspect [name]].  When using libvirt only, you may
11334     optionally pass a libvirt URI using [inspect ~connect:uri ...].
11335
11336     To inspect a disk image or images, pass a list of the filenames
11337     of the disk images: [inspect filenames]
11338
11339     This function inspects the given guest or disk images and
11340     returns a list of operating system(s) found and a large amount
11341     of information about them.  In the vast majority of cases,
11342     a virtual machine only contains a single operating system.
11343
11344     If the optional [~xml] parameter is given, then this function
11345     skips running the external virt-inspector program and just
11346     parses the given XML directly (which is expected to be XML
11347     produced from a previous run of virt-inspector).  The list of
11348     names and connect URI are ignored in this case.
11349
11350     This function can throw a wide variety of exceptions, for example
11351     if the external virt-inspector program cannot be found, or if
11352     it doesn't generate valid XML.
11353 *)
11354 "
11355
11356 (* Generate ocaml/guestfs_inspector.ml. *)
11357 let generate_ocaml_inspector_ml () =
11358   generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
11359
11360   pr "open Unix\n";
11361   pr "\n";
11362
11363   generate_types grammar;
11364   pr "\n";
11365
11366   pr "\
11367 (* Misc functions which are used by the parser code below. *)
11368 let first_child = function
11369   | Xml.Element (_, _, c::_) -> c
11370   | Xml.Element (name, _, []) ->
11371       failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
11372   | Xml.PCData str ->
11373       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11374
11375 let string_child_or_empty = function
11376   | Xml.Element (_, _, [Xml.PCData s]) -> s
11377   | Xml.Element (_, _, []) -> \"\"
11378   | Xml.Element (x, _, _) ->
11379       failwith (\"expected XML tag with a single PCDATA child, but got \" ^
11380                 x ^ \" instead\")
11381   | Xml.PCData str ->
11382       failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
11383
11384 let optional_child name xml =
11385   let children = Xml.children xml in
11386   try
11387     Some (List.find (function
11388                      | Xml.Element (n, _, _) when n = name -> true
11389                      | _ -> false) children)
11390   with
11391     Not_found -> None
11392
11393 let child name xml =
11394   match optional_child name xml with
11395   | Some c -> c
11396   | None ->
11397       failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
11398
11399 let attribute name xml =
11400   try Xml.attrib xml name
11401   with Xml.No_attribute _ ->
11402     failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
11403
11404 ";
11405
11406   generate_parsers grammar;
11407   pr "\n";
11408
11409   pr "\
11410 (* Run external virt-inspector, then use parser to parse the XML. *)
11411 let inspect ?connect ?xml names =
11412   let xml =
11413     match xml with
11414     | None ->
11415         if names = [] then invalid_arg \"inspect: no names given\";
11416         let cmd = [ \"virt-inspector\"; \"--xml\" ] @
11417           (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
11418           names in
11419         let cmd = List.map Filename.quote cmd in
11420         let cmd = String.concat \" \" cmd in
11421         let chan = open_process_in cmd in
11422         let xml = Xml.parse_in chan in
11423         (match close_process_in chan with
11424          | WEXITED 0 -> ()
11425          | WEXITED _ -> failwith \"external virt-inspector command failed\"
11426          | WSIGNALED i | WSTOPPED i ->
11427              failwith (\"external virt-inspector command died or stopped on sig \" ^
11428                        string_of_int i)
11429         );
11430         xml
11431     | Some doc ->
11432         Xml.parse_string doc in
11433   parse_operatingsystems xml
11434 "
11435
11436 (* This is used to generate the src/MAX_PROC_NR file which
11437  * contains the maximum procedure number, a surrogate for the
11438  * ABI version number.  See src/Makefile.am for the details.
11439  *)
11440 and generate_max_proc_nr () =
11441   let proc_nrs = List.map (
11442     fun (_, _, proc_nr, _, _, _, _) -> proc_nr
11443   ) daemon_functions in
11444
11445   let max_proc_nr = List.fold_left max 0 proc_nrs in
11446
11447   pr "%d\n" max_proc_nr
11448
11449 let output_to filename k =
11450   let filename_new = filename ^ ".new" in
11451   chan := open_out filename_new;
11452   k ();
11453   close_out !chan;
11454   chan := Pervasives.stdout;
11455
11456   (* Is the new file different from the current file? *)
11457   if Sys.file_exists filename && files_equal filename filename_new then
11458     unlink filename_new                 (* same, so skip it *)
11459   else (
11460     (* different, overwrite old one *)
11461     (try chmod filename 0o644 with Unix_error _ -> ());
11462     rename filename_new filename;
11463     chmod filename 0o444;
11464     printf "written %s\n%!" filename;
11465   )
11466
11467 let perror msg = function
11468   | Unix_error (err, _, _) ->
11469       eprintf "%s: %s\n" msg (error_message err)
11470   | exn ->
11471       eprintf "%s: %s\n" msg (Printexc.to_string exn)
11472
11473 (* Main program. *)
11474 let () =
11475   let lock_fd =
11476     try openfile "HACKING" [O_RDWR] 0
11477     with
11478     | Unix_error (ENOENT, _, _) ->
11479         eprintf "\
11480 You are probably running this from the wrong directory.
11481 Run it from the top source directory using the command
11482   src/generator.ml
11483 ";
11484         exit 1
11485     | exn ->
11486         perror "open: HACKING" exn;
11487         exit 1 in
11488
11489   (* Acquire a lock so parallel builds won't try to run the generator
11490    * twice at the same time.  Subsequent builds will wait for the first
11491    * one to finish.  Note the lock is released implicitly when the
11492    * program exits.
11493    *)
11494   (try lockf lock_fd F_LOCK 1
11495    with exn ->
11496      perror "lock: HACKING" exn;
11497      exit 1);
11498
11499   check_functions ();
11500
11501   output_to "src/guestfs_protocol.x" generate_xdr;
11502   output_to "src/guestfs-structs.h" generate_structs_h;
11503   output_to "src/guestfs-actions.h" generate_actions_h;
11504   output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
11505   output_to "src/guestfs-actions.c" generate_client_actions;
11506   output_to "src/guestfs-bindtests.c" generate_bindtests;
11507   output_to "src/guestfs-structs.pod" generate_structs_pod;
11508   output_to "src/guestfs-actions.pod" generate_actions_pod;
11509   output_to "src/guestfs-availability.pod" generate_availability_pod;
11510   output_to "src/MAX_PROC_NR" generate_max_proc_nr;
11511   output_to "src/libguestfs.syms" generate_linker_script;
11512   output_to "daemon/actions.h" generate_daemon_actions_h;
11513   output_to "daemon/stubs.c" generate_daemon_actions;
11514   output_to "daemon/names.c" generate_daemon_names;
11515   output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
11516   output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
11517   output_to "capitests/tests.c" generate_tests;
11518   output_to "fish/cmds.c" generate_fish_cmds;
11519   output_to "fish/completion.c" generate_fish_completion;
11520   output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
11521   output_to "ocaml/guestfs.mli" generate_ocaml_mli;
11522   output_to "ocaml/guestfs.ml" generate_ocaml_ml;
11523   output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
11524   output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
11525   output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
11526   output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
11527   output_to "perl/Guestfs.xs" generate_perl_xs;
11528   output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
11529   output_to "perl/bindtests.pl" generate_perl_bindtests;
11530   output_to "python/guestfs-py.c" generate_python_c;
11531   output_to "python/guestfs.py" generate_python_py;
11532   output_to "python/bindtests.py" generate_python_bindtests;
11533   output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
11534   output_to "ruby/bindtests.rb" generate_ruby_bindtests;
11535   output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
11536
11537   List.iter (
11538     fun (typ, jtyp) ->
11539       let cols = cols_of_struct typ in
11540       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
11541       output_to filename (generate_java_struct jtyp cols);
11542   ) java_structs;
11543
11544   output_to "java/Makefile.inc" generate_java_makefile_inc;
11545   output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
11546   output_to "java/Bindtests.java" generate_java_bindtests;
11547   output_to "haskell/Guestfs.hs" generate_haskell_hs;
11548   output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
11549   output_to "csharp/Libguestfs.cs" generate_csharp;
11550
11551   (* Always generate this file last, and unconditionally.  It's used
11552    * by the Makefile to know when we must re-run the generator.
11553    *)
11554   let chan = open_out "src/stamp-generator" in
11555   fprintf chan "1\n";
11556   close_out chan;
11557
11558   printf "generated %d lines of code\n" !lines